diff --git a/components/fpexif/examples/metadata_viewer/MetadataViewer.ico b/components/fpexif/examples/metadata_viewer/MetadataViewer.ico
new file mode 100644
index 000000000..0341321b5
Binary files /dev/null and b/components/fpexif/examples/metadata_viewer/MetadataViewer.ico differ
diff --git a/components/fpexif/examples/metadata_viewer/MetadataViewer.lpi b/components/fpexif/examples/metadata_viewer/MetadataViewer.lpi
new file mode 100644
index 000000000..24703615c
--- /dev/null
+++ b/components/fpexif/examples/metadata_viewer/MetadataViewer.lpi
@@ -0,0 +1,77 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/fpexif/examples/metadata_viewer/MetadataViewer.lpr b/components/fpexif/examples/metadata_viewer/MetadataViewer.lpr
new file mode 100644
index 000000000..9ff49df61
--- /dev/null
+++ b/components/fpexif/examples/metadata_viewer/MetadataViewer.lpr
@@ -0,0 +1,22 @@
+program MetadataViewer;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, mdvMain
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ MainForm.BeforeRun;
+ Application.Run;
+end.
+
diff --git a/components/fpexif/examples/metadata_viewer/mdvmain.lfm b/components/fpexif/examples/metadata_viewer/mdvmain.lfm
new file mode 100644
index 000000000..a59782920
--- /dev/null
+++ b/components/fpexif/examples/metadata_viewer/mdvmain.lfm
@@ -0,0 +1,271 @@
+object MainForm: TMainForm
+ Left = 579
+ Height = 714
+ Top = 200
+ Width = 926
+ Caption = 'Metadata viewer'
+ ClientHeight = 714
+ ClientWidth = 926
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ LCLVersion = '1.9.0.0'
+ object ShellPanel: TPanel
+ Left = 0
+ Height = 691
+ Top = 0
+ Width = 274
+ Align = alLeft
+ BevelOuter = bvNone
+ ClientHeight = 691
+ ClientWidth = 274
+ TabOrder = 0
+ object ShellTreeView: TShellTreeView
+ Left = 0
+ Height = 269
+ Top = 0
+ Width = 274
+ Align = alTop
+ FileSortType = fstFoldersFirst
+ HideSelection = False
+ Images = ImageList
+ ReadOnly = True
+ TabOrder = 0
+ OnGetImageIndex = ShellTreeViewGetImageIndex
+ OnSelectionChanged = ShellTreeViewSelectionChanged
+ Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
+ ObjectTypes = [otFolders]
+ ShellListView = ShellListView
+ end
+ object Splitter1: TSplitter
+ Cursor = crVSplit
+ Left = 0
+ Height = 5
+ Top = 269
+ Width = 274
+ Align = alTop
+ ResizeAnchor = akTop
+ end
+ object ShellListView: TShellListView
+ Left = 0
+ Height = 273
+ Top = 274
+ Width = 274
+ Align = alClient
+ Color = clDefault
+ HideSelection = False
+ Mask = '*.jpg;*.jpeg;*.jpe;*.tiff;*.tif'
+ ReadOnly = True
+ SmallImages = ImageList
+ SortColumn = 0
+ TabOrder = 2
+ OnSelectItem = ShellListViewSelectItem
+ ObjectTypes = [otNonFolders]
+ ShellTreeView = ShellTreeView
+ end
+ object PreviewImage: TImage
+ Left = 0
+ Height = 144
+ Top = 547
+ Width = 274
+ Align = alBottom
+ Center = True
+ Proportional = True
+ Stretch = True
+ end
+ end
+ object Splitter2: TSplitter
+ Left = 274
+ Height = 691
+ Top = 0
+ Width = 5
+ end
+ object Panel2: TPanel
+ Left = 279
+ Height = 691
+ Top = 0
+ Width = 647
+ Align = alClient
+ BevelOuter = bvNone
+ ClientHeight = 691
+ ClientWidth = 647
+ TabOrder = 2
+ object TagListView: TListView
+ Left = 0
+ Height = 668
+ Top = 23
+ Width = 647
+ Align = alClient
+ AutoSort = False
+ Columns = <
+ item
+ Caption = 'Group'
+ Width = 120
+ end
+ item
+ Caption = 'Property'
+ Width = 220
+ end
+ item
+ AutoSize = True
+ Caption = 'Value'
+ Width = 44
+ end>
+ HideSelection = False
+ ReadOnly = True
+ RowSelect = True
+ SortColumn = 0
+ SortType = stText
+ TabOrder = 0
+ ViewStyle = vsReport
+ OnCompare = TagListViewCompare
+ OnSelectItem = TagListViewSelectItem
+ end
+ object Panel3: TPanel
+ Left = 0
+ Height = 23
+ Top = 0
+ Width = 647
+ Align = alTop
+ AutoSize = True
+ BevelOuter = bvNone
+ BorderWidth = 4
+ ClientHeight = 23
+ ClientWidth = 647
+ TabOrder = 1
+ object FilenameInfo: TLabel
+ Left = 4
+ Height = 15
+ Top = 4
+ Width = 24
+ Caption = 'File: '
+ ParentColor = False
+ end
+ end
+ end
+ object StatusBar1: TStatusBar
+ Left = 0
+ Height = 23
+ Top = 691
+ Width = 926
+ Panels = <
+ item
+ Width = 150
+ end
+ item
+ Width = 150
+ end
+ item
+ Width = 250
+ end
+ item
+ Width = 150
+ end
+ item
+ Width = 100
+ end>
+ SimplePanel = False
+ end
+ object ImageList: TImageList
+ left = 89
+ top = 118
+ Bitmap = {
+ 4C690300000010000000100000000000000000000000D49A5B65E7BC8EB3E7BD
+ 90B5E7BD90B5E7BD90B5E7BD90B5E7BD90B5E7BD90B5E7BD90B5E7BD90B5E7BC
+ 8EB3DCA06466000000000000000000000000BF804008EFCDA7EEFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFF3D4B1F2BF8040080000000000000000CD8C4B33F9E0C4F8FEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFBE4CAFCD298563E0000000000000000D3985A6FFDEAD3FFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEECD7FFD9A269810000000000000000DDAD77A7FEF0DEFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFE3B583AF0000000000000000E6BC90C5FEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFECC49ACA0000000000000000EFCAA4DAFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFF1D0ACE00000000000000000F3D5B3ECFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFF5D9BAF1BF804004C98B4D21FAE0C4F7FEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFBE4CAFBD6965B38D5995D66FDE9D2FFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEECD7FFDAA2687BE1AE7B9BFEEFDEFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFE2B585A9DDA56B9FFDD5AAFFFDD5AAFFFDD5AAFFFDD5
+ AAFFFDD5AAFFFDD5AAFFFDD5AAFFFDD5AAFFFDD5AAFFFDD5AAFFFDD5AAFFFDD5
+ AAFFFDD5AAFFFDD5AAFFDEAA71A2DBA2659CFDCC98FFE4AC72FFF0BC85FFF0BC
+ 85FFE4AC72FFF5C18BFFE8B178FFE8B178FFF5C18BFFE4AC72FFFDCC98FFFDD3
+ A6FFFEDFBFFFFDCC98FFDDA468A6DBA2659CFDCC98FFCA8C4CFFCF9353FFCF93
+ 53FFCA8C4CFFD19556FFCC8E4EFFCC8E4EFFD19556FFCD8F50FFFDCC98FFFEE0
+ C0FFFFF6EDFFFDCC98FFDDA468A6D99F6292FDCC98FFFDCC98FFFDCC98FFFDCC
+ 98FFFDCC98FFFDCC98FFFDCC98FFFDCC98FFFDCC98FFFDCC98FFFDCC98FFFDCC
+ 98FFFDCC98FFFDCC98FFDAA06497C8894900D99F6094DBA2659CDBA2659CDBA2
+ 659CDBA2659CDBA2659CDBA2659CDBA2659CDBA2659CDBA2659CDBA2659CDBA2
+ 659CDBA2659CDAA06497C8894900000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000D59D624ED69F6788D69F6788D69F6788D69F
+ 647DBF8040040000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000DBA7719CFEDCB6FFFEDCB6FFFEDCB6FFFCD8
+ B1F7DCA670B4C6864770C6864770C6864770C6864770C6864770C6864770C686
+ 4770C6864770C6864770C486454AD9A56EBAE9C093FFE9C093FFE9C093FFE9BE
+ 91FFE4BA8FFFF0D6B9FFF0D6B9FFF0D6B9FFF0D6B9FFF0D6B9FFF0D6B9FFF0D6
+ B9FFF0D6B9FFF0D6B9FFD9A976E3DCAE7DD8FEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFDEB083E0DCAE7DD8FEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFDEB083E0DCAE7DD8FEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFDEB083E0DCAE7DD8FEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFDEB083E0DCAE7DD8FEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFDEB083E0DCAE7DD8FEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFDEB083E0DCAE7DD8FEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFDEB083E0DCAE7DD8FEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFDEB083E0DCAE7DD8FEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFDEB083E0DCAE7DD8FEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFDEB083E0D59E6684D7A56FC7D7A56FC7D7A56FC7D7A5
+ 6FC7D7A56FC7D7A56FC7D7A56FC7D7A56FC7D7A56FC7D7A56FC7D7A56FC7D7A5
+ 6FC7D7A56FC7D7A56FC7D59E6684000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000D59D624ED69F6788D69F6788D69F6788D69F
+ 647DBF8040040000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000DBA7719CF9D4ACFFF0C79AFFF0C79AFFEFC4
+ 96F9D59D63C6C6864770C6864770C6864770C6864770C6864770C6864770C686
+ 4770C6864770C88B482E00000000DBA7719CE9C195FFF1E1D1FFF1E1D1FFF1E1
+ D1FFF1E1D1FFF1E1D1FFF1E1D1FFF1E1D1FFF1E1D1FFF1E1D1FFF1E1D1FFF1E1
+ D1FFF1E1D1FFD7A876C700000000DBA7719CE9C195FFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFF9F2EBFFF1E1D1FFF1E1D1FFF1E1D1FFF1E1D1FFF1E1
+ D1FFF1E1D1FFD39E68D5C7874840DBA7719CE9C195FFEAD1B6FFEAD0B5FFEAD0
+ B5FFEAD0B5FFE7CAACFFE9CAA9FFF0D6B9FFF0D6B9FFF0D6B9FFF0D6B9FFF0D6
+ B9FFF0D6B9FFF0D6B9FFDCB182DDDBA7719CE3B888FFEED3B5FFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFE2B990B7DBA7719CE1B484FFF9E6D1FFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFDBAF82A3DBA7719CDEB180FFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFDEEDDFFD9A8738CDBA7719CE0B487FFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFF5DEC4FDD7A37253DBA7719CE5BE93FFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFE8C7A2F4CC8C4D14D9A56DA1E9C59EFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFDFB68AEA00000000D8A56FB6F3DABEFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFDCAF81E000000000D6A36FD2FCEDDAFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0DFFFFEF0
+ DFFFFEF0DFFFDAAA78D500000000D59D6478D7A56FC7D7A56FC7D7A56FC7D7A5
+ 6FC7D7A56FC7D7A56FC7D7A56FC7D7A56FC7D7A56FC7D7A56FC7D7A56FC7D7A5
+ 6FC7D7A56FC7D39D646300000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000
+ }
+ end
+end
diff --git a/components/fpexif/examples/metadata_viewer/mdvmain.pas b/components/fpexif/examples/metadata_viewer/mdvmain.pas
new file mode 100644
index 000000000..4b4378054
--- /dev/null
+++ b/components/fpexif/examples/metadata_viewer/mdvmain.pas
@@ -0,0 +1,319 @@
+unit mdvMain;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ShellCtrls,
+ ExtCtrls, ComCtrls, StdCtrls,
+ fpeMetadata;
+
+type
+
+ { TMainForm }
+
+ TMainForm = class(TForm)
+ FilenameInfo: TLabel;
+ Panel2: TPanel;
+ Panel3: TPanel;
+ PreviewImage: TImage;
+ ImageList: TImageList;
+ StatusBar1: TStatusBar;
+ TagListView: TListView;
+ ShellPanel: TPanel;
+ ShellListView: TShellListView;
+ ShellTreeView: TShellTreeView;
+ Splitter1: TSplitter;
+ Splitter2: TSplitter;
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure ShellListViewSelectItem(Sender: TObject; Item: TListItem;
+ Selected: Boolean);
+ procedure ShellTreeViewGetImageIndex(Sender: TObject; Node: TTreeNode);
+ procedure ShellTreeViewSelectionChanged(Sender: TObject);
+ procedure TagListViewCompare(Sender: TObject; Item1, Item2: TListItem;
+ Data: Integer; var Compare: Integer);
+ procedure TagListViewSelectItem(Sender: TObject; Item: TListItem;
+ Selected: Boolean);
+ private
+ FImgInfo: TImgInfo;
+ procedure LoadFile(const AFileName: String);
+ procedure LoadFromIni;
+ procedure SaveToIni;
+ procedure UpdateCaption;
+
+ public
+ procedure BeforeRun;
+
+ end;
+
+var
+ MainForm: TMainForm;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ IniFiles, Math, StrUtils,
+ fpeGlobal, fpeTags, fpeExifData, fpeIptcData;
+
+
+function CalcIniName: String;
+begin
+ Result := ChangeFileExt(Application.ExeName, '.ini');
+end;
+
+
+{ TMainForm }
+
+procedure TMainForm.BeforeRun;
+begin
+ LoadFromIni;
+end;
+
+procedure TMainForm.FormCreate(Sender: TObject);
+begin
+ //ShellListView.Parent.DoubleBuffered := true;
+end;
+
+procedure TMainForm.FormDestroy(Sender: TObject);
+begin
+ try
+ SaveToIni;
+ except
+ end;
+ FImgInfo.Free;
+end;
+
+procedure TMainForm.LoadFile(const AFileName: String);
+var
+ lTag: TTag;
+ item: TListItem;
+ i: Integer;
+ ms: TMemoryStream;
+begin
+ TagListView.Items.BeginUpdate;
+ try
+ TagListView.Clear;
+ FImgInfo.Free;
+ FImgInfo := TImgInfo.Create;
+ try
+ try
+ FImgInfo.LoadFromFile(AFileName);
+ except
+ on E:EFpExif do
+ MessageDlg(E.Message, mtError, [mbOK], 0);
+ end;
+ if FImgInfo.HasExif then begin
+ FImgInfo.ExifData.ExportOptions := FImgInfo.ExifData.ExportOptions + [eoTruncateBinary];
+ for i := 0 to FImgInfo.ExifData.TagCount-1 do begin
+ lTag := FImgInfo.ExifData.TagByIndex[i];
+ item := TagListView.Items.Add;
+ item.Data := lTag;
+ item.Caption := 'EXIF.' + NiceGroupNames[lTag.Group];
+ item.SubItems.Add(lTag.Description);
+ item.SubItems.Add(lTag.AsString);
+ end;
+ end;
+ if FImgInfo.HasIptc then begin
+ for i := 0 to FImgInfo.IptcData.TagCount-1 do begin
+ lTag := FImgInfo.IptcData.TagByIndex[i];
+ item := TagListView.Items.Add;
+ item.Data := lTag;
+ item.Caption := 'IPTC';
+ item.SubItems.Add(lTag.Description);
+ item.SubItems.Add(lTag.AsString);
+ end;
+ end;
+ if FImgInfo.HasThumbnail then begin
+ ms := TMemoryStream.Create;
+ try
+ FImgInfo.ExifData.SaveThumbnailToStream(ms);
+ ms.Position := 0;
+ PreviewImage.Picture.LoadFromStream(ms);
+ finally
+ ms.Free;
+ end;
+ end;
+ if FImgInfo.HasWarnings then
+ MessageDlg(FImgInfo.Warnings, mtWarning, [mbOK], 0);
+ except
+ FreeAndNil(FImgInfo);
+ raise;
+ end;
+ UpdateCaption;
+ finally
+ TagListView.Items.EndUpdate;
+ TagListView.Sort;
+ end;
+end;
+
+procedure TMainForm.LoadFromIni;
+var
+ ini: TCustomIniFile;
+ i, W, H, L, T: Integer;
+ rct: TRect;
+ s: String;
+begin
+ ini := TIniFile.Create(CalcIniName);
+ try
+ L := ini.ReadInteger('MainForm', 'Left', Left);
+ T := ini.ReadInteger('MainForm', 'Top', Top);
+ W := ini.ReadInteger('MainForm', 'Width', Width);
+ H := ini.ReadInteger('MainForm', 'Height', Height);
+ rct := Screen.DesktopRect;
+ if W > rct.Right - rct.Left then W := rct.Right - rct.Left;
+ if H > rct.Bottom - rct.Top then H := rct.Bottom - rct.Top;
+ if L < rct.Left then L := rct.Left;
+ if T < rct.Top then T := rct.Top;
+ if L+W > rct.Right then L := rct.Right - W;
+ if T+H > rct.Bottom then T := rct.Bottom - H;
+ SetBounds(L, T, W, H);
+
+ s := ini.ReadString('MainForm', 'Path', '');
+ if s <> '' then ShellTreeView.Path := s;
+
+ w := ini.ReadInteger('MainForm', 'LeftPanelWidth', 0);
+ if w <> 0 then ShellPanel.Width := w;
+
+ h := ini.ReadInteger('MainForm', 'TreeHeight', 0);
+ if h <> 0 then ShellTreeView.Height := h;
+
+ for i:=0 to TagListView.Columns.Count-1 do begin
+ w := ini.ReadInteger('TagList', 'ColWidth'+IntToStr(i), 0);
+ if w <> 0 then
+ TagListView.Columns[i].Width := w;
+ end;
+ finally
+ ini.Free;
+ end;
+end;
+
+procedure TMainForm.SaveToIni;
+var
+ ini: TCustomIniFile;
+ i: Integer;
+begin
+ ini := TIniFile.Create(CalcIniName);
+ try
+ if WindowState = wsNormal then begin
+ ini.WriteInteger('MainForm', 'Left', Left);
+ ini.WriteInteger('MainForm', 'Top', Top);
+ ini.WriteInteger('MainForm', 'Width', Width);
+ ini.WriteInteger('MainForm', 'Height', Height);
+ end;
+ ini.WriteString('MainForm', 'Path', ShellTreeView.Path);
+ ini.WriteInteger('MainForm', 'LeftPanelWidth', ShellPanel.Width);
+ ini.WriteInteger('MainForm', 'TreeHeight', ShellTreeView.Height);
+ for i:=0 to TagListView.Columns.Count-1 do
+ ini.WriteInteger('TagList', 'ColWidth'+IntToStr(i), TagListView.Columns[i].Width);
+ finally
+ ini.Free;
+ end;
+end;
+
+procedure TMainForm.ShellListViewSelectItem(Sender: TObject; Item: TListItem;
+ Selected: Boolean);
+var
+ dir, fn: String;
+begin
+ if Selected then
+ begin
+ dir := ShellTreeView.GetPathFromNode(ShellTreeView.Selected);
+ fn := Item.Caption;
+ LoadFile(dir + fn);
+ end;
+end;
+
+procedure TMainForm.ShellTreeViewGetImageIndex(Sender: TObject; Node: TTreeNode);
+begin
+ if Node = nil then
+ exit;
+ if Node.Level = 0 then
+ Node.ImageIndex := 0
+ else
+ if Node.Expanded then
+ Node.ImageIndex := 2
+ else
+ Node.ImageIndex := 1;
+ Node.SelectedIndex := Node.ImageIndex;
+end;
+
+procedure TMainForm.ShellTreeViewSelectionChanged(Sender: TObject);
+begin
+ TagListView.Items.Clear;
+ PreviewImage.Picture.Assign(nil);
+ ShellTreeViewGetImageIndex(nil, ShellTreeView.Selected);
+ FreeAndNil(FImgInfo);
+ UpdateCaption;
+end;
+
+procedure TMainForm.TagListViewCompare(Sender: TObject; Item1, Item2: TListItem;
+ Data: Integer; var Compare: Integer);
+var
+ tag1, tag2: TTag;
+begin
+ tag1 := TTag(Item1.Data);
+ tag2 := TTag(Item2.Data);
+ Compare := CompareValue(ord(tag1.Group), ord(tag2.Group));
+ if Compare = 0 then
+ Compare := CompareText(Item1.SubItems[0], Item2.SubItems[0]);
+end;
+
+procedure TMainForm.TagListViewSelectItem(Sender: TObject; Item: TListItem;
+ Selected: Boolean);
+const
+ { TTagType:
+ ttUInt8 = 1, ttString, ttUInt16, ttUInt32, ttURational,
+ ttSInt8, ttBinary, ttSInt16, ttSInt32, ttSRational,
+ ttSingle, ttDouble,
+ ttIFD // rarely used, in Olympus maker notes
+ }
+ TAGTYPE_NAMES: array[TTagType] of string = (
+ 'BYTE', 'ASCII', 'UINT16', 'UINT32', 'URATIONAL',
+ 'SBYTE', 'BINARY', 'SINT16', 'SINT32', 'SRATIONAL',
+ 'SINGLE', 'DOUBLE',
+ 'IFD'
+ );
+var
+ lTag: TTag;
+ s: String;
+ tagID: TTagIDRec;
+begin
+ if Selected then begin
+ lTag := TTag(Item.Data);
+ if lTag <> nil then begin
+ tagID := TTagIDRec(lTag.TagID);
+ Statusbar1.Panels[0].Text := Format('ID %d [$%.4x]', [tagID.Tag, tagID.Tag]);
+ Statusbar1.Panels[1].Text := Format('Parent %d [$%.4x]', [tagID.Parent, tagID.Parent]);
+ Statusbar1.Panels[2].Text := 'Name: ' + lTag.Name;
+ Statusbar1.Panels[3].Text := 'Type: ' + TAGTYPE_NAMES[lTag.TagType];
+ Statusbar1.Panels[4].Text := 'Elements: ' + IntToStr(lTag.Count);
+ exit;
+ end;
+ end;
+ Statusbar1.Panels[0].Text := '';
+ Statusbar1.Panels[1].Text := '';
+ Statusbar1.Panels[2].Text := '';
+ Statusbar1.Panels[3].Text := '';
+ Statusbar1.Panels[4].Text := '';
+end;
+
+procedure TMainForm.UpdateCaption;
+var
+ fn: String;
+begin
+ if FImgInfo <> nil then
+ FileNameInfo.Caption := Format(
+ 'File: %s' + LineEnding +
+ 'Size: %d kB' + LineEnding +
+ 'Date: %s', [
+ FImgInfo.Filename, FImgInfo.FileSize div 1024, DateTimeToStr(FImgInfo.FileDate)])
+ else
+ FilenameInfo.caption := '< no file >';
+end;
+
+end.
+
diff --git a/components/fpexif/examples/simple_demo/ExifSimpleDemo.ico b/components/fpexif/examples/simple_demo/ExifSimpleDemo.ico
new file mode 100644
index 000000000..0341321b5
Binary files /dev/null and b/components/fpexif/examples/simple_demo/ExifSimpleDemo.ico differ
diff --git a/components/fpexif/examples/simple_demo/ExifSimpleDemo.lpi b/components/fpexif/examples/simple_demo/ExifSimpleDemo.lpi
new file mode 100644
index 000000000..0a808f5cb
--- /dev/null
+++ b/components/fpexif/examples/simple_demo/ExifSimpleDemo.lpi
@@ -0,0 +1,82 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/fpexif/examples/simple_demo/ExifSimpleDemo.lpr b/components/fpexif/examples/simple_demo/ExifSimpleDemo.lpr
new file mode 100644
index 000000000..762559c99
--- /dev/null
+++ b/components/fpexif/examples/simple_demo/ExifSimpleDemo.lpr
@@ -0,0 +1,22 @@
+program ExifSimpleDemo;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, sdMain
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ MainForm.BeforeRun;
+ Application.Run;
+end.
+
diff --git a/components/fpexif/examples/simple_demo/sdmain.lfm b/components/fpexif/examples/simple_demo/sdmain.lfm
new file mode 100644
index 000000000..54be135a2
--- /dev/null
+++ b/components/fpexif/examples/simple_demo/sdmain.lfm
@@ -0,0 +1,248 @@
+object MainForm: TMainForm
+ Left = 329
+ Height = 478
+ Top = 131
+ Width = 788
+ Caption = 'MainForm'
+ ClientHeight = 478
+ ClientWidth = 788
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ LCLVersion = '1.9.0.0'
+ object BtnLoad: TButton
+ AnchorSideTop.Control = Owner
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ Left = 728
+ Height = 25
+ Top = 8
+ Width = 52
+ Anchors = [akTop, akRight]
+ AutoSize = True
+ BorderSpacing.Top = 8
+ BorderSpacing.Right = 8
+ Caption = 'Load'
+ OnClick = BtnLoadClick
+ TabOrder = 0
+ end
+ object CbFilename: TComboBox
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = BtnLoad
+ AnchorSideTop.Side = asrCenter
+ AnchorSideRight.Control = BtnBrowse
+ Left = 8
+ Height = 23
+ Top = 9
+ Width = 677
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Left = 8
+ BorderSpacing.Right = 4
+ ItemHeight = 15
+ OnSelect = CbFilenameSelect
+ TabOrder = 1
+ Text = '..\..\tests\pictures\originals\Canon-Powershot_A70-II-Th.JPG'
+ end
+ object Memo: TMemo
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = BtnLoad
+ AnchorSideTop.Side = asrBottom
+ AnchorSideRight.Control = Thumbnail
+ AnchorSideBottom.Control = Panel1
+ Left = 8
+ Height = 398
+ Top = 41
+ Width = 604
+ Anchors = [akTop, akLeft, akRight, akBottom]
+ BorderSpacing.Left = 8
+ BorderSpacing.Top = 8
+ BorderSpacing.Right = 8
+ ScrollBars = ssAutoBoth
+ TabOrder = 2
+ end
+ object BtnBrowse: TButton
+ AnchorSideTop.Control = BtnLoad
+ AnchorSideRight.Control = BtnLoad
+ Left = 689
+ Height = 25
+ Top = 8
+ Width = 35
+ Anchors = [akTop, akRight]
+ AutoSize = True
+ BorderSpacing.Right = 4
+ Caption = '...'
+ OnClick = BtnBrowseClick
+ TabOrder = 3
+ end
+ object Panel1: TPanel
+ Left = 0
+ Height = 39
+ Top = 439
+ Width = 788
+ Align = alBottom
+ AutoSize = True
+ BevelOuter = bvNone
+ ClientHeight = 39
+ ClientWidth = 788
+ TabOrder = 4
+ object CbVerbosity: TComboBox
+ AnchorSideLeft.Control = Panel1
+ AnchorSideTop.Control = Panel1
+ Left = 8
+ Height = 23
+ Top = 8
+ Width = 192
+ BorderSpacing.Left = 8
+ BorderSpacing.Top = 8
+ BorderSpacing.Bottom = 8
+ ItemHeight = 15
+ ItemIndex = 2
+ Items.Strings = (
+ 'Tag names only'
+ 'Decimal tag IDs'
+ 'Hex tag IDs'
+ )
+ OnChange = CbVerbosityChange
+ Style = csDropDownList
+ TabOrder = 0
+ Text = 'Hex tag IDs'
+ end
+ object CbDecodeValue: TCheckBox
+ AnchorSideLeft.Control = CbVerbosity
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = CbVerbosity
+ AnchorSideTop.Side = asrCenter
+ Left = 208
+ Height = 19
+ Top = 10
+ Width = 96
+ BorderSpacing.Left = 8
+ Caption = 'Decode values'
+ Checked = True
+ OnChange = CbDecodeValueChange
+ State = cbChecked
+ TabOrder = 1
+ end
+ object CbTruncateBinaryTags: TCheckBox
+ AnchorSideLeft.Control = CbDecodeValue
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = CbVerbosity
+ AnchorSideTop.Side = asrCenter
+ Left = 312
+ Height = 19
+ Top = 10
+ Width = 128
+ BorderSpacing.Left = 8
+ Caption = 'Truncate binary tags'
+ Checked = True
+ OnChange = CbTruncateBinaryTagsChange
+ State = cbChecked
+ TabOrder = 2
+ end
+ object CbBinaryAsASCII: TCheckBox
+ AnchorSideLeft.Control = CbTruncateBinaryTags
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = CbVerbosity
+ AnchorSideTop.Side = asrCenter
+ Left = 448
+ Height = 19
+ Top = 10
+ Width = 123
+ BorderSpacing.Left = 8
+ Caption = 'Binary tags as ASCII'
+ OnChange = CbBinaryAsASCIIChange
+ TabOrder = 3
+ end
+ object BtnSave: TButton
+ AnchorSideTop.Control = Panel1
+ AnchorSideTop.Side = asrCenter
+ AnchorSideRight.Control = Panel1
+ AnchorSideRight.Side = asrBottom
+ Left = 650
+ Height = 25
+ Top = 7
+ Width = 130
+ Anchors = [akTop, akRight]
+ AutoSize = True
+ BorderSpacing.Right = 8
+ Caption = 'Save as "_modified"'
+ Enabled = False
+ OnClick = BtnSaveClick
+ TabOrder = 4
+ end
+ end
+ object Thumbnail: TImage
+ AnchorSideTop.Control = Memo
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ Left = 620
+ Height = 151
+ Top = 41
+ Width = 160
+ Anchors = [akTop, akRight]
+ BorderSpacing.Right = 8
+ Center = True
+ Proportional = True
+ Stretch = True
+ end
+ object CbTags: TComboBox
+ AnchorSideLeft.Control = EdNewTagValue
+ AnchorSideRight.Control = EdNewTagValue
+ AnchorSideRight.Side = asrBottom
+ AnchorSideBottom.Control = Label1
+ Left = 620
+ Height = 23
+ Top = 366
+ Width = 160
+ Anchors = [akLeft, akRight, akBottom]
+ BorderSpacing.Bottom = 8
+ DropDownCount = 32
+ ItemHeight = 15
+ OnSelect = CbTagsSelect
+ Style = csDropDownList
+ TabOrder = 5
+ end
+ object Label1: TLabel
+ AnchorSideLeft.Control = EdNewTagValue
+ AnchorSideBottom.Control = EdNewTagValue
+ Left = 620
+ Height = 15
+ Top = 397
+ Width = 55
+ Anchors = [akLeft, akBottom]
+ BorderSpacing.Bottom = 4
+ Caption = 'New value'
+ ParentColor = False
+ end
+ object EdNewTagValue: TEdit
+ AnchorSideLeft.Control = Thumbnail
+ AnchorSideRight.Control = Thumbnail
+ AnchorSideRight.Side = asrBottom
+ AnchorSideBottom.Control = Memo
+ AnchorSideBottom.Side = asrBottom
+ Left = 620
+ Height = 23
+ Top = 416
+ Width = 160
+ Anchors = [akLeft, akRight, akBottom]
+ OnEditingDone = EdNewTagValueEditingDone
+ TabOrder = 6
+ end
+ object Label2: TLabel
+ AnchorSideLeft.Control = CbTags
+ AnchorSideBottom.Control = CbTags
+ Left = 620
+ Height = 15
+ Top = 347
+ Width = 19
+ Anchors = [akLeft, akBottom]
+ BorderSpacing.Bottom = 4
+ Caption = 'Tag'
+ ParentColor = False
+ end
+ object OpenDialog: TOpenDialog
+ DefaultExt = '.jpg'
+ Filter = 'All supported images (*.jpg; *.jpeg; *.jfe); *.tiff; *.tif|*.jpg;*.jpeg;*.jfe;*.tiff;*.tif|JPG files (*.jpg; *.jpeg; *.jfe)|*.jpg;*.jpeg;*.jfe|TIFF files (*.tiff; *.tif)|*.tiff;*.tif'
+ left = 248
+ top = 168
+ end
+end
diff --git a/components/fpexif/examples/simple_demo/sdmain.pas b/components/fpexif/examples/simple_demo/sdmain.pas
new file mode 100644
index 000000000..cdf895a98
--- /dev/null
+++ b/components/fpexif/examples/simple_demo/sdmain.pas
@@ -0,0 +1,437 @@
+unit sdMain;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+ ExtCtrls, fpeMetadata;
+
+type
+
+ { TMainForm }
+
+ TMainForm = class(TForm)
+ BtnLoad: TButton;
+ BtnBrowse: TButton;
+ BtnSave: TButton;
+ CbDecodeValue: TCheckBox;
+ CbFilename: TComboBox;
+ CbVerbosity: TComboBox;
+ CbTruncateBinaryTags: TCheckBox;
+ CbBinaryAsASCII: TCheckBox;
+ CbTags: TComboBox;
+ EdNewTagValue: TEdit;
+ Label1: TLabel;
+ Label2: TLabel;
+ Thumbnail: TImage;
+ Memo: TMemo;
+ OpenDialog: TOpenDialog;
+ Panel1: TPanel;
+ procedure BtnLoadClick(Sender: TObject);
+ procedure BtnBrowseClick(Sender: TObject);
+ procedure BtnSaveClick(Sender: TObject);
+ procedure CbBinaryAsASCIIChange(Sender: TObject);
+ procedure CbDecodeValueChange(Sender: TObject);
+ procedure CbFilenameSelect(Sender: TObject);
+ procedure CbTagsSelect(Sender: TObject);
+ procedure CbTruncateBinaryTagsChange(Sender: TObject);
+ procedure CbVerbosityChange(Sender: TObject);
+ procedure EdNewTagValueEditingDone(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ private
+ FImgInfo: TImgInfo;
+ FModified: Boolean;
+ procedure AddToHistory(AFileName: String);
+ procedure DisplayMetadata;
+ procedure LoadFile(const AFileName: String);
+ procedure LoadThumbnail;
+ procedure PopulateTagCombo;
+ procedure ReadFromIni;
+ procedure UpdateCaption(AInit: Boolean);
+ procedure WriteToIni;
+
+ public
+ procedure BeforeRun;
+
+ end;
+
+var
+ MainForm: TMainForm;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ IniFiles, fpeGlobal, fpeTags, fpeExifData;
+
+{ TMainForm }
+
+procedure TMainForm.AddToHistory(AFileName: String);
+var
+ i: Integer;
+begin
+ if (AFileName = '') or (not FileExists(AFileName)) then
+ exit;
+
+ i := CbFileName.Items.Indexof(AFileName);
+ if i > -1 then
+ CbFileName.Items.Delete(i);
+ CbFileName.Items.Insert(0, AFileName);
+ CbFileName.ItemIndex := 0;
+end;
+
+procedure TMainForm.BeforeRun;
+begin
+ ReadFromIni;
+end;
+
+procedure TMainForm.BtnBrowseClick(Sender: TObject);
+var
+ olddir: String;
+begin
+ olddir := GetCurrentDir;
+ OpenDialog.FileName := '';
+ if OpenDialog.Execute then begin
+ AddToHistory(OpenDialog.Filename);
+ SetCurrentDir(oldDir);
+ LoadFile(OpenDialog.Filename);
+ end;
+end;
+
+procedure TMainForm.BtnLoadClick(Sender: TObject);
+begin
+ LoadFile(CbFilename.Text);
+end;
+
+procedure TMainForm.BtnSaveClick(Sender: TObject);
+var
+ fn, ext: String;
+begin
+ ext := ExtractFileExt(CbFilename.Text);
+ fn := ChangeFileExt(CbFileName.Text, '');
+ if pos('_modified', fn) <> Length(fn) - Length('modified') then
+ fn := fn + '_modified' + ext
+ else
+ fn := CbFilename.Text;
+ FImgInfo.SaveToFile(fn);
+ MessageDlg(Format('File saved as "%s"', [fn]), mtInformation, [mbOK], 0);
+end;
+
+procedure TMainForm.CbBinaryAsASCIIChange(Sender: TObject);
+begin
+ DisplayMetadata;
+end;
+
+procedure TMainForm.CbDecodeValueChange(Sender: TObject);
+begin
+ DisplayMetadata;
+end;
+
+procedure TMainForm.CbFilenameSelect(Sender: TObject);
+begin
+ LoadFile(CbFileName.Text);
+end;
+
+procedure TMainForm.CbTagsSelect(Sender: TObject);
+var
+ lTag: TTag;
+ decoded: Boolean;
+begin
+ if FImgInfo.HasExif then begin
+ lTag := FImgInfo.ExifData.TagByName[CbTags.Text];
+ decoded := lTag.DecodeValue;
+ lTag.DecodeValue := false;
+ EdNewTagValue.Text := lTag.AsString;
+ lTag.DecodeValue := decoded;
+ end;
+end;
+
+procedure TMainForm.CbTruncateBinaryTagsChange(Sender: TObject);
+begin
+ DisplayMetadata;
+end;
+
+procedure TMainForm.CbVerbosityChange(Sender: TObject);
+begin
+ DisplayMetadata;
+end;
+
+procedure TMainForm.DisplayMetadata;
+const
+ SEPARATOR = ': ';
+var
+ exportOptions: TExportOptions;
+begin
+ Memo.Lines.Clear;
+
+ if FImgInfo <> nil then begin
+ exportOptions := [eoShowTagName];
+ case CbVerbosity.ItemIndex of
+ 1: Include(exportOptions, eoShowDecimalTagID);
+ 2: Include(exportOptions, eoShowHexTagID);
+ end;
+ if CbDecodeValue.Checked then
+ Include(exportOptions, eoDecodeValue) else
+ Exclude(exportOptions, eoDecodeValue);
+ if CbTruncateBinaryTags.Checked then
+ Include(exportOptions, eoTruncateBinary) else
+ Exclude(exportOptions, eoTruncateBinary);
+ if CbBinaryAsASCII.Checked then
+ Include(exportOptions, eoBinaryAsASCII) else
+ Exclude(exportOptions, eoBinaryAsASCII);
+
+ Memo.Lines.BeginUpdate;
+ try
+ if FImgInfo.ExifData <> nil then begin
+ FImgInfo.ExifData.ExportOptions := exportOptions;
+ FImgInfo.ExifData.ExportToStrings(Memo.Lines, SEPARATOR);
+ end;
+ if FImgInfo.IptcData <> nil then
+ FImgInfo.IptcData.ExportToStrings(Memo.Lines, exportOptions, SEPARATOR);
+ finally
+ Memo.Lines.EndUpdate;
+ Memo.Invalidate;
+ end;
+ end;
+end;
+
+procedure TMainForm.EdNewTagValueEditingDone(Sender: TObject);
+var
+ lTag: TTag;
+ i: Integer;
+ f: Double;
+ dt: TDateTime;
+begin
+ if FImgInfo.HasExif then begin
+ lTag := FImgInfo.ExifData.TagByName[CbTags.Text];
+ if lTag = nil then begin
+ MessageDlg('Tag not found.', mtError, [mbOK], 0);
+ exit;
+ end;
+ if lTag.ReadOnly then begin
+ MessageDlg('This tag is readonly.', mtError, [mbOK], 0);
+ exit;
+ end;
+
+ if (lTag is TDateTimeTag) then begin
+ if TryStrToDateTime(EdNewTagValue.Text, dt) then begin
+ FModified := FModified or (TDateTimeTag(lTag).AsDateTime <> dt);
+ TDateTimeTag(lTag).AsDateTime := dt;
+ end else begin
+ MessageDlg('Date/time value expected for this kind of tag.', mtError, [mbOK], 0);
+ exit;
+ end;
+ end else
+ if (lTag is TShutterSpeedTag) then begin
+ FModified := true;
+ TShutterSpeedTag(lTag).AsString := EdNewTagValue.Text;
+ end else
+ if (lTag is TStringTag) then begin
+ FModified := FModified or (EdNewTagValue.Text <> TStringTAg(lTag).AsString);
+ TStringTag(lTag).AsString := EdNewTagValue.Text;
+ end else
+ if (lTag is TIntegerTag) and (lTag.Count = 1) then begin
+ if TryStrToInt(EdNewTagValue.Text, i) then begin
+ FModified := FModified or (TIntegerTag(lTag).AsInteger <> i);
+ TIntegerTag(lTag).AsInteger := i;
+ end else begin
+ MessageDlg('Integer value expected for this kind of tag.', mtError, [mbOK], 0);
+ exit;
+ end;
+ end else
+ if (lTag is TFloatTag) and (lTag.Count = 1) then begin
+ if TryStrToFloat(EdNewTagValue.Text, f) then begin
+ FModified := FModified or (TFloatTag(lTag).AsFloat <> f);
+ TFloatTag(lTag).AsFloat := f;
+ end else begin
+ MessageDlg('Floating point value expected for this kind of tag.', mtError, [mbOK], 0);
+ exit;
+ end;
+ end;
+ DisplayMetadata;
+ UpdateCaption(false);
+ end;
+end;
+
+procedure TMainForm.FormCreate(Sender: TObject);
+begin
+ UpdateCaption(true);
+end;
+
+procedure TMainForm.FormDestroy(Sender: TObject);
+begin
+ WriteToIni;
+ FImgInfo.Free;
+end;
+
+procedure TMainForm.LoadFile(const AFileName: String);
+var
+ exportOptions: TExportOptions;
+begin
+ if FImgInfo = nil then
+ FImgInfo := TImgInfo.Create;
+
+ try
+ FImgInfo.LoadFromFile(ExpandFileName(CbFilename.Text));
+ if FImgInfo.ExifData <> nil then begin
+ DisplayMetadata;
+ LoadThumbnail;
+ PopulateTagCombo;
+ AddToHistory(AFilename);
+ end else begin
+ Thumbnail.Picture.Clear;
+ CbTags.Items.Clear;
+ end;
+ if FImgInfo.HasWarnings then begin
+ Memo.Lines.Add('');
+ Memo.Lines.Add('*** WARNINGS ****');
+ Memo.Lines.Add(FImgInfo.Warnings);
+ end;
+ UpdateCaption(false);
+ FModified := false;
+ BtnSave.Enabled := FImgInfo.ImgFormat = ifJpeg;
+ except
+ on E:EFpExifReader do begin
+ Memo.Lines.Text := E.Message;
+ Thumbnail.Picture.Clear;
+ CbTags.Items.Clear;
+ ShowMessage(E.Message);
+ end;
+ end;
+end;
+
+procedure TMainForm.LoadThumbnail;
+var
+ ms: TMemoryStream;
+begin
+ if (FImgInfo.ExifData = nil) or (not FImgInfo.Exifdata.HasThumbnail) then
+ exit;
+
+ ms := TMemoryStream.Create;
+ try
+ FImgInfo.ExifData.SaveThumbnailToStream(ms);
+ ms.Position := 0;
+ Thumbnail.Picture.LoadfromStream(ms);
+ finally
+ ms.Free;
+ end;
+end;
+
+procedure TMainForm.PopulateTagCombo;
+var
+ i: Integer;
+ L: TStrings;
+ lTag: TTag;
+begin
+ L := TStringList.Create;
+ try
+ if FImgInfo.HasExif then
+ for i:=0 to FImgInfo.ExifData.TagCount-1 do begin
+ lTag := FImgInfo.ExifData.TagByIndex[i];
+ if not lTag.ReadOnly or lTag.IsVolatile then
+ L.Add(GroupNames[lTag.Group] + '.' + lTag.Name);
+ end;
+ CbTags.Items.Assign(L);
+ CbTags.ItemIndex := -1;
+ finally
+ L.Free;
+ end;
+end;
+
+function CreateIni: TCustomIniFile;
+begin
+ Result := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
+end;
+
+procedure TMainForm.ReadFromIni;
+var
+ ini: TCustomIniFile;
+ list: TStrings;
+ i: Integer;
+ W, H, L, T: Integer;
+ R: TRect;
+begin
+ ini := CreateIni;
+ try
+ list := TStringList.Create;
+ try
+ if WindowState = wsNormal then begin
+ W := ini.ReadInteger('MainForm', 'Width', Width);
+ H := ini.ReadInteger('MainForm', 'Height', Height);
+ L := ini.ReadInteger('MainForm', 'Left', Left);
+ T := ini.ReadInteger('MainForm', 'Top', Top);
+ R := Screen.DesktopRect;
+ if W > R.Right - R.Left then W := R.Right - R.Left;
+ if L+W > R.Right then L := R.Right - W;
+ if L < R.Left then L := R.Left;
+ if H > R.Bottom - R.Top then H := R.Bottom - R.Top;
+ if T+H > R.Bottom then T := R.Bottom - H;
+ if T < R.Top then T := R.Top;
+ SetBounds(L, T, W, H);
+ end;
+
+ CbVerbosity.ItemIndex := ini.ReadInteger('Settings', 'Verbosity', CbVerbosity.ItemIndex);
+ CbDecodeValue.Checked := ini.ReadBool('Settings', 'DecodeValue', CbDecodeValue.Checked);
+
+ ini.ReadSection('History', list);
+ for i:=list.Count-1 downto 0 do // count downward because AddToHistory adds to the beginning of the list
+ AddToHistory(ini.ReadString('History', list[i], ''));
+ CbFilename.ItemIndex := 0;
+ finally
+ list.Free;
+ end;
+ finally
+ ini.Free;
+ end;
+end;
+
+procedure TMainForm.UpdateCaption(AInit: Boolean);
+const
+ DEFAULT_CAPTION = 'Picture metadata viewer';
+var
+ mask: String;
+begin
+ if AInit then
+ Caption := DEFAULT_CAPTION
+ else
+ begin
+ if FModified then
+ mask := '%s - [*] %s' else
+ mask := '%s - %s';
+ if FImgInfo.Filename <> '' then
+ Caption := Format(mask, [DEFAULT_CAPTION, '"' + FImgInfo.FileName + '"'])
+ else
+ Caption := Format(mask, [DEFAULT_CAPTION, 'ERROR']);
+ end;
+end;
+
+procedure TMainForm.WriteToIni;
+var
+ ini: TCustomIniFile;
+ i: Integer;
+begin
+ ini := CreateIni;
+ try
+ ini.WriteInteger('MainForm', 'Left', Left);
+ ini.WriteInteger('MainForm', 'Top', Top);
+ ini.WriteInteger('MainForm', 'Width', Width);
+ ini.WriteInteger('MainForm', 'Height', Height);
+
+ ini.WriteInteger('Settings', 'Verbosity', CbVerbosity.ItemIndex);
+ ini.WriteBool('Settings', 'DecodeValue', CbDecodeValue.Checked);
+
+ for i:=0 to CbFileName.Items.Count-1 do
+ if (CbFilename.Items[i] <> '') and FileExists(CbFilename.Items[i]) then
+ ini.WriteString('History', 'Item'+IntToStr(i+1), CbFilename.Items[i]);
+ ini.UpdateFile;
+ finally
+ ini.Free;
+ end;
+end;
+
+
+end.