fpexif: Support write-back of XMP

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8202 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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'

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);
+        try
-        ms.Position := 0;
+          FImgInfo.XMPData.SaveToStream(ms);
-        SynEdit.Lines.LoadFromStream(ms);
+          ms.Position := 0;
-        
+          XMPSynEdit.Lines.LoadFromStream(ms);
-        XMPListView.Clear;
+          LoadXMPTags;
-        for i := 0 to FImgInfo.XMPData.TagCount-1 do begin
+        finally
-          xmpTag := FImgInfo.XMPData.TagByIndex[i];
+          ms.Free;
-          item := XMPListView.Items.Add;
-          item.Caption := Copy(xmptag, 1, pos('=', xmptag)-1);
-          item.SubItems.Add(copy(xmptag, pos('=', xmptag)+1));
         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;

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);

components/fpexif/fpexif_pkg.lpk

@@ -12,7 +12,7 @@
     <Description Value="Library for displaying and editing of meta data (EXIF, IPTC) in images."/>
     <License Value="LGPL with linking exception (like Lazarus)"/>
     <Version Minor="1"/>
-    <Files Count="21">
+    <Files Count="22">
       <Item1>
         <Filename Value="fpeglobal.pas"/>
         <UnitName Value="fpeGlobal"/>
@@ -97,6 +97,10 @@
         <Filename Value="fpexmpdata.pas"/>
         <UnitName Value="fpeXMPData"/>
       </Item21>
+      <Item22>
+        <Filename Value="fpexmpreadwrite.pas"/>
+        <UnitName Value="fpeXMPReadWrite"/>
+      </Item22>
     </Files>
     <CompatibilityMode Value="True"/>
     <i18n>

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
 

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;
+      lTagName := attr.NodeName;
-      tagValue := attr.NodeValue;
+      lTagValue := attr.NodeValue;
-      FTags.Add(tagName + '=' + tagValue);
+      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;
+        lTagValue := node.TextContent;
-        if tagName <> '' then
+        if lTagName <> '' then
-          FTags.Add(nodeName + '=' + tagValue);
+          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