From 824c5948164725f48146cd8d77c45bd9ef7b78bc Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 6 Dec 2017 22:12:10 +0000 Subject: [PATCH] fpexif: Fix some errors with various test images. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6090 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../metadata_viewer/MetadataViewer.lpi | 5 + .../examples/metadata_viewer/mdvmain.lfm | 139 ++++++++++++++---- .../examples/metadata_viewer/mdvmain.pas | 51 ++++++- components/fpexif/fpeexifreadwrite.pas | 28 ++-- components/fpexif/fpeiptcdata.pas | 7 +- components/fpexif/fpeiptcreadwrite.pas | 5 + components/fpexif/fpemakernote.pas | 52 ++++++- components/fpexif/fpemetadata.pas | 2 + components/fpexif/fpetags.pas | 21 ++- components/fpexif/readme.txt | 1 + 10 files changed, 249 insertions(+), 62 deletions(-) diff --git a/components/fpexif/examples/metadata_viewer/MetadataViewer.lpi b/components/fpexif/examples/metadata_viewer/MetadataViewer.lpi index 24703615c..ec6c2b461 100644 --- a/components/fpexif/examples/metadata_viewer/MetadataViewer.lpi +++ b/components/fpexif/examples/metadata_viewer/MetadataViewer.lpi @@ -59,6 +59,11 @@ + + + + + diff --git a/components/fpexif/examples/metadata_viewer/mdvmain.lfm b/components/fpexif/examples/metadata_viewer/mdvmain.lfm index a59782920..36665a33c 100644 --- a/components/fpexif/examples/metadata_viewer/mdvmain.lfm +++ b/components/fpexif/examples/metadata_viewer/mdvmain.lfm @@ -89,37 +89,6 @@ object MainForm: TMainForm ClientHeight = 691 ClientWidth = 647 TabOrder = 2 - object TagListView: TListView - Left = 0 - Height = 668 - Top = 23 - Width = 647 - Align = alClient - AutoSort = False - Columns = < - item - Caption = 'Group' - Width = 120 - end - item - Caption = 'Property' - Width = 220 - end - item - AutoSize = True - Caption = 'Value' - Width = 44 - end> - HideSelection = False - ReadOnly = True - RowSelect = True - SortColumn = 0 - SortType = stText - TabOrder = 0 - ViewStyle = vsReport - OnCompare = TagListViewCompare - OnSelectItem = TagListViewSelectItem - end object Panel3: TPanel Left = 0 Height = 23 @@ -131,7 +100,7 @@ object MainForm: TMainForm BorderWidth = 4 ClientHeight = 23 ClientWidth = 647 - TabOrder = 1 + TabOrder = 0 object FilenameInfo: TLabel Left = 4 Height = 15 @@ -141,6 +110,112 @@ object MainForm: TMainForm 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 = < + item + Caption = 'Group' + Width = 120 + end + item + Caption = 'Property' + Width = 220 + end + item + AutoSize = True + Caption = 'Value' + Width = 44 + end> + HideSelection = False + ReadOnly = True + RowSelect = True + SortColumn = 0 + SortType = stText + TabOrder = 0 + ViewStyle = vsReport + OnCompare = TagListViewCompare + OnSelectItem = TagListViewSelectItem + end + end + object PgImage: TTabSheet + Caption = 'Image' + ClientHeight = 545 + ClientWidth = 639 + object Image: TImage + Left = 0 + Height = 517 + Top = 0 + 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 + 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 diff --git a/components/fpexif/examples/metadata_viewer/mdvmain.pas b/components/fpexif/examples/metadata_viewer/mdvmain.pas index 4b4378054..948843f4d 100644 --- a/components/fpexif/examples/metadata_viewer/mdvmain.pas +++ b/components/fpexif/examples/metadata_viewer/mdvmain.pas @@ -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 - FreeAndNil(FImgInfo); - raise; + on E:Exception do begin + FreeAndNil(FImgInfo); + 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; diff --git a/components/fpexif/fpeexifreadwrite.pas b/components/fpexif/fpeexifreadwrite.pas index 634dbb2ac..b75163b49 100644 --- a/components/fpexif/fpeexifreadwrite.pas +++ b/components/fpexif/fpeexifreadwrite.pas @@ -336,20 +336,22 @@ begin ifdRec.DataCount := FixEndian32(ifdRec.DataCount); // ifRec.DataValue will be converted later. byteCount := Integer(ifdRec.DataCount) * TagElementSize[ifdRec.DataType]; - SetLength(data, bytecount); - if byteCount <= 4 then - Move(ifdRec.DataValue, data[0], byteCount) - else begin - AStream.Position := FStartPosition + FixEndian32(ifdRec.DataValue); - AStream.Read(data[0], byteCount); - end; - AddTag(AStream, ifdRec, data, AParent); + if byteCount > 0 then begin + SetLength(data, bytecount); + if byteCount <= 4 then + Move(ifdRec.DataValue, data[0], byteCount) + else begin + AStream.Position := FStartPosition + FixEndian32(ifdRec.DataValue); + AStream.Read(data[0], byteCount); + end; + AddTag(AStream, ifdRec, data, AParent); - if ifdRec.DataType = ord(ttIFD) then begin - newPos := FStartPosition + FixEndian32(ifdRec.DataValue); - if newPos < AStream.Size then begin - AStream.Position := newPos; - ReadIFD(AStream, ifdRec.TagID shl 16); + if ifdRec.DataType = ord(ttIFD) then begin + newPos := FStartPosition + FixEndian32(ifdRec.DataValue); + if newPos < AStream.Size then begin + AStream.Position := newPos; + ReadIFD(AStream, ifdRec.TagID shl 16); + end; end; end; diff --git a/components/fpexif/fpeiptcdata.pas b/components/fpexif/fpeiptcdata.pas index f82d0fb26..58b01288d 100644 --- a/components/fpexif/fpeiptcdata.pas +++ b/components/fpexif/fpeiptcdata.pas @@ -330,7 +330,8 @@ begin AIdentifier := block.Identifier; AName := block.Name; SetLength(AData, Length(block.Data)); - Move(block.Data[0], AData[0], Length(AData)); + if Length(block.Data) > 0 then + Move(block.Data[0], AData[0], Length(AData)); end; function TIptcData.GetImageResourceBlockCount: Integer; @@ -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 diff --git a/components/fpexif/fpeiptcreadwrite.pas b/components/fpexif/fpeiptcreadwrite.pas index 5502ff953..bb98abddc 100644 --- a/components/fpexif/fpeiptcreadwrite.pas +++ b/components/fpexif/fpeiptcreadwrite.pas @@ -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; diff --git a/components/fpexif/fpemakernote.pas b/components/fpexif/fpemakernote.pas index 72a31b545..f179e714f 100644 --- a/components/fpexif/fpemakernote.pas +++ b/components/fpexif/fpemakernote.pas @@ -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); - AddMakerNoteTag(1,19, 'AFPoint', w[19], rsCanonAFLkup); + 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); - AddMakerNoteTag(1,33, 'AESetting', w[33], rsCanonAELkup); + 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]); - AddMakerNoteTag(4,14, 'AFPoint', w[14]); + 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; diff --git a/components/fpexif/fpemetadata.pas b/components/fpexif/fpemetadata.pas index d385862a1..085413e54 100644 --- a/components/fpexif/fpemetadata.pas +++ b/components/fpexif/fpemetadata.pas @@ -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)); diff --git a/components/fpexif/fpetags.pas b/components/fpexif/fpetags.pas index d56e12947..1dd33f9f5 100644 --- a/components/fpexif/fpetags.pas +++ b/components/fpexif/fpetags.pas @@ -818,9 +818,10 @@ var len: Integer; begin len := Length(AValue); - FCount := len div TagElementSize[ord(FType)]; SetLength(FRawData, len); - Move(AValue[0], FRawData[0], 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); diff --git a/components/fpexif/readme.txt b/components/fpexif/readme.txt index 214c1cb41..24d006c16 100644 --- a/components/fpexif/readme.txt +++ b/components/fpexif/readme.txt @@ -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 --------------------------------------------------------------------------------