pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpexif: Fix some errors with various test images.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6090 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-12-06 22:12:10 +00:00
parent d4e1105bb9
commit 824c594816
10 changed files with 249 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
components/fpexif/examples/metadata_viewer/MetadataViewer.lpi
View File

@ -59,6 +59,11 @@
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>

109
components/fpexif/examples/metadata_viewer/mdvmain.lfm
View File

@ -89,11 +89,46 @@ object MainForm: TMainForm
ClientHeight = 691
ClientWidth = 647
TabOrder = 2
object TagListView: TListView
object Panel3: TPanel
Left = 0
Height = 668
Height = 23
Top = 0
Width = 647
Align = alTop
AutoSize = True
BevelOuter = bvNone
BorderWidth = 4
ClientHeight = 23
ClientWidth = 647
TabOrder = 0
object FilenameInfo: TLabel
Left = 4
Height = 15
Top = 4
Width = 24
Caption = 'File: '
ParentColor = False
end
end
object PageControl1: TPageControl
Left = 0
Height = 573
Top = 23
Width = 647
ActivePage = PgImage
Align = alClient
TabIndex = 1
TabOrder = 1
OnChange = PageControl1Change
object PgMetadata: TTabSheet
Caption = 'Meta data'
ClientHeight = 640
ClientWidth = 639
object TagListView: TListView
Left = 0
Height = 640
Top = 0
Width = 639
Align = alClient
AutoSort = False
Columns = <
@ -120,28 +155,68 @@ object MainForm: TMainForm
OnCompare = TagListViewCompare
OnSelectItem = TagListViewSelectItem
end
object Panel3: TPanel
end
object PgImage: TTabSheet
Caption = 'Image'
ClientHeight = 545
ClientWidth = 639
object Image: TImage
Left = 0
Height = 23
Height = 517
Top = 0
Width = 647
Align = alTop
Width = 639
Align = alClient
Center = True
Proportional = True
Stretch = True
StretchOutEnabled = False
end
object Panel1: TPanel
Left = 0
Height = 28
Top = 517
Width = 639
Align = alBottom
AutoSize = True
BevelOuter = bvNone
BorderWidth = 4
ClientHeight = 23
ClientWidth = 647
TabOrder = 1
object FilenameInfo: TLabel
Left = 4
Height = 15
Top = 4
Width = 24
Caption = 'File: '
ParentColor = False
ClientHeight = 28
ClientWidth = 639
TabOrder = 0
Visible = False
object CheckBox1: TCheckBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
Left = 0
Height = 19
Top = 5
Width = 127
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
Caption = 'Decode MakerNotes'
TabOrder = 0
end
end
end
end
object Messages: TMemo
Left = 0
Height = 90
Top = 596
Width = 647
Align = alBottom
TabOrder = 2
end
object Splitter3: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 686
Width = 647
Align = alBottom
ResizeAnchor = akBottom
end
end
object StatusBar1: TStatusBar
Left = 0
Height = 23

49
components/fpexif/examples/metadata_viewer/mdvmain.pas
View File

