unit Unit4;
interface
uses
Winapi.Windows, System.SysUtils, System.Classes,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.ExtDlgs;
type
TForm4 =
class(TForm)
Memo1: TMemo;
OpenPictureDialog1: TOpenPictureDialog;
procedure Memo1Click(Sender: TObject);
private
procedure ShowExifInfos(
const AFileName:
string);
procedure LogToMemo(AText:
string);
end;
var
Form4: TForm4;
implementation
uses
Winapi.ActiveX,
Winapi.GDIPAPI,
Winapi.GDIPOBJ,
Winapi.GDIPUTIL;
{$R *.dfm}
procedure GetExifInfo(
const AFileName:
string;
const CommonExifProperties: TArray<PROPID>;
const ALogCallback: TProc<
string>);
var
Image: TGPBitmap;
PropSize: UINT;
PropItemPtr: PPropertyItem;
MyPropID: PROPID;
MyStatus: Status;
LogMsg:
string;
begin
Image := TGPBitmap.Create(AFileName);
try
if (Image.GetWidth <> 0)
and (Image.GetHeight <> 0)
then
begin
for MyPropID
in CommonExifProperties
do
begin
PropSize := Image.GetPropertyItemSize(MyPropID);
if PropSize > 0
then
begin
GetMem(PropItemPtr, PropSize);
try
MyStatus := Image.GetPropertyItem(MyPropID, PropSize, PropItemPtr);
if MyStatus = Status.Ok
then
begin
LogMsg := '
Exif-Property: ' + GetMetaDataIDString(PropItemPtr.id) +
'
with PropSize: ' + PropItemPtr.length.ToString +
'
and data type: ' + ValueTypeFromULONG(PropItemPtr.type_);
if Assigned(ALogCallback)
then
begin
ALogCallback(LogMsg)
end;
end;
finally
FreeMem(PropItemPtr, PropSize);
end;
end;
end;
end;
finally
Image.Free;
end;
end;
procedure TForm4.LogToMemo(AText:
string);
begin
Memo1.Lines.Add(AText);
end;
procedure TForm4.Memo1Click(Sender: TObject);
var
MyFileName:
string;
begin
OpenPictureDialog1.Filter := '
*.jpg; *.jpeg';
if OpenPictureDialog1.Execute(Self.Handle)
then
begin
MyFileName := OpenPictureDialog1.FileName;
LogToMemo('
Öffne Datei ' + MyFileName + sLineBreak);
ShowExifInfos(MyFileName);
LogToMemo(sLineBreak + '
Fertig!');
end;
end;
procedure TForm4.ShowExifInfos(
const AFileName:
string);
var
CommonExifProperties: TArray<PROPID>;
begin
CommonExifProperties := [
PropertyTagExifAperture
, PropertyTagExifBrightness
, PropertyTagExifCfaPattern
, PropertyTagExifColorSpace
, PropertyTagExifCompBPP
, PropertyTagExifCompConfig
, PropertyTagExifDTDigitized
, PropertyTagExifDTDigSS
, PropertyTagExifDTOrig
, PropertyTagExifDTOrigSS
, PropertyTagExifDTSubsec
, PropertyTagExifExposureBias
, PropertyTagExifExposureIndex
, PropertyTagExifExposureProg
, PropertyTagExifExposureTime
, PropertyTagExifFileSource
, PropertyTagExifFlash
, PropertyTagExifFlashEnergy
, PropertyTagExifFNumber
, PropertyTagExifFocalLength
, PropertyTagExifFocalResUnit
, PropertyTagExifFocalXRes
, PropertyTagExifFocalYRes
, PropertyTagExifFPXVer
, PropertyTagExifInterop
, PropertyTagExifISOSpeed
, PropertyTagExifLightSource
, PropertyTagExifMakerNote
, PropertyTagExifMaxAperture
, PropertyTagExifMeteringMode
, PropertyTagExifOECF
, PropertyTagExifPixXDim
, PropertyTagExifPixYDim
, PropertyTagExifRelatedWav
, PropertyTagExifSceneType
, PropertyTagExifSensingMethod
, PropertyTagExifShutterSpeed
, PropertyTagExifSpatialFR
, PropertyTagExifSpectralSense
, PropertyTagExifSubjectDist
, PropertyTagExifSubjectLoc
, PropertyTagExifUserComment
, PropertyTagExifVer
];
GetExifInfo(AFileName, CommonExifProperties, LogToMemo);
end;
end.