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