diff --git a/components/fpexif/examples/file_renamer/file_renamer.lpi b/components/fpexif/examples/file_renamer/file_renamer.lpi new file mode 100644 index 000000000..8819052db --- /dev/null +++ b/components/fpexif/examples/file_renamer/file_renamer.lpi @@ -0,0 +1,82 @@ + + + + + + + + + + <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> diff --git a/components/fpexif/examples/file_renamer/file_renamer.lpr b/components/fpexif/examples/file_renamer/file_renamer.lpr new file mode 100644 index 000000000..9d1ecdc7c --- /dev/null +++ b/components/fpexif/examples/file_renamer/file_renamer.lpr @@ -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. + diff --git a/components/fpexif/examples/file_renamer/frmain.lfm b/components/fpexif/examples/file_renamer/frmain.lfm new file mode 100644 index 000000000..b33bbc084 --- /dev/null +++ b/components/fpexif/examples/file_renamer/frmain.lfm @@ -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 diff --git a/components/fpexif/examples/file_renamer/frmain.pas b/components/fpexif/examples/file_renamer/frmain.pas new file mode 100644 index 000000000..93c37cf8d --- /dev/null +++ b/components/fpexif/examples/file_renamer/frmain.pas @@ -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. +