pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpexif: Support write-back of XMP

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8202 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-03-07 21:03:56 +00:00
parent f39aad84fe
commit 79770ff31d
6 changed files with 175 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

65
components/fpexif/examples/metadata_viewer/mdvmain.lfm
View File

@ -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'

84
components/fpexif/examples/metadata_viewer/mdvmain.pas
View File

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

26
components/fpexif/fpemetadata.pas
View File

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

6
components/fpexif/fpexif_pkg.lpk
View File

@ -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>

2
components/fpexif/fpexif_pkg.pas
View File

@ -12,7 +12,7 @@ uses
fpeIptcReadWrite, fpeExifData, fpeIptcData, fpeStrConsts, fpeMakerNote,
fpeMakerNoteNikon, fpeMakerNoteMinolta, fpeMakerNoteOlympus,
fpeMakerNoteEpson, fpeMakerNoteFuji, fpeMakerNoteSanyo, fpeMakerNoteCasio,
fpeMakerNoteCanon, fpeXMPData;
fpeMakerNoteCanon, fpeXMPData, fpeXMPReadWrite;
implementation

49
components/fpexif/fpexmpdata.pas
View File

@ -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