diff --git a/components/fpexif/delphi examples/console_demo/console_demo.dpr b/components/fpexif/delphi examples/console_demo/console_demo.dpr new file mode 100644 index 000000000..182be9621 --- /dev/null +++ b/components/fpexif/delphi examples/console_demo/console_demo.dpr @@ -0,0 +1,93 @@ +program console_demo; + +{$APPTYPE CONSOLE} +{$DEFINE dExifNoJpeg} + +{$R *.res} + +uses + SysUtils, + fpeMetaData, + fpeTags; + +var + imgInfo: TImgInfo; + tag: TTag; + +const + FILENAME = '..\..\..\test-image.jpg'; + +begin + try + imgInfo := TImgInfo.Create; + try + // Read file + imgInfo.LoadFromFile(FILENAME); + + // Check for EXIF + if imgInfo.HasExif then begin + + // Write out some tags + // (1) date and time when the picture was taken + Write('Date/time: ':20); + tag := imgInfo.ExifData.TagByName['DateTime']; + if tag = nil then + WriteLn('--- not available in this file ---') + else + WriteLn(tag.AsString); + + // (2) shutter speed used when taking the photo + tag := imgInfo.ExifData.TagByName['ShutterSpeed']; + if tag <> nil then + WriteLn('Shutter speed: ':20, tag.AsString) + else + begin + // (3) Sometimes alternative tags are availabe + tag := imgInfo.ExifData.TagByName['ExposureTime']; + if tag <> nil then + WriteLn('Exposure time: ':20, tag.AsString); + end; + + // Focal length + tag := imgInfo.ExifData.TagByName['FocalLength']; + if tag <> nil then + WriteLn('Focal length: ':20, tag.AsString); + + // Add user comment + imgInfo.ExifData.TagByName['UserComment'].AsString := 'This is my favorite photo.'; + + // Save to file + imgInfo.SaveToFile(ExtractFilePath(FILENAME) + 'edited_image.jpg'); + end + else + WriteLn('No EXIF data in this file.'); + + // Check for IPTC + if imgInfo.HasIPTC then begin + // Write out IPTC key words + Write('IPTC Keywords: ':20); + tag := imgInfo.IptcData.TagByName['Keywords']; + if tag = nil then + WriteLn('--- not available in this file ---') + else + WriteLn(tag.AsString); + end + else + WriteLn('No IPTC data in this file.'); + + finally + imgInfo.Free; + end; + + WriteLn; + WriteLn('Press ENTER to quit...'); + ReadLn; + except + on E: Exception do begin + Writeln(E.ClassName, ': ', E.Message); + WriteLn; + WriteLn('Press ENTER to quit...'); + ReadLn; + end; + end; +end. diff --git a/components/fpexif/delphi examples/console_demo/console_demo.dproj b/components/fpexif/delphi examples/console_demo/console_demo.dproj new file mode 100644 index 000000000..8334ac270 --- /dev/null +++ b/components/fpexif/delphi examples/console_demo/console_demo.dproj @@ -0,0 +1,649 @@ + + + {FAF25CF3-1AD3-4E91-AAE4-53A637D73E44} + 18.6 + None + console_demo.dpr + True + Debug + Win32 + 1 + Console + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + console_demo + ..\..;$(DCC_UnitSearchPath) + dExifNoJpeg;$(DCC_Define) + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;tethering;fmxFireDAC;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services-ads-7.0.0.dex.jar;google-play-services-analytics-7.0.0.dex.jar;google-play-services-base-7.0.0.dex.jar;google-play-services-gcm-7.0.0.dex.jar;google-play-services-identity-7.0.0.dex.jar;google-play-services-maps-7.0.0.dex.jar;google-play-services-panorama-7.0.0.dex.jar;google-play-services-plus-7.0.0.dex.jar;google-play-services-wallet-7.0.0.dex.jar + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + 1033 + (Ohne) + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Application + + + + console_demo.dpr + + + Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver + Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server + + + + + + true + + + + + true + + + + + true + + + + + true + + + + + true + + + + + console_demo.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 1 + + + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + + + res\values + 1 + + + + + res\values-v21 + 1 + + + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + False + True + False + + + 12 + + + + + diff --git a/components/fpexif/delphi examples/console_demo/console_demo.pas b/components/fpexif/delphi examples/console_demo/console_demo.pas new file mode 100644 index 000000000..25a4e2334 --- /dev/null +++ b/components/fpexif/delphi examples/console_demo/console_demo.pas @@ -0,0 +1,74 @@ +program console_demo; + +{$mode objfpc}{$H+} + +uses + Classes, + fpeMetaData, fpeTags; + +var + imgInfo: TImgInfo; + tag: TTag; + +begin + imgInfo := TImgInfo.Create; + try + // Read file + imgInfo.LoadFromFile('..\test-image.jpg'); + + // Check for EXIF + if imgInfo.HasExif then begin + + // Write out some tags + // (1) date and time when the picture was taken + Write('Date/time: ':20); + tag := imgInfo.ExifData.TagByName['DateTime']; + if tag = nil then + WriteLn('--- not available in this file ---') + else + WriteLn(tag.AsString); + + // (2) shutter speed used when taking the photo + tag := imgInfo.ExifData.TagByName['ShutterSpeed']; + if tag <> nil then + WriteLn('Shutter speed: ':20, tag.AsString) + else + begin + // (3) Sometimes alternative tags are availabe + tag := imgInfo.ExifData.TagByName['ExposureTime']; + if tag <> nil then + WriteLn('Exposure time: ':20, tag.AsString); + end; + + // Add user comment + imgInfo.ExifData.TagByName['UserComment'].AsString := 'This is my favorite photo.'; + + // Save to file + imgInfo.SaveToFile('edited_image.jpg'); + end + else + WriteLn('No EXIF data in this file.'); + + // Check for IPTC + if imgInfo.HasIPTC then begin + // Write out IPTC key words + Write('Keywords: ':20); + tag := imgInfo.IptcData.TagByName['Keywords']; + if tag = nil then + WriteLn('--- not available in this file ---') + else + WriteLn(tag.AsString); + end + else + WriteLn('No IPTC data in this file.'); + + finally + imgInfo.Free; + end; + + WriteLn; + WriteLn('Press ENTER to quit...'); + ReadLn; + +end. + diff --git a/components/fpexif/delphi examples/metadata_viewer/MetadataViewer.dpr b/components/fpexif/delphi examples/metadata_viewer/MetadataViewer.dpr new file mode 100644 index 000000000..7272039d9 --- /dev/null +++ b/components/fpexif/delphi examples/metadata_viewer/MetadataViewer.dpr @@ -0,0 +1,15 @@ +program MetadataViewer; + +uses + Forms, + mdvMain in 'mdvMain.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + MainForm.BeforeRun; + Application.Run; +end. + diff --git a/components/fpexif/delphi examples/metadata_viewer/MetadataViewer.dproj b/components/fpexif/delphi examples/metadata_viewer/MetadataViewer.dproj new file mode 100644 index 000000000..c5078237e --- /dev/null +++ b/components/fpexif/delphi examples/metadata_viewer/MetadataViewer.dproj @@ -0,0 +1,144 @@ + + + {2958AB0F-1A2B-4CDE-B1F2-B6C5B3644858} + MetadataViewer.dpr + True + Debug + 1 + Application + VCL + 18.6 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + MetadataViewer + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1031 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + ..\..;$(DCC_UnitSearchPath) + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + MetadataViewer_Icon.ico + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\default_app.manifest + MetadataViewer_Icon.ico + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + true + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + + + true + PerMonitorV2 + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + true + + + + MainSource + + +
Form1
+
+ + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + +
+ + Delphi.Personality.12 + + + + + MetadataViewer.dpr + + + Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver + Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server + + + + True + False + + + 12 + + + +
diff --git a/components/fpexif/delphi examples/metadata_viewer/MetadataViewer.res b/components/fpexif/delphi examples/metadata_viewer/MetadataViewer.res new file mode 100644 index 000000000..00d8064f4 Binary files /dev/null and b/components/fpexif/delphi examples/metadata_viewer/MetadataViewer.res differ diff --git a/components/fpexif/delphi examples/metadata_viewer/mdvmain.dfm b/components/fpexif/delphi examples/metadata_viewer/mdvmain.dfm new file mode 100644 index 000000000..cfc4497bf --- /dev/null +++ b/components/fpexif/delphi examples/metadata_viewer/mdvmain.dfm @@ -0,0 +1,319 @@ +object MainForm: TMainForm + Left = 430 + Top = 141 + Caption = 'Metadata viewer' + ClientHeight = 714 + ClientWidth = 926 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = True + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Splitter2: TSplitter + Left = 274 + Top = 0 + Width = 5 + Height = 691 + end + object ShellPanel: TPanel + Left = 0 + Top = 0 + Width = 274 + Height = 691 + Align = alLeft + BevelOuter = bvNone + TabOrder = 0 + object Splitter1: TSplitter + Left = 0 + Top = 269 + Width = 274 + Height = 5 + Cursor = crVSplit + Align = alTop + end + object PreviewImage: TImage + Left = 0 + Top = 547 + Width = 274 + Height = 144 + Hint = 'Thumbnail image embedded in the image file' + Align = alBottom + Center = True + Proportional = True + Stretch = True + end + object ShellTreeView: TDirectoryOutline + Left = 0 + Top = 0 + Width = 274 + Height = 269 + Hint = 'Navigate to the folder with your images.' + Align = alTop + ItemHeight = 13 + Options = [ooDrawFocusRect] + PictureLeaf.Data = { + 46030000424D460300000000000036000000280000000E0000000E0000000100 + 2000000000001003000000000000000000000000000000000000800080008000 + 8000800080008000800080008000800080008000800080008000800080008000 + 8000800080008000800080008000800080008000800080008000800080008000 + 8000800080008000800080008000800080008000800080008000800080008000 + 8000800080008000800080008000800080008000800080008000800080008000 + 8000800080008000800080008000800080008000800080008000800080008000 + 8000800080000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000008000800080008000800080000000000000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF000000000080008000800080008000800000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000008000 + 800080008000800080000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000080008000800080008000 + 800000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF00000000008000800080008000800080000000000000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF000000000080008000800080008000800000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000008000 + 8000800080008000800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008000800080008000800080008000 + 80008000800000000000FFFFFF0000FFFF00FFFFFF0000FFFF00000000008000 + 8000800080008000800080008000800080008000800080008000800080008080 + 8000000000000000000000000000000000008080800080008000800080008000 + 8000800080008000800080008000800080008000800080008000800080008000 + 8000800080008000800080008000800080008000800080008000800080008000 + 80008000800080008000} + TabOrder = 0 + OnChange = ShellTreeViewChange + Data = {10} + end + object ShellListView: TFileListBox + Left = 0 + Top = 274 + Width = 274 + Height = 260 + Hint = 'Select the image for which you want to see the metadata' + Align = alClient + Mask = '*.jpg;*.jpeg;*.jpe;*.tiff;*.tif' + ShowGlyphs = True + TabOrder = 2 + OnChange = ShellListViewChange + end + object Panel4: TPanel + Left = 0 + Top = 534 + Width = 274 + Height = 13 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + TabOrder = 1 + object Label1: TLabel + Left = 8 + Top = 0 + Width = 79 + Height = 13 + Caption = 'Thumbnail image' + Color = clBtnFace + ParentColor = False + end + end + end + object Panel2: TPanel + Left = 279 + Top = 0 + Width = 647 + Height = 691 + Align = alClient + BevelOuter = bvNone + TabOrder = 2 + object Splitter3: TSplitter + Left = 0 + Top = 571 + Width = 647 + Height = 5 + Cursor = crVSplit + Align = alBottom + ExplicitTop = 562 + end + object Panel3: TPanel + Left = 0 + Top = 0 + Width = 647 + Height = 21 + Align = alTop + AutoSize = True + BevelOuter = bvNone + BorderWidth = 4 + TabOrder = 0 + object FilenameInfo: TLabel + Left = 4 + Top = 4 + Width = 23 + Height = 13 + Caption = 'File: ' + Color = clBtnFace + ParentColor = False + end + end + object PageControl1: TPageControl + Left = 0 + Top = 21 + Width = 647 + Height = 550 + ActivePage = PgMetadata + Align = alClient + TabOrder = 1 + OnChange = PageControl1Change + object PgMetadata: TTabSheet + Caption = 'Meta data' + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 + object TagListView: TListView + Left = 0 + Top = 0 + Width = 639 + Height = 503 + Align = alClient + Columns = < + item + Caption = 'Group' + Width = 120 + end + item + Caption = 'Tag ID' + Width = 60 + end + item + Caption = 'Property' + Width = 220 + end + item + AutoSize = True + Caption = 'Value' + end> + HideSelection = False + ReadOnly = True + RowSelect = True + SortType = stText + TabOrder = 0 + ViewStyle = vsReport + OnCompare = TagListViewCompare + OnSelectItem = TagListViewSelectItem + end + object Panel1: TPanel + Left = 0 + Top = 503 + Width = 639 + Height = 19 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + TabOrder = 1 + ExplicitTop = 501 + object CbDecodeMakerNotes: TCheckBox + Left = 0 + Top = 0 + Width = 127 + Height = 19 + Hint = 'Try to decode information in the MakerNote tag if possible' + Caption = 'Decode MakerNotes' + Checked = True + State = cbChecked + TabOrder = 0 + end + end + end + object PgImage: TTabSheet + Caption = 'Image' + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 + object Image: TImage + Left = 0 + Top = 0 + Width = 639 + Height = 522 + Align = alClient + Center = True + Proportional = True + Stretch = True + ExplicitHeight = 545 + end + end + end + object Messages: TMemo + Left = 0 + Top = 576 + Width = 647 + Height = 90 + Align = alBottom + TabOrder = 2 + end + object DateTimePanel: TPanel + Left = 0 + Top = 666 + Width = 647 + Height = 25 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + TabOrder = 3 + object LblChangeDate: TLabel + Left = 4 + Top = 5 + Width = 124 + Height = 13 + Caption = 'Change EXIF date/time to' + Color = clBtnFace + ParentColor = False + end + object EdChangeDate: TEdit + Left = 144 + Top = 1 + Width = 152 + Height = 21 + Hint = 'New date to be assigned to the selected image' + TabOrder = 0 + end + object BtnChangeDate: TButton + Left = 304 + Top = 0 + Width = 67 + Height = 25 + Hint = 'Replaces the image date.' + Caption = 'Execute' + TabOrder = 1 + OnClick = BtnChangeDateClick + end + end + end + object StatusBar1: TStatusBar + Left = 0 + Top = 691 + Width = 926 + Height = 23 + Panels = < + item + Width = 150 + end + item + Width = 150 + end + item + Width = 250 + end + item + Width = 150 + end + item + Width = 100 + end> + end +end diff --git a/components/fpexif/delphi examples/metadata_viewer/mdvmain.pas b/components/fpexif/delphi examples/metadata_viewer/mdvmain.pas new file mode 100644 index 000000000..e8c4e30ce --- /dev/null +++ b/components/fpexif/delphi examples/metadata_viewer/mdvmain.pas @@ -0,0 +1,605 @@ +unit mdvMain; + +{$IFDEF FPC} + !!! THIS PROGRAM IS INTENDED FOR DELPHI ONLY + {$ENDIF} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, + ExtCtrls, ComCtrls, StdCtrls, DirOutLn, FileCtrl, jpeg, + fpeGlobal, fpeMetadata, fpeMakerNote, + Grids, Outline; + +type + + { TMainForm } + + TMainForm = class(TForm) + BtnChangeDate: TButton; + CbDecodeMakerNotes: TCheckBox; + EdChangeDate: TEdit; + FilenameInfo: TLabel; + Image: TImage; + Label1: TLabel; + LblChangeDate: TLabel; + Messages: TMemo; + PageControl1: TPageControl; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + DateTimePanel: TPanel; + Panel4: TPanel; + PreviewImage: TImage; + Splitter3: TSplitter; + StatusBar1: TStatusBar; + PgMetadata: TTabSheet; + PgImage: TTabSheet; + TagListView: TListView; + ShellPanel: TPanel; + ShellTreeView: TDirectoryOutline; + ShellListView: TFileListbox; + Splitter1: TSplitter; + Splitter2: TSplitter; + procedure BtnChangeDateClick(Sender: TObject); + procedure CbShowTagIDsChange(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure PageControl1Change(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); + procedure ShellTreeViewChange(Sender: TObject); + procedure ShellListViewChange(Sender: TObject); + private + FFileName: String; + FImgInfo: TImgInfo; + FImageLoaded: Boolean; + FImageOrientation: TExifOrientation; + procedure LoadFile(const AFileName: String); + procedure LoadFromIni; + procedure SaveToIni; + procedure UpdateCaption; + + public + procedure BeforeRun; + + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +uses + Types, IniFiles, Math, StrUtils, DateUtils, + fpeTags, fpeExifData, fpeIptcData; + +const + TAG_ID_CAPTION = 'Tag ID'; + LineEnding = #13#10; + +function CalcIniName: String; +begin + Result := ChangeFileExt(Application.ExeName, '.ini'); +end; + +procedure RotateBitmap(const ABitmap: TBitmap; AOrientation: TExifOrientation); +{ +Var + bmp: TBitmap; + srcImg, dstImg: TLazIntfImage; + imgHandle, imgMaskHandle: HBitmap; + i, j: integer; + w1, h1: Integer; // Input bitmap width and height diminished by 1 +} +Begin +exit; +(* + Assert(ABitmap <> nil, 'RotateBitmap: Input bitmap is expected not to be nil.'); + + if (AOrientation = eoUnknown) or (AOrientation = eoNormal) then + exit; + + w1 := ABitmap.Width - 1; + h1 := ABitmap.Height - 1; + srcImg := TLazIntfImage.Create(0, 0); + try + srcImg.LoadFromBitmap(ABitmap.Handle, ABitmap.MaskHandle); + bmp := TBitmap.Create; + try + dstImg := TLazIntfImage.Create(0, 0); + try + if AOrientation in [eoRotate90, eoRotate270, eoMirrorHorRot90, eoMirrorHorRot270] then + begin + bmp.SetSize(ABitmap.Height, ABitmap.Width); + dstImg.LoadFromBitmap(bmp.Handle, bmp.MaskHandle); + case AOrientation of + eoRotate90: + for i:=0 to w1 do + for j:=0 to h1 do + dstImg.Colors[h1-j, i] := srcImg.Colors[i, j]; + eoRotate270: + for i:=0 to w1 do + for j:=0 to h1 do + dstImg.Colors[j, w1-i] := srcImg.Colors[i, j]; + eoMirrorHorRot90: + for i:=0 to w1 do + for j:=0 to h1 do + dstImg.Colors[h1-j, w1-i] := srcImg.Colors[i, j]; + eoMirrorHorRot270: + for i:=0 to w1 do + for j:=0 to h1 do + dstImg.Colors[j, i] := srcImg.Colors[i, j]; + end; + end else + if AOrientation in [eoRotate180, eoMirrorHor, eoMirrorVert] then + begin + bmp.SetSize(ABitmap.Width, ABitmap.Height); + dstImg.LoadFromBitmap(bmp.Handle, bmp.MaskHandle); + case AOrientation of + eoRotate180: + for i:=0 to w1 do + for j:=0 to h1 do + dstImg.Colors[w1-i, h1-j] := srcImg.Colors[i, j]; + eoMirrorHor: + for j:=0 to h1 do + for i:=0 to w1 do + dstImg.Colors[w1-i, j] := srcImg.Colors[i, j]; + eoMirrorVert: + for i:=0 to w1 do + for j:=0 to h1 do + dstImg.Colors[i, h1-j] := srcImg.Colors[i, j]; + end; + end; + dstImg.CreateBitmaps(imgHandle, imgMaskHandle, false); + bmp.Handle := ImgHandle; + bmp.MaskHandle := ImgMaskHandle; + finally + dstImg.Free; + end; + ABitmap.Assign(bmp); + finally + bmp.Free; + end; + finally + srcImg.Free; + end; + *) +end; + +{ TMainForm } + +procedure TMainForm.BeforeRun; +begin + LoadFromIni; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + //ShellListView.Parent.DoubleBuffered := true; +end; + +procedure TMainForm.BtnChangeDateClick(Sender: TObject); +var + lTag: TTag; + dt: TDateTime; + fn: String; +begin + if (FImgInfo = nil) or (FImgInfo.ExifData = nil) then + exit; + + if not TryStrToDateTime(EdChangeDate.Text, dt) then begin + MessageDlg('No valid date/time. Use your locale settings.', mtError, [mbOK], 0); + exit; + end; + + lTag := FImgInfo.ExifData.TagByName['DateTimeOriginal']; + if lTag <> nil then + TDateTimeTag(lTag).AsDateTime := dt; + + lTag := FImgInfo.ExifData.TagByName['DateTimeDigitized']; + if lTag <> nil then + TDateTimeTag(lTag).AsDateTime := dt; + + lTag := FImgInfo.ExifData.TagByName['DateTime']; + if lTag <> nil then + TDateTimeTag(lTag).AsDateTime := dt; + + fn := FImgInfo.FileName; + fn := ChangeFileExt(fn, '') + '_modified' + ExtractFileExt(fn); + FImgInfo.SaveToFile(fn); +end; + +procedure TMainForm.CbShowTagIDsChange(Sender: TObject); +var + c: TListColumn; + i: Integer; +begin + TagListView.Items.BeginUpdate; + try + c := nil; + for i:=0 to TagListView.Columns.Count-1 do + if TagListView.Columns[i].Caption = TAG_ID_CAPTION then begin + c := TagListView.Columns[i]; + break; + end; + { + if c <> nil then + c.Visible := CbShowTagIDs.Checked;; + } + finally + TagListView.Items.EndUpdate; + end; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + try + SaveToIni; + except + end; + FImgInfo.Free; +end; + +type + TMyPicture = class(TPicture); + +procedure TMainForm.LoadFile(const AFileName: String); +var + lTag: TTag; + item: TListItem; + i: Integer; + ms: TMemoryStream; + suffix: String; + crs: TCursor; + jpg: TJpegImage; +begin + FImageLoaded := false; + FFileName := AFileName; + Image.Picture.Assign(nil); + PreviewImage.Picture.Assign(nil); + + TagListView.Items.BeginUpdate; + try + TagListView.Clear; + FImgInfo.Free; + FImgInfo := TImgInfo.Create; + try + try + if CbDecodeMakerNotes.Checked then + FImgInfo.MetadataKinds := FImgInfo.MetadataKinds + [mdkExif] - [mdkExifNoMakerNotes] + else + FImgInfo.MetadataKinds := FImgInfo.MetadataKinds - [mdkExif] + [mdkExifNoMakerNotes]; + FImgInfo.LoadFromFile(AFileName); + Messages.Hide; + except + on E:EFpExif do begin + Messages.Lines.Text := E.Message; + Messages.Show; + end; + end; + if FImgInfo.HasExif then begin + FImageOrientation := FImgInfo.ExifData.ImgOrientation; + FImgInfo.ExifData.ExportOptions := FImgInfo.ExifData.ExportOptions + [eoTruncateBinary]; + for i := 0 to FImgInfo.ExifData.TagCount-1 do begin + lTag := FImgInfo.ExifData.TagByIndex[i]; + + if lTag is TMakerNoteStringTag then + suffix := ':' + IntToStr(TMakerNoteStringTag(lTag).Index) + else if lTag is TMakerNoteIntegerTag then + suffix := ':' + IntToStr(TMakerNoteIntegerTag(lTag).Index) + else if lTag is TMakerNoteFloatTag then + suffix := ':' + IntToStr(TMakerNoteFloatTag(lTag).Index) + else + suffix := ''; + + if lTag is TVersionTag then + TVersionTag(lTag).Separator := '.'; + item := TagListView.Items.Add; + item.Data := lTag; + item.Caption := 'EXIF.' + NiceGroupNames[lTag.Group]; + item.SubItems.Add(Format('$%.04x:$%.04x%s', [lTag.TagIDRec.Parent, lTag.TagIDRec.Tag, suffix])); + item.SubItems.Add(lTag.Description); + item.SubItems.Add(lTag.AsString); + end; + + lTag := FImgInfo.ExifData.TagByName['DateTimeOriginal']; + if lTag <> nil then + EdChangeDate.Text := DateTimeToStr(TDateTimeTag(lTag).AsDateTime) + else + EdChangeDate.Text := ''; + DateTimePanel.Show; + end else + DateTimePanel.Hide; + + 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 + try + FImgInfo.SaveThumbnailToStream(ms); + ms.Position := 0; + jpg := TJpegImage.Create; + try + jpg.LoadFromStream(ms); + PreviewImage.Picture.Assign(jpg); + finally + jpg.Free; + end; +// TMyPicture(PreviewImage.Picture).LoadFromStream(ms); // cast needed for old Delphi + //RotateBitmap(PreviewImage.Picture.Bitmap, FImageOrientation); + except + on E:Exception do Messages.Lines.Add(E.Message); + end; + finally + ms.Free; + end; + end else + ; + //PreviewImage.Picture.Clear; + + if FImgInfo.HasWarnings then begin + Messages.Lines.Text := FImgInfo.Warnings; + Messages.Show; + end; + + except + on E:Exception do begin + FreeAndNil(FImgInfo); + Messages.Lines.Text := E.Message; + Messages.Show; + end; + end; + + if PageControl1.ActivePage = PgImage then begin + crs := Screen.Cursor; + try + Screen.Cursor := crHourglass; + Image.Picture.LoadFromFile(AFileName); + { + if Assigned(FImgInfo) and Assigned(FImgInfo.ExifData) then + RotateBitmap(Image.Picture.Bitmap, FImageOrientation); + } + FImageLoaded := true; + finally + Screen.Cursor := crs; + end; + 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; + b: Boolean; +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 begin + ShellTreeView.Directory := s; + ShellListView.Directory := s; + end; + + 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.PageControl1Change(Sender: TObject); +var + crs: TCursor; +begin + if not FImageLoaded then begin + crs := Screen.Cursor; + try + Screen.Cursor := crHourglass; + Image.Picture.LoadFromFile(FFileName); + FImageLoaded := true; + finally + Screen.Cursor := crs; + end; + 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.Directory); + 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.ShellListViewChange(Sender: TObject); +var + fn: String; +begin + fn := ShellListView.FileName; + if fn <> '' then begin + ShellTreeView.Directory := ExtractFilePath(fn); + LoadFile(fn); + end; +end; + +procedure TMainForm.ShellTreeViewChange(Sender: TObject); +begin + ShellListview.Directory := ShellTreeView.Directory; +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 + if FFilename <> '' then + FilenameInfo.Caption := Format('File: %s', [FFileName]) + else + FilenameInfo.caption := '< no file >'; +end; + +end. + diff --git a/components/fpexif/delphi examples/simple_demo/ExifSimpleDemo.dpr b/components/fpexif/delphi examples/simple_demo/ExifSimpleDemo.dpr new file mode 100644 index 000000000..07a757eb8 --- /dev/null +++ b/components/fpexif/delphi examples/simple_demo/ExifSimpleDemo.dpr @@ -0,0 +1,15 @@ +program ExifSimpleDemo; + +uses + Forms, + sdMain in 'sdMain.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + MainForm.BeforeRun; + Application.Run; +end. + diff --git a/components/fpexif/delphi examples/simple_demo/ExifSimpleDemo.dproj b/components/fpexif/delphi examples/simple_demo/ExifSimpleDemo.dproj new file mode 100644 index 000000000..f477e95f4 --- /dev/null +++ b/components/fpexif/delphi examples/simple_demo/ExifSimpleDemo.dproj @@ -0,0 +1,139 @@ + + + {927DB824-6C5B-4A5F-8555-627D51D654D3} + ExifSimpleDemo.dpr + True + Debug + 1 + Application + VCL + 18.6 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + ExifSimpleDemo + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1031 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + ..\..;$(DCC_UnitSearchPath) + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + true + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + + + true + PerMonitorV2 + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + + + + MainSource + + +
Form1
+
+ + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + +
+ + Delphi.Personality.12 + + + + + ExifSimpleDemo.dpr + + + Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver + Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server + + + + True + False + + + 12 + + + +
diff --git a/components/fpexif/delphi examples/simple_demo/ExifSimpleDemo.res b/components/fpexif/delphi examples/simple_demo/ExifSimpleDemo.res new file mode 100644 index 000000000..9123d193d Binary files /dev/null and b/components/fpexif/delphi examples/simple_demo/ExifSimpleDemo.res differ diff --git a/components/fpexif/delphi examples/simple_demo/sdmain.dfm b/components/fpexif/delphi examples/simple_demo/sdmain.dfm new file mode 100644 index 000000000..8f1011a1c --- /dev/null +++ b/components/fpexif/delphi examples/simple_demo/sdmain.dfm @@ -0,0 +1,186 @@ +object MainForm: TMainForm + Left = 329 + Top = 131 + Caption = 'MainForm' + ClientHeight = 477 + ClientWidth = 788 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = True + OnCreate = FormCreate + OnDestroy = FormDestroy + DesignSize = ( + 788 + 477) + PixelsPerInch = 96 + TextHeight = 13 + object Thumbnail: TImage + Left = 620 + Top = 41 + Width = 160 + Height = 151 + Anchors = [akTop, akRight] + Center = True + Proportional = True + Stretch = True + end + object Label1: TLabel + Left = 620 + Top = 380 + Width = 50 + Height = 13 + Anchors = [akRight, akBottom] + Caption = 'New value' + Color = clBtnFace + ParentColor = False + end + object Label2: TLabel + Left = 618 + Top = 330 + Width = 18 + Height = 13 + Anchors = [akRight, akBottom] + Caption = 'Tag' + Color = clBtnFace + ParentColor = False + end + object BtnLoad: TButton + Left = 728 + Top = 8 + Width = 52 + Height = 25 + Anchors = [akTop, akRight] + Caption = 'Load' + TabOrder = 0 + OnClick = BtnLoadClick + end + object CbFilename: TComboBox + Left = 8 + Top = 9 + Width = 677 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 1 + Text = '..\test-image.jpg' + OnSelect = CbFilenameSelect + end + object Memo: TMemo + Left = 8 + Top = 41 + Width = 604 + Height = 384 + Anchors = [akLeft, akTop, akRight, akBottom] + ScrollBars = ssBoth + TabOrder = 2 + end + object BtnBrowse: TButton + Left = 689 + Top = 8 + Width = 35 + Height = 25 + Anchors = [akTop, akRight] + Caption = '...' + TabOrder = 3 + OnClick = BtnBrowseClick + end + object Panel1: TPanel + Left = 0 + Top = 442 + Width = 788 + Height = 35 + Align = alBottom + BevelOuter = bvNone + TabOrder = 4 + DesignSize = ( + 788 + 35) + object CbVerbosity: TComboBox + Left = 8 + Top = 1 + Width = 192 + Height = 21 + Style = csDropDownList + ItemIndex = 2 + TabOrder = 0 + Text = 'Hex tag IDs' + Items.Strings = ( + 'Tag names only' + 'Decimal tag IDs' + 'Hex tag IDs') + end + object CbDecodeValue: TCheckBox + Left = 208 + Top = 3 + Width = 96 + Height = 19 + Caption = 'Decode values' + Checked = True + State = cbChecked + TabOrder = 1 + OnClick = CbDecodeValueClick + end + object CbTruncateBinaryTags: TCheckBox + Left = 312 + Top = 3 + Width = 127 + Height = 19 + Caption = 'Truncate binary tags' + Checked = True + State = cbChecked + TabOrder = 2 + OnClick = CbTruncateBinaryTagsClick + end + object CbBinaryAsASCII: TCheckBox + Left = 447 + Top = 3 + Width = 123 + Height = 19 + Caption = 'Binary tags as ASCII' + TabOrder = 3 + OnClick = CbBinaryAsASCIIClick + end + object BtnSave: TButton + Left = 650 + Top = 0 + Width = 130 + Height = 25 + Anchors = [akTop, akRight] + Caption = 'Save as "_modified"' + Enabled = False + TabOrder = 4 + OnClick = BtnSaveClick + end + end + object CbTags: TComboBox + Left = 620 + Top = 349 + Width = 160 + Height = 21 + Style = csDropDownList + Anchors = [akRight, akBottom] + DropDownCount = 32 + TabOrder = 5 + OnSelect = CbTagsSelect + end + object EdNewTagValue: TEdit + Left = 620 + Top = 399 + Width = 160 + Height = 21 + Anchors = [akRight, akBottom] + TabOrder = 6 + 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)|*.jp' + + 'g;*.jpeg;*.jfe|TIFF files (*.tiff; *.tif)|*.tiff;*.tif' + Left = 248 + Top = 168 + end +end diff --git a/components/fpexif/delphi examples/simple_demo/sdmain.pas b/components/fpexif/delphi examples/simple_demo/sdmain.pas new file mode 100644 index 000000000..97326905d --- /dev/null +++ b/components/fpexif/delphi examples/simple_demo/sdmain.pas @@ -0,0 +1,449 @@ +unit sdMain; + +interface + +uses + Classes, SysUtils, Types, Forms, Controls, Graphics, Dialogs, StdCtrls, + ExtCtrls, fpeMetadata, fpeMakerNote; + +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 CbBinaryAsASCIIClick(Sender: TObject); + procedure CbDecodeValueClick(Sender: TObject); + procedure CbFilenameSelect(Sender: TObject); + procedure CbTagsSelect(Sender: TObject); + procedure CbTruncateBinaryTagsClick(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 *.dfm} + +uses + IniFiles, jpeg, 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.CbBinaryAsASCIIClick(Sender: TObject); +begin + DisplayMetadata; +end; + +procedure TMainForm.CbDecodeValueClick(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.CbTruncateBinaryTagsClick(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.Assign(nil); + 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.Assign(nil); + CbTags.Items.Clear; + ShowMessage(E.Message); + end; + end; +end; + +procedure TMainForm.LoadThumbnail; +var + ms: TMemoryStream; + jpg: TJpegImage; +begin + if not FImgInfo.HasThumbnail then + exit; + + //if (FImgInfo.ExifData = nil) or (not FImgInfo.Exifdata.HasThumbnail) then + // exit; + + ms := TMemoryStream.Create; + try + FImgInfo.SaveThumbnailToStream(ms); + ms.Position := 0; + jpg := TJpegImage.Create; + try + jpg.LoadFromStream(ms); + Thumbnail.Picture.Assign(jpg); + finally + jpg.Free; + end; + 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], '')); + if CbFilename.Items.Count = 0 then + AddToHistory('..\test-image.jpg'); + + + 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. diff --git a/components/fpexif/delphi examples/test-image.jpg b/components/fpexif/delphi examples/test-image.jpg new file mode 100644 index 000000000..cec694dad Binary files /dev/null and b/components/fpexif/delphi examples/test-image.jpg differ