@ -14,12 +14,20 @@ type
{ TMainForm }
TMainForm = class(TForm)
CheckBox1: TCheckBox;
FilenameInfo: TLabel;
Image: TImage;
Messages: TMemo;
PageControl1: TPageControl;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
PreviewImage: TImage;
ImageList: TImageList;
Splitter3: TSplitter;
StatusBar1: TStatusBar;
PgMetadata: TTabSheet;
PgImage: TTabSheet;
TagListView: TListView;
ShellPanel: TPanel;
ShellListView: TShellListView;
@ -28,6 +36,7 @@ type
Splitter2: TSplitter;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
procedure ShellListViewSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure ShellTreeViewGetImageIndex(Sender: TObject; Node: TTreeNode);
@ -38,6 +47,7 @@ type
Selected: Boolean);
private
FImgInfo: TImgInfo;
FImageLoaded: Boolean;
procedure LoadFile(const AFileName: String);
procedure LoadFromIni;
procedure SaveToIni;
@ -94,6 +104,9 @@ var
i: Integer;
ms: TMemoryStream;
begin
FImageLoaded := false;
Image.Picture.Clear;
TagListView.Items.BeginUpdate;
try
TagListView.Clear;
@ -102,9 +115,12 @@ begin
try
try
FImgInfo.LoadFromFile(AFileName);
Messages.Hide;
except
on E:EFpExif do
MessageDlg(E.Message, mtError, [mbOK], 0);
on E:EFpExif do begin
Messages.Lines.Text := E.Message;
Messages.Show;
end;
end;
if FImgInfo.HasExif then begin
FImgInfo.ExifData.ExportOptions := FImgInfo.ExifData.ExportOptions + [eoTruncateBinary];
@ -136,12 +152,24 @@ begin
finally
ms.Free;
end;
end else
PreviewImage.Picture.Clear;
if FImgInfo.HasWarnings then begin
Messages.Lines.Text := FImgInfo.Warnings;
Messages.Show;
end;
if PageControl1.ActivePage = PgImage then begin
Image.Picture.LoadfromFile(AFileName);
FImageLoaded := true;
end;
if FImgInfo.HasWarnings then
MessageDlg(FImgInfo.Warnings, mtWarning, [mbOK], 0);
except
on E:Exception do begin
FreeAndNil(FImgInfo);
raise;
Messages.Lines.Text := E.Message;
Messages.Show;
end;
end;
UpdateCaption;
finally
@ -191,6 +219,17 @@ begin
end;
end;
procedure TMainForm.PageControl1Change(Sender: TObject);
begin
if FImgInfo = nil then
exit;
if not FImageLoaded then begin
Image.Picture.LoadfromFile(FImgInfo.FileName);
FImageLoaded := true;
end;
end;
procedure TMainForm.SaveToIni;
var
ini: TCustomIniFile;

2
components/fpexif/fpeexifreadwrite.pas
View File

@ -336,6 +336,7 @@ begin
ifdRec.DataCount := FixEndian32(ifdRec.DataCount);
// ifRec.DataValue will be converted later.
byteCount := Integer(ifdRec.DataCount) * TagElementSize[ifdRec.DataType];
if byteCount > 0 then begin
SetLength(data, bytecount);
if byteCount <= 4 then
Move(ifdRec.DataValue, data[0], byteCount)
@ -352,6 +353,7 @@ begin
ReadIFD(AStream, ifdRec.TagID shl 16);
end;
end;
end;
tagPos := tagPos + SizeOf(TIFDRecord);
end;

5
components/fpexif/fpeiptcdata.pas
View File

@ -330,6 +330,7 @@ begin
AIdentifier := block.Identifier;
AName := block.Name;
SetLength(AData, Length(block.Data));
if Length(block.Data) > 0 then
Move(block.Data[0], AData[0], Length(AData));
end;
@ -580,7 +581,9 @@ procedure TIptcDateTag.SetAsString(const AValue: String);
var
d: TDateTime;
fmt: String;
{$IFNDEF FPC}
fs: TFormatSettings;
{$ENDIF}
begin
fmt := GetFormat;
if fmt = IPTC_DATE_FORMAT then
@ -642,7 +645,9 @@ procedure TIptcTimeTag.SetAsString(const AValue: String);
var
t: TDateTime;
fmt: String;
{$IFNDEF FPC}
fs: TFormatSettings;
{$ENDIF}
begin
fmt := GetFormat;
if fmt = IPTC_TIME_FORMAT then

5
components/fpexif/fpeiptcreadwrite.pas
View File

@ -118,7 +118,9 @@ var
tagID: TTagID;
s: String;
w: Word;
{$IFNDEF FPC}
sa: ansistring;
{$ENDIF}
begin
Result := nil;
@ -253,6 +255,9 @@ begin
AName := s;
end;
lSize := BEToN(ReadDWord(AStream));
if lSize = 0 then
exit;
SetLength(AData, lSize);
AStream.Read(AData[0], lSize);
end;

46
components/fpexif/fpemakernote.pas
View File

