From 79770ff31dda3ab66736c49261f211be1f18a5ec Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 7 Mar 2022 21:03:56 +0000 Subject: [PATCH] fpexif: Support write-back of XMP git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8202 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/metadata_viewer/mdvmain.lfm | 65 ++++++++++++-- .../examples/metadata_viewer/mdvmain.pas | 84 ++++++++++++++++--- components/fpexif/fpemetadata.pas | 26 ++++-- components/fpexif/fpexif_pkg.lpk | 6 +- components/fpexif/fpexif_pkg.pas | 2 +- components/fpexif/fpexmpdata.pas | 49 ++++------- 6 files changed, 175 insertions(+), 57 deletions(-) diff --git a/components/fpexif/examples/metadata_viewer/mdvmain.lfm b/components/fpexif/examples/metadata_viewer/mdvmain.lfm index c1adb728f..96f37853f 100644 --- a/components/fpexif/examples/metadata_viewer/mdvmain.lfm +++ b/components/fpexif/examples/metadata_viewer/mdvmain.lfm @@ -141,9 +141,9 @@ object MainForm: TMainForm Height = 539 Top = 23 Width = 647 - ActivePage = PgMetadata + ActivePage = PgXMP Align = alClient - TabIndex = 0 + TabIndex = 1 TabOrder = 1 OnChange = PageControl1Change object PgMetadata: TTabSheet @@ -247,9 +247,9 @@ object MainForm: TMainForm Caption = 'XMP' ClientHeight = 511 ClientWidth = 639 - inline SynEdit: TSynEdit + inline XMPSynEdit: TSynEdit Left = 0 - Height = 231 + Height = 206 Top = 280 Width = 639 Align = alClient @@ -690,7 +690,7 @@ object MainForm: TMainForm MouseTextActions = <> MouseSelActions = <> Lines.Strings = ( - 'SynEdit' + 'XMPSynEdit' ) VisibleSpecialChars = [vscSpace, vscTabAtLast] SelectedColor.BackPriority = 50 @@ -763,6 +763,7 @@ object MainForm: TMainForm Caption = 'Value' Width = 435 end> + ReadOnly = True TabOrder = 1 ViewStyle = vsReport end @@ -775,6 +776,60 @@ object MainForm: TMainForm Align = alTop ResizeAnchor = akTop end + object Panel5: TPanel + Left = 0 + Height = 25 + Top = 486 + Width = 639 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + ClientHeight = 25 + ClientWidth = 639 + TabOrder = 3 + object btnApplyChangesXMP: TButton + AnchorSideLeft.Control = cbProcessXMP + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel5 + Left = 149 + Height = 25 + Top = 0 + Width = 104 + AutoSize = True + BorderSpacing.Left = 16 + Caption = 'Apply changes' + OnClick = btnApplyChangesXMPClick + TabOrder = 0 + end + object btnSaveXMP: TButton + AnchorSideLeft.Control = btnApplyChangesXMP + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel5 + Left = 257 + Height = 25 + Top = 0 + Width = 50 + AutoSize = True + BorderSpacing.Left = 4 + Caption = 'Save' + OnClick = btnSaveXMPClick + TabOrder = 1 + end + object cbProcessXMP: TCheckBox + AnchorSideLeft.Control = Panel5 + AnchorSideTop.Control = Panel5 + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 19 + Top = 3 + Width = 125 + BorderSpacing.Left = 8 + Caption = 'Load && display XMP' + Checked = True + State = cbChecked + TabOrder = 2 + end + end end object PgImage: TTabSheet Caption = 'Image' diff --git a/components/fpexif/examples/metadata_viewer/mdvmain.pas b/components/fpexif/examples/metadata_viewer/mdvmain.pas index 3b05c83e2..0bb05afd7 100644 --- a/components/fpexif/examples/metadata_viewer/mdvmain.pas +++ b/components/fpexif/examples/metadata_viewer/mdvmain.pas @@ -15,14 +15,18 @@ type TMainForm = class(TForm) BtnChangeDate: TButton; + btnApplyChangesXMP: TButton; + btnSaveXMP: TButton; CbDecodeMakerNotes: TCheckBox; CbShowTagIDs: TCheckBox; CbShowParentTagID: TCheckBox; + cbProcessXMP: TCheckBox; EdChangeDate: TEdit; FilenameInfo: TLabel; Image: TImage; Label1: TLabel; LblChangeDate: TLabel; + Panel5: TPanel; XMPListView: TListView; Messages: TMemo; PageControl1: TPageControl; @@ -39,7 +43,7 @@ type PgMetadata: TTabSheet; PgImage: TTabSheet; PgXMP: TTabSheet; - SynEdit: TSynEdit; + XMPSynEdit: TSynEdit; SynXMLSyn: TSynXMLSyn; TagListView: TListView; ShellPanel: TPanel; @@ -47,7 +51,9 @@ type ShellTreeView: TShellTreeView; Splitter1: TSplitter; Splitter2: TSplitter; + procedure btnApplyChangesXMPClick(Sender: TObject); procedure BtnChangeDateClick(Sender: TObject); + procedure btnSaveXMPClick(Sender: TObject); procedure CbShowTagIDsChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); @@ -67,6 +73,7 @@ type FFileName: String; procedure LoadFile(const AFileName: String); procedure LoadFromIni; + procedure LoadXMPTags; procedure SaveToIni; procedure UpdateCaption; @@ -222,6 +229,37 @@ begin FImgInfo.SaveToFile(fn); end; +procedure TMainForm.btnApplyChangesXMPClick(Sender: TObject); +var + ms: TMemoryStream; +begin + if Assigned(FImgInfo) and FImgInfo.HasXMP then + begin + ms := TMemoryStream.Create; + try + XMPSynEdit.Lines.SaveToStream(ms); + ms.Position := 0; + FImgInfo.XMPData.LoadFromStream(ms); + LoadXMPTags; + finally + ms.Free; + end; + end; +end; + +procedure TMainForm.btnSaveXMPClick(Sender: TObject); +var + fn: String; +begin + if Assigned(FImgInfo) then + begin + fn := FImgInfo.FileName; + fn := ChangeFileExt(fn, '') + '_modified' + ExtractFileExt(fn); + FImgInfo.SaveToFile(fn); + ShowMessage('Modified image saved as ' + fn); + end; +end; + procedure TMainForm.CbShowTagIDsChange(Sender: TObject); var c: TListColumn; @@ -254,7 +292,6 @@ end; procedure TMainForm.LoadFile(const AFileName: String); var lTag: TTag; - xmpTag: String; item: TListItem; i: Integer; ms: TMemoryStream; @@ -276,6 +313,10 @@ begin FImgInfo.MetadataKinds := FImgInfo.MetadataKinds + [mdkExif] - [mdkExifNoMakerNotes] else FImgInfo.MetadataKinds := FImgInfo.MetadataKinds - [mdkExif] + [mdkExifNoMakerNotes]; + if CbProcessXMP.Checked then + FImgInfo.MetadataKinds := FImgInfo.MetaDataKinds + [mdkXMP] + else + FImgInfo.MetadataKinds := FImgInfo.MetaDataKinds - [mdkXMP]; FImgInfo.LoadFromFile(AFileName); Messages.Hide; except @@ -324,17 +365,18 @@ begin if FImgInfo.HasXMP then begin ms := TMemoryStream.Create; - FImgInfo.XMPData.SaveToStream(ms); - ms.Position := 0; - SynEdit.Lines.LoadFromStream(ms); - - XMPListView.Clear; - for i := 0 to FImgInfo.XMPData.TagCount-1 do begin - xmpTag := FImgInfo.XMPData.TagByIndex[i]; - item := XMPListView.Items.Add; - item.Caption := Copy(xmptag, 1, pos('=', xmptag)-1); - item.SubItems.Add(copy(xmptag, pos('=', xmptag)+1)); + try + FImgInfo.XMPData.SaveToStream(ms); + ms.Position := 0; + XMPSynEdit.Lines.LoadFromStream(ms); + LoadXMPTags; + finally + ms.Free; end; + end else + begin + XMPListView.Clear; + XMPSynEdit.Clear; end; if FImgInfo.HasIptc then begin @@ -444,6 +486,24 @@ begin end; end; +procedure TMainForm.LoadXMPTags; +var + i: Integer; + item: TListItem; +begin + XMPListView.Items.BeginUpdate; + try + XMPListView.Items.Clear; + for i := 0 to FImgInfo.XMPData.TagCount-1 do begin + item := XMPListView.Items.Add; + item.Caption := FImgInfo.XMPData.TagName[i]; + item.SubItems.Add(FImgInfo.XMPData.TagByIndex[i]); + end; + finally + XMPListView.Items.EndUpdate; + end; +end; + procedure TMainForm.PageControl1Change(Sender: TObject); var crs: TCursor; diff --git a/components/fpexif/fpemetadata.pas b/components/fpexif/fpemetadata.pas index b7181f94a..6758e1a90 100644 --- a/components/fpexif/fpemetadata.pas +++ b/components/fpexif/fpemetadata.pas @@ -127,7 +127,7 @@ implementation uses Variants, - fpeStrConsts, fpeUtils, fpeExifReadWrite, fpeIptcReadWrite; + fpeStrConsts, fpeUtils, fpeExifReadWrite, fpeXMPReadWrite, fpeIptcReadWrite; type TJpegJFIFSegment = packed record @@ -433,7 +433,7 @@ begin AInputStream.Position := 0; - // Now write copy all other segments. + // Now copy all other segments. AInputStream.Position := 0; while AInputStream.Position < AInputStream.Size do begin savedPos := AInputStream.Position; // just for debugging @@ -467,8 +467,11 @@ begin M_JFIF, M_IPTC, M_COM: // These segments were already written by WriteJpeg ; M_EXIF: + // XMP segment found which has the same key $E1 as the normal EXIF segment. + // Needs to be copied to the destination file if it has not been handled + // by XMPData. + if not (mdkXMP in FMetadataKinds) then begin - // XMP segment found which has the same key $E1 as the normal EXIF segment. SetLength(s, Length(XMP_SIGNATURE)); AInputStream.Read(s[1], Length(XMP_SIGNATURE)); if s = XMP_SIGNATURE then @@ -564,11 +567,11 @@ begin reader.Free; end; end else - if HasXMPHeader(AStream) then + if HasXMPHeader(AStream) and (mdkXMP in FMetadataKinds) then begin FXmpData := CreateXMPData; try - FXmpData.ReadFromStream(AStream, size - Length(XMP_KEY)); + FXmpData.LoadFromStream(AStream, size - Length(XMP_KEY)); except FreeAndNil(FXmpData); raise; @@ -811,7 +814,18 @@ begin writer.Free; end; end; - + + // XMP --> Write another APP1 segment + if (mdkXMP in FMetadataKinds) and HasXMP then + begin + writer := TXMPWriter.Create(Self); + try + TXMPWriter(writer).WriteToStream(AStream, ifJpeg); + finally + writer.Free; + end; + end; + // Write IPTCSegment (APP13) if (mdkIPTC in FMetadataKinds) and HasIPTC then begin writer := TIptcWriter.Create(Self); diff --git a/components/fpexif/fpexif_pkg.lpk b/components/fpexif/fpexif_pkg.lpk index 2c16f7fed..74184fe29 100644 --- a/components/fpexif/fpexif_pkg.lpk +++ b/components/fpexif/fpexif_pkg.lpk @@ -12,7 +12,7 @@ - + @@ -97,6 +97,10 @@ + + + + diff --git a/components/fpexif/fpexif_pkg.pas b/components/fpexif/fpexif_pkg.pas index 21661443d..df073fdc0 100644 --- a/components/fpexif/fpexif_pkg.pas +++ b/components/fpexif/fpexif_pkg.pas @@ -12,7 +12,7 @@ uses fpeIptcReadWrite, fpeExifData, fpeIptcData, fpeStrConsts, fpeMakerNote, fpeMakerNoteNikon, fpeMakerNoteMinolta, fpeMakerNoteOlympus, fpeMakerNoteEpson, fpeMakerNoteFuji, fpeMakerNoteSanyo, fpeMakerNoteCasio, - fpeMakerNoteCanon, fpeXMPData; + fpeMakerNoteCanon, fpeXMPData, fpeXMPReadWrite; implementation diff --git a/components/fpexif/fpexmpdata.pas b/components/fpexif/fpexmpdata.pas index 22a6f99aa..e51513a14 100644 --- a/components/fpexif/fpexmpdata.pas +++ b/components/fpexif/fpexmpdata.pas @@ -11,19 +11,15 @@ uses {$ENDIF} fpeGlobal, fpeTags; -const - XMP_BASE_KEY = 'http://ns.adobe.com/xap/1.0/'; - XMP_KEY = XMP_BASE_KEY + #0; - type TXMPData = class private FData: String; FDoc: TXMLDocument; FTags: TStringList; -// FTags: TTagList; function GetTagByIndex(AIndex: Integer): String; function GetTagByName(ATagName: String): String; + function GetTagName(AIndex: Integer): String; function GetTagCount: Integer; protected {$IFDEF FPC} @@ -33,38 +29,23 @@ type public constructor Create; destructor Destroy; override; - procedure ReadFromStream(AStream: TStream; ASize: Integer = -1); + procedure LoadFromStream(AStream: TStream; ASize: Integer = -1); procedure SaveToStream(AStream: TStream); property TagByIndex[AIndex: Integer]: String read GetTagByIndex; property TagByName[ATagName: String]: String read GetTagByName; + property TagName[AIndex: Integer]: String read GetTagName; property TagCount: Integer read GetTagCount; end; -function HasXMPHeader(AStream: TStream): Boolean; - implementation - -function HasXMPHeader(AStream: TStream): Boolean; -var - p: Int64; - hdr: array of ansichar; -begin - p := AStream.Position; - SetLength(hdr, Length(XMP_KEY)); - AStream.Read(hdr[0], Length(XMP_KEY)); - Result := CompareMem(@hdr[0], @XMP_KEY[1], Length(XMP_KEY)); - if not Result then - AStream.Position := p; -end; - { TXMPData } constructor TXMPData.Create; begin inherited; - FTags := TStringList.Create; //TTagList.Create; + FTags := TStringList.Create; end; destructor TXMPData.Destroy; @@ -83,7 +64,7 @@ var nodeName: String; i: Integer; attr: TDOMNode; - tagName, tagValue: String; + lTagName, lTagValue: String; lTag: TTag; begin while ANode <> nil do begin @@ -91,9 +72,9 @@ begin for i := 0 to ANode.Attributes.Length-1 do begin attr := ANode.Attributes.Item[i]; - tagName := attr.NodeName; - tagValue := attr.NodeValue; - FTags.Add(tagName + '=' + tagValue); + lTagName := attr.NodeName; + lTagValue := attr.NodeValue; + FTags.Add(lTagName + '=' + lTagValue); end; if ANode.HasChildNodes then begin @@ -101,9 +82,9 @@ begin while node <> nil do begin nodeName := node.NodeName; - tagValue := node.TextContent; - if tagName <> '' then - FTags.Add(nodeName + '=' + tagValue); + lTagValue := node.TextContent; + if lTagName <> '' then + FTags.Add(nodeName + '=' + lTagValue); node := node.NextSibling; end; end; @@ -111,7 +92,6 @@ begin end; end; - procedure TXMPData.CreateTags; var stream: TStringStream; @@ -161,7 +141,12 @@ begin Result := FTags.Count; end; -procedure TXMPData.ReadFromStream(AStream: TStream; ASize: Integer = -1); +function TXMPData.GetTagName(AIndex: Integer): String; +begin + Result := FTags.Names[AIndex]; +end; + +procedure TXMPData.LoadFromStream(AStream: TStream; ASize: Integer = -1); var p: Int64; begin