diff --git a/components/fpexif/delphi examples/metadata_viewer/mdvmain.dfm b/components/fpexif/delphi examples/metadata_viewer/mdvmain.dfm index 8be6484ff..be7c4ce5b 100644 --- a/components/fpexif/delphi examples/metadata_viewer/mdvmain.dfm +++ b/components/fpexif/delphi examples/metadata_viewer/mdvmain.dfm @@ -10,11 +10,9 @@ object MainForm: TMainForm Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] - OldCreateOrder = True ShowHint = True OnCreate = FormCreate OnDestroy = FormDestroy - PixelsPerInch = 96 TextHeight = 13 object Splitter2: TSplitter Left = 274 @@ -181,7 +179,7 @@ object MainForm: TMainForm Top = 21 Width = 647 Height = 550 - ActivePage = PgMetadata + ActivePage = PgXMP Align = alClient TabOrder = 1 OnChange = PageControl1Change @@ -241,6 +239,87 @@ object MainForm: TMainForm end end end + object PgXMP: TTabSheet + Caption = 'XMP' + ImageIndex = 2 + object Splitter4: TSplitter + Left = 0 + Top = 150 + Width = 639 + Height = 3 + Cursor = crVSplit + Align = alTop + end + object XMPListView: TListView + Left = 0 + Top = 0 + Width = 639 + Height = 150 + Align = alTop + Columns = < + item + Caption = 'Description' + Width = 200 + end + item + Caption = 'Value' + Width = 200 + end> + TabOrder = 0 + ViewStyle = vsReport + end + object XMPSynEdit: TMemo + Left = 0 + Top = 153 + Width = 639 + Height = 335 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + TabOrder = 1 + end + object Panel6: TPanel + Left = 0 + Top = 488 + Width = 639 + Height = 34 + Align = alBottom + BevelOuter = bvNone + TabOrder = 2 + object cbProcessXMP: TCheckBox + Left = 8 + Top = 8 + Width = 129 + Height = 17 + Caption = 'Load && display XMP' + Checked = True + State = cbChecked + TabOrder = 0 + end + object btnApplyChangesXMP: TButton + Left = 143 + Top = 7 + Width = 98 + Height = 25 + Caption = 'Apply changes' + TabOrder = 1 + OnClick = btnApplyChangesXMPClick + end + object btnSaveXMP: TButton + Left = 247 + Top = 7 + Width = 75 + Height = 25 + Caption = 'Save' + TabOrder = 2 + OnClick = btnSaveXMPClick + end + end + end object PgImage: TTabSheet Caption = 'Image' object Image: TImage diff --git a/components/fpexif/delphi examples/metadata_viewer/mdvmain.pas b/components/fpexif/delphi examples/metadata_viewer/mdvmain.pas index 072d7f775..9d99c16fe 100644 --- a/components/fpexif/delphi examples/metadata_viewer/mdvmain.pas +++ b/components/fpexif/delphi examples/metadata_viewer/mdvmain.pas @@ -1,8 +1,8 @@ unit mdvMain; {$IFDEF FPC} - !!! THIS PROGRAM IS INTENDED FOR DELPHI ONLY - {$ENDIF} + !!! THIS PROGRAM IS INTENDED FOR DELPHI ONLY !!! +{$ENDIF} interface @@ -44,6 +44,14 @@ type Splitter2: TSplitter; DriveComboBox1: TDriveComboBox; Panel5: TPanel; + PgXMP: TTabSheet; + XMPListView: TListView; + Splitter4: TSplitter; + XMPSynEdit: TMemo; + Panel6: TPanel; + cbProcessXMP: TCheckBox; + btnApplyChangesXMP: TButton; + btnSaveXMP: TButton; procedure BtnChangeDateClick(Sender: TObject); procedure CbShowTagIDsChange(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -63,6 +71,8 @@ type procedure ShellListViewChange(Sender: TObject); procedure DriveComboBox1Change(Sender: TObject); procedure Panel5Resize(Sender: TObject); + procedure btnApplyChangesXMPClick(Sender: TObject); + procedure btnSaveXMPClick(Sender: TObject); private FFileName: String; FImgInfo: TImgInfo; @@ -70,6 +80,7 @@ type FImageOrientation: TExifOrientation; procedure LoadFile(const AFileName: String); procedure LoadFromIni; + procedure LoadXMPTags; procedure SaveToIni; procedure UpdateCaption; @@ -194,6 +205,24 @@ begin //ShellListView.Parent.DoubleBuffered := true; 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.BtnChangeDateClick(Sender: TObject); var lTag: TTag; @@ -225,6 +254,19 @@ begin FImgInfo.SaveToFile(fn); 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; @@ -290,6 +332,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 @@ -332,6 +378,22 @@ begin end else DateTimePanel.Hide; + if FImgInfo.HasXMP then begin + ms := TMemoryStream.Create; + 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 for i := 0 to FImgInfo.IptcData.TagCount-1 do begin lTag := FImgInfo.IptcData.TagByIndex[i]; @@ -449,6 +511,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/examples/metadata_viewer/mdvmain.lfm b/components/fpexif/examples/metadata_viewer/mdvmain.lfm index a484e7473..2586d0a1a 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 = PageControlChange object PgMetadata: TTabSheet diff --git a/components/fpexif/fpeiptcdata.pas b/components/fpexif/fpeiptcdata.pas index e171d3e92..d7ab89d50 100644 --- a/components/fpexif/fpeiptcdata.pas +++ b/components/fpexif/fpeiptcdata.pas @@ -126,7 +126,7 @@ type TAdobeImageResourceBlock = class public Identifier: Word; - Name: String; + Name: AnsiString; Data: TBytes; end; diff --git a/components/fpexif/fpemetadata.pas b/components/fpexif/fpemetadata.pas index 221d24978..478a3f799 100644 --- a/components/fpexif/fpemetadata.pas +++ b/components/fpexif/fpemetadata.pas @@ -13,11 +13,7 @@ uses {$IFDEF FPC} LazUTF8, {$ENDIF} - fpeGlobal, - {$IFDEF FPC} - fpeXmpData, - {$ENDIF} - fpeExifData, fpeIptcData; + fpeGlobal, fpeXmpData, fpeExifData, fpeIptcData; type TImgInfo = class; @@ -67,9 +63,7 @@ type private FExifData: TExifData; FIptcData: TIptcData; - {$IFDEF FPC} FXmpData: TXmpData; - {$ENDIF} function GetComment: String; function GetWarnings: String; procedure SetComment(const AValue: String); @@ -92,18 +86,14 @@ type function CreateExifData(ABigEndian: Boolean = false): TExifData; function CreateIptcData: TIptcData; - {$IFDEF FPC} function CreateXmpData: TXmpData; - {$ENDIF} function HasComment: Boolean; function HasExif: Boolean; function HasIptc: Boolean; function HasThumbnail: Boolean; function HasWarnings: boolean; - {$IFDEF FPC} function HasXMP: Boolean; - {$ENDIF} { Comment stored in the Jpeg COM segment } property Comment: String read GetComment write SetComment; @@ -128,9 +118,7 @@ type property ExifData: TExifData read FExifData; property IptcData: TIptcData read FIptcData; - {$IFDEF FPC} property XmpData: TXmpData read FXmpData; - {$ENDIF} end; @@ -138,8 +126,7 @@ implementation uses Variants, - fpeStrConsts, fpeUtils, fpeExifReadWrite, {$IFDEF FPC}fpeXMPReadWrite,{$ENDIF} - fpeIptcReadWrite; + fpeStrConsts, fpeUtils, fpeExifReadWrite, fpeXMPReadWrite, fpeIptcReadWrite; type TJpegJFIFSegment = packed record @@ -276,9 +263,7 @@ begin FWarnings.Free; FExifData.Free; FIptcData.Free; - {$IFDEF FPC} FXmpData.Free; - {$ENDIF} inherited; end; @@ -298,7 +283,6 @@ begin Result := FIptcData; end; -{$IFDEF FPC} function TImgInfo.CreateXmpData: TXmpData; begin FWarnings.Clear; @@ -306,7 +290,6 @@ begin FXmpData := TXmpData.Create; Result := FXmpData; end; -{$ENDIF} procedure TImgInfo.Error(const AMsg: String); begin @@ -381,12 +364,10 @@ begin Result := FWarnings.Count > 0; end; -{$IFDEF FPC} function TImgInfo.HasXMP: Boolean; begin Result := FXmpData <> nil; end; -{$ENDIF} procedure TImgInfo.LoadFromFile(const AFileName: String); var @@ -441,7 +422,7 @@ var {$IFDEF FPC} s: RawByteString = ''; {$ELSE} - s: String; + s: AnsiString; {$ENDIF} begin // Write the header segment and all metadata segments stored in TImgInfo @@ -588,7 +569,6 @@ begin finally reader.Free; end; - {$IFDEF FPC} end else if HasXMPHeader(AStream) and (mdkXMP in FMetadataKinds) then begin @@ -602,7 +582,6 @@ begin raise EFpExifReader.Create('Error reading XMP data: ' + E.Message); end; end; - {$ENDIF} end; end; M_IPTC: @@ -842,7 +821,6 @@ begin end; end; - {$IFDEF FPC} // XMP --> Write another APP1 segment if (mdkXMP in FMetadataKinds) and HasXMP then begin @@ -853,8 +831,7 @@ begin writer.Free; end; end; - {$ENDIF} - + // Write IPTCSegment (APP13) if (mdkIPTC in FMetadataKinds) and HasIPTC then begin writer := TIptcWriter.Create(Self); diff --git a/components/fpexif/fpexmpdata.pas b/components/fpexif/fpexmpdata.pas index e12f8c4d0..ea8988f40 100644 --- a/components/fpexif/fpexmpdata.pas +++ b/components/fpexif/fpexmpdata.pas @@ -20,24 +20,28 @@ uses Classes, SysUtils, contnrs, {$IFDEF FPC} laz2_dom, laz2_xmlread, + {$ELSE} + XMLDoc, XMLIntf, {$ENDIF} fpeGlobal, fpeTags; type TXMPData = class private - FData: String; + FData: AnsiString; + {$IFDEF FPC} FDoc: TXMLDocument; + {$ELSE} + FDoc: IXMLDocument; + {$ENDIF} FTags: TStringList; function GetTagByIndex(AIndex: Integer): String; function GetTagByName(ATagName: String): String; function GetTagName(AIndex: Integer): String; function GetTagCount: Integer; protected - {$IFDEF FPC} - procedure Create_RDFDescription_Tags(ANode: TDOMNode); + procedure Create_RDFDescription_Tags(ANode: {$IFDEF FPC}TDOMNode{$ELSE}IXMLNode{$ENDIF}); procedure CreateTags; - {$ENDIF} public constructor Create; destructor Destroy; override; @@ -69,61 +73,120 @@ begin inherited; end; -{$IFDEF FPC} -procedure TXMPData.Create_RDFDescription_Tags(ANode: TDOMNode); +procedure TXMPData.Create_RDFDescription_Tags(ANode: {$IFDEF FPC}TDOMNode{$ELSE}IXMLNode{$ENDIF}); var + {$IFDEF FPC} node: TDOMNode; - nodeName: String; - i: Integer; attr: TDOMNode; + {$ELSE} + node: IXMLNode; + attr: IXMLNode; + {$ENDIF} + nodeName: String; + i, n: Integer; lTagName, lTagValue: String; lTag: TTag; begin while ANode <> nil do begin nodeName := ANode.NodeName; + {$IFDEF FPC} for i := 0 to ANode.Attributes.Length-1 do begin attr := ANode.Attributes.Item[i]; lTagName := attr.NodeName; - lTagValue := attr.NodeValue; + lTagValue := attr.nodeValue; FTags.Add(lTagName + '=' + lTagValue); end; if ANode.HasChildNodes then begin node := ANode.FirstChild; - while node <> nil do + while node <> nil do begin nodeName := node.NodeName; + {$IFDEF FPC} lTagValue := node.TextContent; + {$ELSE} + lTagValue := node.NodeValue; + {$ENDIF} if lTagName <> '' then FTags.Add(nodeName + '=' + lTagValue); node := node.NextSibling; end; end; ANode := ANode.NextSibling; + {$ELSE} + for i := 0 to ANode.AttributeNodes.Count-1 do + begin + attr := ANode.AttributeNodes[i]; + lTagName := attr.NodeName; + lTagValue := attr.NodeValue; + FTags.Add(lTagName + '=' + lTagValue); + end; + if ANode.HasChildNodes then + begin + node := ANode.ChildNodes.First; + while node <> nil do + begin + nodeName := node.NodeName; + {$IFDEF FPC} + lTagValue := node.TextContent; + {$ELSE} + lTagValue := node.NodeValue; + {$ENDIF} + if lTagName <> '' then + FTags.Add(nodeName + '=' + lTagValue); + node := node.NextSibling; + end; + end; + ANode := ANode.NextSibling; + {$ENDIF} end; end; procedure TXMPData.CreateTags; var - stream: TStringStream; + {$IFDEF FPC} node: TDOMNode; + {$ELSE} + node: IXMLNode; + {$ENDIF} nodeName: String; + stream: TStringStream; begin + {$IFDEF FPC} FDoc.Free; + {$ENDIF} stream := TStringStream.Create(FData); try + {$IFDEF FPC} ReadXMLFile(FDoc, stream); + {$ELSE} + FDoc := TXMLDocument.Create(nil); + FDoc.Options := FDoc.Options - [doNodeAutoCreate]; + FDoc.LoadFromStream(stream, xetUTF_8); + {$ENDIF} finally stream.Free; end; FTags.Clear; try + {$IFDEF FPC} node := FDoc.DocumentElement.FindNode('rdf:RDF'); if node = nil then exit; node := node.FirstChild; - while node <> nil do + {$ELSE} + + node := FDoc.DocumentElement; + if node.ChildNodes.Count = 0 then + exit; + node := node.ChildNodes.First; + nodename :=node.NodeName; + if nodeName <> 'rdf:RDF' then + exit; + node := node.ChildNodes.First; + {$ENDIF} + while node <> nil do begin nodeName := node.NodeName; if nodeName = 'rdf:Description' then @@ -132,11 +195,12 @@ begin end; except FTags.Clear; + {$IFDEF FPC} FreeAndNil(FDoc); + {$ENDIF} raise; end; end; -{$ENDIF} function TXMPData.GetTagByIndex(AIndex: Integer): String; begin @@ -161,7 +225,7 @@ end; procedure TXMPData.LoadFromStream(AStream: TStream; ASize: Integer = -1); var p: Int64; - i: SizeInt; + i: Cardinal; begin if ASize = -1 then ASize := AStream.Size; @@ -181,9 +245,7 @@ begin end; AStream.Position := p; - {$IFDEF FPC} CreateTags; - {$ENDIF} end; procedure TXMPData.SaveToStream(AStream: TStream); diff --git a/components/fpexif/fpexmpreadwrite.pas b/components/fpexif/fpexmpreadwrite.pas index aaff2a585..572af87eb 100644 --- a/components/fpexif/fpexmpreadwrite.pas +++ b/components/fpexif/fpexmpreadwrite.pas @@ -1,12 +1,14 @@ unit fpeXMPReadWrite; -{$mode objfpc}{$H+} +{$IFDEF FPC} + {$mode objfpc}{$H+} +{$ENDIF} interface uses Classes, SysUtils, - fpeGlobal, fpeMetaData; + fpeGlobal, fpeUtils, fpeMetaData; const XMP_BASE_KEY = 'http://ns.adobe.com/xap/1.0/'; @@ -27,12 +29,12 @@ implementation function HasXMPHeader(AStream: TStream): Boolean; var p: Int64; - hdr: array of ansichar; + 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)); + AStream.Read(hdr[0], Length(XMP_KEY)); + Result := CompareMem(PAnsiChar(hdr), PAnsiChar(AnsiString(XMP_KEY)), Length(XMP_KEY)); if not Result then AStream.Position := p; end; @@ -66,7 +68,7 @@ begin // Size of the segment ADataSize := NToBE(Word(ADataSize)); AStream.WriteBuffer(ADataSize, 2); - AStream.WriteBuffer(XMP_KEY, Length(XMP_KEY)); + AStream.WriteBuffer(AnsiString(XMP_KEY), Length(XMP_KEY)); end; end. diff --git a/components/fpexif/tests/unittest/fpExifTests_Delphi.dproj b/components/fpexif/tests/unittest/fpExifTests_Delphi.dproj index ee8f2b5ee..6ee6b3533 100644 --- a/components/fpexif/tests/unittest/fpExifTests_Delphi.dproj +++ b/components/fpexif/tests/unittest/fpExifTests_Delphi.dproj @@ -7,7 +7,7 @@ 1 Application VCL - 18.8 + 19.5 Win32 @@ -18,6 +18,11 @@ Base true + + true + Base + true + true Base @@ -29,6 +34,12 @@ true true + + true + Cfg_1 + true + true + true Base @@ -40,6 +51,12 @@ true true + + true + Cfg_2 + true + true + false false @@ -58,6 +75,9 @@ 1033 CompanyName=;FileDescription=;FileVersion=0.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion= output\dcu\Delphi + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) @@ -70,6 +90,13 @@ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + $(BDS)\bin\default_app.manifest + RELEASE;$(DCC_Define) 0 @@ -80,6 +107,9 @@ true PerMonitor + + PerMonitorV2 + DEBUG;$(DCC_Define) false @@ -94,6 +124,9 @@ PerMonitor Debug + + PerMonitorV2 + MainSource @@ -107,15 +140,11 @@ - + - - Cfg_2 - Base - Base @@ -123,6 +152,10 @@ Cfg_1 Base + + Cfg_2 + Base + Delphi.Personality.12 @@ -135,6 +168,7 @@ True + False 12 diff --git a/components/fpexif/tests/unittest/fpExifTests_Delphi.res b/components/fpexif/tests/unittest/fpExifTests_Delphi.res index a14298a6b..c2bcc2f14 100644 Binary files a/components/fpexif/tests/unittest/fpExifTests_Delphi.res and b/components/fpexif/tests/unittest/fpExifTests_Delphi.res differ