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;