@ -81,6 +81,9 @@ begin
// Put binary data into a word array and fix endianness
n := Length(AData) div TagElementSize[ord(tagDef.TagType)];
if n = 0 then
exit;
if FBigEndian then
for i:=0 to n-1 do AData[i] := BEtoN(AData[i])
else
@ -94,58 +97,101 @@ begin
1: // Exposure Info 1
with FImgInfo.ExifData do begin
AddMakerNoteTag(1, 1, 'Macro mode', w[1], rsCanonMacroLkup);
if n = 2 then exit;
AddMakerNoteTag(1, 2, 'Self-timer', w[2]/10, '%2:.1f s');
if n = 3 then exit;
AddMakerNoteTag(1, 3, 'Quality', w[3], rsCanonQualityLkup);
if n = 4 then exit;
AddMakerNoteTag(1, 4, 'Flash mode', w[4], rsCanonFlashLkup);
if n = 5 then exit;
AddMakerNoteTag(1, 5, 'Drive mode', w[5], rsSingleContinuous);
if n = 7 then exit;
AddMakerNoteTag(1, 7, 'Focus mode', w[7], rsCanonFocusLkup);
if n = 9 then exit;
AddMakerNoteTag(1, 9, 'Record mode', w[9], rsCanonRecLkup);
if n = 10 then exit;
AddMakerNoteTag(1,10, 'Image size', w[10], rsCanonSizeLkup);
if n = 11 then exit;
AddMakerNoteTag(1,11, 'Easy shoot', w[11], rsCanonEasyLkup);
if n = 12 then exit;
AddMakerNoteTag(1,12, 'Digital zoom', w[12], rsCanonZoomLkup);
if n = 13 then exit;
AddMakerNoteTag(1,13, 'Contrast', w[13], rsCanonGenLkup);
if n = 14 then exit;
AddMakerNoteTag(1,14, 'Saturation', w[14], rsCanonGenLkup);
if n = 15 then exit;
AddMakerNoteTag(1,15, 'Sharpness', w[15], rsCanonGenLkup);
if n = 16 then exit;
AddMakerNoteTag(1,16, 'CCD ISO', w[16], rsCanonISOLkup);
if n = 17 then exit;
AddMakerNoteTag(1,17, 'Metering mode', w[17], rsCanonMeterLkup);
if n = 18 then exit;
AddMakerNoteTag(1,18, 'Focus type', w[18], rsCanonFocTypeLkup);
if n = 19 then exit;
AddMakerNoteTag(1,19, 'AFPoint', w[19], rsCanonAFLkup);
if n = 20 then exit;
AddMakerNoteTag(1,20, 'Exposure mode', w[20], rsCanonExposeLkup);
if n = 24 then exit;
AddMakerNoteTag(1,24, 'Long focal', w[24]);
if n = 25 then exit;
AddMakerNoteTag(1,25, 'Short focal', w[25]);
if n = 26 then exit;
AddMakerNoteTag(1,26, 'Focal units', w[26]);
if n = 28 then exit;
AddMakerNoteTag(1,28, 'Flash activity', w[28], rsCanonFlashActLkup);
if n = 29 then exit;
AddMakerNoteTag(1,29, 'Flash details', w[29]);
if n = 32 then exit;
AddMakerNoteTag(1,32, 'Focus mode', w[32], rsSingleContinuous);
if n = 33 then exit;
AddMakerNoteTag(1,33, 'AESetting', w[33], rsCanonAELkup);
if n = 34 then exit;
AddMakerNoteTag(1,34, 'Image stabilization', w[34], rsSingleContinuous);
end;
2: // Focal length
with FImgInfo.ExifData do begin
AddMakerNoteTag(2, 0, 'FocalType', w[0], rsCanonFocalTypeLkup);
if n = 1 then exit;
AddMakerNoteTag(2, 1, 'FocalLength', w[1]);
end;
4: // ExposureInfo2
with FImgInfo.ExifData do begin
if n = 7 then exit;
AddMakerNoteTag(4, 7, 'WhiteBalance', w[7], rsCanonWhiteBalLkup);
if n = 8 then exit;
AddMakerNoteTag(4, 8, 'Slow shutter', w[8], rsCanonSloShuttLkup);
if n = 9 then exit;
AddMakerNoteTag(4, 9, 'SequenceNumber', w[9]);
if n = 11 then exit;
AddMakerNoteTag(4,11, 'OpticalZoomStep', w[11]);
if n = 12 then exit;
AddMakerNoteTag(4,12, 'Camera temperature', w[12]);
if n = 14 then exit;
AddMakerNoteTag(4,14, 'AFPoint', w[14]);
if n = 15 then exit;
AddMakerNoteTag(4,15, 'FlashBias', w[15], rsCanonBiasLkup);
if n = 19 then exit;
AddMakerNoteTag(4,19, 'Distance', w[19]);
if n = 21 then exit;
AddMakerNoteTag(4,21, 'FNumber', w[21]);
if n = 22 then exit;
AddMakerNoteTag(4,22, 'Exposure time', w[22]);
if n = 23 then exit;
AddMakerNoteTag(4,23, 'Measured EV2', w[23]);
if n = 24 then exit;
AddMakerNoteTag(4,24, 'Bulb duration', w[24]);
if n = 26 then exit;
AddMakerNoteTag(4,26, 'Camera type', w[26], rsCanonCamTypeLkup);
if n = 27 then exit;
AddMakerNoteTag(4,27, 'Auto rotation', w[27], rsCanonAutoRotLkup);
if n = 28 then exit;
AddMakerNoteTag(4,28, 'NDFilter', w[28], rsCanonGenLkup);
end;
5: // Panorma
with FImgInfo.ExifData do begin
if n = 2 then exit;
AddMakerNoteTag(5, 2, 'Panorama frame number', w[2]);
if n = 5 then exit;
AddMakerNoteTag(5, 5, 'Panorama direction', w[5], rsCanonPanDirLkup);
end;
end;

