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

fpexif: Add demos metadata_viewer and simple_demo

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6082 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-12-02 18:45:28 +00:00
parent 13726c172b
commit 3813bcca82
10 changed files with 1478 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
components/fpexif/examples/metadata_viewer/MetadataViewer.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

77
components/fpexif/examples/metadata_viewer/MetadataViewer.lpi Normal file
View File

@@ -0,0 +1,77 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="MetadataViewer"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="fpexif_pkg"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="MetadataViewer.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="mdvmain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="mdvMain"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="MetadataViewer"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

22
components/fpexif/examples/metadata_viewer/MetadataViewer.lpr Normal file
View File

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

271
components/fpexif/examples/metadata_viewer/mdvmain.lfm Normal file
View File

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

319
components/fpexif/examples/metadata_viewer/mdvmain.pas Normal file
View File

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

BIN
components/fpexif/examples/simple_demo/ExifSimpleDemo.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

82
components/fpexif/examples/simple_demo/ExifSimpleDemo.lpi Normal file
View File

@@ -0,0 +1,82 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="ExifSimpleDemo"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="fpexif_pkg"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="ExifSimpleDemo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="sdmain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="sdMain"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="ExifSimpleDemo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

22
components/fpexif/examples/simple_demo/ExifSimpleDemo.lpr Normal file
View File

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

248
components/fpexif/examples/simple_demo/sdmain.lfm Normal file
View File

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

437
components/fpexif/examples/simple_demo/sdmain.pas Normal file
View File

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