You've already forked lazarus-ccr
fpexif: Add example "file_renamer" (adds EXIF date to filename).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6136 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
82
components/fpexif/examples/file_renamer/file_renamer.lpi
Normal file
82
components/fpexif/examples/file_renamer/file_renamer.lpi
Normal file
@ -0,0 +1,82 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="file_renamer"/>
|
||||
<Scaled Value="True"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="fpexif_pkg"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="file_renamer.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="frmain.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="frMain"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="file_renamer"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<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/file_renamer/file_renamer.lpr
Normal file
22
components/fpexif/examples/file_renamer/file_renamer.lpr
Normal file
@ -0,0 +1,22 @@
|
||||
program file_renamer;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, frMain
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Scaled := True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
289
components/fpexif/examples/file_renamer/frmain.lfm
Normal file
289
components/fpexif/examples/file_renamer/frmain.lfm
Normal file
@ -0,0 +1,289 @@
|
||||
object Form1: TForm1
|
||||
Left = 303
|
||||
Height = 545
|
||||
Top = 129
|
||||
Width = 772
|
||||
Caption = 'Exif file renamer'
|
||||
ClientHeight = 545
|
||||
ClientWidth = 772
|
||||
OnCloseQuery = FormCloseQuery
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '1.9.0.0'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 545
|
||||
Top = 0
|
||||
Width = 336
|
||||
Align = alLeft
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 545
|
||||
ClientWidth = 336
|
||||
TabOrder = 0
|
||||
object ShellTreeView: TShellTreeView
|
||||
Left = 4
|
||||
Height = 406
|
||||
Top = 4
|
||||
Width = 332
|
||||
Align = alClient
|
||||
BorderSpacing.Left = 4
|
||||
BorderSpacing.Top = 4
|
||||
BorderSpacing.Bottom = 4
|
||||
FileSortType = fstNone
|
||||
Images = ImageList
|
||||
TabOrder = 0
|
||||
OnGetImageIndex = ShellTreeViewGetImageIndex
|
||||
OnGetSelectedIndex = ShellTreeViewGetSelectedIndex
|
||||
OnSelectionChanged = ShellTreeViewSelectionChanged
|
||||
ObjectTypes = [otFolders]
|
||||
end
|
||||
object ThumbImg: TImage
|
||||
Left = 4
|
||||
Height = 122
|
||||
Top = 419
|
||||
Width = 332
|
||||
Align = alBottom
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 4
|
||||
BorderSpacing.Bottom = 4
|
||||
Center = True
|
||||
Proportional = True
|
||||
Stretch = True
|
||||
end
|
||||
object Splitter2: TSplitter
|
||||
Cursor = crVSplit
|
||||
Left = 0
|
||||
Height = 5
|
||||
Top = 414
|
||||
Width = 336
|
||||
Align = alBottom
|
||||
ResizeAnchor = akBottom
|
||||
end
|
||||
end
|
||||
object Panel2: TPanel
|
||||
Left = 341
|
||||
Height = 545
|
||||
Top = 0
|
||||
Width = 431
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 545
|
||||
ClientWidth = 431
|
||||
TabOrder = 1
|
||||
object BtnRename: TButton
|
||||
AnchorSideLeft.Control = Panel2
|
||||
AnchorSideRight.Control = BtnClose
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 264
|
||||
Height = 25
|
||||
Top = 516
|
||||
Width = 69
|
||||
Anchors = [akRight]
|
||||
AutoSize = True
|
||||
BorderSpacing.Right = 4
|
||||
BorderSpacing.Bottom = 4
|
||||
Caption = 'Rename'
|
||||
OnClick = BtnRenameClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object BtnClose: TButton
|
||||
AnchorSideTop.Control = BtnRename
|
||||
AnchorSideRight.Control = BtnInfo
|
||||
AnchorSideBottom.Control = Panel2
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 337
|
||||
Height = 25
|
||||
Top = 516
|
||||
Width = 55
|
||||
Anchors = [akTop, akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Right = 4
|
||||
BorderSpacing.Bottom = 4
|
||||
Caption = 'Close'
|
||||
OnClick = BtnCloseClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object FileListView: TListView
|
||||
AnchorSideLeft.Control = Panel2
|
||||
AnchorSideTop.Control = Panel2
|
||||
AnchorSideRight.Control = Panel2
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = BtnClose
|
||||
Left = 0
|
||||
Height = 508
|
||||
Top = 4
|
||||
Width = 427
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Top = 4
|
||||
BorderSpacing.Right = 4
|
||||
BorderSpacing.Bottom = 4
|
||||
Checkboxes = True
|
||||
Columns = <
|
||||
item
|
||||
AutoSize = True
|
||||
Caption = 'Original file name'
|
||||
Width = 109
|
||||
end
|
||||
item
|
||||
AutoSize = True
|
||||
Caption = 'New file name'
|
||||
Width = 91
|
||||
end>
|
||||
RowSelect = True
|
||||
TabOrder = 2
|
||||
ViewStyle = vsReport
|
||||
OnSelectItem = FileListViewSelectItem
|
||||
end
|
||||
object BtnCheckAll: TButton
|
||||
AnchorSideLeft.Control = Panel2
|
||||
AnchorSideTop.Control = BtnClose
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 0
|
||||
Height = 25
|
||||
Top = 516
|
||||
Width = 74
|
||||
AutoSize = True
|
||||
BorderSpacing.Bottom = 5
|
||||
Caption = 'Check all'
|
||||
OnClick = BtnCheckAllClick
|
||||
TabOrder = 3
|
||||
end
|
||||
object BtnCheckNone: TButton
|
||||
AnchorSideLeft.Control = BtnCheckAll
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = BtnClose
|
||||
Left = 78
|
||||
Height = 25
|
||||
Top = 516
|
||||
Width = 89
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 4
|
||||
Caption = 'Check none'
|
||||
OnClick = BtnCheckNoneClick
|
||||
TabOrder = 4
|
||||
end
|
||||
object BtnInfo: TButton
|
||||
AnchorSideTop.Control = BtnClose
|
||||
AnchorSideRight.Control = Panel2
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 396
|
||||
Height = 25
|
||||
Top = 516
|
||||
Width = 31
|
||||
Anchors = [akTop, akRight]
|
||||
AutoSize = True
|
||||
BorderSpacing.Right = 4
|
||||
Caption = '?'
|
||||
OnClick = BtnInfoClick
|
||||
TabOrder = 5
|
||||
end
|
||||
end
|
||||
object Splitter1: TSplitter
|
||||
Left = 336
|
||||
Height = 545
|
||||
Top = 0
|
||||
Width = 5
|
||||
end
|
||||
object ImageList: TImageList
|
||||
left = 117
|
||||
top = 128
|
||||
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
|
||||
285
components/fpexif/examples/file_renamer/frmain.pas
Normal file
285
components/fpexif/examples/file_renamer/frmain.pas
Normal file
@ -0,0 +1,285 @@
|
||||
unit frMain;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, ShellCtrls,
|
||||
ExtCtrls, StdCtrls, ComCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
BtnRename: TButton;
|
||||
BtnClose: TButton;
|
||||
BtnCheckAll: TButton;
|
||||
BtnCheckNone: TButton;
|
||||
BtnInfo: TButton;
|
||||
Splitter2: TSplitter;
|
||||
ThumbImg: TImage;
|
||||
ImageList: TImageList;
|
||||
FileListView: TListView;
|
||||
Panel1: TPanel;
|
||||
Panel2: TPanel;
|
||||
ShellTreeView: TShellTreeView;
|
||||
Splitter1: TSplitter;
|
||||
procedure BtnCheckAllClick(Sender: TObject);
|
||||
procedure BtnCheckNoneClick(Sender: TObject);
|
||||
procedure BtnRenameClick(Sender: TObject);
|
||||
procedure BtnCloseClick(Sender: TObject);
|
||||
procedure BtnInfoClick(Sender: TObject);
|
||||
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FileListViewSelectItem(Sender: TObject; Item: TListItem;
|
||||
Selected: Boolean);
|
||||
procedure ShellTreeViewGetImageIndex(Sender: TObject; Node: TTreeNode);
|
||||
procedure ShellTreeViewGetSelectedIndex(Sender: TObject; Node: TTreeNode);
|
||||
procedure ShellTreeViewSelectionChanged(Sender: TObject);
|
||||
private
|
||||
function ExtractExifDate(AFileName: String): TDateTime;
|
||||
procedure PopulateListview;
|
||||
function RemoveDateFromFilename(AFileName: String): String;
|
||||
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
FileUtil, IniFiles,
|
||||
fpeMetadata, fpeExifData, fpeTags;
|
||||
|
||||
function CreateIni: TCustomIniFile;
|
||||
begin
|
||||
Result := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
|
||||
end;
|
||||
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.BtnCheckAllClick(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to FileListView.Items.Count-1 do
|
||||
FileListView.Items[i].Checked := true;
|
||||
end;
|
||||
|
||||
procedure TForm1.BtnCheckNoneClick(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to FileListView.Items.Count-1 do
|
||||
FileListView.Items[i].Checked := false;
|
||||
end;
|
||||
|
||||
procedure TForm1.BtnCloseClick(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TForm1.BtnInfoClick(Sender: TObject);
|
||||
begin
|
||||
ShowMessage(
|
||||
'This program renames the checked files. It extracts the date/time from '+
|
||||
'the EXIF metadata and puts it in front of the original file name.'
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TForm1.BtnRenameClick(Sender: TObject);
|
||||
var
|
||||
oldname: String;
|
||||
newname: String;
|
||||
i: Integer;
|
||||
n: Integer;
|
||||
begin
|
||||
n := 0;
|
||||
for i:=0 to FileListView.Items.Count-1 do begin
|
||||
newname := FileListView.Items[i].SubItems[0];
|
||||
if (newname <> '') and FileListView.Items[i].Checked then begin
|
||||
newname := ShellTreeView.Path + newname;
|
||||
oldname := ShellTreeView.Path + RemoveDateFromFilename(FileListView.Items[i].Caption);
|
||||
if not FileExists(newname) then begin
|
||||
RenameFile(oldname, newname);
|
||||
inc(n);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
PopulateListview;
|
||||
ShowMessage(IntToStr(n) + ' files renamed.');
|
||||
end;
|
||||
|
||||
function TForm1.ExtractExifDate(AFileName: String): TDateTime;
|
||||
var
|
||||
imginfo: TImgInfo;
|
||||
lTag: TTag;
|
||||
begin
|
||||
Result := 0;
|
||||
imgInfo := TImgInfo.Create;
|
||||
try
|
||||
imgInfo.LoadfromFile(AFileName);
|
||||
if not imgInfo.HasExif then
|
||||
exit;
|
||||
lTag := imgInfo.ExifData.TagByName['DateTimeOriginal'];
|
||||
if lTag = nil then
|
||||
lTag := imgInfo.ExifData.TagByName['DateTime'];
|
||||
if lTag = nil then
|
||||
lTag := imgInfo.ExifData.TagByName['DateTimeDigitized'];
|
||||
if lTag is TDateTimeTag then
|
||||
Result := TDateTimeTag(lTag).AsDateTime;
|
||||
finally
|
||||
imgInfo.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
|
||||
var
|
||||
ini: TCustomIniFile;
|
||||
begin
|
||||
if CanClose then
|
||||
ini := CreateIni;
|
||||
try
|
||||
ini.WriteString('Config', 'Path', ShellTreeView.Path);
|
||||
finally
|
||||
ini.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
var
|
||||
ini: TCustominiFile;
|
||||
begin
|
||||
ini := CreateIni;
|
||||
try
|
||||
ShellTreeView.Path := ini.ReadString('Config', 'Path', '');
|
||||
finally
|
||||
ini.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.FileListViewSelectItem(Sender: TObject; Item: TListItem;
|
||||
Selected: Boolean);
|
||||
var
|
||||
imgInfo: TImgInfo;
|
||||
ms: TMemoryStream;
|
||||
begin
|
||||
if not Selected then
|
||||
exit;
|
||||
|
||||
Screen.Cursor := crHourglass;
|
||||
imgInfo := TImgInfo.Create;
|
||||
try
|
||||
imgInfo.LoadFromFile(ShellTreeView.Path + Item.Caption);
|
||||
if not (imgInfo.HasExif and imgInfo.HasThumbnail) then begin
|
||||
ThumbImg.Picture.LoadFromFile(ShellTreeView.Path + Item.Caption);
|
||||
exit;
|
||||
end;
|
||||
|
||||
ms := TMemoryStream.Create;
|
||||
try
|
||||
imgInfo.ExifData.SaveThumbnailToStream(ms);
|
||||
if ms.Size > 0 then begin
|
||||
ms.Position := 0;
|
||||
ThumbImg.Picture.LoadfromStream(ms);
|
||||
end else
|
||||
ThumbImg.Picture.Clear;
|
||||
finally
|
||||
ms.Free;
|
||||
end;
|
||||
finally
|
||||
imgInfo.Free;
|
||||
Screen.Cursor := crDefault;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.PopulateListview;
|
||||
const
|
||||
DATETIME_MASK = 'yyyymmdd-hhnnss';
|
||||
var
|
||||
L: TStrings;
|
||||
i: Integer;
|
||||
dt: TDateTime;
|
||||
oldname, newname: String;
|
||||
begin
|
||||
Screen.Cursor := crHourglass;
|
||||
FileListView.Items.Clear;
|
||||
L := TStringList.Create;
|
||||
try
|
||||
FindAllFiles(L, ShellTreeView.Path, '*.jpg;*.jpeg', false);
|
||||
for i:=0 to L.Count-1 do begin
|
||||
dt := ExtractExifDate(L[i]);
|
||||
oldname := ExtractFileName(L[i]);
|
||||
if dt <> 0 then
|
||||
newname := FormatDateTime(DATETIME_MASK, dt) + ' ' + oldname
|
||||
else
|
||||
newname := '';
|
||||
with FileListView.Items.Add do begin
|
||||
Caption := oldname;
|
||||
SubItems.Add(newname);
|
||||
Checked := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
finally
|
||||
L.Free;
|
||||
Screen.Cursor := crDefault;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TForm1.RemoveDateFromFilename(AFileName: String): String;
|
||||
var
|
||||
sy, sm, sd, sh, sn, ss: String;
|
||||
vy, vm, vd, vh, vn, vs: Integer;
|
||||
fd, ft: TDateTime;
|
||||
begin
|
||||
sy := Copy(AFileName, 1, 4);
|
||||
sm := Copy(AFileName, 5, 2);
|
||||
sd := Copy(AFileName, 7, 2);
|
||||
sh := Copy(AFileName, 10, 2);
|
||||
sn := Copy(AFileName, 12, 2);
|
||||
ss := Copy(AFileName, 14, 2);
|
||||
if TryStrToInt(sy, vy) and TryStrToInt(sm, vm) and TryStrToInt(sd, vd) and
|
||||
TryStrToInt(sh, vh) and TryStrToInt(sn, vn) and TryStrToInt(ss, vs) and
|
||||
TryEncodeDate(vy,vm,vd, fd) and TryEncodeTime(vh,vn,vs,0, ft)
|
||||
then
|
||||
Result := trim(Copy(AFileName, 16, Length(AFileName)))
|
||||
else
|
||||
Result := AFilename;
|
||||
end;
|
||||
|
||||
procedure TForm1.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 TForm1.ShellTreeViewGetSelectedIndex(Sender: TObject;
|
||||
Node: TTreeNode);
|
||||
begin
|
||||
ShellTreeviewGetImageIndex(nil, Node);
|
||||
end;
|
||||
|
||||
procedure TForm1.ShellTreeViewSelectionChanged(Sender: TObject);
|
||||
begin
|
||||
PopulateListview;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user