2
components/fpexif/fpemetadata.pas
View File

@ -639,7 +639,9 @@ const
var
jfifSegment: TJpegJFIFSegment;
writer: TBasicMetadataWriter;
{$IFNDEF FPC}
sa: ansistring;
{$ENDIF}
begin
// Write Start-of-image segment (SOI)
AStream.WriteBuffer(SOI_MARKER, SizeOf(SOI_MARKER));

19
components/fpexif/fpetags.pas
View File

@ -818,9 +818,10 @@ var
len: Integer;
begin
len := Length(AValue);
FCount := len div TagElementSize[ord(FType)];
SetLength(FRawData, len);
if len > 0 then
Move(AValue[0], FRawData[0], len);
FCount := len div TagElementSize[ord(FType)];
end;
procedure TTag.SetTruncBinary(const AValue: Boolean);
@ -1225,11 +1226,13 @@ var
r: TExifRational;
begin
Result := GetRational(AIndex, r);
if Result then begin
if Result and (r.Denominator <> 0) then
begin
AValue := r.Numerator / r.Denominator;
if IsInt(AValue) then
AValue := Round(AValue);
end;
end else
Result := false;
end;
function TFloatTag.GetRational(AIndex: Integer; out AValue: TExifRational): Boolean;
@ -1457,6 +1460,9 @@ begin
// Not sure what Delphi does when a unicodestring is put into FValue.
Result := '';
if Length(FRawData) = 0 then
exit;
SetLength(sa, Length(FRawData));
Move(FRawData[0], sa[1], Length(FRawData));
while (sa <> '') and (sa[Length(sa)] = #0) do
@ -1472,9 +1478,10 @@ procedure TStringTag.SetAsString(const AValue: String);
var
sa: Ansistring;
begin
if AValue = '' then
SetLength(FRawData, 0)
else
if AValue = '' then begin
SetLength(FRawData, 0);
FCount := 0;
end else
begin
sa := ansistring(AValue);
FCount := Length(sa);

1
components/fpexif/readme.txt
View File

@ -28,6 +28,7 @@ Some examples in which fpexif can be applied:
in foreign countries)
- adding GPS information to scanned photographs
- remember exposure settings of difficult photos
- extract thumbnails for a super-fast thumbnail viewer
--------------------------------------------------------------------------------