fpexif: Initial commit of units and tests

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6080 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-12-02 17:12:00 +00:00
parent 615a6d44e1
commit e03afa62f1
70 changed files with 23516 additions and 0 deletions

3597
components/fpexif/fpEXIF.pas Normal file

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,156 @@
unit fpeGlobal;
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}
{$I fpExif.inc}
interface
uses
Classes, SysUtils;
type
TMetaDataKind = (mdkExif, mdkIPTC, mdkComment);
TMetaDataKinds = set of TMetaDataKind;
const
mdkAll = [mdkExif, mdkIPTC, mdkComment];
type
{$IFNDEF FPC}
DWord = Cardinal;
PDWord = ^DWord;
PtrInt = NativeInt;
Int32 = LongInt;
{$ENDIF}
TBytes = array of byte; // Needed for Delphi 7 and old Lazarus (1.0)
TTagGroup = (
tgUnknown,
tgJFIF,
tgExifPrimary, tgExifThumbnail, tgExifSub, tgExifInterop, tgExifGps,
tgExifMakerNote, tgExifMakerNoteSub,
tgIPTC
);
// The TagID consists of two parts: the low-word is the ID of the tag itself,
// the high-word the ID of its parent (sub-IFD)
TTagID = DWord;
TTagIDRec = record
Tag: Word;
Parent: Word;
end;
TTagType = (
ttUInt8 = 1, ttString, ttUInt16, ttUInt32, ttURational,
ttSInt8, ttBinary, ttSInt16, ttSInt32, ttSRational,
ttSingle, ttDouble,
ttIFD // rarely used, in Olympus maker notes
);
TTagOption = (
toBigEndian, // value is stored in big-endian byte order
toDecodeValue, // (enumerated) value is converted to string representation
toReadOnly, // tag value cannot be changed by user
toTruncateBinary, // show only first bytes of a binary tag
toBinaryAsASCII, // should display binary tag values as ASCII text
toVolatile // tag value is not written to file
);
TTagOptions = set of TTagOption;
TExportOption = (eoShowTagName, eoShowDecimalTagID, eoShowHexTagID,
eoDecodeValue, eoTruncateBinary, eoBinaryAsASCII);
TExportOptions = set of TExportOption;
TExifRational = record
Numerator, Denominator: LongInt;
end;
PExifRational = ^TExifRational;
TExifIntegerArray = array of Integer;
TExifDoubleArray = array of Double;
TExifRationalArray = array of TExifRational;
TImgFormat = (ifUnknown, ifJpeg, ifTiff);
TLookupCompareFunc = function(AValue1, AValue2: String): Boolean;
EFpExif = class(Exception);
EFpExifReader = class(EFpExif);
EFpExifWriter = class(EFpExif);
// TTagAcceptProc = function(ATag: TTagEntry): Boolean;
const
TagElementSize: array[1..13] of Integer = (1, 1, 2, 4, 8, 1, 1, 2, 4, 8, 4, 8, 4);
// The index is ord(TTagtype).
GroupNames: array[TTagGroup] of string = ('',
'JFIF',
'IFD0', 'IFD1', 'EXIF', 'INTEROP', 'GPS', 'MAKERNOTE', 'MAKERNOTE_SUBIFD',
'IPTC'
);
NiceGroupNames: array[TTagGroup] of String = ('',
'JPEG',
'Primary', 'Thumbnail', 'EXIF', 'InterOperability', 'GPS', 'Maker Notes', 'Maker Notes Subdir',
'IPTC'
);
ISO_DATE_FORMAT = 'yyyy-mm-dd';
ISO_TIME_FORMAT = 'hh:nn:ss';
ISO_DATETIME_FORMAT = ISO_DATE_FORMAT + ' ' + ISO_TIME_FORMAT;
IPTC_DATE_FORMAT = 'yyyymmdd';
IPTC_TIME_FORMAT = 'hhnnss';
IPTC_DATETIME_FORMAT = IPTC_DATE_FORMAT + ' ' + IPTC_TIME_FORMAT;
EXIF_DATE_FORMAT = 'yyyy:mm:dd';
EXIF_TIME_FORMAT = 'hh:nn:ss';
EXIF_DATETIME_FORMAT = EXIF_DATE_FORMAT + ' ' + EXIF_TIME_FORMAT;
//GpsFormat = gf_DMS_Short;
ValidExifHeader: ansistring = 'Exif'#0;
DEFAULT_THUMBNAIL_SIZE = 200;
IPTC_MULTI_TAG_COUNT = $FFFF;
IPTC_MULTI_TAG_SEPARATOR = #1;
var
fpExifDataSep : ansistring = ', ';
fpExifDecodeSep : string = ',';
fpExifLookupSep : string = ',';
fpExifLookupKeySep: string = ':';
fpExifDelim : string = ' = ';
// If Exif.ExportOptions contains eoTruncateBinary then exported binary tags
// show only this number of bytes
MaxBinaryBytes : Integer = 10;
// FormatSettings for how to pass floating point values to dExif
fpExifFmtSettings : TFormatSettings;
implementation
initialization
{$IFNDEF DELPHI7}
fpExifFmtSettings := FormatSettings;
{$ENDIF}
fpExifFmtSettings.DecimalSeparator := '.';
fpExifFmtSettings.ListSeparator := ',';
fpExifFmtSettings.DateSeparator := '-';
fpExifFmtSettings.TimeSeparator := ':';
fpExifFmtSettings.ShortDateFormat := 'yyyy-mm-dd';
fpExifFmtSettings.LongDateFormat := 'yyyy-mm-dd';
fpExifFmtSettings.LongTimeFormat := 'hh:nn:ss';
fpExifFmtSettings.ShortTimeFormat := 'hh:nn';
end.

View File

@ -0,0 +1,674 @@
unit fpeIptcData;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
{$I fpexif.inc}
interface
uses
Classes, SysUtils, Contnrs,
fpeGlobal, fpeTags;
type
TIptcData = class
private
FTagList: TTagList;
FImageResourceBlocks: TObjectList;
function GetTagByID(ATagID: TTagID): TTag;
function GetTagByIndex(AIndex: Integer): TTag;
function GetTagByName(ATagName: String): TTag;
function GetTagCount: Integer;
procedure SetTagByID(ATagID: TTagID; const ATag: TTag);
procedure SetTagByIndex(AIndex: Integer; const ATag: TTag);
procedure SetTagByName(ATagName: String; const ATag: TTag);
protected
function IndexOfTagID(ATagID: TTagID): Integer;
function IndexOfTagName(ATagName: String): Integer;
function InternalAddTag(ATagDef: TTagDef): TTag;
public
constructor Create;
destructor Destroy; override;
procedure AddImageResourceBlock(AIdentifier: Word; AName: String; AData: TBytes);
function AddTag(ATag: TTag): Integer;
function AddTagByName(ATagName: String): TTag;
procedure AppendTagTo(ATag, AParentTag: TTag);
procedure Clear;
procedure ExportToStrings(AList: TStrings; AOptions: TExportOptions;
ASeparator: String = '=');
procedure GetImageResourceBlock(AIndex: Integer; out AIdentifier: Word;
out AName: String; out AData: TBytes);
function GetImageResourceBlockCount: Integer;
property TagbyID[ATagID: TTagID]: TTag
read GetTagByID write SetTagByID;
property TagByIndex[AIndex: Integer]: TTag
read GetTagByIndex write SetTagByIndex;
property TagByName[ATagName: String]: TTag
read GetTagByName write SetTagByName;
property TagCount: Integer
read GetTagCount;
end;
type
TIptcStringTag = class(TStringTag)
private
FMaxLen: Integer;
public
constructor Create(ATagDef: TTagDef; AOptions: TTagOptions); override;
property MaxLength: Integer read FMaxLen;
end;
TIptcMultiStringTag = class(TIptcStringTag)
protected
function GetAsString: String; override;
procedure SetAsString(const AValue: String); override;
public
procedure AddString(const AValue: String); virtual;
end;
TIptcObjectAttrTag = class(TIptcMultiStringTag)
public
procedure AddString(const AValue: String); override;
end;
TIptcUrgencyTag = class(TIptcStringTag)
protected
procedure SetAsString(const AValue: String); override;
end;
TIptcDateTag = class(TIptcStringTag)
private
function GetFormat: String;
protected
function GetAsDate: TDateTime;
function GetAsString: String; override;
procedure SetAsDate(const AValue: TDateTime);
procedure SetAsString(const AValue: String); override;
public
property AsDate: TDateTime read GetAsDate write SetAsDate;
property FormatStr; // e.g. 'yyyy-mm-dd';
end;
TIptcTimeTag = class(TIptcStringTag)
private
function GetFormat: String;
protected
function GetAsString: String; override;
function GetAsTime: TDateTime;
procedure SetAsString(const AValue: String); override;
procedure SetAsTime(const AValue: TDateTime);
public
property AsTime: TDateTime read GetAsTime write SetAsTime;
property FormatStr; // e.g. 'hh:nn';
end;
procedure BuildIptcTagDefs;
procedure FreeIptcTagDefs;
function FindIptcTagDef(ATagID: TTagID): TTagDef; overload;
function FindIptcTagDef(ATagName: String): TTagDef; overload;
implementation
uses
Math, DateUtils, StrUtils, Variants,
fpeStrConsts, fpeUtils;
type
TAdobeImageResourceBlock = class
Identifier: Word;
Name: String;
Data: TBytes;
end;
var
IptcTagDefs: TTagDefList = nil;
procedure BuildIptcTagDefs;
const
I = DWord(TAGPARENT_IPTC); // for shorter lines...
begin
if IptcTagDefs = nil then
IptcTagDefs := TTagDefList.Create;
with IptcTagDefs do begin
Clear;
// NOTE: The Count field is "abused" as MaxLength of string value
AddStringTag(I+$015A {1:90}, 'CodedCharacterSet', 32, rsCodedCharSet, '', TIptcStringTag);
AddUShortTag(I+$0200 {2: 0}, 'RecordVersion', 1, rsRecordVersion);
AddStringTag(I+$0203 {2: 3}, 'ObjectType', 64, rsObjectType, '', TIptcStringTag);
AddStringTag(I+$0204 {2: 4}, 'ObjectAttr', 68, rsObjectAttr, '', TIptcObjectAttrTag);
AddStringTag(I+$0205 {2: 5}, 'ObjectName', 64, rsObjectName, '', TIptcStringTag);
AddStringTag(I+$0207 {2: 7}, 'EditStatus', 64, rsEditStatus, '', TIptcStringTag);
AddStringTag(I+$0208 {2: 8}, 'EditorialUpdate', 2, rsEditorialUpdate,'', TIptcStringTag);
AddStringTag(I+$020A {2:10}, 'Urgency', 1, rsUrgency, rsUrgencyLkUp, TIptcUrgencyTag);
AddStringTag(I+$020C {2:12}, 'SubRef', 236, rsSubjectRef, '', TIptcMultiStringTag); // Min 13
AddStringTag(I+$020F {2:15}, 'Category', 3, rsCategory, '', TIptcStringTag);
AddStringTag(I+$0214 {2:20}, 'SuppCategory', 32, rsSuppCategory, '', TIptcMultiStringTag);
AddStringTag(I+$0216 {2:22}, 'FixtureID', 32, rsFixtureID, '', TIptcStringTag);
AddStringTag(I+$0219 {2:25}, 'KeyWords', 64, rsKeyWords, '', TIptcMultiStringTag);
AddStringTag(I+$021A {2:26}, 'ContentLocCode', 3, rsContentLocCode, '', TIptcMultiStringTag);
AddStringTag(I+$021B {2:27}, 'ContentLocName', 64, rsContentLocName, '', TIptcMultiStringTag);
AddStringTag(I+$021E {2:30}, 'ReleaseDate', 8, rsReleaseDate, '', TIptcDateTag);
AddStringTag(I+$0223 {2:35}, 'ReleaseTime', 11, rsReleaseTime, '', TIptcTimeTag);
AddStringTag(I+$0225 {2:37}, 'ExpireDate', 8, rsExpireDate, '', TIptcStringTag);
AddStringTag(I+$0226 {2:38}, 'ExpireTime', 11, rsExpireTime, '', TIptcStringTag);
AddStringTag(I+$0228 {2:40}, 'SpecialInstruct', 256, rsSpecialInstruct,'', TIptcStringTag);
AddStringTag(I+$022A {2:42}, 'ActionAdvised', 2, rsActionAdvised, '', TIptcStringTag);
AddStringTag(I+$022D {2:45}, 'RefService', $FFFF, rsRefService, '', TIptcMultiStringTag);
AddStringTag(I+$022F {2:47}, 'RefDate', $FFFF, rsRefDate, '', TIptcMultiStringTag);
AddStringTag(I+$0232 {2:50}, 'RefNumber', $FFFF, rsRefNumber, '', TIptcMultiStringTag);
AddStringTag(I+$0237 {2:55}, 'DateCreated', 8, rsDateCreated, '', TIptcDateTag);
AddStringTag(I+$023C {2:60}, 'TimeCreated', 11, rsTimeCreated, '', TIptcTimeTag);
AddStringTag(I+$023E {2:62}, 'DigitizeDate', 8, rsDigitizeDate, '', TIptcDateTag);
AddStringTag(I+$023F {2:63}, 'DigitizeTime', 11, rsDigitizeTime, '', TIptcTimeTag);
AddStringTag(I+$0241 {2:65}, 'OriginatingProgram',32, rsOriginatingProg,'', TIptcStringTag);
AddStringTag(I+$0246 {2:70}, 'ProgramVersion', 10, rsProgVersion, '', TIptcStringTag);
AddStringTag(I+$024B {2:75}, 'ObjectCycle', 1, rsObjectCycle, rsObjectCycleLkup, TIptcStringTag);
AddStringTag(I+$0250 {2:80}, 'ByLine', 32, rsByLine, '', TIptcMultiStringTag);
AddStringTag(I+$0255 {2:85}, 'ByLineTitle', 32, rsByLineTitle, '', TIptcMultiStringTag);
AddStringTag(I+$025A {2:90}, 'City', 32, rsCity, '', TIptcStringTag);
AddStringTag(I+$025C {2:92}, 'SubLocation', 32, rsSubLocation, '', TIptcStringTag);
AddStringTag(I+$025F {2:95}, 'State', 32, rsState, '', TIptcStringTag);
AddStringTag(I+$0264 {2:100}, 'LocationCode', 3, rsLocationCode, '', TIptcStringTag);
AddStringTag(I+$0265 {2:101}, 'LocationName', 64, rsLocationName, '', TIptcStringTag);
AddStringTag(I+$0267 {2:103}, 'TransmissionRef', 32, rsTransmissionRef,'', TIptcStringTag);
AddStringTag(I+$0269 {2:105}, 'ImageHeadline', 256, rsImgHeadline, '', TIptcStringTag);
AddStringTag(I+$026E {2:110}, 'ImageCredit', 32, rsImgCredit, '', TIptcStringTag);
AddStringTag(I+$0273 {2:115}, 'Source', 32, rsSource, '', TIptcStringTag);
AddStringTag(I+$0274 {2:116}, 'Copyright', 128, rsCopyright, '', TIptcStringTag);
AddStringTag(I+$0276 {2:118}, 'Contact', 128, rsContact, '', TIptcMultiStringTag);
AddStringTag(I+$0278 {2:120}, 'ImageCaption', 2000, rsImgCaption, '', TIptcStringTag);
AddStringTag(I+$027A {2:122}, 'ImageCaptionWriter',32, rsImgCaptionWriter,'', TIptcStringTag);
AddStringTag(I+$0282 {2:130}, 'ImageType', 2, rsImgType, '', TIptcStringTag);
AddStringTag(I+$0283 {2:131}, 'Orientation', 1, rsOrientation, rsIptcOrientationLkup, TIptcStringTag);
AddStringTag(I+$0287 {2:135}, 'LangID', 3, rsLangID, '', TIptcStringTag);
end;
end;
function FindIptcTagDef(ATagID: TTagID): TTagDef;
begin
if IptcTagDefs = nil then
BuildIptcTagDefs;
Result := IptcTagDefs.FindByID(ATagID);
end;
function FindIptcTagDef(ATagName: String): TTagDef;
begin
if IptcTagDefs = nil then
BuildIptcTagDefs;
Result := IptcTagDefs.FindByName(ATagName);
end;
procedure FreeIptcTagDefs;
begin
FreeAndNil(IptcTagDefs);
end;
//==============================================================================
// TIptcData
//==============================================================================
constructor TIptcData.Create;
begin
BuildIptcTagDefs;
inherited Create;
FTagList := TTagList.Create;
FImageResourceBlocks := TObjectList.Create;
end;
destructor TIptcData.Destroy;
begin
FImageResourceBlocks.Free;
FTagList.Free;
inherited;
end;
procedure TIptcData.AddImageResourceBlock(AIdentifier: Word; AName: String;
AData: TBytes);
var
block: TAdobeImageResourceBlock;
begin
block := TAdobeImageResourceBlock.Create;
block.Identifier := AIdentifier;
block.Name := AName;
SetLength(block.Data, Length(AData));
if Length(AData) > 0 then
Move(AData[0], block.Data[0], Length(AData));
FImageResourceBlocks.Add(block);
end;
function TIptcData.AddTag(ATag: TTag): Integer;
var
idx: Integer;
begin
idx := IndexOfTagID(ATag.TagID);
if idx <> -1 then begin
// Replace existing tag
FTagList.Delete(idx);
FTagList.Insert(idx, ATag);
end else
// Add the new tag
Result := FTagList.Add(ATag);
end;
function TIptcData.AddTagByName(ATagName: String): TTag;
var
idx: Integer;
tagdef: TTagDef;
begin
idx := IndexOfTagName(ATagName);
if idx > -1 then
Result := FTagList[idx]
else begin
tagDef := FindIptcTagDef(ATagName);
Result := InternalAddTag(tagDef);
end;
end;
{ Adds ATag to AParentTag }
procedure TIptcData.AppendTagTo(ATag, AParentTag: TTag);
begin
Assert(ATag <> nil);
Assert(AParentTag <> nil);
Assert(ATag.TagID = AParentTag.TagID);
Assert(ATag.TagType = AParentTag.TagType);
if AParentTag is TIptcMultiStringTag then
TIptcMultiStringTag(AParentTag).AddString(ATag.AsString);
end;
procedure TIptcData.Clear;
begin
FImageResourceBlocks.Clear;
FTagList.Clear;
end;
procedure TIptcData.ExportToStrings(AList: TStrings; AOptions: TExportOptions;
ASeparator: String = '=');
var
i: Integer;
tag: TTag;
nam: String;
tagval: String;
usedExportOptions: TExportOptions;
begin
Assert(AList <> nil);
if TagCount = 0 then
exit;
if AList.Count > 0 then
AList.Add('');
AList.Add('*** IPTC ***');
for i := 0 to TagCount-1 do begin
tag := TagByIndex[i];
usedExportOptions := AOptions * [eoShowDecimalTagID, eoShowHexTagID];
if usedExportOptions = [eoShowDecimalTagID] then
nam := Format('[%d] %s', [tag.TagID, tag.Description])
else
if usedExportOptions = [eoShowHexTagID] then
nam := Format('[$%.4x] %s', [tag.TagID, tag.Description])
else
nam := tag.Description;
tagval := tag.AsString;
if tagval <> '' then
AList.Add(nam + ASeparator + tagval);
end;
end;
procedure TIptcData.GetImageResourceBlock(AIndex: Integer; out AIdentifier: Word;
out AName: String; out AData: TBytes);
var
block: TAdobeImageResourceBlock;
begin
block := TAdobeImageResourceBlock(FImageResourceBlocks[AIndex]);
AIdentifier := block.Identifier;
AName := block.Name;
SetLength(AData, Length(block.Data));
Move(block.Data[0], AData[0], Length(AData));
end;
function TIptcData.GetImageResourceBlockCount: Integer;
begin
Result := FImageResourceBlocks.Count;
end;
function TIptcData.GetTagByID(ATagID: TTagID): TTag;
var
idx: Integer;
begin
idx := IndexOfTagID(ATagID);
if idx = -1 then
Result := nil
else
Result := FTagList[idx];
end;
function TIptcData.GetTagByIndex(AIndex: Integer): TTag;
begin
Result := FTagList[AIndex];
end;
function TIptcData.GetTagByName(ATagName: String): TTag;
var
idx: Integer;
begin
idx := IndexOfTagName(ATagName);
if idx = -1 then
Result := nil
else
Result := FTagList[idx];
end;
function TIptcData.GetTagCount: Integer;
begin
Result := FTagList.Count;
end;
function TIptcData.IndexOfTagID(ATagID: TTagID): Integer;
var
i: Integer;
tag: TTag;
begin
for i:=0 to FTagList.Count-1 do begin
tag := FTagList[i];
if (tag.TagID = ATagID) then begin
Result := i;
exit;
end;
end;
Result := -1;
end;
function TIptcData.IndexOfTagName(ATagName: String): Integer;
var
i: Integer;
tag: TTag;
begin
for i:=0 to FTagList.Count-1 do begin
tag := FTagList[i];
if SameText(tag.Name, ATagName) then begin
Result := i;
exit;
end;
end;
Result := -1;
end;
function TIptcData.InternalAddTag(ATagDef: TTagDef): TTag;
var
optns: TTagOptions;
begin
if ATagDef <> nil then begin
optns := [toBigEndian]; //ExportOptionsToTagOptions;
Result := ATagDef.TagClass.Create(ATagDef, optns);
AddTag(Result);
end else
Result := nil
end;
procedure TIptcData.SetTagByID(ATagID: TTagID; const ATag: TTag);
var
idx: Integer;
begin
if (ATag <> nil) and ATag.ReadOnly then
exit;
idx := IndexOfTagID(ATagID);
SetTagByIndex(idx, ATag);
end;
procedure TIptcData.SetTagByIndex(AIndex: Integer; const ATag: TTag);
var
tag: TTag;
begin
if (ATag <> nil) and ATag.ReadOnly then
exit;
if AIndex > -1 then begin
tag := FTagList[AIndex];
if tag.ReadOnly then
exit;
FTagList.Delete(AIndex);
if ATag <> nil then
FTagList.Insert(AIndex, ATag);
end else
AddTag(ATag);
end;
procedure TIptcData.SetTagByName(ATagName: String; const ATag: TTag);
var
idx: Integer;
begin
if (ATag <> nil) and ATag.ReadOnly then
exit;
idx := IndexOfTagName(ATagName);
SetTagByIndex(idx, ATag);
end;
//==============================================================================
// TIptcStringTag
//==============================================================================
constructor TIptcStringTag.Create(ATagDef: TTagDef; AOptions: TTagOptions);
begin
inherited Create(ATagDef, AOptions);
FMaxLen := FCount;
FCount := 1;
end;
//==============================================================================
// TIptcMultiStringTag
//==============================================================================
procedure TIptcMultiStringTag.AddString(const AValue: String);
var
s: String;
mxlen: Integer;
begin
s := inherited GetAsString;
mxlen := Min(MaxInt, FMaxLen);
if s = '' then
s := Copy(AValue, 1, mxlen)
else
s := s + IPTC_MULTI_TAG_SEPARATOR + Copy(AValue, 1, mxlen);
inherited SetAsString(s);
end;
function TIptcMultiStringTag.GetAsString: String;
var
s: String;
begin
s := inherited GetAsString;
Result := StringReplace(s, IPTC_MULTI_TAG_SEPARATOR, fpExifDataSep, [rfReplaceAll])
end;
procedure TIptcMultiStringTag.SetAsString(const AValue: String);
var
sArr: TStringArray;
i: Integer;
begin
inherited SetAsString('');
if AValue <> '' then begin
sArr := Split(AValue, fpExifDataSep);
for i:=0 to High(sArr) do
AddString(sArr[i]);
end;
end;
//==============================================================================
// TIptcObjectAttrTag
//==============================================================================
procedure TIptcObjectAttrTag.AddString(const AValue: String);
begin
//!!!!!!!!!!!!!!!
(*
if (Length(AValue) < 4) or (AValue[4] <> ':') or not TryStrToInt(Copy(AValue, 1, 3), n) then
raise EFpExif.Create('Tag "ObjectAttr" must constist of 3 numeric characters, '+
'a colon and an optional description of max 64 characters');
*)
inherited AddString(AValue);
end;
//==============================================================================
// TIptcUrgencyTag
//==============================================================================
procedure TIptcUrgencyTag.SetAsString(const AValue: String);
var
n: Integer;
ok: Boolean;
begin
if (AValue <> '') then begin
n := 0;
ok := TryStrToInt(AValue, n);
if (not ok) or (n < 0) or (n > 9) then
raise EFpExif.Create('Tag "Urgency" can only contain one numeric character 0..9');
end;
inherited SetAsString(AValue);
end;
//==============================================================================
// TIptcDateTag
//==============================================================================
function TIptcDateTag.GetAsDate: TDateTime;
var
s: String;
y, m, d: String;
begin
s := inherited GetAsString;
if Length(s) >= 8 then begin
y := Copy(s, 1, 4);
m := Copy(s, 5, 2);
d := Copy(s, 7, 2);
Result := EncodeDate(StrToInt(y), StrToInt(m), StrToInt(d));
end else
Result := 0;
end;
function TIptcDateTag.GetAsString: String;
begin
Result := FormatDateTime(GetFormat, GetAsDate);
end;
function TIptcDateTag.GetFormat: String;
begin
Result := IfThen(FFormatStr = '', fpExifFmtSettings.ShortDateFormat, FFormatStr);
end;
procedure TIptcDateTag.SetAsDate(const AValue: TDateTime);
begin
inherited SetAsString(FormatDateTime(IPTC_DATE_FORMAT, AValue));
end;
procedure TIptcDateTag.SetAsString(const AValue: String);
var
d: TDateTime;
fmt: String;
begin
fmt := GetFormat;
if fmt = IPTC_DATE_FORMAT then
d := IptcDateStrToDate(AValue)
else begin
{$IFDEF FPC}
d := ScanDateTime(fmt, AValue);
{$ELSE}
fs := fpExifFmtSettings;
fs.ShortDateFormat := fmt;
fs.LongDateFormat := fmt;
if pos(':', fmt) > 0 then
fs.DateSeparator := ':'
else if pos('.', fmt) > 0 then
fs.DateSeparator := '.'
else if pos('/', fmt) > 0 then
fs.DateSeparator := '/'
else if pos('-', fmt) > 0 then
fs.DateSeparator := '-'
else
fs.DateSeparator := ' ';
d := StrToDate(AValue, fs);
{$ENDIF}
end;
SetAsDate(d);
end;
//==============================================================================
// TIptcTimeTag
//==============================================================================
function TIptcTimeTag.GetAsString: String;
begin
Result := FormatDateTime(GetFormat, GetAsTime);
end;
function TIptcTimeTag.GetFormat: String;
begin
Result := IfThen(FFormatStr = '', fpExifFmtSettings.LongTimeformat, FFormatStr);
end;
function TIptcTimeTag.GetAsTime: TDateTime;
var
s: String;
hr, mn, sec: String;
begin
s := inherited GetAsString;
if Length(s) >= 6 then begin
hr := Copy(s, 1, 2);
mn := Copy(s, 3, 2);
sec := Copy(s, 5, 2);
Result := EncodeTime(StrToInt(hr), StrToInt(mn), StrToInt(sec), 0);
end else
Result := 0;
end;
procedure TIptcTimeTag.SetAsString(const AValue: String);
var
t: TDateTime;
fmt: String;
begin
fmt := GetFormat;
if fmt = IPTC_TIME_FORMAT then
t := IptcTimeStrToTime(AValue)
else begin
{$IFDEF FPC}
t := ScanDateTime(fmt, AValue);
{$ELSE}
fs := fpExifFmtSettings;
fs.LongTimeFormat := GetFormat;
t := StrToTime(AValue, fs);
{$ENDIF}
end;
SetAsTime(t);
end;
procedure TIptcTimeTag.SetAsTime(const AValue: TDateTime);
var
s: String;
begin
s := FormatDateTime(IPTC_TIME_FORMAT, AValue) + LocalTimeZoneStr;
inherited SetAsString(s);
end;
initialization
finalization
FreeIptcTagDefs;
end.

View File

@ -0,0 +1,485 @@
{
Reader and writer for IPTC data (Adobe image resource blocks)
NOTE: Data is in Big-Endian format.
Adobe Image Resource Block:
--------------------------
https://www.adobe.com/devnet-apps/photoshop/fileformatashtml/#50577409_pgfId-1037504
Length Description
------ ----------------------------------------------------------------
4 Signature: '8BIM'
2 Unique identifier for the resource.
(var) Name: Pascal string, padded to make the size even
(a null name consists of two bytes of 0)
4 Actual size of resource data that follows
(var) The resource data, described in the sections on the individual
resource types. It is padded to make the size even.
The image resource block with unique identifier $0404 is the IPTC block.
https://www.iptc.org/std/IIM/4.2/specification/IIMV4.2.pdf
The IPTC block consists of several "records".
Every "record" constists of several "datasets".
Every "dataset" consists of a unique tag and a data field.
There are two types of tags:
"Standard" tag:
- 1 byte: tag "marker" ($1C)
- 1 byte: record number
- 1 byte: dataset number
- 2 bytes: datafield byte count
"Extended" tag (probably not used):
- 1 byte: tag "marker" ($1C)
- 1 byte: record number
- 1 byte: dataset number
- 2 bytes: count of bytes (n) used in "datafield byte count" field
(always has highest bit set)
- n bytes: datafield byte count
}
unit fpeIptcReadWrite;
{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$ENDIF}
interface
uses
Classes, SysUtils,
fpeGlobal, fpeUtils, fpeTags, fpeMetadata, fpeIptcData;
type
{ TIPTCReader }
TIPTCReader = class(TBasicMetadataReader)
private
function ExtractTag(const ABuffer: TBytes; var AStart: Integer): TTag;
procedure ReadImageResourceBlock(AStream: TStream; out AID: Word;
out AName: String; out AData: TBytes);
protected
public
procedure ReadFromStream(AStream: TStream; AImgFormat: TImgFormat); override;
procedure ReadIPTCData(const ABuffer: TBytes);
end;
{ TIPTCWriter }
TIPTCWriter = class(TBasicMetadataWriter)
private
FIPTCSegmentStartPos: Int64;
protected
procedure WriteEndOfDataResourceBlock(AStream: TStream);
procedure WriteImageResourceBlockHeader(AStream: TStream; AResourceID: Integer;
AResourceName: String); //; ABuffer: Pointer; ABufferSize: DWord);
procedure WriteIPTCHeader(AStream: TStream);
procedure WriteIPTCImageResourceBlock(AStream: TStream; AName: String);
procedure WriteTag(AStream: TStream; ATag: TTag); overload;
public
constructor Create(AImgInfo: TImgInfo); override;
procedure WriteToStream(AStream: TStream; AImgFormat: TImgFormat); override;
end;
implementation
uses
fpeStrConsts;
type
// http://search.cpan.org/dist/Image-MetaData-JPEG/lib/Image/MetaData/JPEG/Structures.pod#Structure_of_an_IPTC_data_block
TIptcTag = packed record
TagMarker: Byte; // must be $1C
RecordNumber: Byte; // this is the number before the colon in the tag listing
DatasetNumber: Byte; // this is the number after the colon in the tag listing ("Tag")
Size: Word; // Size of data if < 32768, otherwise size of datalength element
// SizeOfDatasize: word --> if Size of data > 32767
// Data: variable
end;
const
IPTC_SIGNATURE: ansistring = 'Photoshop 3.0'#0;
RESOURCE_MARKER: ansistring = '8BIM';
IPTC_IMAGERESOURCEID = $0404;
//------------------------------------------------------------------------------
// TIptcReader
//------------------------------------------------------------------------------
function TIptcReader.ExtractTag(const ABuffer: TBytes; var AStart: Integer): TTag;
var
recordNo: Byte;
datasetNo: Byte;
len: DWord;
tagdef: TTagDef;
tagID: TTagID;
s: String;
w: Word;
begin
Result := nil;
recordNo := ABuffer[AStart];
datasetNo := ABuffer[AStart+1];
len := BEtoN(PWord(@ABuffer[AStart+2])^);
inc(AStart, 4);
// Take care of highest bit which indicates an Extended Dataset
if word(len) and $8000 <> 0 then
begin
len := word(len) and (not $8000);
if len = 2 then
begin
len := BEtoN(PWord(@ABuffer[AStart])^);
inc(AStart, 2);
end else
if len = 4 then
begin
len := BEtoN(PDWord(@ABuffer[AStart - len])^);
inc(AStart, 4);
end else
Error(Format(rsIptcExtendedDataSizeNotSupported, [len]));
end;
if not (recordNo in [1, 2, 8]) then begin
AStart := AStart + Integer(len);
exit;
end;
tagID := (recordNo shl 8) or datasetNo or TAGPARENT_IPTC;
tagdef := FindIPTCTagDef(tagID);
if tagdef <> nil then begin
Result := tagdef.TagClass.Create(tagdef, true);
case tagdef.TagType of
ttString:
begin
{$IFDEF FPC}
SetLength(s, len);
Move(ABuffer[AStart], s[1], len);
{$ELSE}
SetLength(sa,len);
Move(ABuffer[AStart], sa[1], len);
s := UTF8Decode(sa);
{$ENDIF}
if Result is TIptcDateTag then
with TIptcDateTag(Result) do begin
FormatStr := IPTC_DATE_FORMAT;
AsString := s;
FormatStr := '';
end
else
if Result is TIptcTimeTag then
with TIptcTimeTag(Result) do begin
FormatStr := IPTC_TIME_FORMAT;
AsString := s;
FormatStr := '';
end
else
(Result as TStringTag).AsString := s;
end;
ttUInt16:
begin
w := BEtoN(PWord(@ABuffer[AStart])^);
(Result as TIntegerTag).AsInteger := w;
end;
else
Warning(Format(rsTagTypeNotSupported, [tagDef.Name]));
end;
end else
begin
// to do: create a dummy tag for the unknown tagdef
end;
AStart := AStart + Integer(len);
end;
procedure TIptcReader.ReadFromStream(AStream: TStream; AImgFormat: TImgFormat);
const
MARKER_SIZE = 4;
var
marker: packed array[1..MARKER_SIZE] of ansichar;
lID: Word; // Image resoure ID
lName: String;
lData: TBytes;
begin
FImgFormat := AImgFormat;
SetLength(lData, Length(IPTC_SIGNATURE)); // 'Photoshop 3.0'
if AStream.Read(lData[0], Length(lData)) <> Length(lData) then begin
Error(rsIncorrectFileStructure);
exit;
end;
if not CompareMem(@lData[0], @IPTC_SIGNATURE[1], Length(lData)) then begin
Error(rsNoValidIptcSignature);
exit;
end;
while (AStream.Position < AStream.Size) do begin
AStream.Read({%H-}marker[1], MARKER_SIZE);
if AStream.Position >= AStream.Size then begin
Error(rsIncorrectFileStructure);
break;
end;
if not CompareMem(@marker[1], @RESOURCE_MARKER[1], MARKER_SIZE) then // '8BIM'
break;
ReadImageResourceBlock(AStream, lID, lName, lData);
if lID = IPTC_IMAGERESOURCEID then begin // $0404
FImgInfo.IptcData.AddImageResourceBlock(lID, lName, nil);
ReadIptcData(lData);
end else
FImgInfo.IptcData.AddImageResourceBlock(lID, lName, lData);
end;
end;
procedure TIptcReader.ReadImageResourceBlock(AStream: TStream;
out AID: Word; out AName: String; out AData: TBytes);
var
len: Byte;
s: Ansistring;
lSize: DWord;
begin
AID := BEtoN(ReadWord(AStream));
len := ReadByte(AStream);
if len = 0 then begin
ReadByte(AStream);
AName := '';
end else begin
SetLength(s, len);
AStream.Read(s[1], len);
if s[len] = #0 then SetLength(s, len-1);
AName := s;
end;
lSize := BEToN(ReadDWord(AStream));
SetLength(AData, lSize);
AStream.Read(AData[0], lSize);
end;
procedure TIptcReader.ReadIptcData(const ABuffer: TBytes);
var
tag, parentTag: TTag;
start: Integer;
begin
FImgInfo.IptcData.Clear;
if Length(ABuffer) = 0 then begin
Error(rsIptcDataExpected);
exit;
end;
start := 0;
while (start < High(ABuffer) - 1) do
begin
if ABuffer[start] <> $1C then
Error(rsNoValidIptcFile);
inc(start);
tag := ExtractTag(ABuffer, start);
if tag is TIptcMultiStringTag then begin
// if tag.Count = IPTC_MULTI_TAG_COUNT then begin
parentTag := FImgInfo.IptcData.TagByID[tag.TagID];
if parentTag = nil then
FImgInfo.IptcData.AddTag(tag)
else begin
FImgInfo.IptcData.AppendTagTo(tag, parentTag);
tag.Free;
end;
end else
FImgInfo.IptcData.AddTag(tag);
end;
end;
//------------------------------------------------------------------------------
// TIptcWriter
//------------------------------------------------------------------------------
constructor TIPTCWriter.Create(AImgInfo: TImgInfo);
begin
inherited;
FIPTCSegmentStartPos := -1;
end;
procedure TIptcWriter.WriteEndOfDataResourceBlock(AStream: TStream);
begin
WriteImageResourceBlockHeader(AStream, $0B04, ''); //, nil, 0);
end;
//------------------------------------------------------------------------------
// Writes the IPTC header needed by JPEG files (Segment APP13 header)
// Call WriteToStream immediately afterwards
//------------------------------------------------------------------------------
procedure TIPTCWriter.WriteIPTCHeader(AStream: TStream);
const
SEGMENT_MARKER: array[0..1] of byte = ($FF, $ED);
begin
FIPTCSegmentStartPos := AStream.Position;
AStream.WriteBuffer(SEGMENT_MARKER[0], 2);
// Next two zero bytes are the size of the entire IPTC segiment, they will be
// replaced when the segment is completely written. For this, we store the
// offset to the begin of the IPTC segment in FIPTCSegmentStartPos.
WriteWord(AStream, 0);
AStream.WriteBuffer(IPTC_SIGNATURE[1], Length(IPTC_SIGNATURE));
end;
procedure TIPTCWriter.WriteIPTCImageResourceBlock(AStream: TStream; AName: String);
var
i: Integer;
tag: TTag;
ms: TMemoryStream;
dw: DWord;
begin
// Write the image resource header
WriteImageResourceBlockHeader(AStream, IPTC_IMAGERESOURCEID, AName);
// Now, we must write the length of the ImageResourceBlock.
// Since we don't know this we write the tags to a memory stream first
ms := TMemoryStream.Create;
try
// Write the tags to the temporary memory stream
for i := 0 to FImgInfo.IptcData.TagCount-1 do begin
tag := FImgInfo.IptcData.TagByIndex[i];
WriteTag(ms, tag);
end;
// Now the length of the data field is known (ms.Size).
// Write the length field to "real" stream
dw := ms.Size;
WriteDWord(AStream, NtoBE(dw));
// Copy the tags from the memorystream to the "real" stream
ms.Position := 0;
AStream.Copyfrom(ms, ms.Size);
finally
ms.Free;
end;
end;
procedure TIPTCWriter.WriteImageResourceBlockHeader(AStream: TStream;
AResourceID: Integer; AResourceName: String);
var
dw: DWord;
sa: ansistring;
begin
// Resource marker: 8BIM
AStream.WriteBuffer(RESOURCE_MARKER[1], Length(RESOURCE_MARKER));
// Resource ID
WriteWord(AStream, NtoBE(word(AResourceID)));
// Resource name
if Length(AResourceName) = 0 then
WriteWord(AStream, 0)
else
begin
sa := AResourceName;
dw := Length(sa);
if dw > 255 then begin
dw := 255;
SetLength(sa, dw);
Warning(Format(rsImageResourceNameTooLong, [AResourceName]));
end;
if not odd(dw) then begin
inc(dw);
sa := sa + #0;
end;
WriteByte(AStream, byte(dw));
AStream.WriteBuffer(sa[1], dw);
end;
end;
procedure TIptcWriter.WriteTag(AStream: TStream; ATag: TTag);
const
TAG_MARKER = $1C;
var
iptcTag: TIptcTag;
len: DWord;
begin
iptcTag.TagMarker := byte(TAG_MARKER);
iptcTag.RecordNumber := byte((ATag.TagID and $FF00) shr 8);
iptctag.DatasetNumber := byte(ATag.TagID and $00FF);
case ATag.TagType of
ttUInt16:
begin
iptcTag.Size := NtoBE(2);
AStream.WriteBuffer(iptcTag, SizeOf(iptcTag));
AStream.WriteBuffer(ATag.RawData[0], 2);
end;
ttString:
begin
len := Length(ATag.RawData);
if odd(len) then begin
inc(len);
end;
// "Standard" dataset
if len < 32768 then begin
iptcTag.Size := NtoBE(word(len));
AStream.WriteBuffer(iptcTag, SizeOf(iptcTag));
AStream.WriteBuffer(ATag.RawData[0], Length(ATag.RawData));
end else
// "Extended" dataset
if len < 65536 then begin
// Size is 2, but we must set highest bit to mark tag as being extended.
iptcTag.Size := NtoBE($8002);
AStream.WriteBuffer(iptcTag, SizeOf(iptcTag));
WriteWord(AStream, NtoBE(word(len)));
AStream.WriteBuffer(ATag.RawData[0], Length(ATag.RawData));
end else begin
// Size is 4, but we must set highest bit to mark tag as being extended.
iptcTag.Size := $8004;
AStream.WriteBuffer(iptcTag, SizeOf(iptcTag));
WriteDWord(AStream, NtoBE(len));
AStream.WriteBuffer(ATag.RawData[0], Length(ATag.RawData));
end;
if odd(Length(ATag.RawData)) then // zero-termination of string
WriteByte(AStream, 0);
end;
else
// I've never seen other tag types than USHORT and STRING...
Error(Format(rsTagTypeNotSupported, [ATag.Name]));
end;
end;
procedure TIptcWriter.WriteToStream(AStream: TStream; AImgFormat: TImgFormat);
var
i: Integer;
lID: Word;
lName: String;
lData: TBytes;
begin
FImgFormat := AImgFormat;
case FImgFormat of
ifJpeg:
WriteIptcHeader(AStream);
else
Error(rsImageFormatNotSupported);
end;
if (FImgInfo.IptcData.GetImageResourceBlockCount = 0) and
(FImgInfo.IptcData.TagCount > 0)
then
FImgInfo.IptcData.AddImageResourceBlock(IPTC_IMAGERESOURCEID, '', nil);
for i := 0 to FImgInfo.IptcData.GetImageResourceBlockCount-1 do begin
FImgInfo.IptcData.GetImageResourceBlock(i, lID, lName, lData);
if lID = IPTC_IMAGERESOURCEID then
// Write the IPTC tags
WriteIptcImageResourceBlock(AStream, lName)
else begin
// Write the other image resource blocks.
WriteImageResourceBlockHeader(AStream, lID, lName);
if odd(Length(lData)) then begin
SetLength(lData, Length(lData) + 1);
lData[High(lData)] := 0;
end;
WriteDWord(AStream, NtoBE(Length(lData)));
AStream.Write(lData[0], Length(lData));
end;
end;
// If WriteToStream is called within a JPEG structure we must update the
// size of the IPTC segment.
UpdateSegmentSize(AStream, FIptcSegmentStartPos);
end;
end.

View File

@ -0,0 +1,838 @@
unit fpeMakerNote;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
{$I fpexif.inc}
interface
uses
Sysutils, Classes,
fpeGlobal, fpeTags, fpeExifReadWrite;
type
TCanonMakerNoteReader = class(TMakerNoteReader)
protected
function AddTag(AStream: TStream; const AIFDRecord: TIFDRecord;
const AData: TBytes; AParent: TTagID): Integer; override;
end;
TCasioMakerNoteReader = class(TMakerNoteReader)
protected
FVersion: Integer;
function Prepare(AStream: TStream): Boolean; override;
end;
TMinoltaMakerNoteReader = class(TMakerNoteReader)
protected
function AddTag(AStream: TStream; const AIFDRecord: TIFDRecord;
const AData: TBytes; AParent: TTagID): Integer; override;
end;
TOlympusMakerNoteReader = class(TMinoltaMakerNoteReader)
protected
FVersion: Integer;
function Prepare(AStream: TStream): Boolean; override;
end;
procedure BuildCanonTagDefs(AList: TTagDefList);
procedure BuildCasio1TagDefs(AList: TTagDefList);
procedure BuildCasio2TagDefs(AList: TTagDefList);
procedure BuildEpsonTagDefs(AList: TTagDefList);
procedure BuildFujiTagDefs(AList: TTagDefList);
procedure BuildMinoltaTagDefs(AList: TTagDefList);
procedure BuildNikon1TagDefs(AList: TTagDefList);
procedure BuildNikon2TagDefs(AList: TTagDefList);
procedure BuildOlympusTagDefs(AList: TTagDefList);
procedure BuildSanyoTagDefs(AList: TTagDefList);
implementation
uses
fpeStrConsts, fpeUtils, fpeExifData;
//==============================================================================
// TCanonMakerNoteReader
//==============================================================================
function TCanonMakerNoteReader.AddTag(AStream: TStream;
const AIFDRecord: TIFDRecord; const AData: TBytes; AParent: TTagID): Integer;
var
tagDef: TTagDef;
w: array of Word;
n,i: Integer;
begin
Result := -1;
tagDef := FindTagDef(AIFDRecord.TagID or AParent);
if (tagDef = nil) then
exit;
Result := inherited AddTag(AStream, AIFDRecord, AData, AParent);
// We only handle 16-bit integer types here for further processing
if not (tagDef.TagType in [ttUInt16, ttSInt16]) then
exit;
// Put binary data into a word array and fix endianness
n := Length(AData) div TagElementSize[ord(tagDef.TagType)];
if FBigEndian then
for i:=0 to n-1 do AData[i] := BEtoN(AData[i])
else
for i:=0 to n-1 do AData[i] := LEtoN(AData[i]);
SetLength(w, n);
Move(AData[0], w[0], Length(AData));
// This is a special treatment of array tags which will be added as
// separate "MakerNote" tags.
case AIFDRecord.TagID of
1: // Exposure Info 1
with FImgInfo.ExifData do begin
AddMakerNoteTag(1, 1, 'Macro mode', w[1], rsCanonMacroLkup);
AddMakerNoteTag(1, 2, 'Self-timer', w[2]/10, '%2:.1f s');
AddMakerNoteTag(1, 3, 'Quality', w[3], rsCanonQualityLkup);
AddMakerNoteTag(1, 4, 'Flash mode', w[4], rsCanonFlashLkup);
AddMakerNoteTag(1, 5, 'Drive mode', w[5], rsSingleContinuous);
AddMakerNoteTag(1, 7, 'Focus mode', w[7], rsCanonFocusLkup);
AddMakerNoteTag(1, 9, 'Record mode', w[9], rsCanonRecLkup);
AddMakerNoteTag(1,10, 'Image size', w[10], rsCanonSizeLkup);
AddMakerNoteTag(1,11, 'Easy shoot', w[11], rsCanonEasyLkup);
AddMakerNoteTag(1,12, 'Digital zoom', w[12], rsCanonZoomLkup);
AddMakerNoteTag(1,13, 'Contrast', w[13], rsCanonGenLkup);
AddMakerNoteTag(1,14, 'Saturation', w[14], rsCanonGenLkup);
AddMakerNoteTag(1,15, 'Sharpness', w[15], rsCanonGenLkup);
AddMakerNoteTag(1,16, 'CCD ISO', w[16], rsCanonISOLkup);
AddMakerNoteTag(1,17, 'Metering mode', w[17], rsCanonMeterLkup);
AddMakerNoteTag(1,18, 'Focus type', w[18], rsCanonFocTypeLkup);
AddMakerNoteTag(1,19, 'AFPoint', w[19], rsCanonAFLkup);
AddMakerNoteTag(1,20, 'Exposure mode', w[20], rsCanonExposeLkup);
AddMakerNoteTag(1,24, 'Long focal', w[24]);
AddMakerNoteTag(1,25, 'Short focal', w[25]);
AddMakerNoteTag(1,26, 'Focal units', w[26]);
AddMakerNoteTag(1,28, 'Flash activity', w[28], rsCanonFlashActLkup);
AddMakerNoteTag(1,29, 'Flash details', w[29]);
AddMakerNoteTag(1,32, 'Focus mode', w[32], rsSingleContinuous);
AddMakerNoteTag(1,33, 'AESetting', w[33], rsCanonAELkup);
AddMakerNoteTag(1,34, 'Image stabilization', w[34], rsSingleContinuous);
end;
2: // Focal length
with FImgInfo.ExifData do begin
AddMakerNoteTag(2, 0, 'FocalType', w[0], rsCanonFocalTypeLkup);
AddMakerNoteTag(2, 1, 'FocalLength', w[1]);
end;
4: // ExposureInfo2
with FImgInfo.ExifData do begin
AddMakerNoteTag(4, 7, 'WhiteBalance', w[7], rsCanonWhiteBalLkup);
AddMakerNoteTag(4, 8, 'Slow shutter', w[8], rsCanonSloShuttLkup);
AddMakerNoteTag(4, 9, 'SequenceNumber', w[9]);
AddMakerNoteTag(4,11, 'OpticalZoomStep', w[11]);
AddMakerNoteTag(4,12, 'Camera temperature', w[12]);
AddMakerNoteTag(4,14, 'AFPoint', w[14]);
AddMakerNoteTag(4,15, 'FlashBias', w[15], rsCanonBiasLkup);
AddMakerNoteTag(4,19, 'Distance', w[19]);
AddMakerNoteTag(4,21, 'FNumber', w[21]);
AddMakerNoteTag(4,22, 'Exposure time', w[22]);
AddMakerNoteTag(4,23, 'Measured EV2', w[23]);
AddMakerNoteTag(4,24, 'Bulb duration', w[24]);
AddMakerNoteTag(4,26, 'Camera type', w[26], rsCanonCamTypeLkup);
AddMakerNoteTag(4,27, 'Auto rotation', w[27], rsCanonAutoRotLkup);
AddMakerNoteTag(4,28, 'NDFilter', w[28], rsCanonGenLkup);
end;
5: // Panorma
with FImgInfo.ExifData do begin
AddMakerNoteTag(5, 2, 'Panorama frame number', w[2]);
AddMakerNoteTag(5, 5, 'Panorama direction', w[5], rsCanonPanDirLkup);
end;
end;
end;
//==============================================================================
// TCasioMakerNoteReader
//==============================================================================
function TCasioMakerNoteReader.Prepare(AStream: TStream): Boolean;
var
p: Int64;
hdr: Array[0..5] of ansichar;
begin
Result := false;
p := AStream.Position;
AStream.Read({%H-}hdr[0], SizeOf(hdr));
if (hdr[0] = 'Q') and (hdr[1] = 'V') and (hdr[2] = 'C') and
(hdr[3] = #0) and (hdr[4] = #0) and (hdr[5] = #0)
then begin
FVersion := 2;
BuildCasio2TagDefs(FTagDefs);
AStream.Position := p + SizeOf(hdr);
end else
begin
FVersion := 1;
BuildCasio1TagDefs(FTagDefs);
AStream.Position := p;
end;
FBigEndian := true;
Result := true;
end;
//==============================================================================
// TMinoltaMakerNoteReader
//==============================================================================
function TMinoltaMakerNoteReader.AddTag(AStream: TStream;
const AIFDRecord: TIFDRecord; const AData: TBytes; AParent: TTagID): Integer;
var
tagDef: TTagDef;
v: array of DWord;
n, i: Integer;
t: TTagID;
d: Integer;
isDiMAGE7Hi: Boolean;
//p: PByte;
begin
Result := -1;
tagDef := FindTagDef(AIFDRecord.TagID or AParent);
if (tagDef = nil) then
exit;
Result := inherited AddTag(AStream, AIFDRecord, AData, AParent);
// This is a special treatment of array tags which will be added as
// separate "MakerNote" tags.
// Ref: https://sno.phy.queensu.ca/~phil/exiftool/TagNames/Minolta.html#CameraSettings
t := AIFDRecord.TagID;
case AIFDRecord.TagID of
$0001,
$0003: // Minolta camera settings tags
// Contains an array of ULong values encoded in big-endian style,
// regardless of the byte order in the picture (i.e., even if the
// JPEG or TIFF itself is little-endian).
begin
// Put binary data into a DWord array and fix endianness
// ASSUMING HERE THAT DATA ARE ULONG HERE!
n := Length(AData) div TagElementSize[ord(ttUInt32)];
SetLength(v, n);
Move(AData[0], v[0], Length(AData));
for i:=0 to n-1 do
v[i] := BEtoN(v[i]);
// Fix problem with DiMAGE7Hi (http://www.dalibor.cz/software/minolta-makernote)
isDiMAGE7Hi := FModel = 'DiMAGE7Hi';
if isDiMAGE7Hi then d := 1 else d := 0;
with FImgInfo.ExifData do begin
AddMakerNoteTag(t, 1, 'Exposure mode', v[1], rsMinoltaExposureModeLkup, '', ttUInt32);
AddMakerNoteTag(t, 2, 'Flash mode', v[2], rsMinoltaFlashModeLkup, '', ttUInt32);
AddMakerNoteTag(t, 3, 'White balance', v[3], '', '', ttUInt32);
AddMakerNoteTag(t, 4, 'Minolta image size', v[4], rsMinoltaImageSizeLkup1, '', ttUInt32);
AddMakerNoteTag(t, 5, 'Minolta quality', v[5], rsMinoltaQualityLkup, '', ttUInt32);
AddMakerNoteTag(t, 6, 'Drive mode', v[6], rsMinoltaDriveModeLkup, '', ttUInt32);
AddMakerNoteTag(t, 7, 'Metering mode', v[7], rsMinoltaMeteringModeLkup, '', ttUInt32);
AddMakerNoteTag(t, 8, 'ISO', v[8], '', '', ttUInt32);
AddMakerNoteTag(t, 9, 'Exposure time', v[9], '', '', ttUInt32);
AddMakerNoteTag(t,10, 'F number', v[10], '', '', ttUInt32);
AddMakerNoteTag(t,11, 'Macro mode', v[11], rsOffOn, '', ttUInt32);
AddMakerNoteTag(t,12, 'Digital zoom', v[12], rsMinoltaDigitalZoomLkup, '', ttUInt32);
AddMakerNoteTag(t,13, 'Exposure compensation', v[13], '', '', ttUInt32);
AddMakerNoteTag(t,14, 'Bracket step', v[14], rsMinoltaBracketStepLkup, '', ttUInt32);
AddMakerNoteTag(t,16, 'Interval length', v[16], '', '', ttUInt32);
AddMakerNoteTag(t,17, 'Interval number', v[17], '', '', ttUInt32);
AddMakerNoteTag(t,18, 'Focal length', v[18], '', '', ttUInt32); // crashes
AddMakerNoteTag(t,19, 'Focus distance', v[19], '', '', ttUInt32);
AddMakerNoteTag(t,20, 'Flash fired', v[20], rsNoYes, '', ttUInt32);
AddMakerNoteTag(t,21, 'Minolta date', v[21], '', '', ttUInt32);
AddMakerNoteTag(t,22, 'Minolta time', v[22], '', '', ttUInt32);
AddMakerNoteTag(t,23, 'Max aperture', v[23], '', '', ttUInt32);
AddMakerNoteTag(t,26, 'File number memory', v[26], rsOffOn, '', ttUInt32);
AddMakerNoteTag(t,27, 'Last file number', v[27], '', '', ttUInt32);
AddMakerNoteTag(t,28, 'Color balance red', v[28], '', '', ttUInt32);
AddMakerNoteTag(t,29, 'Color balance green', v[29], '', '', ttUInt32);
AddMakerNoteTag(t,30, 'Color balance blue', v[30], '', '', ttUInt32);
AddMakerNoteTag(t,31, 'Saturation', v[31], '', '', ttUInt32);
AddMakerNoteTag(t,32, 'Contrast', v[32], '', '', ttUInt32);
AddMakerNoteTag(t,33, 'Sharpness', v[33], rsMinoltaSharpnessLkup, '', ttUInt32);
AddMakerNoteTag(t,34, 'Subject program', v[34], rsMinoltaSubjectProgramLkup, '', ttUInt32);
AddMakerNoteTag(t,35, 'Flash exposure compensation', v[35], '', '', ttUInt32);
AddMakerNoteTag(t,36, 'AE setting', v[36], rsMinoltaIsoSettingLkup, '', ttUInt32);
AddMakerNoteTag(t,37, 'Minolta model ID', v[37], rsMinoltaModelIDLkup, '', ttUInt32);
AddMakerNoteTag(t,38, 'Interval mode', v[38], rsMinoltaIntervalModeLkup, '', ttUInt32);
AddMakerNoteTag(t,39, 'Folder name', v[39], rsMinoltaFolderNameLkup, '', ttUInt32);
AddMakerNoteTag(t,40, 'Color mode', v[40], rsMinoltaColorModeLkup, '', ttUInt32);
AddMakerNoteTag(t,41, 'Color filter', v[41], '', '', ttUInt32);
AddMakerNoteTag(t,42, 'BW filter', v[42], '', '', ttUInt32);
AddMakerNoteTag(t,43, 'Internal flash', v[43], rsMinoltaInternalFlashLkup, '', ttUInt32);
AddMakerNoteTag(t,44, 'Brightness', v[44], '', '', ttUInt32);
AddMakerNoteTag(t,45, 'Spot focus point X', v[45], '', '', ttUInt32);
AddMakerNoteTag(t,46, 'Spot focus point Y', v[46], '', '', ttUInt32);
AddMakerNoteTag(t,47, 'Wide focus zone', v[47], rsMinoltaWideFocusZoneLkup, '', ttUInt32);
AddMakerNoteTag(t,48, 'Focus mode', v[48], rsMinoltaFocusModeLkup, '', ttUInt32);
AddMakerNoteTag(t,49, 'Focus area', v[49], rsMinoltaFocusAreaLkup, '', ttUInt32);
AddMakerNoteTag(t,50, 'DEC position', v[50], rsMinoltaDECPositionLkup, '', ttUInt32);
if isDiMAGE7Hi then
AddMakerNoteTag(t,51, 'Color profile', v[51], rsMinoltaColorProfileLkup, '', ttUInt32);
AddMakerNoteTag(t,51+d, 'Data imprint', v[52], rsMinoltaDataImprintLkup, '', ttUInt32);
AddMakerNoteTag(t,63+d, 'Flash metering', v[63], rsMinoltaFlashMeteringLkup, '', ttUInt32); // or is the index 53?
end;
end;
$0010: // CameraInfoA100
begin
//p := @AData[0];
//... conversion stopped due to unclear documentation on
// https://www.sno.phy.queensu.ca/~phil/exiftool/TagNames/Minolta.html#CameraInfoA100
// --- Is there an index 0?
end;
end;
end;
//==============================================================================
// TOlympusMakerNoteReader
//==============================================================================
{ Read the header and determine the version of the olympus makernotes:
- version 1: header OLYMP#0#1+0, offsets relative to EXIF
- version 2: header OLYMP#0#2#0, offsets relative to EXIF
- version 3: header OLYMPUS#0 + BOM (II or MM) + version (#3#0)
offsets relative to maker notes !!!! }
function TOlympusMakerNoteReader.Prepare(AStream: TStream): Boolean;
var
p: Int64;
hdr: packed array[0..11] of ansichar;
begin
Result := false;
// Remember begin of makernotes tag.
p := AStream.Position;
// Read header
AStream.Read(hdr{%H-}, 12);
// The first 5 bytes must be 'OLYMP'; this is common to all versions
if not ((hdr[0] = 'O') and (hdr[1] = 'L') and (hdr[2] = 'Y') and (hdr[3] = 'M') and (hdr[4] = 'P')) then
exit;
FVersion := 0;
// Version 1 or 2 if a #0 follows after the 'OLYMP'
if (hdr[5] = #0) then begin
if (hdr[6] = #1) and (hdr[7] = #0) then
FVersion := 1
else
if (hdr[6] = #2) and (hdr[7] = #0) then
FVersion := 2;
end else
// Version 3 if the first 8 bytes are 'OLYMPUS'#0
if (hdr[5] = 'U') and (hdr[6] = 'S') and (hdr[7] = #0) then begin
// Endianness marker, like in standard EXIF: 'II' or 'MM'
if (hdr[8] = 'I') and (hdr[9] = 'I') then
FBigEndian := false
else
if (hdr[8] = 'M') and (hdr[9] = 'M') then
FBigEndian := true;
if (hdr[10] = #3) then
FVersion := 3;
FStartPosition := p; // Offsets are relative to maker notes
end;
// Jump to begin of IFD
case FVersion of
1, 2: AStream.Position := p + 8;
3 : AStream.Position := p + 12;
else exit;
end;
BuildOlympusTagDefs(FTagDefs);
Result := true;
end;
(*
{ Read the header and determine the version of the olympus makernotes:
- version 1: header OLYMP#0#1+0, offsets relative to EXIF
- version 2: header OLYMP#0#2#0, offsets relative to EXIF
- version 3: header OLYMPUS#0 + BOM (II or MM) + version (#3#0)
offsets relative to maker notes !!!! }
procedure TOlympusMakerNoteReader.ReadIFD(AStream: TStream; AParent: TTagID);
//procedure TOlympusMakerNoteReader.ReadIFD(AStream: TStream; AGroup: TTagGroup);
var
p: Int64;
hdr: packed array[0..11] of ansichar;
begin
if TTagIDRec(AParent).Parent = TAG_MAKERNOTE then
begin
// if AGroup = tgExifMakerNote then
// Remember begin of makernotes tag.
p := AStream.Position;
// Read header
AStream.Read(hdr, 12);
// The first 5 bytes must be 'OLYMP'; this is common to all versions
if not ((hdr[0] = 'O') and (hdr[1] = 'L') and (hdr[2] = 'Y') and (hdr[3] = 'M') and (hdr[4] = 'P')) then
exit;
FVersion := 0;
// Version 1 or 2 if a #0 follows after the 'OLYMP'
if (hdr[5] = #0) then begin
if (hdr[6] = #1) and (hdr[7] = #0) then
FVersion := 1
else
if (hdr[6] = #2) and (hdr[7] = #0) then
FVersion := 2;
end else
// Version 3 if the first 8 bytes are 'OLYMPUS'#0
if (hdr[5] = 'U') and (hdr[6] = 'S') and (hdr[7] = #0) then begin
// Endianness marker, like in standard EXIF: 'II' or 'MM'
if (hdr[8] = 'I') and (hdr[9] = 'I') then
FBigEndian := false
else
if (hdr[8] = 'M') and (hdr[9] = 'M') then
FBigEndian := true;
if (hdr[10] = #3) then
FVersion := 3;
FStartPosition := p; // Offsets are relative to maker notes
end;
// Jump to begin of IFD
case FVersion of
1, 2: AStream.Position := p + 8;
3 : AStream.Position := p + 12;
else exit;
end;
BuildOlympusTagDefs(FTagDefs)
end;
inherited;
end;
*)
//==============================================================================
// Tag definition lists
//==============================================================================
const
M = DWord(TAGPARENT_MAKERNOTE);
procedure BuildCanonTagDefs(AList: TTagDefList);
begin
Assert(AList <> nil);
with AList do begin
AddUShortTag(M+$0001, 'ExposureInfo1');
AddUShortTag(M+$0002, 'Panorama');
AddUShortTag(M+$0004, 'ExposureInfo2');
AddStringTag(M+$0006, 'ImageType');
AddStringTag(M+$0007, 'FirmwareVersion');
AddULongTag (M+$0008, 'ImageNumber');
AddStringTag(M+$0009, 'OwnerName');
AddULongTag (M+$000C, 'CameraSerialNumber');
AddUShortTag(M+$000F, 'CustomFunctions');
end;
end;
{ Casio Type 1
Standard TIFF IFD Data using Casio Type 1 Tags but always uses
Motorola (Big-Endian) byte alignment
This makernote has no header - the IFD starts immediately
Ref.: http://www.ozhiker.com/electronics/pjmt/jpeg_info/casio_mn.html }
procedure BuildCasio1TagDefs(AList: TTagDefList);
begin
Assert(AList <> nil);
with AList do begin
AddUShortTag(M+$0001, 'RecordingMode', 1, '', rsCasioRecordingModeLkup);
AddUShortTag(M+$0002, 'Quality', 1, '', rsEconomyNormalFine1);
AddUShortTag(M+$0003, 'FocusingMode', 1, '', rsCasioFocusingModeLkup);
AddUShortTag(M+$0004, 'FlashMode', 1, '', rsCasioFlashModeLkup);
AddUShortTag(M+$0005, 'FlashIntensity', 1, '', rsCasioFlashIntensityLkup);
AddULongTag (M+$0006, 'ObjectDistance', 1, '', '', '%d mm');
AddUShortTag(M+$0007, 'WhiteBalance', 1, '', rsCasioWhiteBalanceLkup);
AddULongTag (M+$000A, 'DigitalZoom', 1, '', rsCasioDigitalZoomLkup);
AddUShortTag(M+$000B, 'Sharpness', 1, '', rsNormalSoftHard);
AddUShortTag(M+$000C, 'Contrast', 1, '', rsNormalLowHigh);
AddUShortTag(M+$000D, 'Saturation', 1, '', rsNormalLowHigh);
AddUShortTag(M+$000A, 'DigitalZoom', 1, '', rsCasioDigitalZoomLkup);
AddUShortTag(M+$0014, 'CCDSensitivity', 1, '', rsCasioCCDSensitivityLkup);
end;
end;
{ Case Type 2
Header: 6 Bytes "QVC\x00\x00\x00"
IFD Data: Standard TIFF IFD Data using Casio Type 2 Tags but always uses
Motorola (Big-Endian) Byte Alignment.
All EXIF offsets are relative to the start of the TIFF header at the beginning of the EXIF segment
Ref.: http://www.ozhiker.com/electronics/pjmt/jpeg_info/casio_mn.html
http://www.exiv2.org/tags-casio.html
https://sno.phy.queensu.ca/~phil/exiftool/TagNames/Casio.html#Type2
}
procedure BuildCasio2TagDefs(AList: TTagDefList);
begin
Assert(AList <> nil);
with AList do begin
AddUShortTag (M+$0002, 'PreviewImageSize', 2); // width and height, in pixels
AddULongTag (M+$0003, 'PreviewImageLength');
AddULongTag (M+$0004, 'PreviewImageStart');
AddUShortTag (M+$0008, 'QualityMode', 1, '', rsEconomyNormalFine);
AddUShortTag (M+$0009, 'ImageSize', 1, '', rsCasioImageSize2Lkup);
AddUShortTag (M+$000D, 'FocusMode', 1, '', rsCasioFocusMode2Lkup);
AddUShortTag (M+$0014, 'ISOSpeed', 1, '', rsCasioISOSpeed2Lkup);
AddUShortTag (M+$0019, 'WhiteBalance', 1, '', rsCasioWhiteBalance2Lkup);
AddURationalTag(M+$001D, 'FocalLength');
AddUShortTag (M+$001F, 'Saturation', 1, '', rsLowNormalHigh);
AddUShortTag (M+$0020, 'Contrast', 1, '', rsLowNormalHigh);
AddUShortTag (M+$0021, 'Sharpness', 1, '', rsCasioSharpness2Lkup);
AddBinaryTag (M+$0E00, 'PrintIM');
AddBinaryTag (M+$2000, 'PreviewImage');
AddStringTag (M+$2001, 'FirwareDate', 18);
AddUShortTag (M+$2011, 'WhiteBalanceBias', 2);
AddUShortTag (M+$2012, 'WhiteBalance2', 2, '', rsCasioWhiteBalance22Lkup);
AddUShortTag (M+$2021, 'AFPointPosition', 4);
AddULongTag (M+$2022, 'ObjectDistance');
AddUShortTag (M+$2034, 'FlashDistance');
AddByteTag (M+$2076, 'SpecialEffectMode', 3); // to do: array lkup - should be: '0 0 0' = Off,'1 0 0' = Makeup,'2 0 0' = Mist Removal,'3 0 0' = Vivid Landscape
AddBinaryTag (M+$2089, 'FaceInfo');
AddByteTag (M+$211C, 'FacesDetected');
AddUShortTag (M+$3000, 'RecordMode', 1, '', rsCasioRecordMode2Lkup);
AddUShortTag (M+$3001, 'ReleaseMode', 1, '', rsCasioReleaseMode2Lkup);
AddUShortTag (M+$3002, 'Quality', 1, '', rsEconomyNormalFine1);
AddUShortTag (M+$3003, 'FocusMode2', 1, '', rsCasioFocusMode2Lkup);
AddStringTag (M+$3006, 'HometownCity');
AddUShortTag (M+$3007, 'BestShotMode'); // Lkup depends severly on camera model
AddUShortTag (M+$3008, 'AutoISO', 1, '', rsCasioAutoIso2Lkup);
AddUShortTag (M+$3009, 'AFMode', 1, '', rsCasioAFMode2Lkup);
AddBinaryTag (M+$3011, 'Sharpness2');
AddBinaryTag (M+$3012, 'Contrast2');
AddBinaryTag (M+$3013, 'Saturation2');
AddUShortTag (M+$3014, 'ISO');
AddUShortTag (M+$3015, 'ColorMode', 1, '', rsCasioColorMode2Lkup);
AddUShortTag (M+$3016, 'Enhancement', 1, '', rsCasioEnhancement2Lkup);
AddUShortTag (M+$3017, 'ColorFilter', 1, '', rsCasioColorFilter2Lkup);
AddUShortTag (M+$301B, 'ArtMode', 1, '', rsCasioArtMode2Lkup);
AddUShortTag (M+$301C, 'SequenceNumber');
AddUShortTag (M+$301D, 'BracketSequence', 2);
AddUShortTag (M+$3020, 'ImageStabilization', 1, '', rsCasioImageStabilization2Lkup);
AddUShortTag (M+$302A, 'LightingMode', 1, '', rsCasioLightingMode2Lkup);
AddUShortTag (M+$302B, 'PortraitRefiner', 1, '', rsCasioPortraitRefiner2Lkup);
AddUShortTag (M+$3030, 'SpecialEffectLevel');
AddUShortTag (M+$3031, 'SpecialEffectSetting', 1, '', rsCasioSpecialEffectSetting2Lkup);
AddUShortTag (M+$3103, 'DriveMode', 1, '', rsCasioDriveMode2Lkup);
AddBinaryTag (M+$310B, 'ArtModeParameters', 3);
AddUShortTag (M+$4001, 'CaptureFrameRate');
AddUShortTag (M+$4003, 'VideoQuality', 1, '', rsCasioVideoQuality2Lkup);
// to do...
end;
end;
procedure BuildEpsonTagDefs(AList: TTagDefList);
begin
Assert(AList <> nil);
with AList do begin
AddUShortTag(M+$0200, 'SpecialMode');
AddUShortTag(M+$0201, 'JpegQuality');
AddUShortTag(M+$0202, 'Macro');
AddUShortTag(M+$0204, 'DigitalZoom');
AddUShortTag(M+$0209, 'CameraID');
AddStringTag(M+$020A, 'Comments');
AddUShortTag(M+$020B, 'Width');
AddUShortTag(M+$020C, 'Height');
AddUShortTag(M+$020D, 'SoftRelease');
end;
end;
procedure BuildFujiTagDefs(AList: TTagDefList);
begin
Assert(AList <> nil);
with AList do begin
AddBinaryTag (M+$0000, 'Version');
AddStringTag (M+$1000, 'Quality');
AddUShortTag (M+$1001, 'Sharpness', 1, '', rsFujiSharpnessLkup);
AddUShortTag (M+$1002, 'WhiteBalance', 1, '', rsFujiWhiteBalLkup);
AddUShortTag (M+$1003, 'Saturation', 1, '', rsFujiSaturationLkup);
AddUShortTag (M+$1004, 'Contrast', 1, '', rsFujiContrastLkup);
AddUShortTag (M+$1005, 'ColorTemperature');
AddUShortTag (M+$1006, 'Contrast', 1, '', rsFujiContrastLkup1);
AddURationalTag(M+$100A, 'WhiteBalanceFineTune');
AddUShortTag (M+$100B, 'NoiseReduction', 1, '', rsFujiNoiseReductionLkup);
AddUShortTag (M+$100E, 'HighISONoiseReduction', 1, '', rsFujiHighIsoNoiseReductionLkup);
AddUShortTag (M+$1010, 'FlashMode', 1, '', rsFujiFlashModeLkup);
AddURationalTag(M+$1011, 'FlashStrength');
AddUShortTag (M+$1020, 'Macro', 1, '', rsOffOn);
AddUShortTag (M+$1021, 'FocusMode', 1, '', rsAutoManual);
AddUShortTag (M+$1030, 'SlowSync', 1, '', rsOffOn);
AddUShortTag (M+$1031, 'PictureMode', 1, '', rsFujiPictureModeLkup);
AddUShortTag (M+$1032, 'ExposureCount');
AddUShortTag (M+$1033, 'EXRAuto', 1, '', rsAutoManual);
AddUShortTag (M+$1034, 'EXRMode', 1, '', rsFujiEXRModeLkup);
AddSLongTag (M+$1040, 'ShadowTone', 1, '', rsFujiShadowHighlightLkup);
AddSLongTag (M+$1041, 'HighlightTone', 1, '', rsFujiShadowHighlightLkup);
AddULongTag (M+$1044, 'DigitalZoom');
AddUShortTag (M+$1050, 'ShutterType', 1, '', rsFujiShutterTypeLkup);
AddUShortTag (M+$1100, 'AutoBracketing', 1, '', rsFujiAutoBracketingLkup);
AddUShortTag (M+$1101, 'SequenceNumber');
AddUShortTag (M+$1153, 'PanoramaAngle');
AddUShortTag (M+$1154, 'PanoramaDirection', 1, '', rsFujiPanoramaDirLkup);
AddULongTag (M+$1201, 'AdvancedFilter', 1, '', rsFujiAdvancedFilterLkup);
AddUShortTag (M+$1210, 'ColorMode', 1, '', rsFujiColorModeLkup);
AddUShortTag (M+$1300, 'BlurWarning', 1, '', rsFujiBlurWarningLkup);
AddUShortTag (M+$1301, 'FocusWarning', 1, '', rsFujiFocusWarningLkup);
AddUShortTag (M+$1302, 'ExposureWarning', 1, '', rsFujiExposureWarningLkup);
AddUShortTag (M+$1400, 'DynamicRange', 1, '', rsFujiDynamicRangeLkup);
AddURationalTag(M+$1404, 'MinFocalLength');
AddURationalTag(M+$1405, 'MaxFocalLength');
AddURationalTag(M+$1406, 'MaxApertureAtMinFocal');
AddURationalTag(M+$1407, 'MaxApertureAtMaxFocal');
AddUShortTag (M+$140B, 'AutoDynamicRange');
AddUShortTag (M+$1422, 'ImageStabilization', 3);
AddUShortTag (M+$1425, 'SceneRecognition', 1, '', rsFujiSceneRecognLkup);
AddUShortTag (M+$1431, 'Rating');
AddStringTag (M+$8000, 'FileSource');
AddULongTag (M+$8002, 'OrderNumber');
AddUShortTag (M+$8003, 'FrameNumber');
end;
end;
{ The Minolta MakerNote can be quite long, about 12 kB. In the beginning
of this tag there is a normal tag directory in usual format.
References:
- http://www.dalibor.cz/software/minolta-makernote
- https://sno.phy.queensu.ca/~phil/exiftool/TagNames/Minolta.html }
procedure BuildMinoltaTagDefs(AList: TTagDefList);
begin
Assert(AList <> nil);
with AList do begin
{ This tag stores the string 'MLT0', not zero-terminated, as an identifier }
AddBinaryTag (M+$0000, 'Version', 4, '', '', '', TVersionTag);
{ Stores all settings which were in effect when taking the picture.
Details depend on camera. }
AddBinaryTag (M+$0001, 'MinoltaCameraSettingsOld'); // Camera D5, D7, S304, S404
AddBinaryTag (M+$0003, 'MinoltaCameraSettings'); // Camera D7u, D7i, D7Hi
// this is the size of the JPEG (compressed) or TIFF or RAW file.
AddULongTag (M+$0040, 'CompressedImageSize');
{ Stores the thumbnail image (640×480). It is in normal JFIF format but the
first byte should be changed to 0xFF. Beware! Sometimes the thumbnail
is not stored in the file and this tag points beyond the end of the file. }
AddBinaryTag (M+$0081, 'ReviewImage');
{ The cameras D7u, D7i and D7Hi no longer store the thumbnail inside the tag.
It has instead two tags describing the position of the thumbnail in the
file and its size }
AddULongTag (M+$0088, 'PreviewImageStart');
AddULongTag (M+$0089, 'PreviewImageLength');
AddULongTag (M+$0100, 'SceneMode', 1, '', rsMinoltaSceneModeLkup);
AddULongTag (M+$0101, 'ColorMode', 1, '', rsMinoltaColorModeLkup);
AddULongtag (M+$0102, 'Quality', 1, '', rsMinoltaQualityLkup);
AddULongTag (M+$0103, 'ImageSize', 1, '', rsMinoltaImageSizeLkup);
AddSRationalTag(M+$0104, 'FlashExposureComp');
AddULongTag (M+$0105, 'TeleConverter', 1, '', rsMinoltaTeleconverterLkup);
AddULongTag (M+$0107, 'ImageStabilization', 1, '', rsMinoltaImageStabLkup);
AddULongTag (M+$0109, 'RawAndJpegRecording', 1, '', rsOffOn);
AddULongTag (M+$010A, 'ZoneMatching', 1, '', rsMinoltaZoneMatchingLkup);
AddULongTag (M+$010B, 'ColorTemperature', 1);
AddULongTag (M+$010C, 'LensType', 1);
AddSLongTag (M+$0111, 'ColorCompensationFilter', 1);
AddULongTag (M+$0112, 'WhiteBalanceFileTune', 1);
AddULongTag (M+$0113, 'ImageStabilization', 1, '', rsOffOn);
AddULongTag (M+$0115, 'WhiteBalance', 1, '', rsMinoltaWhiteBalanceLkup);
AddBinaryTag (M+$0E00, 'PrintPIM');
end;
end;
// not tested
procedure BuildNikon1TagDefs(AList: TTagDefList);
begin
Assert(AList <> nil);
with AList do begin
AddUShortTag(M+$0002, 'FamilyID');
AddUShortTag(M+$0003, 'Quality', 1, '', rsNikonQualityLkup);
AddUShortTag(M+$0004, 'ColorMode', 1, '', rsNikonColorModeLkup);
AddUShortTag(M+$0005, 'ImageAdjustment', 1, '', rsNikonImgAdjLkup);
AddUShortTag(M+$0006, 'ISOSpeed', 1, '', rsNikonISOLkup);
AddUShortTag(M+$0007, 'WhiteBalance', 1, '', rsNikonWhiteBalanceLkup);
AddUShortTag(M+$0008, 'Focus');
AddUShortTag(M+$000A, 'DigitalZoom');
AddUShortTag(M+$000B, 'Converter', 1, '', rsNikonConverterLkup);
end;
end;
{ for Nikon D1, E880, E885, E990, E995, E2500, E5000
Ref http://www.tawbaware.com/990exif.htm
https://sno.phy.queensu.ca/~phil/exiftool/TagNames/Nikon.html }
procedure BuildNikon2TagDefs(AList: TTagDefList);
begin
Assert(AList <> nil);
with AList do begin
AddBinaryTag (M+$0001, 'Version', 4, '', '', '', TVersionTag);
AddUShortTag (M+$0002, 'ISO', 2);
AddStringTag (M+$0003, 'ColorMode');
AddStringTag (M+$0004, 'Quality');
AddStringTag (M+$0005, 'WhiteBalance');
AddStringtag (M+$0006, 'ImageSharpening');
AddStringTag (M+$0007, 'FocusMode');
AddStringTag (M+$0008, 'FlashSetting');
AddStringTag (M+$0009, 'FlashType');
AddURationalTag(M+$000A, 'UNKNOWN');
AddStringTag (M+$000F, 'ISOSelection');
AddStringTag (M+$0080, 'ImageAdjustment');
AddStringTag (M+$0081, 'ToneComp');
AddStringTag (M+$0082, 'AuxiliaryLens');
AddURationalTag(M+$0085, 'ManualFocusDistance');
AddURationalTag(M+$0086, 'DigitalZoom');
AddBinaryTag (M+$0088, 'AFInfo');
AddStringTag (M+$008D, 'ColorHue');
AddStringTag (M+$008F, 'SceneMode');
AddStringTag (M+$0090, 'LightSource');
AddBinaryTag (M+$0010, 'DataDump');
end;
end;
// Most from https://sno.phy.queensu.ca/~phil/exiftool/TagNames/Olympus.html
// some from dExif
const
E = $2010 shl 16; // Equipment version
C = $2011 shl 16; // Camera settings
procedure BuildOlympusTagDefs(AList: TTagDefList);
begin
Assert(AList <> nil);
with AList do begin
AddBinaryTag (M+$0000, 'Version', 4, '', '', '', TVersionTag);
{ Stores all settings which were in effect when taking the picture.
Details depend on camera. }
AddBinaryTag (M+$0001, 'MinoltaCameraSettingsOld'); //, $FFFF, '', '', '', TSubIFDTag, true);
AddBinaryTag (M+$0003, 'MinoltaCameraSettings'); //, $FFFF, '', '', '', TSubIFDTag, false);
// this is the size of the JPEG (compressed) or TIFF or RAW file.
AddULongTag (M+$0040, 'CompressedImageSize');
{ Stores the thumbnail image (640×480). It is in normal JFIF format but the
first byte should be changed to 0xFF. Beware! Sometimes the thumbnail
is not stored in the file and this tag points beyond the end of the file. }
AddBinaryTag (M+$0081, 'ReviewImage');
{ The cameras D7u, D7i and D7Hi no longer store the thumbnail inside the tag.
It has instead two tags describing the position of the thumbnail in the
file and its size }
AddULongTag (M+$0088, 'PreviewImageStart');
AddULongTag (M+$0089, 'PreviewImageLength');
AddULongTag (M+$0200, 'SpecialMode', 3);
AddUShortTag (M+$0201, 'JpegQuality', 1, '', rsOlympusJpegQualLkup);
AddUShortTag (M+$0202, 'Macro', 1, '', rsOlympusMacroLkup);
AddURationalTag(M+$0204, 'DigitalZoom');
// AddUShortTag (M+$0207, 'Firmware');
AddStringTag (M+$9207, 'CameraType');
AddStringTag (M+$0208, 'PictureInfo');
AddStringTag (M+$0209, 'CameraID');
AddUShortTag (M+$020B, 'EpsonImageWidth');
AddUShortTag (M+$020C, 'EpsonImageHeight');
AddStringTag (M+$020D, 'EpsonSoftware');
AddUShortTag (M+$0403, 'SceneMode', 1, '', rsOlympusSceneModeLkup);
AddStringTag (M+$0404, 'SerialNumber');
AddStringTag (M+$0405, 'Firmware');
AddSRationalTag(M+$1000, 'ShutterSpeedValue');
AddSRationalTag(M+$1001, 'ISOValue');
AddSRationalTag(M+$1002, 'ApertureValue');
AddSRationalTag(M+$1003, 'BrightnessValue');
AddUShortTag (M+$1004, 'FlashMode', 1, '', rsOlympusFlashModeLkup);
AddUShortTag (M+$1005, 'FlashDevice', 1, '', rsOlympusFlashDevLkup);
AddURationalTag(M+$1006, 'Bracket');
AddSShortTag (M+$1007, 'SensorTemperature');
AddSShortTag (M+$1008, 'LensTemperature');
AddUShortTag (M+$100B, 'FocusMode', 1, '', rsAutoManual);
AddURationalTag(M+$100C, 'FocusDistance');
AddUShortTag (M+$100D, 'ZoomStepCount');
AddUShortTag (M+$100E, 'FocusStepCount');
AddUShortTag (M+$100F, 'Sharpness', 1, '', rsOlympusSharpnessLkup);
AddUShortTag (M+$1010, 'FlashChargeLevel');
AddUShortTag (M+$1011, 'ColorMatrix', 9);
AddUShortTag (M+$1012, 'BlackLevel', 4);
AddUShortTag (M+$1015, 'WhiteBalanceMode', 2);
AddUShortTag (M+$1017, 'RedBalance', 2);
AddUShortTag (M+$1018, 'BlueBalance', 2);
AddStringTag (M+$101A, 'SerialNumber');
AddURationalTag(M+$1023, 'FlashBias');
AddUShortTag (M+$1029, 'Contrast', 1, '', rsOlympusContrastLkup);
AddUShortTag (M+$102A, 'SharpnessFactor');
AddUShortTag (M+$102B, 'ColorControl', 6);
AddUShortTag (M+$102C, 'ValidBits', 2);
AddUShortTag (M+$102D, 'CoringFilter');
AddULongTag (M+$102E, 'FinalWidth');
AddULongTag (M+$102F, 'FinalHeight');
AddUShortTag (M+$1030, 'SceneDetect');
AddULongTag (M+$1031, 'SceneArea', 8);
AddURationalTag(M+$1034, 'CompressionRatio');
AddUShortTag (M+$1038, 'AFResult');
AddUShortTag (M+$1039, 'CCDScanMode', 1, '', rsOlympusCCDScanModeLkup);
AddUShortTag (M+$103A, 'NoiseReduction', 1, '', rsOffOn);
AddUShortTag (M+$103B, 'FocusStepInfinity');
AddUShortTag (M+$103C, 'FocusStepNear');
AddSRationalTag(M+$103D, 'LightValueCenter');
AddSRationalTag(M+$103E, 'LightValuePeriphery');
AddIFDTag (M+$2010, 'Equipment', '', TSubIFDTag);
AddIFDTag (M+$2011, 'CameraSettings', '', TSubIFDTag);
// Olympus Equipment Tags
AddBinaryTag (E+$0000, 'EquipmentVersion', 4, '', '', '', TVersionTag);
AddStringTag (E+$0100, 'CameraType', 6);
AddStringTag (E+$0101, 'SerialNumber', 32);
AddStringTag (E+$0102, 'InternalSerialNumber', 32);
AddURationalTag(E+$0103, 'FocalPlaneDiagonal');
AddULongTag (E+$0104, 'BodyFirmwareVersion');
AddByteTag (E+$0201, 'LensType', 6);
AddStringTag (E+$0202, 'LensSerialNumber', 32);
AddStringTag (E+$0203, 'LensModel');
AddULongTag (E+$0204, 'LensFirmwareVersion');
AddUShortTag (E+$0205, 'MaxApertureAtMinFocal');
AddUShortTag (E+$0206, 'MaxApertureAtMaxFocal');
AddUShortTag (E+$0207, 'MinFocalLength');
AddUShortTag (E+$0208, 'MaxFocalLength');
AddUShortTag (E+$020A, 'MaxAperture');
AddUShortTag (E+$020B, 'LensProperties');
AddByteTag (E+$0301, 'Extender', 6);
AddStringTag (E+$0302, 'ExtenderSerialNumber', 32);
AddStringTag (E+$0303, 'ExtenderModel');
AddULongTag (E+$0304, 'ExtenderFirmwareVersion');
AddStringTag (E+$0403, 'ConversionLens');
AddUShortTag (E+$1000, 'FlashType', 1, '', rsOlympusFlashTypeLkup);
AddUShortTag (E+$1001, 'FlashModel', 1, '', rsOlympusFlashModelLkup);
AddULongTag (E+$1002, 'FlashFirmwareVersion');
AddStringTag (E+$1003, 'FlashSerialNumber', 32);
// Olympus camera settings tags
AddBinaryTag (C+$0000, 'CameraSettingsVersion', 4, '', '', '', TVersionTag);
AddULongTag (C+$0100, 'PreviewImageValid', 1, rsOlympusPreviewImgValid, rsOffOn);
AddULongTag (C+$0101, 'PreviewImageStart', 1, rsOlympusPreviewImgStart);
AddULongTag (C+$0102, 'PreviewImageLength', 1, rsOlympusPreviewImgLength);
end;
end;
// from dExif.
procedure BuildSanyoTagDefs(AList: TTagDefList);
begin
Assert(AList <> nil);
with AList do begin
AddULongTag (M+$0200, 'SpecialMode', 3, rsSanyoSpecialMode);
AddUShortTag (M+$0201, 'Quality', 1, rsQuality, rsSanyoQualityLkup);
AddUShortTag (M+$0202, 'Macro', 1, rsMacro, rsSanyoMacroLkup);
AddURationalTag(M+$0204, 'DigitalZoom', 1, rsDigitalZoom);
end;
end;
initialization
RegisterMakerNoteReader(TCanonMakerNoteReader, 'Canon', '');
RegisterMakerNoteReader(TCanonMakerNoteReader, 'Casio', '');
RegisterMakerNoteReader(TMinoltaMakerNoteReader, 'Minolta', '');
RegisterMakerNoteReader(TOlympusMakerNoteReader, 'Olympus', '');
end.

View File

@ -0,0 +1,701 @@
unit fpeMetadata;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
{$I fpexif.inc}
interface
uses
Classes, SysUtils,
{$IFDEF FPC}
LazUTF8,
{$ENDIF}
fpeGlobal,
fpeExifData, fpeIptcData;
type
TImgInfo = class;
{ TBasicMetadataReaderWriter }
TBasicMetadataReaderWriter = class
protected
FImgInfo: TImgInfo;
FImgFormat: TImgFormat;
procedure Warning(const AMsg: String);
public
constructor Create(AImgInfo: TImgInfo); virtual;
end;
{ TBasicMetadataReader }
TBasicMetadataReader = class(TBasicMetadataReaderWriter)
protected
procedure Error(const AMsg: String); virtual;
public
procedure ReadFromStream(AStream: TStream; AImgFormat: TImgFormat); virtual;
end;
{ TBasicMetadataWriter }
TBasicMetadataWriter = class(TBasicMetadataReaderWriter)
protected
procedure Error(const AMsg: String); virtual;
procedure UpdateSegmentSize(AStream: TStream; ASegmentStartPos: Int64);
public
procedure WriteToStream(AStream: TStream; AImgFormat: TImgFormat); virtual;
end;
{ TImgInfo }
TImgInfo = class
private
FFileName: String;
FFileDate: TDateTime;
FFileSize: Int64;
FImgFormat: TImgFormat;
FImgWidth: Integer;
FImgHeight: Integer;
FWarnings: TStrings;
FMetadataKinds: TMetadataKinds;
FHeaderSegment: TBytes;
FComment: String;
private
FExifData: TExifData;
FIptcData: TIptcData;
function GetComment: String;
function GetWarnings: String;
procedure SetComment(const AValue: String);
protected
procedure Error(const AMsg: String);
function ExtractImgFormat(AStream: TStream): TImgFormat;
procedure MergeToJpegStream(AInputStream, AOutputStream: TStream);
procedure ReadJpeg(AStream: TStream);
procedure ReadTiff(AStream: TStream);
procedure StoreFileInfo(const AFileName: String);
procedure WriteJpeg(AStream: TStream);
public
constructor Create;
destructor Destroy; override;
procedure LoadFromFile(const AFileName: String);
procedure LoadFromStream(AStream: TStream);
procedure SaveToFile(const AFileName: String; AImgFile: String = '');
function CreateExifData(ABigEndian: Boolean = false): TExifData;
function CreateIptcData: TIptcData;
function HasComment: Boolean;
function HasExif: Boolean;
function HasIptc: Boolean;
function HasThumbnail: Boolean;
function HasWarnings: boolean;
{ Comment stored in the Jpeg COM segment }
property Comment: String read GetComment write SetComment;
{ Name of the file processed }
property FileName: String read FFileName;
{ Date when the file was created }
property FileDate: TDateTime read FFileDate;
{ Size of the file in bytes }
property FileSize: Int64 read FFileSize;
{ Image format, jpeg or tiff }
property ImgFormat: TImgFormat read FImgFormat;
{ Image width }
property ImgWidth: Integer read FImgWidth;
{ Image height }
property ImgHeight: Integer read FImgHeight;
{ Selects which kind of metadata will be loaded }
property MetadataKinds: TMetadataKinds read FMetadataKinds write FMetadataKinds default mdkAll;
{ Warning message - NOTE: Reading of warnings is erasing the warnings list! }
property Warnings: String read GetWarnings;
property ExifData: TExifData read FExifData;
property IptcData: TIptcData read FIptcData; // to do: rename to IptcData
end;
implementation
uses
Variants,
fpeStrConsts, fpeUtils, fpeExifReadWrite, fpeIptcReadWrite;
type
TJpegJFIFSegment = packed record
Identifier: packed array[0..4] of AnsiChar; // 'JFIF'#0
JFIFVersion: packed array[0..1] of Byte; // 01 02
DensityUnit: Byte; // 0: aspect ratio, 1: inches, 2: cm
XDensity: Word;
YDensity: Word;
ThumbnailWidth: Byte; // Pixel count of thumbnail width...
ThumbnailHeight: Byte; // ... and height
end;
PJpegJFIFSegment = ^TJpegJFIFSegment;
TJpegSOF0Segment = packed record
DataPrecision: Byte;
ImageHeight: Word;
ImageWidth: Word;
// and more..., not needed here.
end;
PJpegSOF0Segment = ^TJpegSOF0Segment;
const
{ JPEG markers consist of one or more $FF bytes, followed by a marker code
byte (which is not an FF). Here are the marker codes needed by fpExif: }
M_SOF0 = $C0; // Start Of Frame 0
M_SOI = $D8; // Start Of Image (beginning of datastream)
M_EOI = $D9; // End Of Image (end of datastream)
M_SOS = $DA; // Start Of Scan (begins compressed data)
M_JFIF = $E0; // Jfif marker 224
M_EXIF = $E1; // Exif marker 225
M_IPTC = $ED; // IPTC - Photoshop 237
M_COM = $FE; // Comment 254
//==============================================================================
// TBasicMetaDataWriter
//==============================================================================
constructor TBasicMetadataReaderWriter.Create(AImgInfo: TImgInfo);
begin
FImgInfo := AImgInfo;
end;
procedure TBasicMetadataReaderWriter.Warning(const AMsg: String);
begin
FImgInfo.FWarnings.Add(AMsg);
end;
//==============================================================================
// TBasicMetaDataReader
//==============================================================================
procedure TBasicMetadataReader.Error(const AMsg: String);
begin
raise EFpExifReader.Create(AMsg);
end;
procedure TBasicMetadataReader.ReadFromStream(AStream: TStream;
AImgFormat: TImgFormat);
begin
Assert(AStream <> nil);
FImgFormat := AImgFormat;
end;
//==============================================================================
// TBasicMetaDataWriter
//==============================================================================
procedure TBasicMetadataWriter.Error(const AMsg: String);
begin
raise EFpExifWriter.Create(AMsg);
end;
procedure TBasicMetadataWriter.UpdateSegmentSize(AStream: TStream;
ASegmentStartPos: Int64);
var
startPos: Int64;
segmentSize: Word;
w: Word;
begin
// If the metadata structure is part of a jpeg file (e.g.) then the start
// position of the corresponding metadata segment has been stored in
// ASegmentStartPos. In other cases ASegmentStartPos is -1.
// This means: if ASegmentStartPos is > -1 then the segment size must be
// written to the segment start position.
if (ASegmentStartPos < 0) then
exit;
// From the current stream position (at the end) and the position where
// the segment size must be written, we calculate the size of the segment
startPos := ASegmentStartPos + SizeOf(word);
segmentSize := AStream.Position - startPos;
// Move the stream to where the segment size must be written...
AStream.Position := startPos;
// ... and write the segment size.
w := BEToN(segmentSize);
AStream.WriteBuffer(w, SizeOf(w));
// Rewind stream to the end
AStream.Seek(0, soFromEnd);
end;
procedure TBasicMetadataWriter.WriteToStream(AStream: TStream;
AImgFormat: TImgFormat);
begin
Assert(AStream <> nil);
FImgFormat := AImgFormat;
end;
//==============================================================================
// TImgInfo
//==============================================================================
constructor TImgInfo.Create;
begin
FMetadataKinds := mdkAll;
FWarnings := TStringList.Create;
end;
destructor TImgInfo.Destroy;
begin
FWarnings.Free;
FExifData.Free;
FIptcData.Free;
inherited;
end;
function TImgInfo.CreateExifData(ABigEndian: Boolean = false): TExifData;
begin
FWarnings.Clear;
FExifData.Free;
FExifData := TExifData.Create(ABigEndian);
Result := FExifData;
end;
function TImgInfo.CreateIptcData: TIptcData;
begin
FWarnings.Clear;
FIptcData.Free;
FIptcData := TIptcData.Create;
Result := FIptcData;
end;
procedure TImgInfo.Error(const AMsg: String);
begin
raise EFpExif.Create(AMsg);
end;
function TImgInfo.ExtractImgFormat(AStream: TStream): TImgFormat;
var
p: Int64;
hdr: array[0..SizeOf(TTiffHeader)-1] of byte;
tiffHdr: TTiffHeader absolute hdr;
begin
p := AStream.Position;
try
AStream.Read({%H-}hdr[0], SizeOf(hdr));
// Test for jpeg signature
if (hdr[0] = $FF) and (hdr[1] = $D8) then begin
Result := ifJpeg;
exit;
end;
// Test for TIFF header
if (tiffHdr.BOM[0]='I') and (tiffHdr.BOM[1]='I') and (LEtoN(tiffHdr.Signature) = 42)
then begin
Result := ifTiff;
exit;
end;
if (tiffHdr.BOM[0]='M') and (tiffHdr.BOM[1]='M') and (BEtoN(tiffHdr.signature) = 42)
then begin
Result := ifTiff;
exit;
end;
Result := ifUnknown;
finally
AStream.Position := p;
end;
end;
function TImgInfo.GetComment: String;
begin
Result := FComment;
end;
function TImgInfo.GetWarnings: String;
begin
Result := FWarnings.Text;
FWarnings.Clear;
end;
function TImgInfo.HasComment: Boolean;
begin
Result := FComment <> '';
end;
function TImgInfo.HasExif: Boolean;
begin
Result := (FExifData <> nil) and (FExifData.TagCount > 0);
end;
function TImgInfo.HasIptc: Boolean;
begin
Result := (FIptcData <> nil) and (FIptcData.TagCount > 0);
end;
function TImgInfo.HasThumbnail: boolean;
begin
Result := (FExifData <> nil) and FExifData.HasThumbnail;
end;
function TImgInfo.HasWarnings: boolean;
begin
Result := FWarnings.Count > 0;
end;
procedure TImgInfo.LoadFromFile(const AFileName: String);
var
stream: TStream;
begin
if not FileExists(AFileName) then
Error(Format(rsFileNotFoundError, [AFileName]));
FWarnings.Clear;
StoreFileInfo(AFileName);
stream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
try
LoadFromStream(stream);
finally
stream.Free;
end;
end;
procedure TImgInfo.LoadFromStream(AStream: TStream);
begin
FWarnings.Clear;
FImgFormat := ExtractImgFormat(AStream);
if FImgFormat = ifUnknown then
Error(rsUnknownImageFormat);
case FImgFormat of
ifJpeg:
ReadJpeg(AStream);
ifTiff:
ReadTiff(AStream);
else
Error('TImgInfo.LoadFromStream: ' + rsImageFormatNotSupported);
end;
end;
{ Reads the image data from AInputstream and replaces the meta data segments
by those of TImgInfo }
procedure TImgInfo.MergeToJpegStream(AInputStream, AOutputStream: TStream);
type
TSegmentHeader = packed record
Key: byte;
Marker: byte;
Size: Word;
end;
var
header: TSegmentHeader;
n, count: Int64;
savedPos: Int64;
begin
// Write the header segment and all metadata segments stored in TImgInfo
// to the beginning of the stream
AOutputStream.Position := 0;
WriteJpeg(AOutputStream);
// Now write copy all other segments.
AInputStream.Position := 0;
while AInputStream.Position < AInputStream.Size do begin
savedPos := AInputStream.Position; // just for debugging
n := AInputStream.Read(header{%H-}, SizeOf(header));
if n <> Sizeof(header) then
Error(rsIncompleteJpegSegmentHeader);
if header.Key <> $FF then
Error(rsJpegSegmentMarkerExpected);
header.Size := BEToN(header.Size);
// Save stream position before segment size value.
savedPos := AInputStream.Position - 2;
case header.Marker of
M_SOI:
header.Size := 0;
M_JFIF, M_EXIF, M_IPTC, M_COM: // these segments were already written by WriteJpeg
;
M_SOS:
begin
// this is the last segment before compressed data which don't have a marker
// --> just copy the rest of the file
count := AInputStream.Size - savedPos;
AInputStream.Position := savedPos;
AOutputStream.WriteBuffer(header, 2);
n := AOutputStream.CopyFrom(AInputStream, count);
if n <> count then
Error(rsJpegCompressedDataWriting);
break;
end;
else
AInputStream.Position := AInputStream.Position - 4; // go back to where the segment begins
n := AOutputStream.CopyFrom(AInputStream, Int64(header.Size) + 2);
if n <> Int64(header.Size) + 2 then
Error(rsJpegReadWriteErrorInSegment);
end;
AInputStream.Position := savedPos + header.Size;
end;
end;
procedure TImgInfo.ReadJpeg(AStream: TStream);
var
marker: Byte;
size: Word;
streamsize: Int64;
p: Int64;
buf: TBytes;
reader: TBasicMetadataReader;
bigEndian: Boolean;
begin
p := AStream.Position;
streamsize := AStream.Size;
if not ((ReadByte(AStream) = $FF) and (ReadByte(AStream) = M_SOI)) then
exit;
while p < streamsize do begin
repeat
marker := ReadByte(AStream);
until marker <> $FF;
size := BEtoN(ReadWord(AStream)) - 2;
p := AStream.Position;
case marker of
M_EXIF:
if (mdkEXIF in FMetadataKinds) then begin
reader := TExifReader.Create(self);
try
if not TExifReader(reader).ReadExifHeader(AStream) then
exit;
if not TExifReader(reader).ReadTiffHeader(AStream, bigEndian) then
exit;
FExifData := CreateExifData(bigEndian);
try
reader.ReadFromStream(AStream, ifJpeg);
except
FreeAndNil(FExifData);
raise;
end;
finally
reader.Free;
end;
end;
M_IPTC:
if (mdkIPTC in FMetadataKinds) then begin
reader := TIptcReader.Create(self);
try
FIptcData := CreateIptcData;
try
reader.ReadFromStream(AStream, ifJpeg);
except
FreeAndNil(FIptcData);
raise;
end;
except
reader.Free;
end;
end;
M_COM:
if (mdkComment in FMetadataKinds) and (size > 0) then
begin
// JFIF comment is encoded as UTF8 according to
// http://mail.kde.org/pipermail/digikam-devel/2006-May/005000.html
{$IFDEF FPC}
SetLength(FComment, size);
AStream.Read(FComment[1], size);
{$ELSE}
SetLength(sa, size);
AStream.Read(sa[1], size);
{$IFDEF UNITCODE}
FComment := UTF8Decode(sa);
{$ELSE}
FComment := Utf8ToAnsi(sa);
{$ENDIF}
{$ENDIF}
end;
M_JFIF:
begin
SetLength(FHeaderSegment, size);
AStream.Read(FHeaderSegment[0], size);
with PJpegJFIFSegment(@FHeaderSegment[0])^ do begin
if not (
(Identifier[0]='J') and (Identifier[1]='F') and
(Identifier[2]='I') and (Identifier[3]='F') and
(Identifier[4]=#0) )
then
exit;
if (JFIFVersion[0] <> 1) then
exit;
end;
end;
M_SOF0:
begin
SetLength(buf, size);
AStream.Read(buf[0], size);
with PJpegSOF0Segment(@buf[0])^ do begin
FImgHeight := BEtoN(ImageHeight);
FImgWidth := BEtoN(ImageWidth);
end;
SetLength(buf, 0);
end;
M_EOI, M_SOS:
break;
end;
AStream.Position := p + size;
end;
end;
procedure TImgInfo.ReadTiff(AStream: TStream);
var
reader: TExifReader;
bigEndian: Boolean;
begin
reader := TExifReader.Create(self);
try
if not TExifReader(reader).ReadTiffHeader(AStream, bigEndian) then
exit;
FExifData := CreateExifData(bigEndian);
try
reader.ReadFromStream(AStream, ifTiff);
except
FreeAndNil(FExifData);
raise;
end;
finally
reader.Free;
end;
end;
procedure TImgInfo.SaveToFile(const AFileName: String; AImgFile: String = '');
var
ms: TMemoryStream;
srcStream: TFileStream;
begin
if (AImgFile = '') then
AImgFile := FFileName;
if AImgFile = '' then
Error(rsImageDataFileNotSpecified);
if not FileExists(AImgFile) then
Error(Format(rsImageDataFileNotExisting, [AImgFile]));
FWarnings.Clear;
ms := TMemoryStream.Create;
try
srcstream := TFileStream.Create(AImgFile, fmOpenRead + fmShareDenyNone);
try
if FImgFormat = ifUnknown then begin
FimgFormat := ExtractImgFormat(srcstream);
if FImgFormat = ifUnknown then
Error(rsCannotSaveToUnknownFileFormat);
end;
case FImgFormat of
ifJpeg: MergeToJpegStream(srcstream, ms);
ifTiff: Error(Format(rsWritingNotImplemented, ['TIFF']));
else Error(rsImageFormatNotSupported);
end;
finally
// Destroy the srcStream before saving the memorystream to file to prevent
// an error if AImgFile = AFileName
srcStream.Free;
end;
ms.SaveToFile(AFileName)
finally
ms.Free;
end;
end;
procedure TImgInfo.SetComment(const AValue: String);
begin
FComment := AValue;
end;
procedure TImgInfo.StoreFileInfo(const AFileName: String);
var
rec: TSearchRec;
res: word;
begin
res := FindFirst(AFilename, faAnyFile, rec);
if res = 0 then
begin
FFilename := AFilename;
FFileDate := FileDateToDateTime(rec.Time);
FFileSize := rec.Size;
end;
FindClose(rec);
end;
{ Writes all metadata-related segments to a stream. Note image data must be
written separately. }
procedure TImgInfo.WriteJpeg(AStream: TStream);
const
SOI_MARKER: array[0..1] of byte = ($FF, $D8);
COM_MARKER: array[0..1] of byte = ($FF, $FE);
JFIF_MARKER: array[0..1] of byte = ($FF, $E0);
JFIF: ansistring = 'JFIF'#0;
var
jfifSegment: TJpegJFIFSegment;
writer: TBasicMetadataWriter;
begin
// Write Start-of-image segment (SOI)
AStream.WriteBuffer(SOI_MARKER, SizeOf(SOI_MARKER));
// No Exif --> write an APP0 segment
if not HasExif or not (mdkExif in FMetadataKinds) then begin
if Length(FHeaderSegment) = 0 then begin
Move(JFIF[1], {%H-}JFIFSegment.Identifier[0], Length(JFIF));
JFIFSegment.JFIFVersion[0] := 1;
JFIFSegment.JFIFVersion[1] := 2;
JFIFSegment.DensityUnit := 1; // inch
JFIFSegment.XDensity := NtoBE(72); // 72 ppi
JFIFSegment.YDensity := NtoBE(72);
JFIFSegment.ThumbnailWidth := 0; // no thumbnail in APP0 segment
JFIFSegment.ThumbnailHeight := 0;
AStream.WriteBuffer(JFIF_MARKER, SizeOf(JFIF_MARKER));
WriteWord(AStream, NtoBE(Word(SizeOf(JFIFSegment) + 2)));
AStream.WriteBuffer(JFIFSegment, SizeOf(JFIFSegment));
end else
begin
AStream.WriteBuffer(JFIF_MARKER, SizeOf(JFIF_MARKER));
WriteWord(AStream, NtoBE(Word(Length(FHeaderSegment) + 2)));
AStream.WriteBuffer(FHeaderSegment[0], Length(FHeaderSegment));
end;
end else
begin
// Exif --> Write APP1 segment
writer := TExifWriter.Create(Self);
try
TExifWriter(writer).BigEndian:= FExifData.BigEndian;
writer.WriteToStream(AStream, ifJpeg);
finally
writer.Free;
end;
end;
// Write IPTCSegment (APP13)
if (mdkIPTC in FMetadataKinds) and HasIPTC then begin
writer := TIptcWriter.Create(Self);
try
TIptcWriter(writer).WriteToStream(AStream, ifJpeg);
finally
writer.Free;
end;
end;
// Write comment segment
if (mdkComment in FMetadataKinds) and HasComment then begin
// JFIF Comment is encoded as utf8
// according to http://mail.kde.org/pipermail/digikam-devel/2006-May/005000.html
AStream.WriteBuffer(COM_MARKER, SizeOf(COM_MARKER));
{$IFDEF FPC}
WriteWord(AStream, NtoBE(Word(Length(FComment) + 2)));
AStream.WriteBuffer(FComment[1], Length(FComment));
{$ELSE}
{$IFDEF UNICODE}
sa := UTF8Encode(FComment);
{$ELSE}
sa := AnsiToUTF8(FComment);
{$ENDIF}
WriteWord(AStream, NtoBE(Word(Length(sa) + 2)));
AStream.WriteBuffer(sa[1], Length(sa));
{$ENDIF}
end;
end;
end.

View File

@ -0,0 +1,660 @@
unit fpeStrConsts;
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
interface
uses
Classes, SysUtils;
resourcestring
// *** Error messages ***
rsCannotSaveToUnknownFileFormat = 'The metadata structure cannot be saved because '+
'the file format of the receiving file is not known or not supported.';
rsFileNotFoundError = 'File "%s" not found.';
rsImageDataFileNotExisting = 'File "%s" providing the image data does not exist.';
rsImageDataFileNotSpecified = 'The metadata structure is not linked to an image. '+
'Specify the name of the file providing the image data.';
rsImageFormatNotSupported = 'Image format not supported.';
rsImageResourceNameTooLong = 'Image resource name "%s" too long.';
rsIncompleteJpegSegmentHeader = 'Defective JPEG structure: Incomplete segment header';
rsIncorrectFileStructure = 'Incorrect file structure';
rsIncorrectTagType = 'Incorrect tag type %d: Index=%d, TagID=$%.04x, File:"%s"';
rsIptcDataExpected = 'IPTC data expected, but not found.';
rsIptcExtendedDataSizeNotSupported = 'Data size %d not supported for an IPTC extended dataset.';
rsJpegCompressedDataWriting = 'Writing error of compressed data.';
rsJpegSegmentMarkerExpected = 'Defective JPEG structure: Segment marker ($FF) expected.';
rsJpegReadWriteErrorInSegment = 'Read/write error in segment $FF%.2x';
rsMoreThumbnailTagsThanExpected = 'More thumbnail tags than expected.';
rsNoValidIptcFile = 'No valid IPTC file';
rsNoValidIptcSignature = 'No valid IPTC signature';
rsRangeCheckError = 'Range check error.';
rsReadIncompleteIFDRecord = 'Read incomplete IFD record at stream position %d.';
rsTagTypeNotSupported = 'Tag "%s" has an unsupported type.';
rsUnknownImageFormat = 'Unknown image format.';
rsWritingNotImplemented = 'Writing of %s files not yet implemented.';
// general lookup values
rsAutoManual = '0:Auto,1:Manual';
rsEconomyNormalFine = '0:Economy,1:Normal,2:Fine';
rsEconomyNormalFine1 = '1:Economy,2:Normal,3:Fine';
rsLowNormalHigh = '0:Low,1:Normal,2:High';
rsNormalLowHigh = '0:Normal,1:Low,2:High';
rsNormalSoftHard = '0:Normal,1:Soft,2:Hard';
rsNoYes = '0:No,1:Yes';
rsOffOn = '0:Off,1:On';
rsSingleContinuous = '0:Single,1:Continuous';
// *** EXIF tags ***
rsAcceleration = 'Acceleration';
// rsActionAdvised = 'Action advised';
rsAperturevalue = 'Aperture value';
rsArtist = 'Artist';
rsBitsPerSample = 'Bits per sample';
rsBrightnessValue = 'Brightness value';
// rsByLine = 'By-line';
// rsByLineTitle = 'By-line title';
rsCameraElevationAngle = 'Camera elevation angle';
// rsCategory = 'Category';
rsCellHeight = 'Cell height';
rsCellWidth = 'Cell width';
rsCFAPattern = 'CFA pattern';
// rsCity = 'City';
// rsCodedCharacterSet = 'Coded character set';
rsColorSpace = 'Color space';
rsColorSpaceLkup = '0:sBW,1:sRGB,2:Adobe RGB,65533:Wide Gamut RGB,65534:ICC Profile,65535:Uncalibrated';
rsComponentsConfig = 'Components configuration';
rsCompressedBitsPerPixel = 'Compressed bits per pixel';
rsCompression = 'Compression';
rsCompressionLkup = '1:Uncompressed,2:CCITT 1D,3:T4/Group 3 Fax,'+
'4:T6/Group 4 Fax,5:LZW,6:JPEG (old-style),7:JPEG,8:Adobe Deflate,'+
'9:JBIG B&W,10:JBIG Color,99:JPEG,262:Kodak 262,32766:Next,'+
'32767:Sony ARW Compressed,32769:Packed RAW,32770:Samsung SRW Compressed,'+
'32771:CCIRLEW,32772:Samsung SRW Compressed 2,32773:PackBits,'+
'32809:Thunderscan,32867:Kodak KDC Compressed,32895:IT8CTPAD,'+
'32896:IT8LW,32897:IT8MP,32898:IT8BL,32908:PixarFilm,32909:PixarLog,'+
'32946:Deflate,32947:DCS,34661:JBIG,34676:SGILog,34677:SGILog24,'+
'34712:JPEG 2000,34713:Nikon NEF Compressed,34715:JBIG2 TIFF FX,'+
'34718:Microsoft Document Imaging (MDI) Binary Level Codec,'+
'34719:Microsoft Document Imaging (MDI) Progressive Transform Codec,'+
'34720:Microsoft Document Imaging (MDI) Vector,34892:Lossy JPEG,'+
'65000:Kodak DCR Compressed,65535:Pentax PEF Compressed';
// rsContact = 'Contact';
// rsContentLocCode = 'Content location code';
// rsContentLocName = 'Content location name';
rsContrast = 'Contrast';
rsCopyright = 'Copyright';
rsCustomRendered = 'Custom rendered';
rsCustomRenderedLkup = '0:Normal,1:Custom';
// rsDateCreated = 'Date created';
rsDateTime = 'Date/time';
rsDateTimeOriginal = 'Date/time original';
rsDateTimeDigitized = 'Date/time digitized';
rsDeviceSettingDescription = 'Device setting description';
rsDigitalZoom = 'Digital zoom';
rsDigitalZoomRatio = 'Digital zoom ratio';
rsDigitizeDate = 'Digital creation date';
rsDigitizeTime = 'Digital creation time';
rsDocumentName = 'Document name';
// rsEditorialUpdate = 'Editorial update';
// rsEditStatus = 'Edit status';
rsExifImageHeight = 'EXIF image height';
rsExifImageWidth = 'EXIF image width';
rsExifOffset = 'EXIF offset';
rsExifVersion = 'EXIF version';
// rsExpireDate = 'Expiration date';
// rsExpireTime = 'Expiration time';
rsExposureBiasValue = 'Exposure bias value';
rsExposureIndex = 'Exposure index';
rsExposureMode = 'Exposure mode';
rsExposureModeLkup = '0:Auto,1:Manual,2:Auto bracket';
rsExposureProgram = 'Exposure program';
rsExposureProgramLkup = '0:Not defined,1:Manual,2:Program AE,3:Aperture-priority AE,'+
'4:Shutter speed priority AE,5:Creative (slow speed),6:Action (high speed),'+
'7:Portrait,8:Landscape;9:Bulb';
rsExposureTime = 'Exposure time';
rsExtensibleMetadataPlatform = 'Extensible metadata platform';
rsFileSource = 'File source';
rsFileSourceLkup = '0:Unknown,1:Film scanner,2:Reflection print scanner,3:Digital camera';
rsFillOrder = 'Fill order';
rsFillOrderLkup = '1:Normal,2:Reversed';
// rsFixtureID = 'Fixture ID';
rsFlash = 'Flash';
rsFlashEnergy = 'Flash energy';
rsFlashLkup = '0:No flash,1:Fired,5:Fired; return not detected,'+
'7:Fired; return detected,8:On; did not fire,9:On; fired,'+
'13:On; return not detected,15:On; return detected,16:Off; did not fire,'+
'20:Off; did not fire, return not detected,24:Auto; did not fire,'+
'25:Auto; fired;29:Auto; fired; return not detected,31:Auto; fired; return detected,'+
'32:No flash function,48:Off, no flash function,65:Fired; red-eye reduction,'+
'69:Fired; red-eye reduction; return not detected,'+
'71:Fired; red-eye reduction; return detected,73:On; red-eye reduction,'+
'77:On; red-eye reduction, return not detected,'+
'79:On, red-eye reduction, return detected,80:Off; red-eye reduction,'+
'88:Auto; did not fire; red-eye reduction,89:Auto; fired; red-eye reduction,'+
'93:Auto; fired; red-eye reduction; return not detected,'+
'95:Auto; fired; red-eye reduction, return detected';
rsFlashPixVersion = 'FlashPix version';
rsFNumber = 'F number';
rsFocalLength = 'Focal length';
rsFocalLengthIn35mm = 'Focal length in 35 mm film';
rsFocalPlaneResUnit = 'Focal plane resolution unit';
rsFocalPlaneResUnitLkup = '1:None,2:inches,3:cm,4:mm,5:um';
rsFocalPlaneXRes = 'Focal plane x resolution';
rsFocalPlaneYRes = 'Focal plane y resolution';
rsGainControl = 'Gain control';
rsGainControlLkup = '0:None,1:Low gain up,2:High gain up,3:Low gain down,4:High gain down';
rsGamma = 'Gamma';
rsGPSAltitude = 'GPS altitude';
rsGPSAltitudeRef = 'GPS altitude reference';
rsGPSAltitudeRefLkup = '0: Above sea level,1:Below sea level';
rsGPSAreaInformation = 'Area information';
rsGPSDateDifferential = 'GPS date differential';
rsGPSDateDifferentialLkup = '0:No correction,1:Differential corrected';
rsGPSDateStamp = 'GPS date stamp';
rsGPSDestBearing = 'GPS destination bearing';
rsGPSDestBearingRef = 'GPS destination bearing reference';
rsGPSDestDistance = 'GPS destination distance';
rsGPSDestDistanceRef = 'GPS destination distance reference';
rsGPSDestLatitude = 'GPS destination latitude';
rsGPSDestLatitudeRef = 'GPS destination latitude reference';
rsGPSDestLongitude = 'GPS destination longitude';
rsGPSDestLongitudeRef = 'GPS destination longitude reference';
rsGPSDistanceRefLkup = 'K:Kilometers,M:Miles,N:Nautical miles';
rsGPSDOP = 'GPS DOP';
rsGPSHPositioningError = 'GPS H positioning error';
rsGPSImageDirection = 'GPS image direction';
rsGPSImageDirectionRef = 'GPS image direction reference';
rsGPSInfo = 'GPS info';
rsGPSLatitude = 'GPS latitude';
rsGPSLatitudeRef = 'GPS latitude reference';
rsGPSLatitudeRefLkup = 'N:North,S:South';
rsGPSLongitude = 'GPS longitude';
rsGPSLongitudeRef = 'GPS longitude reference';
rsGPSLongitudeRefLkup = 'E:East,W:West';
rsGPSMapDatum = 'GPS map datum';
rsGPSMeasureMode = 'GPS measurement mode';
rsGPSMeasureModeLkup = '2:2-Dimensional Measurement,3:3-Dimensional Measurement';
rsGPSProcessingMode = 'GPS processing mode';
rsGPSSatellites = 'GPS satellites';
rsGPSSpeed = 'GPS speed';
rsGPSSpeedRef = 'GPS speed reference';
rsGPSSpeedRefLkup = 'K:km/h,M:mph,N:knots';
rsGPSStatus = 'GPS status';
rsGPSTimeStamp = 'GPS time stamp';
rsGPSTrack = 'GPS track';
rsGPSTrackRef = 'GPS track reference';
rsGPSTrackRefLkup = 'M:Magnetic north,T:True north';
rsGPSVersionID = 'GPS version ID';
rsHalftoneHints = 'Half-tone hints';
rsHostComputer = 'Host computer';
rsHumidity = 'Humidity';
// rsImageCaption = 'Image caption';
// rsImageCaptionWriter = 'Image caption writer';
// rsImageCredit = 'Image credit';
rsImageDescr = 'Image description';
// rsImageHeadline = 'Image headline';
rsImageHeight = 'Image height';
rsImageHistory = 'Image history';
rsImageNumber = 'Image number';
// rsImageType = 'Image type';
rsImageUniqueID = 'Unique image ID';
rsImageWidth = 'Image width';
rsInkSet = 'Ink set';
rsInkSetLkup = '1:CMYK,2:Not CMYK';
rsInteropIndex = 'Interoperabiliy index';
rsInteropOffset = 'Interoperability offset';
rsInteropVersion = 'Interoperability version';
rsIPTCNAA = 'IPTC/NAA';
rsISOSpeed = 'ISO speed';
rsISOSpeedLatitudeYYY = 'ISO latitude yyy';
rsISOSpeedLatitudeZZZ = 'ISO speed latitude zzz';
rsISO = 'ISO';
rsLensInfo = 'Lens info';
rsLensMake = 'Lens make';
rsLensModel = 'Lens model';
rsLensSerialNumber = 'Lens serial number';
rsLightSource = 'Light source';
rsLightSourceLkup = '0:Unknown,1:Daylight,2:Fluorescent,3:Tungsten (incandescent),'+
'4:Flash,9:Fine weather,10:Cloudy,11:Shade,12:Daylight fluorescent,'+
'13:Day white fluorescent,14:Cool white fluorescent,15:White fluorescent,'+
'16:Warm white fluorescent,17:Standard light A, 18:Standard light B,'+
'19:Standard light C,20:D55,21:D65,22:D74,23:D50,24:ISO Studio tungsten,'+
'255:Other';
rsMacro = 'Macro';
rsMake = 'Make';
rsMakerNote = 'Maker note';
rsMaxApertureValue = 'Max aperture value';
rsMaxSampleValue = 'Max sample value';
rsMeteringMode = 'Metering mode';
rsMeteringModeLkup = '0:Unknown,1:Average,2:Center-weighted average,'+
'3:Spot,4:Multi-spot,5:Multi-segment,6:Partial,255:Other';
rsMinSampleValue = 'Min sample value';
rsModel = 'Model';
rsOffsetTime = 'Time zone for date/time';
rsOffsetTimeOriginal = 'Time zone for date/time original';
rsOffsetTimeDigitized = 'Time zone for date/time digitized';
rsOrientation = 'Orientation';
rsOrientationLkup = '1:Horizontal (normal),2:Mirror horizontal,3:Rotate 180,'+
'4:Mirror vertical,5:Mirror horizontal and rotate 270 CW,6:Rotate 90 CW,'+
'7:Mirror horizontal and rotate 90 CW,8:Rotate 270 CW';
rsOwnerName = 'Owner name';
rsPageName = 'Page name';
rsPageNumber = 'Page number';
rsPhotometricInt = 'Photometric interpretation';
rsPhotometricIntLkup = '0:White is zero,1:Black is zero,2:RGB,3:RGB palette,'+
'4:Transparency mask,5:CMYK,6:YCbCr,8:CIELab,9:ICCLab,10:ITULab,'+
'32803:Color filter array,32844:Pixar LogL,32845:Pixar LogLuv,34892:Linear Raw';
rsPlanarConfiguration = 'Planar configuration';
rsPlanarConfigurationLkup = '1:Chunky,2:Planar';
rsPredictor = 'Predictor';
rsPredictorLkup = '1:None,2:Horizontal differencing';
rsPressure = 'Pressure';
rsPrimaryChromaticities = 'Primary chromaticities';
rsQuality = 'Quality';
rsRecExpIndex = 'Recommended exposure index';
rsRefBlackWhite = 'Reference black & white';
rsRelatedImageFileFormat = 'Related image file format';
rsRelatedImageHeight = 'Related image height';
rsRelatedImageWidth = 'Related image width';
rsRelatedSoundFile = 'Related sound file';
rsResolutionUnit = 'Resolution unit';
rsResolutionUnitLkup = '1:None,2:inches,3:cm';
rsRowsPerStrip = 'Rows per strip';
rsSamplesPerPixel = 'Samples per pixel';
rsSaturation = 'Saturation';
rsSceneCaptureType = 'Scene capture type';
rsSceneCaptureTypeLkup = '0:Standard,1:Landscape,2:Portrait,3:Night';
rsSceneType = 'Scene type';
rsSceneTypeLkup = '0:Unknown,1:Directly photographed';
rsSecurityClassification = 'Security classification';
rsSelfTimerMode = 'Self-timer mode';
rsSEMInfo = 'SEM info';
rsSensingMethod = 'Sensing method';
rsSensingMethodLkup = '1:Not defined,2:One-chip color area,3:Two-chip color area,'+
'4:Three-chip color area,5:Color sequential area,7:Trilinear,8:Color sequential linear';
rsSensitivityType = 'Sensitivity type';
rsSensitivityTypeLkup = '0:Unknown,1:Standard Output Sensitivity'+
'2:Recommended exposure index,3:ISO speed,'+
'4:Standard output sensitivity and recommended exposure index,'+
'5:Standard output sensitivity and ISO Speed,6:Recommended exposure index and ISO speed,'+
'7:Standard output sensitivity, recommended exposure index and ISO speed';
rsSerialNumber = 'Serial number';
rsSharpness = 'Sharpness';
rsShutterSpeedValue = 'Shutter speed value';
rsSoftware = 'Software';
rsSpatialFrequResponse = 'Spatial frequency response';
rsSpectralSensitivity = 'Spectral sensitivity';
rsStdOutputSens = 'Standard output sensitivity';
rsStripByteCounts = 'Strip byte counts';
rsStripOffsets = 'Strip offsets';
rsSubfileTypeLkup =
'0:Full-resolution image,'+
'1:Reduced-resolution image,'+
'2:Single page of multi-page image,'+
'3:Single page of multi-page reduced-resolution image,'+
'4:Transparency mask,'+
'5:Transparency mask of reduced-resolution image,'+
'6:Transparency mask of multi-page image,'+
'7:Transparency mask of reduced-resolution multi-page image';
rsSubjectArea = 'Subject area';
rsSubjectDistance = 'Subject distance';
rsSubjectDistanceRange = 'Subject distance range';
rsSubjectDistanceRangeLkup = '0:Unknown,1:Macro,2:Close,3:Distant';
rsSubjectLocation = 'Subject location';
rsSubSecTime = 'Fractional seconds of date/time';
rsSubSecTimeOriginal = 'Fractional seconds of date/time original';
rsSubSecTimeDigitized = 'Fractional seconds of date/time digitized';
rsTargetPrinter = 'Target printer';
rsTemperature = 'Temperature';
rsThresholding = 'Thresholding';
rsThresholdingLkup = '1:No dithering or halftoning,2:Ordered dither or halftone,'+
'3:Randomized dither';
rsThumbnailHeight = 'Thumbnail height';
rsThumbnailOffset = 'Thumbnail offset';
rsThumbnailSize = 'Thumbnail size';
rsThumbnailWidth = 'Thumbnail width';
rsTileLength = 'Tile length';
rsTileWidth = 'Tile width';
rsTimeZoneOffset = 'Time zone offset';
rsTransferFunction = 'Transfer function';
rsTransmissionRef = 'Original transmission reference';
rsUserComment = 'User comment';
rsWhiteBalance = 'White balance';
rsWaterDepth = 'Water depth';
rsWhitePoint = 'White point';
rsXPosition = 'X position';
rsXResolution = 'X resolution';
rsYCbCrCoefficients = 'YCbCr coefficients';
rsYCbCrPositioning = 'YCbCr positioning';
rsYCbCrPosLkup = '1:Centered,2:Co-sited';
rsYCbCrSubsampling = 'YCbCr subsampling';
rsYPosition = 'Y position';
rsYResolution = 'Y resolution';
// *** MakerNote ***
// Canon
rsCanonAELkup = '0:Normal AE,1:Exposure compensation,2:AE lock,'+
'3:AE lock + Exposure compensation,4:No AE';
{
rsCanonAFLkup = '12288:None (MF),12289:Auto-selected,12290:Right,12291:Center,'+
'12292:Left';
}
rsCanonAFLkup = '$2005:Manual AF point selection,$3000:None (MF),' +
'$3001:Auto AF point selection,$3002:Right,$3003:Center,$3004:Left,' +
'$4001:Auto AF point selection,$4006:Face Detect';
rsCanonAutoRotLkup = '0:None,1:Rotate 90 CW,2:Rotate 180,3:Rotate 270 CW';
rsCanonBiasLkup = '65472:-2 EV,65484:-1.67 EV,65488:-1.50 EV,65492:-1.33 EV,'+
'65504:-1 EV,65516:-0.67 EV,65520:-0.50 EV,65524:-0.33 EV,0:0 EV,'+
'12:0.33 EV,16:0.50 EV,20:0.67 EV,32:1 EV,44:1.33 EV,48:1.50 EV,'+
'52:1.67 EV,64:2 EV';
rsCanonCamTypeLkup = '248:EOS High-end,250:Compact,252:EOS Mid-range,255:DV Camera';
rsCanonEasyLkup = '0:Full Auto,1:Manual,2:Landscape,3:Fast Shutter,4:Slow Shutter,'+
'5:Night,6:Gray scale,7:Sepia,8:Portrait,9:Sports,10:Macro,11:Black & White,'+
'12:Pan Focus,13:Vivid,14:Neutral,15:Flash off,16:Long shutter,'+
'17:Super macro,18:Foliage,19:Indoor,20:Fireworks,21:Beach,22:Underwater,'+
'23:Snow,24:Kids & Pets,25:Night snapshot,26:Digital macro,27:My colors,'+
'28:Movie snap,29:Super macro 2,30:Color accent,31:Color swap,32:Aquarium,'+
'33:ISO3200,34:ISO6400,35:Creative light effect,36:Easy,37:Quick shot,'+
'38:Creative auto,39:Zoom blur,40:Low light,41:Nostalgic,42:Super vivid,'+
'43:Poster effect,44:Face self-timer,45:Smile,46:Wink self-timer,'+
'47:Fisheye effect,48:Miniature effect,49:High-speed burst,'+
'50:Best image selection,51:High dynamic range,52:Handheld night scene,'+
'53:Movie digest,54:Live view control,55:Discreet,56:Blur reduction,'+
'57:Monochrome,58:Toy camera effect,59:Scene intelligent auto,'+
'60:High-speed burst HQ,61:Smooth skin,62:Soft focus,257:Spotlight,'+
'258:Night 2,259:Night+,260:Super night,261:Sunset,263:Night scene,'+
'264:Surface,265:Low light 2';
rsCanonExposeLkup = '0:Easy shooting,1:Program AE,2:Shutter speed priority AE,'+
'3:Aperture priority AE,4:Manual,5:Depth-of-field AE,6:M-Dep,7:Bulb';
rsCanonFlashActLkup = '0:Did not fire,1:Fired';
rsCanonFlashLkup = '0:Not fired,1:Auto,2:On,3:Red-eye,4:Slow sync,'+
'5:Auto+red-eye,6:On+red eye,16:External flash';
rsCanonFocalTypeLkup = '1:Fixed,2:Zoom';
rsCanonFocTypeLkup = '0:Manual,1:Auto,3:Close-up (macro),8:Locked (pan mode)';
rsCanonFocusLkup = '0:One-Shot AF,1:AI Servo AF,2:AI Focus AF,3:Manual focus,'+
'4:Single,5:Continuous,6:Manual focus,16:Pan focus,256:AF+MF,'+
'512:Movie snap focus,519:Movie servo AF';
rsCanonGenLkup = '65535:Low,0:Normal,1:High';
rsCanonImgStabLkup = '0:Off,1:On,2:Shoot only,3:Panning,4:Dynamic,256:Off,'+
'257:On,258:Shoot only,259:Panning,260:Dynamic';
rsCanonISOLkup = '0:Not used,15:auto,16:50,17:100,18:200,19:400';
rsCanonMacroLkup = '1:Macro,2:Normal';
rsCanonMeterLkup = '0:Default,1:Spot,2:Average,3:Evaluative,4:Partial,'+
'5:Center-weighted average';
rsCanonPanDirLkup = '0:Left to right,1:Right to left,2:Bottom to top,'+
'3:Top to bottom,4:2x2 Matrix (clockwise)';
rsCanonQualityLkup = '65535:n/a,1:Economy,2:Normal,3:Fine,4:RAW,5:Superfine,'+
'130:Normal Movie,131:Movie (2)';
rsCanonRecLkup = '1:JPEG,2:CRW+THM,3:AVI+THM,4:TIF,5:TIF+JPEG,6:CR2,'+
'7:CR2+JPEG,9:MOV,10:MP4';
rsCanonSizeLkup = '65535:n/a,0:Large,1:Medium,2:Small,4:5 MPixel,5:2 MPixel,'+
'6:1.5 MPixel,8:Postcard,9:Widescreen,10:Medium widescreen,14:Small 1,'+
'15:Small 2,16:Small 3,128:640x480 movie,129:Medium movie,130:Small movie,'+
'137:128x720 movie,142:1920x1080 movie';
rsCanonSloShuttLkup = '65535:n/a,0:Off,1:Night scene,2:On,3:None';
rsCanonWhiteBalLkup = '0:Auto,1:Daylight,2:Cloudy,3:Tungsten,4:Flourescent,'+
'5:Flash,6:Custom,7:Black & white,8:Shade,9:Manual temperature (Kelvin),'+
'14:Daylight fluorescent,17:Under water';
rsCanonZoomLkup = '0:None,1:2x,2:4x,3:Other';
// Casio
rsCasioAFMode2Lkup = '0:Off,1:Spot,2:Multi,3:Face detection,4:Tracking,5:Intelligent';
rsCasioArtMode2Lkup = '0:Normal,8:Silent movie,39:HDR,45:Premium auto,' +
'47:Painting,49:Crayon drawing,51:Panorama,52:Art HDR,62:High Speed night shot,'+
'64:Monochrome,67:Toy camera,68:Pop art,69:Light tone';
rsCasioAutoIso2Lkup = '1:On,2:Off,7:On (high sensitivity),8:On (anti-shake),'+
'10:High Speed';
rsCasioCCDSensitivityLkup = '64:Normal,125:+1.0,250:+2.0,244:+3.0,80:Normal,'+
'100:High';
rsCasioColorFilter2Lkup = '0:Off,1:Blue,3:Green,4:Yellow,5:Red,6:Purple,7:Pink';
rsCasioColorMode2Lkup = '0:Off,2:Black & White,3:Sepia';
rsCasioDigitalZoomLkup = '$10000:Off,$10001:2x Digital zoom,'+
'$20000:2x digital zoom,$40000:4x digital zoom';
rsCasioDriveMode2Lkup = '0:Single shot,1:Continuous shooting,'+
'2:Continuous (2 fps),3:Continuous (3 fps),4:Continuous (4 fps),'+
'5:Continuous (5 fps),6:Continuous (6 fps),7:Continuous (7 fps),'+
'10:Continuous (10 fps),12:Continuous (12 fps),15:Continuous (15 fps),'+
'20:Continuous (20 fps),30:Continuous (30 fps),40:Continuous (40 fps),'+
'60:Continuous (60 fps),240:Auto-N';
rsCasioEnhancement2Lkup = '0:Off,1:Scenery,3:Green,5:Underwater,9:Flesh tones';
rsCasioFlashIntensityLkup = '11:Weak,13:Normal,15:Strong';
rsCasioFlashModeLkup = '1:Auto,2:On,3:Off,4:Red-eye reduction';
rsCasioFocusingModeLkup = '2:Macro,3:Auto focus,4:Manual focus,5:Infinity';
rsCasioFocusMode2Lkup = '0:Normal,1:Macro';
rsCasioFocusMode22Lkup = '0:Manual,1:Focus lock,2:Macro,3:Single-area auto focus,'+
'5:Infinity,6:Multi-area auto focus,8:Super macro';
rsCasioImageSize2Lkup = '0:640 x 480,4:1600 x 1200,5:2048 x 1536,'+
'20:2288 x 1712,21:2592 x 1944,22:2304 x 1728,36:3008 x 2008';
rsCasioImageStabilization2Lkup = '0:Off,1:On,2:Best shot,3:Movie anti-shake';
rsCasioISOSpeed2Lkup = '3 = 50,4:64,6:100,9:200';
rsCasioLightingMode2Lkup = '0:Off,1:High dynamic range,5:Shadow enhance low,'+
'6:Shadow enhance high';
rsCasioPortraitRefiner2Lkup = '0:Off,1:+1,2:+2';
rsCasioRecordingModeLkup = '1:Single shutter,2:Panorama,3:Night scene,'+
'4:Portrait,5:Landscape';
rsCasioRecordMode2Lkup = '2:Program AE,3:Shutter priority,4:Aperture priority,'+
'5:Manual,6:Best shot,17:Movie,19:Movie (19),20:YouTube Movie';
rsCasioReleaseMode2Lkup = '1:Normal,3:AE Bracketing,11:WB Bracketing,'+
'13 = Contrast Bracketing,19:High Speed Burst';
rsCasioSharpness2Lkup = '0:Soft,1:Normal,2:Hard';
rsCasioSpecialEffectSetting2Lkup = '0:Off,1:Makeup,2:Mist removal,'+
'3:Vivid landscape,16:Art shot';
rsCasioVideoQuality2Lkup = '1:Standard,3:HD (720p),4:Full HD (1080p),5:Low';
rsCasioWhiteBalanceLkup = '1:Auto,2:Tungsten,3:Daylight,4:Fluorescent,'+
'5:Shade,129:Manual';
rsCasioWhiteBalance2Lkup = '0:Auto,1:Daylight,2:Shade,3:Tungsten,4:Fluorescent,5:Manual';
rsCasioWhiteBalance22Lkup = '0:Manual,1:Daylight,2:Cloudy,3:Shade,4:Flash?,'+
'6:Fluorescent,9:Tungsten?,10:Tungsten,12:Flash';
// Fuji
rsFujiSharpnessLkup = '0:-4 (softest),1:-3 (very soft),2:-2 (soft),3:0 (normal),' +
'4:+2 (hard),5:+3 (very hard),6:+4 (hardest),130:-1 (medium soft),'+
'132:+1 (medium hard),32768:Film Simulation,65535:n/a';
rsFujiWhiteBalLkup = '0:Auto,256:Daylight,512:Cloudy,768:Daylight Fluorescent,' +
'769:Day White Fluorescent,770:White Fluorescent,771:Warm White Fluorescent,'+
'772:Living Room Warm White Fluorescent,1024:Incandescent,1280:Flash,'+
'1536:Underwater,3840:Custom,3841:Custom2,3842:Custom3,3843:Custom4,'+
'3844:Custom5,4080:Kelvin';
rsFujiSaturationLkup = '0:0 (normal),128:+1 (medium high),192:+3 (very high),'+
'224:+4 (highest),256:+2 (high),384:-1 (medium low),512:Low,768:None (B&W),'+
'769:B&W Red Filter,770:B&W Yellow Filter,771:B&W Green Filter,'+
'784:B&W Sepia,1024:-2 (low),1216:-3 (very low),1248:-4 (lowest),'+
'1280:Acros,1281:Acros Red Filter,1282:Acros Yellow Filter,'+
'1283:Acros Green Filter,32768:Film Simulation';
rsFujiContrastLkup = '0:Normal,128:Medium High,256:High,384:Medium Low,'+
'512:Low,32768:Film Simulation';
rsFujiContrastLkup1 = '0:Normal,256:High,768:Low';
rsFujiNoiseReductionLkup = '64:Low,128:Normal,256:n/a';
rsFujiHighIsoNoiseReductionLkup = '0:0 (normal),256:+2 (strong),'+
'384:+1 (medium strong),448:+3 (very strong),480:+4 (strongest)'+
'512:-2 (weak),640:-1 (medium weak),704:-3 (very weak),736:-4 (weakest)';
rsFujiFlashModeLkup = '0:Auto,1:On,2:Off,3:Red-eye reduction,4:External,'+
'16:Commander,32768:Not Attached,33056:TTL,38976:Manual,39040:Multi-flash,'+
'43296:1st Curtain (front),51488:2nd Curtain (rear),59680:High Speed Sync (HSS)';
rsFujiPictureModeLkup = '0:Auto,1:Portrait,2:Landscape,3:Macro,4:Sports,'+
'5:Night Scene,6:Program AE,7:Natural Light,8:Anti-blur,9:Beach & Snow,'+
'10:Sunset,11:Museum,12:Party,13:Flower,14:Text,15:Natural Light & Flash,'+
'16:Beach,17:Snow,18:Fireworks,19:Underwater,20:Portrait with Skin Correction,'+
'22:Panorama,23:Night (tripod),24:Pro Low-light,25:Pro Focus,26:Portrait 2,'+
'27:Dog Face Detection,28:Cat Face Detection,64:Advanced Filter,'+
'256:Aperture-priority AE,512:Shutter speed priority AE,768:Manual';
rsFujiEXRModeLkup = '128:HR (High Resolution),512:SN (Signal to Noise priority),'+
'768:DR (Dynamic Range priority)';
rsFujiShadowHighlightLkup = '-64:+4 (hardest),-48:+3 (very hard),'+
'-32:+2 (hard),-16:+1 (medium hard)';
rsFujiShutterTypeLkup = '0:Mechanical,1:Electronic';
rsFujiAutoBracketingLkup = '0:Off,1:On,2:No flash & flash';
rsFujiPanoramaDirLkup = '1:Right,2:Up,3:Left,4:Down';
rsFujiAdvancedFilterLkup = '65536:Pop Color,131072:Hi Key,196608:Toy Camera,'+
'262144:Miniature, 327680:Dynamic Tone,327681:Partial Color Red,'+
'327682:Partial Color Yellow,327683:Partial Color Green,'+
'327684:Partial Color Blue,327685:Partial Color Orange,'+
'327686:Partial Color Purple,458752:Soft Focus,589824:Low Key';
rsFujiColorModeLkup = '0:Standard,16:Chrome,48:B & W';
rsFujiBlurWarningLkup = '0:None,1:Blur Warning';
rsFujiFocusWarningLkup = '0:Good,1:Out of focus';
rsFujiExposureWarningLkup = '0:Good,1:Bad exposure';
rsFujiDynamicRangeLkup = '1:Standard,3:Wide';
rsFujiSceneRecognLkup = '0:Unrecognized,256:Portrait Image,512:Landscape Image,'+
'768:Night Scene,1024:Macro';
// Minolta
rsMinoltaBracketStepLkup = '0:1/3 EV,1:2/3 EV,2:1 EV';
rsMinoltaColorModeLkup = '0:Natural color,1:Black & White,2:Vivid color,'+
'3:Solarization,4:Adobe RGB,5:Sepia,9:Natural,12:Portrait,13:Natural sRGB,'+
'14:Natural+ sRGB,15:Landscape,16:Evening,17:Night Scene,18:Night Portrait,'+
'132:Embed Adobe RGB';
rsMinoltaColorProfileLkup = '0:Not embedded,1:Embedded';
rsMinoltaDataImprintLkup = '0;None,1:YYYY/MM/DD,2:MM/DD/HH:MM,3:Text,4:Text + ID#';
rsMinoltaDECPositionLkup = '0:Exposure,1:Contrast,2:Saturation,3:Filter';
rsMinoltaDigitalZoomLkup = '0:Off,1:Electronic magnification,2:2x';
rsMinoltaDriveModeLkup = '0:Single,1:Continuous,2:Self-timer,4:Bracketing,'+
'5:Interval,6:UHS continuous,7:HS continuous';
rsMinoltaExposureModeLkup = '0:Program,1:Aperture priority,2:Shutter priority,3:Manual';
rsMinoltaFocusAreaLkup = '0:Wide Focus (normal),1:Spot Focus';
rsMinoltaFlashMeteringLkup = '0:ADI (Advanced Distance Integration),1:Pre-flash TTL,2:Manual flash control';
rsMinoltaFlashModeLkup = '0:Fill flash,1:Red-eye reduction,2:Rear flash sync,3:Wireless,4:Off?';
rsMinoltaFocusModeLkup = '0:AF,1:MF';
rsMinoltaFolderNameLkup = '0:Standard Form,1:Data Form';
rsMinoltaImageSizeLkup = '1:1600x1200,2:1280x960,3:640x480,5:2560x1920,6:2272x1704,7:2048x1536';
rsMinoltaImageSizeLkup1 = '0:Full,1:1600x1200,2:1280x960,3:640x480,6:2080x1560,7:2560x1920,8;3264x2176';
rsMinoltaImageStabLkup = '1:Off,5:On';
rsMinoltaInternalFlashLkup = '0:No,1:Fired';
rsMinoltaIntervalModeLkup = '0:Still image,1:Time-lapse movie';
rsMinoltaIsoSettingLkup = '0:100,1:200,2:400,3:800,4:Auto,5:64';
rsMinoltaMeteringModeLkup = '0:Multi-segment,1:Center-weighted average,2:Spot';
rsMinoltaModelIDLkup = '0:DiMAGE 7/X1/X21 or X31,1:DiMAGE 5,2:DiMAGE S304,'+
'3:DiMAGE S404,4:DiMAGE 7i,5:DiMAGE 7Hi,6:DiMAGE A1,7:DiMAGE A2 or S414';
rsMinoltaQualityLkup = '0:Raw,1:Super Fine,2:Fine,3:Standard,4:Economy,5:Extra fine';
rsMinoltaSceneModeLkup = '0:Standard,1:Portrait,2:Text,3:Night Scene,'+
'4:Sunset,5:Sports,6:Landscape,7:Night Portrait,8:Macro,9:Super Macro,'+
'16:Auto,17:Night View/Portrait,18:Sweep Panorama,19:Handheld Night Shot,'+
'20:Anti Motion Blur,21:Cont. Priority AE,22:Auto+,23:3D Sweep Panorama,'+
'24:Superior Auto,25:High Sensitivity,26:Fireworks,27:Food,28:Pet,33:HDR,'+
'65535:n/a';
rsMinoltaSharpnessLkup = '0:Hard,1:Normal,2:Soft';
rsMinoltaSubjectProgramLkup = '0:None,1:Portrait,2:Text,3:Night portrait,4:Sunset,5:Sports action';
rsMinoltaTeleconverterLkup = '$0:None,$4:Minolta/Sony AF 1.4x APO (D) (0x04),'+
'$5:Minolta/Sony AF 2x APO (D) (0x05),$48 = Minolta/Sony AF 2x APO (D),'+
'$50:Minolta AF 2x APO II,$60:Minolta AF 2x APO,$88:Minolta/Sony AF 1.4x APO (D),'+
'$90 = Minolta AF 1.4x APO II,$A0 = Minolta AF 1.4x APO';
rsMinoltaWhiteBalanceLkup = '$00:Auto,$01:Color Temperature/Color Filter,$10:Daylight,'+
'$20:Cloudy,$30:Shade,$40:Tungsten,$50:Flash,$60:Fluorescent,$70:Custom';
rsMinoltaWideFocusZoneLkup = '0:No zone,1:Center zone (horizontal orientation),'+
'2:Center zone (vertical orientation),3:Left zone,4:Right zone';
rsMinoltaZoneMatchingLkup = '0:ISO Setting Used,1:High Key,2:Low Key';
// Nikon
rsNikonColorModeLkup = '1:Color,2:Monochrome';
rsNikonConverterLkup = '0:Not used,1:Used';
rsNikonImgAdjLkup = '0:Normal,1:Bright+,2:Bright-,3:Contrast+,4:Contrast-';
rsNikonISOLkup = '0:ISO80,2:ISO160,4:ISO320,5:ISO100';
rsNikonQualityLkup = '1:Vga Basic,2:Vga Normal,3:Vga Fine,4:SXGA Basic,'+
'5:SXGA Normal,6:SXGA Fine,10:2 Mpixel Basic,11:2 Mpixel Normal,'+
'12:2 Mpixel Fine';
rsNikonWhiteBalanceLkup = '0:Auto,1:Preset,2:Daylight,3:Incandescense,'+
'4:Fluorescence,5:Cloudy,6:SpeedLight';
// Olympus
rsOlympusCCDScanModeLkup = '0:Interlaced,1:Progressive';
rsOlympusContrastLkup = '0:High,1:Normal,2:Low';
rsOlympusFlashDevLkup = '0:None,1:Internal,4:External,5:Internal + External';
rsOlympusFlashModeLkup = '2:On,3;Off';
rsOlympusFlashModelLkup = '0:None,1:FL-20,2:FL-50,3:RF-11,4:TF-22,5:FL-36,'+
'6:FL-50R,7:FL-36R,9:FL-14,11:FL-600R';
rsOlympusFlashTypeLkup = '0:None,2:Simple E-System,3:E-System';
rsOlympusJpegQualLkup = '1:SQ,2:HQ,3:SHQ,4:Raw';
rsOlympusMacroLkup = '0:Off,1:On,2:Super Macro';
rsOlympusPreviewImgLength = 'Preview image length';
rsOlympusPreviewImgStart = 'Preview image start';
rsOlympusPreviewImgValid = 'Preview image valid';
rsOlympusSharpnessLkup = '0:Normal,1:Hard,2:Soft';
rsOlympusSceneModeLkup = '0:Normal,1:Standard,2:Auto,3:Intelligent Auto,' +
'4:Portrait,5:Landscape+Portrait,6:Landscape,7:Night Scene,8:Night+Portrait' +
'9:Sport,10:Self Portrait,11:Indoor,12:Beach & Snow,13:Beach,14:Snow,' +
'15:Self Portrait+Self Timer,16:Sunset,17:Cuisine,18:Documents,19:Candle,' +
'20:Fireworks,21:Available Light,22:Vivid,23:Underwater Wide1,24:Underwater Macro,' +
'25:Museum,26:Behind Glass,27:Auction,28:Shoot & Select1,29:Shoot & Select2,'+
'30:Underwater Wide2,31:Digital Image Stabilization,32:Face Portrait,33:Pet,'+
'34:Smile Shot,35:Quick Shutter,43:Hand-held Starlight,100:Panorama,'+
'101:Magic Filter,103:HDR';
// Sanyo
rsSanyoMacroLkup = '0:Normal,1:Macro,2:View,3:Manual';
rsSanyoQualityLkup = '0:Normal/Very Low,1:Normal/Low,2:Normal/Medium Low,'+
'3:Normal/Medium,4:Normal/Medium High,5:Normal/High,6:Normal/Very High'+
'7:Normal/Super High,256:Fine/Very Low,257:Fine/Low,258:Fine/Medium Low'+
'259:Fine/Medium,260:Fine/Medium High,261:Fine/High,262:Fine/Very High'+
'263:Fine/Super High,512:Super Fine/Very Low,513:Super Fine/Low,'+
'514:Super Fine/Medium Low,515:Super Fine/Medium,516:Super Fine/Medium High,'+
'517:Super Fine/High,518:Super Fine/Very High,519:Super Fine/Super High';
rsSanyoSpecialMode = 'Special mode';
// *** IPTC tags ***
rsActionAdvised = 'Action advised';
rsByLine = 'ByLine';
rsByLineTitle = 'ByLine title';
rsCategory = 'Category';
rsCity = 'City';
rsCodedCharSet = 'Coded character set';
rsContact = 'Contact';
// rsCopyright = 'Copyright notice';
rsContentLocCode = 'Content location code';
rsContentLocName = 'Content location name';
rsDateCreated = 'Date created';
// rsDigitizeDate = 'Digital creation date';
// rsDigitizeTime = 'Digital creation time';
rsEditorialUpdate = 'Editorial update';
rsEditStatus = 'Edit status';
rsExpireDate = 'Expiration date';
rsExpireTime = 'Expiration time';
rsFixtureID = 'Fixture ID';
rsImgCaption = 'Image caption';
rsImgCaptionWriter = 'Image caption writer';
rsImgCredit = 'Image credit';
rsImgHeadline = 'Image headline';
rsImgType = 'Image type';
rsIptcOrientationLkup = 'P:Portrait,L:Landscape,S:Square';
rsKeywords = 'Keywords';
rsLangID = 'Language ID';
rsLocationCode = 'Country/primary location code';
rsLocationName = 'Country/primary location name';
rsObjectAttr = 'Object attribute reference';
rsObjectCycle = 'Object cycle';
rsObjectCycleLkup = 'a:morning,p:evening,b:both';
rsObjectName = 'Object name';
rsObjectType = 'Object type reference';
// rsOrientation = 'Image orientation';
rsOriginatingProg = 'Originating program';
rsProgVersion = 'Program version';
rsRecordVersion = 'Record version';
rsRefDate = 'Reference date';
rsRefNumber = 'Reference number';
rsRefService = 'Reference service';
rsReleaseDate = 'Release date';
rsReleaseTime = 'Release time';
rsSource = 'Source';
rsSpecialInstruct = 'Special instructions';
rsState = 'Province/State';
rsSubjectRef = 'Subject reference';
rsSubfile = 'Subfile';
rsSubLocation = 'Sublocation';
rsSuppCategory = 'Supplemental category';
rsTimeCreated = 'Time created';
rsUrgency = 'Urgency';
rsUrgencyLkup = '0:reserved,1:most urgent,5:normal,8:least urgent,9:reserved';
implementation
end.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,34 @@
{$IFDEF FPC}
{------------------------------------------------------------------
Defines for Lanzarus and FPC
------------------------------------------------------------------}
////// { Activate this define if an FPC version of at least 3.0 is used. }
{ This define signals that an FPC version >= 3.0 is used }
{$DEFINE FPC3+}
{$I fpexif_fpc.inc}
// Don't use jpeg units
{$DEFINE dExifNoJpeg}
{$ELSE}
{------------------------------------------------------------------
Defines for Delphi
------------------------------------------------------------------}
{$UNDEF FPC3+}
{ Activate this define if a library other than Delphi's jpeg is
used for reading of jpeg files.
Is active by default for Lazarus/FPC }
{.$DEFINE dEXIFNoJpeg}
{ Activate the define ENDIAN_BIG if working on a Big-Endian machine }
{.$DEFINE ENDIAN_BIG}
{ I did not test all Delphi versions. Extend the list if needed... }
{$IFDEF VER150}
{$DEFINE DELPHI7}
{$ENDIF}
{$ENDIF}

View File

@ -0,0 +1,3 @@
{$IF FPC_FullVersion < 30000}
{$UNDEF FPC3+}
{$ENDIF}

View File

@ -0,0 +1,84 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<Name Value="fpexif_pkg"/>
<Author Value="Werner Pamler"/>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
</SearchPaths>
</CompilerOptions>
<Description Value="Library for displaying and editing of meta data (EXIF, IPTC) in images."/>
<License Value="LGPL with linking exception (like Lazarus)"/>
<Version Minor="1"/>
<Files Count="12">
<Item1>
<Filename Value="fpeglobal.pas"/>
<UnitName Value="fpeGlobal"/>
</Item1>
<Item2>
<Filename Value="fpetags.pas"/>
<UnitName Value="fpeTags"/>
</Item2>
<Item3>
<Filename Value="fpeutils.pas"/>
<UnitName Value="fpeUtils"/>
</Item3>
<Item4>
<Filename Value="fpexif.inc"/>
<Type Value="Include"/>
</Item4>
<Item5>
<Filename Value="fpemetadata.pas"/>
<UnitName Value="fpeMetadata"/>
</Item5>
<Item6>
<Filename Value="fpeexifreadwrite.pas"/>
<UnitName Value="fpeExifReadWrite"/>
</Item6>
<Item7>
<Filename Value="fpeiptcreadwrite.pas"/>
<UnitName Value="fpeIptcReadWrite"/>
</Item7>
<Item8>
<Filename Value="fpexif_fpc.inc"/>
<Type Value="Include"/>
</Item8>
<Item9>
<Filename Value="fpeexifdata.pas"/>
<UnitName Value="fpeExifData"/>
</Item9>
<Item10>
<Filename Value="fpeiptcdata.pas"/>
<UnitName Value="fpeIptcData"/>
</Item10>
<Item11>
<Filename Value="fpestrconsts.pas"/>
<UnitName Value="fpeStrConsts"/>
</Item11>
<Item12>
<Filename Value="fpemakernote.pas"/>
<UnitName Value="fpeMakerNote"/>
</Item12>
</Files>
<i18n>
<EnableI18N Value="True"/>
<OutDir Value="languages"/>
</i18n>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LazUtils"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

View File

@ -0,0 +1,16 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit fpexif_pkg;
{$warn 5023 off : no warning about unused units}
interface
uses
fpeGlobal, fpeTags, fpeUtils, fpeMetadata, fpeExifReadWrite,
fpeIptcReadWrite, fpeExifData, fpeIptcData, fpeStrConsts, fpemakernote;
implementation
end.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,40 @@
-$A8
-$B-
-$C-
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$Y+
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$42200000
-E"D:\Prog_Lazarus\wp-laz\fpexif\tests\multiread"
-N"D:\Prog_Lazarus\wp-laz\fpexif\tests\multiread\output\dcu\Delphi7"
-LE"d:\programme\borland\delphi7\Projects\Bpl"
-LN"d:\programme\borland\delphi7\Projects\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

View File

@ -0,0 +1,151 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=0
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=2
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=1109393408
ExeDescription=TeeChart 2014 Components
[Directories]
OutputDir=D:\Prog_Lazarus\wp-laz\fpexif\tests\multiread
UnitOutputDir=D:\Prog_Lazarus\wp-laz\fpexif\tests\multiread\output\dcu\Delphi7
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Tee97;TeeUI97;TeeDB97;TeePro97;TeeGL97;TeeImage97;TeeLanguage97;TeeWorld97
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=D:\Programme\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=9
MinorVer=0
Release=11
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Steema Software
FileDescription=
FileVersion=9.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=9.0.0.0
[Excluded Packages]
D:\Prog_Delphi\common\Components\3rdParty\TeeChart\Sources\Compiled\Delphi7\Bin\DclTeeMaker17.bpl=TeeMaker
D:\Programme\Borland\Delphi7\Lib\HelpCtxD7.bpl=HelpScribble HelpContext Property Editor for Delphi 7
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=1
Item0=D:\Prog_Lazarus\git\dexif-afriess-master
[HistoryLists\hlUnitOutputDirectory]
Count=1
Item0=D:\Prog_Lazarus\wp-laz\fpexif\tests\multiread\output\dcu\Delphi7
[HistoryLists\hlOutputDirectorry]
Count=2
Item0=D:\Prog_Lazarus\wp-laz\fpexif\tests\multiread
Item1=D:\Prog_Lazarus\wp-laz\fpexif\tests\multiread\Delphi

View File

@ -0,0 +1,24 @@
program MultiRead_D7;
uses
Forms,
mrtmain in 'common\mrtmain.pas',
fpeStrConsts in '..\..\fpestrconsts.pas',
fpeGlobal in '..\..\fpeglobal.pas',
fpeTags in '..\..\fpetags.pas',
fpeUtils in '..\..\fpeutils.pas',
fpeExifData in '..\..\fpeexifdata.pas',
fpeIptcData in '..\..\fpeiptcdata.pas',
fpeExifReadWrite in '..\..\fpeexifreadwrite.pas',
fpeMakerNote in '..\..\fpemakernote.pas',
fpeIptcReadWrite in '..\..\fpeiptcreadwrite.pas',
fpeMetadata in '..\..\fpemetadata.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

Binary file not shown.

View File

@ -0,0 +1,24 @@
program MultiRead_Delphi;
uses
Forms,
mrtmain in 'common\mrtmain.pas',
fpeStrConsts in '..\..\fpestrconsts.pas',
fpeGlobal in '..\..\fpeglobal.pas',
fpeTags in '..\..\fpetags.pas',
fpeUtils in '..\..\fpeutils.pas',
fpeExifData in '..\..\fpeexifdata.pas',
fpeIptcData in '..\..\fpeiptcdata.pas',
fpeExifReadWrite in '..\..\fpeexifreadwrite.pas',
fpeMakerNote in '..\..\fpemakernote.pas',
fpeIptcReadWrite in '..\..\fpeiptcreadwrite.pas',
fpeMetadata in '..\..\fpemetadata.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

View File

@ -0,0 +1,142 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{935C648F-D321-4462-B3C2-5CD89F17CD4F}</ProjectGuid>
<MainSource>MultiRead_Delphi.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_E>false</DCC_E>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_N>true</DCC_N>
<DCC_S>false</DCC_S>
<DCC_ImageBase>42200000</DCC_ImageBase>
<DCC_AssertionsAtRuntime>false</DCC_AssertionsAtRuntime>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_Description>TeeChart 2014 Components</DCC_Description>
<DCC_ExeOutput>D:\Prog_Lazarus\wp-laz\fpexif\tests\multiread</DCC_ExeOutput>
<DCC_DcuOutput>D:\Prog_Lazarus\wp-laz\fpexif\tests\multiread\output\dcu\Delphi</DCC_DcuOutput>
<DCC_UsePackage>Tee97;TeeUI97;TeeDB97;TeePro97;TeeGL97;TeeImage97;TeeLanguage97;TeeWorld97;$(DCC_UsePackage)</DCC_UsePackage>
<SanitizedProjectName>MultiRead_Delphi</SanitizedProjectName>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_MajorVer>9</VerInfo_MajorVer>
<VerInfo_Release>11</VerInfo_Release>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=Steema Software;FileDescription=;FileVersion=9.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=9.0.0.0</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<Icon_MainIcon>MultiRead_D7_Icon.ico</Icon_MainIcon>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppEnableHighDPI>true</AppEnableHighDPI>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppEnableHighDPI>true</AppEnableHighDPI>
<VerInfo_MajorVer>1</VerInfo_MajorVer>
<VerInfo_Release>0</VerInfo_Release>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="common\mrtmain.pas"/>
<DCCReference Include="..\..\fpestrconsts.pas"/>
<DCCReference Include="..\..\fpeglobal.pas"/>
<DCCReference Include="..\..\fpetags.pas"/>
<DCCReference Include="..\..\fpeutils.pas"/>
<DCCReference Include="..\..\fpeexifdata.pas"/>
<DCCReference Include="..\..\fpeiptcdata.pas"/>
<DCCReference Include="..\..\fpeexifreadwrite.pas"/>
<DCCReference Include="..\..\fpemakernote.pas"/>
<DCCReference Include="..\..\fpeiptcreadwrite.pas"/>
<DCCReference Include="..\..\fpemetadata.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">MultiRead_Delphi.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

Binary file not shown.

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,122 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="MultiRead_Laz"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="13">
<Unit0>
<Filename Value="MultiRead_Laz.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="common\mrtmain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
<Unit2>
<Filename Value="..\..\fpexif.inc"/>
<IsPartOfProject Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\fpeexifreadwrite.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeExifReadWrite"/>
</Unit3>
<Unit4>
<Filename Value="..\..\fpeglobal.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeGlobal"/>
</Unit4>
<Unit5>
<Filename Value="..\..\fpetags.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeTags"/>
</Unit5>
<Unit6>
<Filename Value="..\..\fpeutils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeUtils"/>
</Unit6>
<Unit7>
<Filename Value="..\..\fpexif_fpc.inc"/>
<IsPartOfProject Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\..\fpeexifdata.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeExifData"/>
</Unit8>
<Unit9>
<Filename Value="..\..\fpeiptcdata.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeIptcData"/>
</Unit9>
<Unit10>
<Filename Value="..\..\fpeiptcreadwrite.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeIptcReadWrite"/>
</Unit10>
<Unit11>
<Filename Value="..\..\fpemakernote.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeMakerNote"/>
</Unit11>
<Unit12>
<Filename Value="..\..\fpestrconsts.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeStrConsts"/>
</Unit12>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="MultiRead_Laz"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir);..\.."/>
<OtherUnitFiles Value="common;..\.."/>
<UnitOutputDirectory Value="output\ppu\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,21 @@
program MultiReadTest;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, mrtmain
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

Binary file not shown.

View File

@ -0,0 +1,601 @@
object MainForm: TMainForm
Left = 326
Top = 138
Width = 1040
Height = 599
ActiveControl = BtnRunTest
Caption = 'Multi read test'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Splitter1: TSplitter
Left = 403
Top = 33
Width = 5
Height = 527
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 1024
Height = 33
Align = alTop
AutoSize = True
BevelOuter = bvNone
BorderWidth = 4
TabOrder = 0
DesignSize = (
1024
33)
object BtnReadFiles: TButton
Left = 945
Top = 4
Width = 75
Height = 25
Caption = 'Read files'
TabOrder = 0
OnClick = BtnReadFilesClick
end
object EdImageDir: TEdit
Left = 4
Top = 4
Width = 931
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 1
Text = '..\pictures\originals'
end
end
object Panel2: TPanel
Left = 0
Top = 33
Width = 403
Height = 527
Align = alLeft
BevelOuter = bvNone
BorderWidth = 4
Caption = 'Panel2'
TabOrder = 1
object Bevel1: TBevel
Left = 4
Top = 494
Width = 395
Height = 4
Align = alBottom
Shape = bsSpacer
end
object FileTreeView: TTreeView
Left = 4
Top = 4
Width = 395
Height = 490
Align = alClient
Images = ImageList1
Indent = 19
ReadOnly = True
StateImages = StateImages
TabOrder = 0
OnClick = FileTreeViewClick
end
object Panel3: TPanel
Left = 4
Top = 498
Width = 395
Height = 25
Align = alBottom
AutoSize = True
BevelOuter = bvNone
TabOrder = 1
object BtnCreateTxtFiles: TButton
Left = 0
Top = 0
Width = 100
Height = 25
Caption = 'Create txt files'
TabOrder = 0
OnClick = BtnCreateTxtFilesClick
end
object BtnUncheckAll: TButton
Left = 104
Top = 0
Width = 75
Height = 25
Caption = 'Uncheck all'
TabOrder = 1
OnClick = BtnUncheckAllClick
end
object BtnCheckAll: TButton
Left = 184
Top = 0
Width = 75
Height = 25
Caption = 'Check all'
TabOrder = 2
OnClick = BtnUncheckAllClick
end
end
end
object Panel4: TPanel
Left = 408
Top = 33
Width = 616
Height = 527
Align = alClient
BevelOuter = bvNone
BorderWidth = 4
TabOrder = 2
object Bevel2: TBevel
Left = 4
Top = 494
Width = 608
Height = 4
Align = alBottom
Shape = bsSpacer
end
object Panel5: TPanel
Left = 4
Top = 498
Width = 608
Height = 25
Align = alBottom
AutoSize = True
BevelOuter = bvNone
TabOrder = 0
object MismatchInfo: TLabel
Left = 0
Top = 0
Width = 361
Height = 25
Align = alLeft
AutoSize = False
Caption = 'MismatchInfo'
Color = clBtnFace
ParentColor = False
Layout = tlCenter
end
object BtnRunTest: TButton
Left = 539
Top = 0
Width = 69
Height = 25
Caption = 'Run test'
TabOrder = 0
OnClick = BtnRunTestClick
end
end
object Memo: TMemo
Left = 4
Top = 4
Width = 608
Height = 490
Align = alClient
ScrollBars = ssBoth
TabOrder = 1
end
end
object ImageList1: TImageList
Left = 99
Top = 111
Bitmap = {
494C010104000900300010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000002000000001002000000000000020
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000D7CCC400A57E5E00B2805600AF7E
5200A47A5900CFC2B70000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000003F3D
ED413B38EB08000000000000000000000000000000000000000000000000211F
E3081E1CE2410000000000000000000000000000000000000000000000000000
00000000000000000000E6E0DA00A9876A00B2815800CBAB8900D1B49500BB8E
6300B5875A00AB774D00A3806300E1D9D4000000000000000000000000000000
000000000000317A360A2D753207000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000077130900000000000000000000
00000000000000000000000000000000000000000000000000004A47F0414F4C
F2FF403EEDFD3C39EB08000000000000000000000000000000002725E5082422
E4FC312FEAFF1F1DE24100000000000000000000000000000000000000000000
0000F3F6F400FAFBFA00AD805700D5BB9F00D6BB9E00D3B89C00D1B39400B789
5D00BA8E6200B88D6100B2815600A8764E000000000000000000000000000000
00003985400A37833DFF317B37FB2E7633070000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000007D21F5037B1EFF00791521000000000000
000000000000000000000000000000000000000000005451F3415856F5FF6361
FAFF5855F6FF413FEDFC3D3AEC080000000000000000302DE7082C2AE6FC413F
F1FF4C4AF6FF312FEAFF1F1DE241000000000000000000000000C6D4C700689A
6C0063A26A0061A16900B17E5200E1CDB800D8C0A500D8C0A700D4BA9D00B88C
6000B78A6000B88D6100BA8E6200B17E52000000000000000000000000004292
490A408E47FF54A35CFF4F9F57FF327C38FE2E77340800000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000001832BF543A15FFF007B1FE4007919270000
000000000000000000000000000000000000000000005956F52B5B58F6FF6562
FAFF7170FFFF5956F6FF4240EEFC3E3BEC083937EB083532E9FC4745F2FF6362
FFFF4A48F4FF2F2DE9FF2220E32B00000000DCE4DD0076A07A0066A36C0093C0
99009EC7A40071AC7800AF7E5100E3D0BC00DAC3AB00D3B89E00C7A37D00C198
6F00B6895C00B78A6000BA8E6200B180540000000000000000004B9E530A499A
51FF5BAC64FF77CA82FF74C87EFF51A059FF337D39FE2F783508000000000000
0000000000000000000000000000000000000000000000000000000000002197
51FE1B9149FE158F43FE0F8B3BFE3A9F5EFF80C196FF46A362FF007D1FE70079
192A0000000000000000000000000000000000000000000000005A57F52B5B59
F6FF6663FAFF7471FFFF5A58F6FF4341EEFC3E3CECFD504DF4FF6867FFFF504E
F5FF3634EBFF2A27E52B0000000000000000649F6C00A9CDAF00A6CCAC00A2C9
A90099C59F006BA97400AE7C4F00DCC8B000BF9F8100B88D6500D1B38F00D1B3
8F00BB906600BC916800B78A6000B17E52000000000053A95C0A51A65AFF63B5
6DFF7ECE89FF7BCC87FF76CA81FF76C981FF52A25AFF347E3AFE307935080000
000000000000000000000000000000000000000000000000000000000000299B
5BFF90CAA9FF8DC8A5FF8AC6A1FF88C59EFF6AB685FF82C297FF48A566FF007D
21EA00791B300000000000000000000000000000000000000000000000005B58
F62B5C5AF6FF6764FAFF7472FFFF7370FFFF706EFFFF6E6CFFFF5755F7FF3F3D
EEFF3230E82B00000000000000000000000062A16900C0DAC500ADD0B300ABCE
B1009EC8A6006DAA7600957B7E005A61C8005058E3004F56E000585FC8009078
8400BB906600D1B38F00C6A27B00A97950005AB4650959B063FF6BBD76FF84D2
90FF7AC985FF60B26AFF63B46DFF78C983FF78CB82FF53A35CFF347F3AFD317A
360800000000000000000000000000000000000000000000000000000000319F
63FF94CDADFF6FBA8EFF6BB889FF66B685FF61B380FF67B582FF83C298FF3CA0
5CFF007F25FC0000000000000000000000000000000000000000000000000000
00005C59F62B5D5BF7FF7976FFFF5956FFFF5754FFFF7270FFFF4846F0FF3C39
EB2B0000000000000000000000000000000060A06800C5DEC900B4D4B900A4C9
AA0081AB9A00616DC3005058E0006668EB009393F4006163EA00585BE4004952
DC006063BE00A6897F00C19A7100B89F8B005EB969465BB566E479C986FF80CE
8DFF51A65AFC4DA1566F499C518B5CAD67FF7CCC86FF79CB85FF54A45DFF3580
3BFC317B370800000000000000000000000000000000000000000000000037A3
6BFF96CEB0FF94CDADFF91CBAAFF90CBA8FF74BC90FF8AC7A1FF46A568FF0787
35FD01832D0F0000000000000000000000000000000000000000000000000000
0000615EF8085D5AF6FD7D79FFFF5E5BFFFF5B58FFFF7674FFFF4643EFFD413F
ED08000000000000000000000000000000005D9F6500B9D6BE0087BA8F0071AC
78005359DC00666AEB009896F4009191F300898AF0005B5FE7005F62E9005D61
E8005158E4004A55D800E3DDDB00FCFAFA00000000005FBA6A3C5CB666E66DC0
79FF55AC5F6F00000000000000004A9D52915EAE68FF7DCD89FF7CCD87FF56A5
5FFF36813CFC327C380800000000000000000000000000000000000000003DA5
6FFF37A36DFD33A167FD2F9D61FD55AF7CFF91CBAAFF4FAB74FF178F45FD118B
3D0C000000000000000000000000000000000000000000000000000000006967
FB086663F9FC706DFBFF807EFFFF7E7BFFFF7C79FFFF7977FFFF5E5CF7FF4744
EFFC4240EE0800000000000000000000000065A06C0086BA8F0099C6A20074AD
7C004F57E200B4B1F9009796F4009393F4008C8DF0005C60E8005C61E7005D61
E8005F62E9004F57E200E4E5F2000000000000000000000000005FBB6A435CB7
6765000000000000000000000000000000004B9E53915FAF69FF7FCE8AFF7ECE
89FF57A660FF37823DFC337D3908000000000000000000000000000000000000
0000000000000000000000000000319F63F55AB381FF289857FF1F954F090000
0000000000000000000000000000000000000000000000000000716EFD086E6B
FCFC7774FDFF8682FFFF7673FCFF6462F8FF605DF7FF6D6AFAFF7B79FFFF605D
F7FF4845EFFC4341EE08000000000000000093B397007CB4850076AF7E006FAB
78004E54E100B4B1F9009596F500666AEB006F71EC006E72EC005A5CE5005C61
E7005F62E9005158E200E4E5F200000000000000000000000000000000000000
000000000000000000000000000000000000000000004B9F549160B06AFF81CF
8DFF7FCF8BFF58A761FF398540FF347E3A080000000000000000000000000000
000000000000000000000000000037A36BF5319F65FF2D9D5F09000000000000
000000000000000000000000000000000000000000007673FF087471FEFD7D7A
FEFF8A87FFFF7C79FDFF6C69FBFF6361F92B5F5CF72B615EF8FF6E6CFAFF7D7A
FFFF615FF7FF4946F0FC4441EE0500000000FAFBFA00DFE6DF00CBD7CC006EA8
77004C52E000A2A2F4006A6CEC006163EA009793F7009793F7006468E9006566
EA005C61E7004F57E200E4E5F200000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000004CA0559162B2
6CFF82D18FFF7AC885FF57A660FF38843F7B0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000007774FF1F7A77FFFF817E
FFFF817EFEFF7471FDFF6C69FB2B0000000000000000605DF72B625FF8FF6F6D
FBFF7E7CFFFF625FF8FF4A47F06F4542EE020000000000000000000000000000
0000555BDB007C7CF2009793F7006468E9005258E3005258E3006468E9009793
F7007C7CF2004E57D900E9EAF500000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000004DA1
569163B36DFF5FAF69FF41914979000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000007774FF1F7A77
FFFF7976FEFF726FFD2B00000000000000000000000000000000615EF82B6461
F8FF6A68F9FF5451F3A84F4DF229000000000000000000000000000000000000
00009195D9006E6FEC006668EB005F62E9007878F0007474F0005F62E900696B
EB006F71EC009094D70000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00004EA257914A9D527F00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000007774
FF1F7774FF2B000000000000000000000000000000000000000000000000625F
F82B5D5BF76F5956F53E00000000000000000000000000000000000000000000
0000FAFAFD00DFE1F100CBCDE7006163E3005157E2005157E2005F62E300C9CC
E600DFE0F100FAFAFD0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006360F80A0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000424D3E000000000000003E000000
2800000040000000200000000100010000000000000100000000000000000000
000000000000000000000000FFFFFF0000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000FFFFFFFFFF03FFFFFFFFE7E7FC00F9FF
FF7FC3C3F000F0FFFE3F8181C000E07FFE1F80010000C03FE00FC0030000801F
E007E0070000000FE007F00F00000007E007F00F00008603E00FE0070001CF01
FE1FC0030001FF80FE3F80010001FFC0FFFF8180F001FFE1FFFFC3C1F003FFF3
FFFFE7E3F003FFFFFFFFFFF7FFFFFFFF00000000000000000000000000000000
000000000000}
end
object StateImages: TImageList
Left = 99
Top = 176
Bitmap = {
494C010103003800480010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000001000000001002000000000000010
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000001919
1926151515661515157515151575151515751515157515151575151515751515
1566191919260000000000000000000000000000000000000000000000001919
1926151515661515157515151575151515751515157515151575151515751515
1566191919260000000000000000000000000000000000000000000000001919
1926151515661515157515151575151515751515157515151575151515751515
1566191919260000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000003838
3862CCCCCCD6E9E9E9FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE9E9E9FFCCCC
CCD6383838620000000000000000000000000000000000000000000000003838
3862CCCCCCD6E9E9E9FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE9E9E9FFCCCC
CCD6383838620000000000000000000000000000000000000000000000003838
3862CCCCCCD6E9E9E9FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE9E9E9FFCCCC
CCD6383838620000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000004949
496EEBEBEBFFE3E3E3FFE3E3E3FFE3E3E3FFE3E3E3FFE3E3E3FFE3E3E3FFEBEB
EBFF4949496E0000000000000000000000000000000000000000000000004949
496EEBEBEBFFE3E3E3FFD3D3D3FF5C5C5CFFD3D3D3FFE3E3E3FFE3E3E3FFEBEB
EBFF4949496E0000000000000000000000000000000000000000000000004949
496EEBEBEBFFE3E3E3FFE3E3E3FFE3E3E3FFE3E3E3FFE3E3E3FFE3E3E3FFEBEB
EBFF4949496E0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000005252
526DEEEEEEFFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFEEEE
EEFF5252526D0000000000000000000000000000000000000000000000005252
526DEEEEEEFFD9D9D9FF6B6B6BFF6B6B6BFF6B6B6BFFD9D9D9FFE8E8E8FFEEEE
EEFF5252526D0000000000000000000000000000000000000000000000005252
526DEEEEEEFFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFEEEE
EEFF5252526D0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000005C5C
5C6CF1F1F1FFEDEDEDFFEDEDEDFFEDEDEDFFEDEDEDFFEDEDEDFFEDEDEDFFF1F1
F1FF5C5C5C6C0000000000000000000000000000000000000000000000005C5C
5C6CF1F1F1FF7C7C7CFF7C7C7CFFD0D0D0FF7C7C7CFF7C7C7CFFDFDFDFFFF1F1
F1FF5C5C5C6C0000000000000000000000000000000000000000000000005C5C
5C6CF1F1F1FFEDEDEDFFEDEDEDFFEDEDEDFFEDEDEDFFEDEDEDFFEDEDEDFFF1F1
F1FF5C5C5C6C0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000006464
646AF6F6F6FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF6F6
F6FF6464646A0000000000000000000000000000000000000000000000006464
646AF6F6F6FF8C8C8CFFE5E5E5FFF2F2F2FFE5E5E5FF8C8C8CFF8C8C8CFFF6F6
F6FF6464646A0000000000000000000000000000000000000000000000006464
646AF6F6F6FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF6F6
F6FF6464646A0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000006C6C
6C69F9F9F9FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF9F9
F9FF6C6C6C690000000000000000000000000000000000000000000000006C6C
6C69F9F9F9FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFEBEBEBFF979797FFF9F9
F9FF6C6C6C690000000000000000000000000000000000000000000000006C6C
6C69F9F9F9FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF9F9
F9FF6C6C6C690000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000007474
7468FDFDFDFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFDFD
FDFF747474680000000000000000000000000000000000000000000000007474
7468FDFDFDFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFE3E3E3FFFDFD
FDFF747474680000000000000000000000000000000000000000000000007474
7468FDFDFDFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFDFD
FDFF747474680000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000007A7A
7A5AE9E9E9D3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE9E9
E9D37A7A7A5A0000000000000000000000000000000000000000000000007A7A
7A5AE9E9E9D3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE9E9
E9D37A7A7A5A0000000000000000000000000000000000000000000000007A7A
7A5AE9E9E9D3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE9E9
E9D37A7A7A5A0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000007F7F
7F227F7F7F597F7F7F667F7F7F667F7F7F667F7F7F667F7F7F667F7F7F667F7F
7F597F7F7F220000000000000000000000000000000000000000000000007F7F
7F227F7F7F597F7F7F667F7F7F667F7F7F667F7F7F667F7F7F667F7F7F667F7F
7F597F7F7F220000000000000000000000000000000000000000000000007F7F
7F227F7F7F597F7F7F667F7F7F667F7F7F667F7F7F667F7F7F667F7F7F667F7F
7F597F7F7F220000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000424D3E000000000000003E000000
2800000040000000100000000100010000000000800000000000000000000000
000000000000000000000000FFFFFF00FFFFFFFFFFFF0000FFFFFFFFFFFF0000
FFFFFFFFFFFF0000E007E007E0070000E007E007E0070000E007E007E0070000
E007E007E0070000E007E007E0070000E007E007E0070000E007E007E0070000
E007E007E0070000E007E007E0070000E007E007E0070000FFFFFFFFFFFF0000
FFFFFFFFFFFF0000FFFFFFFFFFFF000000000000000000000000000000000000
000000000000}
end
end

View File

@ -0,0 +1,425 @@
object MainForm: TMainForm
Left = 326
Height = 560
Top = 138
Width = 1024
ActiveControl = BtnRunTest
Caption = 'Multi read test'
ClientHeight = 560
ClientWidth = 1024
OnCreate = FormCreate
LCLVersion = '1.9.0.0'
object Panel1: TPanel
Left = 0
Height = 33
Top = 0
Width = 1024
Align = alTop
AutoSize = True
BevelOuter = bvNone
BorderWidth = 4
ClientHeight = 33
ClientWidth = 1024
TabOrder = 0
object BtnReadFiles: TButton
Left = 945
Height = 25
Top = 4
Width = 75
Align = alRight
Caption = 'Read files'
OnClick = BtnReadFilesClick
TabOrder = 0
end
object EdImageDir: TEdit
Left = 4
Height = 23
Top = 4
Width = 931
Anchors = [akTop, akLeft, akRight]
TabOrder = 1
Text = '..\pictures\originals'
end
end
object Panel2: TPanel
Left = 0
Height = 527
Top = 33
Width = 403
Align = alLeft
BevelOuter = bvNone
BorderWidth = 4
Caption = 'Panel2'
ClientHeight = 527
ClientWidth = 403
TabOrder = 1
object FileTreeView: TTreeView
Left = 4
Height = 490
Top = 4
Width = 395
Align = alClient
Images = ImageList1
ReadOnly = True
StateImages = StateImages
TabOrder = 0
OnClick = FileTreeViewClick
Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
end
object Panel3: TPanel
Left = 4
Height = 25
Top = 498
Width = 395
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 25
ClientWidth = 395
TabOrder = 1
object BtnCreateTxtFiles: TButton
Left = 0
Height = 25
Top = 0
Width = 100
AutoSize = True
Caption = 'Create txt files'
OnClick = BtnCreateTxtFilesClick
TabOrder = 0
end
object BtnUncheckAll: TButton
Left = 104
Height = 25
Top = 0
Width = 75
Caption = 'Uncheck all'
OnClick = BtnUncheckAllClick
TabOrder = 1
end
object BtnCheckAll: TButton
Left = 184
Height = 25
Top = 0
Width = 75
Caption = 'Check all'
OnClick = BtnUncheckAllClick
TabOrder = 2
end
end
object Bevel1: TBevel
Left = 4
Height = 4
Top = 494
Width = 395
Align = alBottom
Shape = bsSpacer
end
end
object Splitter1: TSplitter
Left = 403
Height = 527
Top = 33
Width = 5
end
object Panel4: TPanel
Left = 408
Height = 527
Top = 33
Width = 616
Align = alClient
BevelOuter = bvNone
BorderWidth = 4
ClientHeight = 527
ClientWidth = 616
TabOrder = 3
object Panel5: TPanel
Left = 4
Height = 25
Top = 498
Width = 608
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 25
ClientWidth = 608
TabOrder = 0
object BtnRunTest: TButton
Left = 539
Height = 25
Top = 0
Width = 69
Align = alRight
AutoSize = True
Caption = 'Run test'
OnClick = BtnRunTestClick
TabOrder = 0
end
object MismatchInfo: TLabel
Left = 0
Height = 25
Top = 0
Width = 266
Align = alLeft
AutoSize = False
Caption = 'MismatchInfo'
Layout = tlCenter
ParentColor = False
end
end
object Memo: TMemo
Left = 4
Height = 490
Top = 4
Width = 608
Align = alClient
ScrollBars = ssAutoBoth
TabOrder = 1
end
object Bevel2: TBevel
Left = 4
Height = 4
Top = 494
Width = 608
Align = alBottom
Shape = bsSpacer
end
end
object ImageList1: TImageList
left = 99
top = 111
Bitmap = {
4C69040000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF0037A36BF5319F65FF2D9D5F09FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00319F63F55AB381FF289857FF1F954F09FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003DA56FFF37A3
6DFD33A167FD2F9D61FD55AF7CFF91CBAAFF4FAB74FF178F45FD118B3D0CFFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0037A36BFF96CE
B0FF94CDADFF91CBAAFF90CBA8FF74BC90FF8AC7A1FF46A568FF078735FD0183
2D0FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00319F63FF94CD
ADFF6FBA8EFF6BB889FF66B685FF61B380FF67B582FF83C298FF3CA05CFF007F
25FCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00299B5BFF90CA
A9FF8DC8A5FF8AC6A1FF88C59EFF6AB685FF82C297FF48A566FF007D21EA0079
1B30FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00219751FE1B91
49FE158F43FE0F8B3BFE3A9F5EFF80C196FF46A362FF007D1FE70079192AFFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF0001832BF543A15FFF007B1FE400791927FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00007D21F5037B1EFF00791521FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF0000771309FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006360
F80AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007774FF1F7774
FF2BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00625FF82B5D5B
F76F5956F53EFFFFFF00FFFFFF00FFFFFF00FFFFFF007774FF1F7A77FFFF7976
FEFF726FFD2BFFFFFF00FFFFFF00FFFFFF00FFFFFF00615EF82B6461F8FF6A68
F9FF5451F3A84F4DF229FFFFFF00FFFFFF007774FF1F7A77FFFF817EFFFF817E
FEFF7471FDFF6C69FB2BFFFFFF00FFFFFF00605DF72B625FF8FF6F6DFBFF7E7C
FFFF625FF8FF4A47F06F4542EE02FFFFFF007673FF087471FEFD7D7AFEFF8A87
FFFF7C79FDFF6C69FBFF6361F92B5F5CF72B615EF8FF6E6CFAFF7D7AFFFF615F
F7FF4946F0FC4441EE05FFFFFF00FFFFFF00FFFFFF00716EFD086E6BFCFC7774
FDFF8682FFFF7673FCFF6462F8FF605DF7FF6D6AFAFF7B79FFFF605DF7FF4845
EFFC4341EE08FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006967FB086663
F9FC706DFBFF807EFFFF7E7BFFFF7C79FFFF7977FFFF5E5CF7FF4744EFFC4240
EE08FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00615E
F8085D5AF6FD7D79FFFF5E5BFFFF5B58FFFF7674FFFF4643EFFD413FED08FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005C59
F62B5D5BF7FF7976FFFF5956FFFF5754FFFF7270FFFF4846F0FF3C39EB2BFFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005B58F62B5C5A
F6FF6764FAFF7472FFFF7370FFFF706EFFFF6E6CFFFF5755F7FF3F3DEEFF3230
E82BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005A57F52B5B59F6FF6663
FAFF7471FFFF5A58F6FF4341EEFC3E3CECFD504DF4FF6867FFFF504EF5FF3634
EBFF2A27E52BFFFFFF00FFFFFF00FFFFFF005956F52B5B58F6FF6562FAFF7170
FFFF5956F6FF4240EEFC3E3BEC083937EB083532E9FC4745F2FF6362FFFF4A48
F4FF2F2DE9FF2220E32BFFFFFF00FFFFFF005451F3415856F5FF6361FAFF5855
F6FF413FEDFC3D3AEC08FFFFFF00FFFFFF00302DE7082C2AE6FC413FF1FF4C4A
F6FF312FEAFF1F1DE241FFFFFF00FFFFFF00FFFFFF004A47F0414F4CF2FF403E
EDFD3C39EB08FFFFFF00FFFFFF00FFFFFF00FFFFFF002725E5082422E4FC312F
EAFF1F1DE241FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003F3DED413B38
EB08FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00211FE3081E1C
E241FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00C2880100C2880100C2880100C2880100C389
014EC38901DEC38901DEC38901DEC38901DEC38901DEC389014EC2880100C288
0100C2880100C2880100FFFFFF00BF840100BF840100BF840100BF840100BF84
01BCE7B236F3FECB54FFFECB54FFFECB54FFE7B236F3BF8401BCBF840100BF84
0100BF840100BF840100FFFFFF005D406000B97E0100B97E0100B97E0100B97E
01DCEBB841FFDDAA33FFDDAA33FFDDAA33FFEBB841FFB97E01DCB97E0100B97E
0100B97E0100B97E0100FFFFFF000000BF002D1E9000B1760100B1760100B176
01DBE7B43DFFDAA730FFDAA730FFDAA730FFE7B43DFFB17601DBB1760100B176
0100B17601005A912B00FFFFFF000000BF000000BF002B1C9000A96E0100A96E
01D9E1AE38FFD6A32CFFD6A32CFFD6A32CFFE1AE38FFA96E01D9A96E0100A96E
01002B9C400000AA5500FFFFFF000000BF000000BF000000BF00291A9000A165
01D7DCA932FFD19E27FFD19E27FFD19E27FFDCA932FFA16501D7A1650100299A
400000AA550000AA5500FFFFFF000000BE480000BECC0000BECC0000BECC5030
5AE6DCA932FFD7A42DFFD7A42DFFD7A42DFFDCA932FF975A01D52797400000AA
550000AA550000AA5500FFFFFF000000BAAE4C4BE6ED7675FEFF7675FEFF7962
A3FF7B5055FF7B5055FF594528EF595D19EF595D19EF3F742BE500A954CC00A9
54CC00A954CC00A95448FFFFFF000000B4CC4635F2FF2000E9FF2000E9FF2000
E9FF2000E9FF2000E9FF005282CC44CC88FF65EDA9FF65EDA9FF65EDA9FF65ED
A9FF41D389ED00A450AEFFFFFF000000AECC3E2DECFF1C00E3FF1C00E3FF1C00
E3FF1C00E3FF1C00E3FF004E7CCC42CA86FF51D995FF42CA86FF42CA86FF42CA
86FF51D995FF009C4ACCFFFFFF000000A6CC3625E4FF1900DBFF1900DBFF1900
DBFF1900DBFF1900DBFF004A75CC3EC682FF4DD591FF3EC682FF3EC682FF3EC6
82FF4DD591FF009444CCFFFFFF0000009ECC2D1CDEFF1500D5FF1500D5FF1500
D5FF1500D5FF1500D5FF00466DCC3BC37FFF48CF8CFF3BC37FFF3BC37FFF3BC3
7FFF48CF8CFF008B3CCCFFFFFF00000095CC2F1EDCFF2513D8FF2513D8FF2513
D8FF2513D8FF2513D8FF004165CC37BF7BFF42CA86FF37BF7BFF37BF7BFF37BF
7BFF42CA86FF008134CCFFFFFF0000007E9900007ACC00007ACC00007ACC0000
7ACC00007ACC00007ACC003B53CC35BD79FF43CB87FF3EC682FF3EC682FF3EC6
82FF43CB87FF00752BCCFFFFFF0000007A000000730000007300000073000000
7300000073000000730000591499005510CC005510CC005510CC005510CC0055
10CC005510CC00591499FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004EA2
57914A9D527FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004DA1569163B3
6DFF5FAF69FF41914979FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004CA0559162B26CFF82D1
8FFF7AC885FF57A660FF38843F7BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004B9F549160B06AFF81CF8DFF7FCF
8BFF58A761FF398540FF347E3A08FFFFFF00FFFFFF005FBB6A435CB76765FFFF
FF00FFFFFF00FFFFFF00FFFFFF004B9E53915FAF69FF7FCE8AFF7ECE89FF57A6
60FF37823DFC337D3908FFFFFF00FFFFFF005FBA6A3C5CB666E66DC079FF55AC
5F6FFFFFFF00FFFFFF004A9D52915EAE68FF7DCD89FF7CCD87FF56A55FFF3681
3CFC327C3808FFFFFF00FFFFFF005EB969465BB566E479C986FF80CE8DFF51A6
5AFC4DA1566F499C518B5CAD67FF7CCC86FF79CB85FF54A45DFF35803BFC317B
3708FFFFFF00FFFFFF00FFFFFF005AB4650959B063FF6BBD76FF84D290FF7AC9
85FF60B26AFF63B46DFF78C983FF78CB82FF53A35CFF347F3AFD317A3608FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0053A95C0A51A65AFF63B56DFF7ECE
89FF7BCC87FF76CA81FF76C981FF52A25AFF347E3AFE30793508FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004B9E530A499A51FF5BAC
64FF77CA82FF74C87EFF51A059FF337D39FE2F783508FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004292490A408E
47FF54A35CFF4F9F57FF327C38FE2E773408FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003985
400A37833DFF317B37FB2E763307FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00317A360A2D753207FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00
}
end
object StateImages: TImageList
left = 99
top = 176
Bitmap = {
4C69030000001000000010000000B8A596EFB5A291FFB39F8FFFB39F8EFFB39F
8EFFB39F8EFFB39F8EFFB39F8EFFB39F8EFFB39F8EFFB39F8EFFB39F8EFFB39F
8FFFB5A291FFB8A596EFFFFFFF00B5A291FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFB5A291FFFFFFFF00B4A090FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFB4A090FFFFFFFF00B4A090FFFEFEFCFFFEFCFBFFFCFAF9FFFCFA
F9FFFCFAF9FFFCFAF9FFFCFAF9FFFCFAF9FFFCFAF9FFFCFAF9FFFCFAF9FFFEFC
FBFFFEFEFCFFB4A090FFFFFFFF00B4A090FFFBF9F5FFFCF9F7FFFAF7F5FFFAF7
F5FFFAF7F5FFFAF7F5FFFAF7F5FFFAF7F5FFFAF7F5FFFAF7F5FFFAF7F5FFFCF9
F7FFFBF9F5FFB4A090FFFFFFFF00B4A091FFF7F4EFFFFBF7F4FFF9F5F2FFF9F5
F2FFF9F5F2FFF9F5F2FFF9F5F2FFF9F5F2FFF9F5F2FFF9F5F2FFF9F5F2FFFBF7
F4FFF7F4EFFFB4A091FFFFFFFF00B4A191FFF4F0E9FFF9F4F0FFF7F2EEFFF7F2
EEFFF7F2EEFFF7F2EEFFF7F2EEFFF7F2EEFFF7F2EEFFF7F2EEFFF7F2EEFFF9F4
F0FFF4F0E9FFB4A191FFFFFFFF00B5A191FFF0ECE4FFF7F1EEFFF5EFEBFFF5EF
EBFFF5EFEBFFF5EFEBFFF5EFEBFFF5EFEBFFF5EFEBFFF5EFEBFFF5EFEBFFF7F1
EEFFF0ECE4FFB5A191FFFFFFFF00B5A292FFEDE7DEFFF5EFEAFFF3EDE7FFF3ED
E7FFF3EDE7FFF3EDE7FFF3EDE7FFF3EDE7FFF3EDE7FFF3EDE7FFF3EDE7FFF5EF
EAFFEDE7DEFFB5A292FFFFFFFF00B5A293FFE9E3D9FFF4ECE6FFF2EAE3FFF2EA
E3FFF2EAE3FFF2EAE3FFF2EAE3FFF2EAE3FFF2EAE3FFF2EAE3FFF2EAE3FFF4EC
E6FFE9E3D9FFB5A293FFFFFFFF00B5A393FFE6DED3FFF2E9E3FFF0E7E0FFF0E7
E0FFF0E7E0FFF0E7E0FFF0E7E0FFF0E7E0FFF0E7E0FFF0E7E0FFF0E7E0FFF2E9
E3FFE6DED3FFB5A393FFFFFFFF00B6A394FFE3D9CDFFF0E6DFFFEFE4DDFFEEE4
DCFFEEE4DCFFEEE4DCFFEEE4DCFFEEE4DCFFEEE4DCFFEEE4DCFFEFE4DDFFF0E6
DFFFE3D9CDFFB6A394FFFFFFFF00B6A394FFE1D5C9FFF0E6DEFFEEE5DCFFEEE4
DCFFEEE4DCFFEEE4DCFFEEE4DCFFEEE4DCFFEEE4DCFFEEE4DCFFEEE5DCFFF0E6
DEFFE1D5C9FFB6A394FFFFFFFF00B7A596FFE0D5C6FFDDD2C3FFDDD1C2FFDDD1
C2FFDDD1C2FFDDD1C2FFDDD1C2FFDDD1C2FFDDD1C2FFDDD1C2FFDDD1C2FFDDD2
C3FFE0D5C6FFB7A596FFFFFFFF00AA998BC0B7A596FFB7A495FFB6A394FFB6A3
94FFB6A394FFB6A394FFB6A394FFB6A394FFB6A394FFB6A394FFB6A394FFB7A4
95FFB7A596FFB3A293E1FFFFFF00000000000000003300000033000000330000
0033000000330000003300000033000000330000003300000033000000330000
0033000000330000002CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F227F7F
7F597F7F7F667F7F7F667F7F7F667F7F7F667F7F7F667F7F7F667F7F7F597F7F
7F22FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007A7A7A5AE9E9
E9D3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE9E9E9D37A7A
7A5AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0074747468FDFD
FDFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFE3E3E3FFFDFDFDFF7474
7468FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006C6C6C69F9F9
F9FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFEBEBEBFF979797FFF9F9F9FF6C6C
6C69FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006464646AF6F6
F6FF8C8C8CFFE5E5E5FFF2F2F2FFE5E5E5FF8C8C8CFF8C8C8CFFF6F6F6FF6464
646AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005C5C5C6CF1F1
F1FF7C7C7CFF7C7C7CFFD0D0D0FF7C7C7CFF7C7C7CFFDFDFDFFFF1F1F1FF5C5C
5C6CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005252526DEEEE
EEFFD9D9D9FF6B6B6BFF6B6B6BFF6B6B6BFFD9D9D9FFE8E8E8FFEEEEEEFF5252
526DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004949496EEBEB
EBFFE3E3E3FFD3D3D3FF5C5C5CFFD3D3D3FFE3E3E3FFE3E3E3FFEBEBEBFF4949
496EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0038383862CCCC
CCD6E9E9E9FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE9E9E9FFCCCCCCD63838
3862FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00191919261515
1566151515751515157515151575151515751515157515151575151515661919
1926FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F227F7F
7F597F7F7F667F7F7F667F7F7F667F7F7F667F7F7F667F7F7F667F7F7F597F7F
7F22FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007A7A7A5AE9E9
E9D3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE9E9E9D37A7A
7A5AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0074747468FDFD
FDFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFDFDFDFF7474
7468FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006C6C6C69F9F9
F9FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF9F9F9FF6C6C
6C69FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006464646AF6F6
F6FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF2F2F2FFF6F6F6FF6464
646AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005C5C5C6CF1F1
F1FFEDEDEDFFEDEDEDFFEDEDEDFFEDEDEDFFEDEDEDFFEDEDEDFFF1F1F1FF5C5C
5C6CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005252526DEEEE
EEFFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFEEEEEEFF5252
526DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004949496EEBEB
EBFFE3E3E3FFE3E3E3FFE3E3E3FFE3E3E3FFE3E3E3FFE3E3E3FFEBEBEBFF4949
496EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0038383862CCCC
CCD6E9E9E9FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE9E9E9FFCCCCCCD63838
3862FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00191919261515
1566151515751515157515151575151515751515157515151575151515661919
1926FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00
}
end
end

View File

@ -0,0 +1,526 @@
unit mrtmain;
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}
interface
uses
{$IFDEF FPC}
FileUtil,
{$ELSE}
Windows, ImgList, {$IFDEF UNICODE}ImageList,{$ENDIF}
{$ENDIF}
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
ComCtrls, ExtCtrls,
fpeMetaData;
type
{ TMainForm }
TMainForm = class(TForm)
Bevel1: TBevel;
Bevel2: TBevel;
BtnReadFiles: TButton;
BtnCreateTxtFiles: TButton;
BtnRunTest: TButton;
BtnUncheckAll: TButton;
BtnCheckAll: TButton;
EdImageDir: TEdit;
StateImages: TImageList;
MismatchInfo: TLabel;
Memo: TMemo;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
FileTreeView: TTreeView;
Panel4: TPanel;
Panel5: TPanel;
Splitter1: TSplitter;
ImageList1: TImageList;
procedure BtnReadFilesClick(Sender: TObject);
procedure BtnRunTestClick(Sender: TObject);
procedure BtnCreateTxtFilesClick(Sender: TObject);
procedure BtnUncheckAllClick(Sender: TObject);
procedure FileTreeViewClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FTotalCount: Integer;
FMismatchCount: Integer;
function CreateRefTags(ANode: TTreeNode; AFileName: String): Boolean;
function ExtractRefTags(ANode: TTreeNode; AList: TStringList): Boolean;
function GetImageDir: String;
procedure Log(AMsg: String);
procedure RunTest(ANode: TTreeNode);
public
end;
var
MainForm: TMainForm;
implementation
{$IFDEF FPC}
{$R *.lfm}
{$ELSE}
{$R *.dfm}
{$ENDIF}
uses
{$IFDEF FPC}
Process, StrUtils,
{$ELSE}
ShellApi,
{$ENDIF}
fpeGlobal, fpeUtils, fpeTags, fpeExifData;
{ TMainForm }
const
EXIFTOOL_CMD = '..\..\tools\exiftool.exe';
IMG_INDEX_WORKING = 0;
IMG_INDEX_FAIL = 1;
IMG_INDEX_IGNORE = 1;
IMG_INDEX_EXIF = 2;
IMG_INDEX_SUCCESS = 3;
IMG_UNCHECKED = 2; //0;
IMG_CHECKED = 1;
{ Finds all image files in the image folder (--> GetImageDir). For every image
there is a text file containing the meta data written by ExifTool. Reads this
reference file and stores the meta data in the nodes af the FileTreeView. }
procedure TMainForm.BtnReadFilesClick(Sender: TObject);
var
info: TSearchRec;
imgDir: String;
node: TTreeNode;
tagFile: String;
L: TStringList;
s: String;
begin
FileTreeView.Items.Clear;
imgDir := GetImageDir;
if FindFirst(imgDir + '*.jpg', faAnyFile and faDirectory, info) = 0 then
begin
repeat
if (info.Name <> '.') and (info.Name <> '..') and (info.Attr and faDirectory = 0) then
begin
node := FileTreeview.Items.AddChild(nil, ExtractFileName(info.Name));
node.ImageIndex := IMG_INDEX_IGNORE;
tagFile := ChangeFileExt(imgDir + info.Name, '.txt');
if FileExists(tagFile) then
begin
L := TStringList.Create;
try
L.LoadFromFile(tagFile);
// Note: ExifTool wrote the file in UTF8 --> We must convert this for Delphi
{$IFNDEF FPC}
{$IFDEF UNICODE}
L.Text := UTF8Decode(L.Text);
{$ELSE}
s := L.Text;
// s := UTF8Decode(s);
s := fpeUtils.UTF8ToAnsi(s);
L.Text := s;
{$ENDIF}
{$ENDIF}
if ExtractRefTags(node, L) then begin
node.ImageIndex := IMG_INDEX_EXIF;
node.StateIndex := IMG_CHECKED;
end;
finally
L.Free;
end;
end;
node.SelectedIndex := node.ImageIndex;
end;
until FindNext(info) <> 0;
end;
FindClose(info);
end;
procedure TMainForm.BtnRunTestClick(Sender: TObject);
var
node: TTreeNode;
begin
Memo.Lines.Clear;
FMismatchCount := 0;
FTotalCount := 0;
node := FileTreeView.Items.GetFirstNode;
while node <> nil do begin
RunTest(node);
node := node.GetNextSibling;
end;
MismatchInfo.Caption := Format('%d mismatches out of %d tests (%.0f%%)', [
FMismatchCount, FTotalCount, FMismatchCount/FTotalCount*100]);
MismatchInfo.Show;
end;
procedure TMainForm.BtnUncheckAllClick(Sender: TObject);
var
node: TTreeNode;
checkNode: Boolean;
begin
checkNode := (Sender = BtnCheckAll);
node := FileTreeView.Items.GetFirstNode;
while node <> nil do begin
if checkNode and (node.StateIndex = IMG_UNCHECKED) then
node.StateIndex := IMG_CHECKED
else if not checkNode and (node.StateIndex = IMG_CHECKED) then
node.StateIndex := IMG_UNCHECKED;
node := node.GetNextSibling;
end;
end;
procedure TMainForm.BtnCreateTxtFilesClick(Sender: TObject);
var
imgDir: String;
node: TTreeNode;
begin
if not FileExists(EXIFTOOL_CMD) then
begin
MessageDlg(Format('Program "ExifTool" not found in folder "%s".', [
ExtractFileDir(ExpandFilename(EXIFTOOL_CMD))
]), mtError, [mbOK], 0
);
exit;
end;
imgDir := GetImageDir;
node := FileTreeView.Items.GetFirstNode;
while (node <> nil) do begin
node.DeleteChildren;
node.ImageIndex := -1;
node := node.GetNextSibling;
end;
node := FileTreeView.Items.GetFirstNode;
while (node <> nil) do begin
node.ImageIndex := IMG_INDEX_WORKING;
Application.ProcessMessages;
if not CreateRefTags(node, imgDir + node.Text) then begin
node.ImageIndex := IMG_INDEX_IGNORE;
end else
node.ImageIndex := IMG_INDEX_EXIF;
node.SelectedIndex := node.ImageIndex;
node := node.GetNextSibling;
end;
end;
function TMainForm.CreateRefTags(ANode: TTreeNode; AFileName: String): Boolean;
var
destFile: String;
output: String;
L: TStringList;
{$IFNDEF FPC}
params: String;
res: Integer;
s: String;
const
DEG_SYMBOL: ansistring = #176;
{$ENDIF}
begin
Result := false;
destFile := ChangeFileExt(AFileName, '.txt');
{$IFDEF FPC}
if RunCommand(EXIFTOOL_CMD, ['-a', '-H', '-s', '-G', '-c', '"%d° %d'' %.2f"\"', AFileName], output) then
// -a ... extract all tags, also duplicates.
// -H ... extract hex tag id if possible
// -s ... short tag name (hopefully this is the dExif tag name)
// -G ... print group name for each tag
// -c ... format for GPS coordinates
begin
if (output = '') then
exit;
L := TStringList.Create;
try
L.Text := output;
if ExtractReftags(ANode, L) then
ANode.ImageIndex := IMG_INDEX_EXIF else
ANode.ImageIndex := IMG_INDEX_IGNORE;
ANode.SelectedIndex := ANode.ImageIndex;
L.SaveToFile(destFile);
Result := true;
finally
L.Free;
end;
end;
{$ELSE}
// params := '/c ' + EXIFTOOL_CMD + ' -a -H -s -G -c "%d' + DEG_SYMBOL + ' %d'' %.2f"\"' + AFileName + ' > ' + destFile;
params := '/c ' + EXIFTOOL_CMD + ' -a -H -s -G -c "%d° %d'' %.2f"\"' + AFileName + ' > ' + destFile;
res := ShellExecute(Application.Handle, 'open', PChar('cmd'), PChar(params), '', SW_HIDE);
if (res <= 32) or not FileExists(destFile) then
exit;
L := TStringList.Create;
try
L.LoadFromFile(destFile);
// Note: ExifTool wrote the file in UTF8 --> We must convert this for Delphi
{$IFDEF UNICODE}
L.Text := UTF8Decode(L.Text);
{$ELSE}
s := UTF8ToAnsi(L.Text);
L.Text := s;
{$ENDIF}
if ExtractRefTags(ANode, L) then
ANode.ImageIndex := IMG_INDEX_EXIF else
ANode.ImageIndex := IMG_INDEX_IGNORE;
ANode.SelectedIndex := ANode.ImageIndex;
Result := true;
finally
L.Free;
end;
{$ENDIF}
end;
function TMainForm.ExtractRefTags(ANode: TTreeNode; AList: TStringList): Boolean;
const
GROUP_START = 1;
GROUP_LEN = 15;
TAGID_START = 19;
TAGID_LEN = 4;
NAME_START = 24;
NAME_LEN = 32;
VALUE_START = 58;
var
i: Integer;
p: Integer;
s: String;
sGroup: String;
sTagID: String;
sTagName: String;
sTagValue: String;
tagID: Word;
node: TTreeNode;
begin
Result := false;
for i:=0 to AList.Count-1 do begin
s := AList[i];
sGroup := trim(Copy(s, GROUP_START, GROUP_LEN));
sTagID := trim(Copy(s, TAGID_START, TAGID_LEN));
sTagName := trim(Copy(s, NAME_START, NAME_LEN));
sTagValue := trim(Copy(s, VALUE_START, MaxInt));
if sTagID = '-' then
Continue;
// So far, consider only EXIF-Tag
if sGroup <> '[EXIF]' then
Continue;
tagID := StrToInt('$' + sTagID);
node := ANode.Owner.AddChild(ANode, sTagName + ': ' + sTagValue);
node.Data := Pointer(PtrInt(tagID));
end;
Result := ANode.Count > 0;
end;
procedure TMainForm.FileTreeViewClick(Sender: TObject);
var
P: TPoint;
ht: THitTests;
node: TTreeNode;
begin
P := FileTreeView.ScreenToClient(Mouse.CursorPos);
ht := FileTreeView.GetHitTestInfoAt(P.X, P.Y);
if htOnStateIcon in ht then begin
node := FileTreeView.GetNodeAt(P.X, P.Y);
if node.StateIndex = IMG_CHECKED then
node.StateIndex := IMG_UNCHECKED else
node.StateIndex := IMG_CHECKED;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
fpExifFmtSettings.ListSeparator := ' ';
if EdImageDir.Text <> '' then
BtnReadFilesClick(nil);
end;
function TMainForm.GetImageDir: String;
begin
Result := IncludeTrailingPathDelimiter(ExpandFilename(EdImageDir.Text));
Caption := Result;
end;
procedure TMainForm.Log(AMsg: String);
begin
Memo.Lines.Add(AMsg);
Memo.SelStart := Length(Memo.Lines.Text);
end;
{ Loads the image file represented by the specified node, reads the meta data,
and compares with the reference file. }
procedure TMainForm.RunTest(ANode: TTreeNode);
const
{$IFDEF FPC}
GPS_MASK = '%0:.0f° %1:.0f'' %2:.2f"';
{$ELSE}
{$IFDEF UNICODE}
GPS_MASK = '%0:.0f° %1:.0f'' %2:.2f"';
{$ELSE}
GPS_MASK = '%0:.0f'#176' %1:.0f'' %2:.2f"';
{$ENDIF}
{$ENDIF}
var
imgInfo: TImgInfo;
tagName: String;
uctagname: String;
expectedTagValue: String;
currTagValue: String;
s: String;
p: Integer;
node: TTreeNode;
tagID: TTagID;
lTag: TTag;
lTagDef: TTagDef;
// v: Variant;
offs: Int64;
localMismatchCount: Integer;
begin
if ANode.StateIndex = IMG_UNCHECKED then
exit;
if ANode.Count = 0 then begin
Log('Skipping image "' + ANode.Text + '":');
Log(' No EXIF data found by ExifTool.');
Log('');
exit;
end;
localMismatchCount := 0;
Log('Testing image "' + ANode.Text + '":');
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(GetImageDir + ANode.Text);
if not imgInfo.HasExif then begin
Log('Skipping "' + ANode.Text + '":');
Log(' No EXIF data found by fpExif.');
Log('');
exit;
end;
node := ANode.GetFirstChild;
while node <> nil do begin
s := node.Text;
p := pos(':', s);
if p = 0 then begin
node := node.GetNextSibling;
Log(' Skipping tag "' + s + '": Has no value');
continue;
end;
tagName := trim(Copy(s, 1, p-1));
uctagName := Uppercase(tagName);
lTagDef := FindExifTagDefWithoutParent(PtrInt(node.Data));
if lTagDef = nil then begin
Log(' Skipping tag "' + tagName + '": tag definition not found.');
node := node.GetNextSibling;
Continue;
end;
tagID := lTagDef.TagID;
if (tagID = TAGPARENT_EXIF + $EA1C) then begin // "Padding"
Log(Format(' Skipping tag "%s" ($%.4x): no useful data', [tagName, TTagIDRec(tagID).Tag]));
node := node.GetNextSibling;
Continue;
end;
lTag := imgInfo.ExifData.FindTagByID(tagID);
if lTag = nil then begin
Log(Format('Tag "%s% (ID $%.04x) not found.', [tagName, TTagIDRec(tagID).Tag]));
node := node.GetNextSibling;
continue;
end;
// Modify fpExif's tag format to match that used by ExifTool.
case lTag.TagID of
TAGPARENT_GPS + $0000: // GPSVersionID
lTag.ListSeparator := '.';
TAGPARENT_EXIF + $9102, // CompressedBitsPerPixel
TAGPARENT_EXIF + $A20E, // FocalPlaneXResolution
TAGPARENT_EXIF + $A20F: // FocalPlaneYResolution
if lTag is TFloatTag then TFloatTag(lTag).FormatStr := '%2:.3f';
TAGPARENT_EXIF + $A405: // FocalLengthIn35mmFilm
if lTag is TIntegerTag then TFloatTag(lTag).FormatStr := '%d mm';
else
if lTag is TDateTimeTag then
TDateTimeTag(lTag).FormatStr := EXIF_DATETIME_FORMAT
else
if lTag is TGpsPositionTag then
TGpsPositionTag(lTag).FormatStr := GPS_MASK
else
if ltag is TExposureTimeTag then
TExposureTimeTag(ltag).FormatStr := '1/%.0f;%.0f' // to do: use rational values
else
if (lTag is TFloatTag) and
((ucTagName = 'FNUMBER') or (pos('APERTURE', ucTagName) > 0))
then
TFloatTag(lTag).FormatStr := '%2:.1f';
end;
currTagValue := trim(lTag.AsString);
expectedTagvalue := Copy(s, p+1, MaxInt);
p := pos(' -->', expectedTagValue);
if p > 0 then SetLength(expectedTagValue, p);
expectedTagValue := trim(expectedTagValue);
case lTag.TagID of
TAGPARENT_INTEROP + $0001: // InteropIndex
if pos('INTEROP', ucTagName) <> 0 then
expectedTagValue := FirstWord(expectedTagValue);
TAGPARENT_EXIF + $9101: // ComponentsConfiguration
expectedTagValue := LettersOnly(expectedTagValue);
TAGPARENT_EXIF + $9102, // CompressedBitsPerPixel
TAGPARENT_EXIF + $A20E, // FocalPlaneXResolution
TAGPARENT_EXIF + $A20F: // FocalPlaneYResolution
expectedTagValue := Format('%.3f', [StrToFloat(expectedTagValue, fpExifFmtSettings)], fpExifFmtSettings);
else
if (lTag is TIntegerTag) and (pos(';', currTagValue) > 0) then
// currTagValue := ReplaceText(currTagValue, ';', ',')
currTagValue := StringReplace(currTagValue, ';', ',', [rfReplaceAll])
else
if (lTag is TOffsetTag) then begin
offs := StrToInt(currTagValue);
currTagValue := IntToStr(offs + TOffsetTag(lTag).TiffHeaderOffset);
end;
end;
if SameText(expectedTagValue, currTagValue) then
node.ImageIndex := IMG_INDEX_SUCCESS
else begin
Log(' Tag mismatch "' + Format('[$%.4x] %s', [TTagIDRec(tagID).Tag, tagName]) + '"');
Log(' expected: ' + expectedTagValue);
Log(' found: ' + currTagValue);
node.ImageIndex := IMG_INDEX_FAIL;
node.Text := tagname + ': ' + expectedTagValue + ' --> found: ' + currTagValue;
inc(FMismatchCount);
inc(localMismatchCount);
end;
node.SelectedIndex := node.ImageIndex;
node := node.GetNextSibling;
inc(FTotalCount);
end;
if localMismatchCount = 0 then
Log(' All tags matching');
finally
Log('');
imgInfo.Free;
end;
FileTreeView.Invalidate;
end;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 32 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.0 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.5 KiB

View File

@ -0,0 +1,39 @@
-$A8
-$B-
-$C-
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$Y+
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$42200000
-N"D:\Prog_Lazarus\wp-laz\fpexif\tests\readwrite\output\dcu\Delphi7"
-LE"d:\programme\borland\delphi7\Projects\Bpl"
-LN"d:\programme\borland\delphi7\Projects\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

View File

@ -0,0 +1,151 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=0
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=2
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=1109393408
ExeDescription=TeeChart 2014 Components
[Directories]
OutputDir=
UnitOutputDir=D:\Prog_Lazarus\wp-laz\fpexif\tests\readwrite\output\dcu\Delphi7
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=Tee97;TeeUI97;TeeDB97;TeePro97;TeeGL97;TeeImage97;TeeLanguage97;TeeWorld97
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=D:\Programme\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=9
MinorVer=0
Release=11
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=ReadWriteTest
FileVersion=9.0.11.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=ReadWriteTest
ProductVersion=1.0.0.0
ProgramID=com.embarcadero.ReadWriteTest
[Excluded Packages]
D:\Prog_Delphi\common\Components\3rdParty\TeeChart\Sources\Compiled\Delphi7\Bin\DclTeeMaker17.bpl=TeeMaker
D:\Programme\Borland\Delphi7\Lib\HelpCtxD7.bpl=HelpScribble HelpContext Property Editor for Delphi 7
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=1
Item0=D:\Prog_Lazarus\git\dexif-afriess-master
[HistoryLists\hlUnitOutputDirectory]
Count=4
Item0=D:\Prog_Lazarus\wp-laz\fpexif\tests\readwrite\output\dcu\Delphi7
Item1=D:\Prog_Lazarus\wp-laz\fpexif\tests\readwrite\output\tpu\Delphi7
Item2=D:\Prog_Lazarus\wp-laz\fpexif\output\tpu\D7
Item3=D:\Prog_Lazarus\wp-laz\fpexif\output\ppu\D7

View File

@ -0,0 +1,25 @@
program ReadWriteTest_D7;
uses
Forms,
rwMain in 'common\rwMain.pas',
fpeGlobal in '..\..\fpeglobal.pas',
fpeExifReadWrite in '..\..\fpeexifreadwrite.pas',
fpeTags in '..\..\fpetags.pas',
fpeUtils in '..\..\fpeutils.pas',
fpeMetadata in '..\..\fpemetadata.pas',
fpeIptcReadWrite in '..\..\fpeiptcreadwrite.pas',
fpeexifdata in '..\..\fpeexifdata.pas',
fpeIptcData in '..\..\fpeiptcdata.pas',
fpeMakerNote in '..\..\fpemakernote.pas',
fpeStrConsts in '..\..\fpestrconsts.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
MainForm.BeforeRun;
Application.Run;
end.

Binary file not shown.

View File

@ -0,0 +1,25 @@
program ReadWriteTest_Delphi;
uses
Forms,
rwMain in 'common\rwMain.pas',
fpeexifreadwrite in '..\..\fpeexifreadwrite.pas',
fpeglobal in '..\..\fpeglobal.pas',
fpetags in '..\..\fpetags.pas',
fpemetadata in '..\..\fpemetadata.pas',
fpeexifdata in '..\..\fpeexifdata.pas',
fpeiptcdata in '..\..\fpeiptcdata.pas',
fpeiptcreadwrite in '..\..\fpeiptcreadwrite.pas',
fpemakernote in '..\..\fpemakernote.pas',
fpestrconsts in '..\..\fpestrconsts.pas',
fpeutils in '..\..\fpeutils.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
MainForm.BeforeRun;
Application.Run;
end.

View File

@ -0,0 +1,141 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{6C35BA62-BF64-4BCB-8BAA-3B554EC4D396}</ProjectGuid>
<MainSource>ReadWriteTest_Delphi.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_UnitSearchPath>D:\Prog_Lazarus\git\dexif-afriess-master;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_F>false</DCC_F>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<DCC_E>false</DCC_E>
<VerInfo_MajorVer>9</VerInfo_MajorVer>
<DCC_ImageBase>42200000</DCC_ImageBase>
<SanitizedProjectName>ReadWriteTest_Delphi</SanitizedProjectName>
<DCC_N>true</DCC_N>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
<DCC_UsePackage>Tee97;TeeUI97;TeeDB97;TeePro97;TeeGL97;TeeImage97;TeeLanguage97;TeeWorld97;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_S>false</DCC_S>
<VerInfo_Keys>CompanyName=Steema Software;FileDescription=;FileVersion=9.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=9.0.0.0</VerInfo_Keys>
<DCC_K>false</DCC_K>
<VerInfo_Release>11</VerInfo_Release>
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_AssertionsAtRuntime>false</DCC_AssertionsAtRuntime>
<DCC_Description>TeeChart 2014 Components</DCC_Description>
<DCC_DcuOutput>D:\Prog_Lazarus\wp-laz\fpexif\tests\readwrite\output\dcu\Delphi\</DCC_DcuOutput>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<VerInfo_Locale>1033</VerInfo_Locale>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<Icon_MainIcon>Delphi\ReadWriteTest_Icon.ico</Icon_MainIcon>
<VerInfo_Keys>CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<AppEnableHighDPI>true</AppEnableHighDPI>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<Icon_MainIcon>Delphi\Delphi\ReadWriteTest_Icon.ico</Icon_MainIcon>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Optimize>false</DCC_Optimize>
<DCC_RangeChecking>true</DCC_RangeChecking>
<DCC_IntegerOverflowCheck>true</DCC_IntegerOverflowCheck>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<VerInfo_Keys>CompanyName=;FileVersion=9.0.11.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<AppEnableHighDPI>true</AppEnableHighDPI>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="common\rwMain.pas"/>
<DCCReference Include="..\..\fpeexifreadwrite.pas"/>
<DCCReference Include="..\..\fpeglobal.pas"/>
<DCCReference Include="..\..\fpetags.pas"/>
<DCCReference Include="..\..\fpemetadata.pas"/>
<DCCReference Include="..\..\fpeexifdata.pas"/>
<DCCReference Include="..\..\fpeiptcdata.pas"/>
<DCCReference Include="..\..\fpeiptcreadwrite.pas"/>
<DCCReference Include="..\..\fpemakernote.pas"/>
<DCCReference Include="..\..\fpestrconsts.pas"/>
<DCCReference Include="..\..\fpeutils.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">ReadWriteTest_Delphi.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

View File

@ -0,0 +1,139 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="ReadWriteTest_Laz"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="14">
<Unit0>
<Filename Value="ReadWriteTest_Laz.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="common\rwmain.lfm"/>
<IsPartOfProject Value="True"/>
</Unit1>
<Unit2>
<Filename Value="common\rwMain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit2>
<Unit3>
<Filename Value="..\..\fpeglobal.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeGlobal"/>
</Unit3>
<Unit4>
<Filename Value="..\..\fpeutils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeUtils"/>
</Unit4>
<Unit5>
<Filename Value="..\..\fpeexifreadwrite.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeExifReadWrite"/>
</Unit5>
<Unit6>
<Filename Value="..\..\fpetags.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeTags"/>
</Unit6>
<Unit7>
<Filename Value="..\..\fpexif_fpc.inc"/>
<IsPartOfProject Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\..\fpeexifdata.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeExifData"/>
</Unit8>
<Unit9>
<Filename Value="..\..\fpeiptcdata.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeIptcData"/>
</Unit9>
<Unit10>
<Filename Value="..\..\fpeiptcreadwrite.pas"/>
<IsPartOfProject Value="True"/>
</Unit10>
<Unit11>
<Filename Value="..\..\fpemakernote.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeMakerNote"/>
</Unit11>
<Unit12>
<Filename Value="..\..\fpemetadata.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeMetadata"/>
</Unit12>
<Unit13>
<Filename Value="..\..\fpestrconsts.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeStrConsts"/>
</Unit13>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="ReadWriteTest_Laz"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir);..\.."/>
<OtherUnitFiles Value="common;..\.."/>
<UnitOutputDirectory Value="output\ppu\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<VerifyObjMethodCallValidity Value="True"/>
</CodeGeneration>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,19 @@
program ReadWriteTest_Laz;
{$mode objfpc}{$H+}
uses
Interfaces, // this includes the LCL widgetset
Forms,
rwMain;
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
MainForm.BeforeRun;
Application.Run;
end.

View File

@ -0,0 +1,308 @@
object MainForm: TMainForm
Left = 329
Top = 127
Width = 1041
Height = 620
Caption = 'EXIF read/write test'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
OnCreate = FormCreate
OnDestroy = FormDestroy
DesignSize = (
1025
581)
PixelsPerInch = 96
TextHeight = 13
object BtnTest1: TSpeedButton
Left = 916
Top = 8
Width = 48
Height = 22
Anchors = [akTop, akRight]
Caption = 'Test 1'
OnClick = BtnTest1Click
end
object BtnTest2: TSpeedButton
Left = 969
Top = 8
Width = 48
Height = 22
Anchors = [akTop, akRight]
Caption = 'Test 2'
OnClick = BtnTest1Click
end
object BtnBrowse: TSpeedButton
Left = 888
Top = 8
Width = 23
Height = 22
Anchors = [akTop, akRight]
Caption = '...'
OnClick = BtnBrowseClick
end
object Panel1: TPanel
Left = 8
Top = 40
Width = 1009
Height = 482
Anchors = [akLeft, akTop, akRight, akBottom]
BevelOuter = bvNone
TabOrder = 0
object Splitter1: TSplitter
Left = 730
Top = 0
Width = 5
Height = 482
Align = alRight
end
object ListView: TListView
Left = 0
Top = 0
Width = 730
Height = 482
Align = alClient
Columns = <
item
AutoSize = True
Caption = 'Tag/property'
end
item
AutoSize = True
Caption = 'Current value'
end
item
AutoSize = True
Caption = 'Value to be written'
end
item
Caption = 'Value read-back'
Width = 441
end>
SmallImages = ImageList1
TabOrder = 0
ViewStyle = vsReport
end
object ExifTabControl: TTabControl
Left = 735
Top = 0
Width = 274
Height = 482
Align = alRight
TabOrder = 1
Tabs.Strings = (
'Original file'
'Modified')
TabIndex = 0
OnChange = ExifTabControlChange
object ExifListView: TListView
Left = 4
Top = 24
Width = 266
Height = 454
Align = alClient
Columns = <
item
Caption = 'Tag name'
Width = 120
end
item
Caption = 'Value'
Width = 146
end>
RowSelect = True
TabOrder = 0
ViewStyle = vsReport
end
end
end
object Panel2: TPanel
Left = 0
Top = 520
Width = 1025
Height = 61
Align = alBottom
AutoSize = True
BevelOuter = bvNone
BorderWidth = 8
TabOrder = 1
object Label1: TLabel
Left = 8
Top = 8
Width = 1009
Height = 45
Align = alClient
Caption =
'Buttons "Test 1" and "Test 2" read test conditions from files "t' +
'estcases1.txt" and "testcases2.txt", respectively.'#13#10'- Test value' +
's expressed as fractions (e.g. exposure times) are evaluated by ' +
'the program.'#13#10'- Enumerated values can be shown by their index, o' +
'r by their text followd by | and their index.'
Color = clBtnFace
ParentColor = False
end
end
object CbTestfile: TComboBox
Left = 8
Top = 8
Width = 872
Height = 21
Anchors = [akLeft, akTop, akRight]
ItemHeight = 13
TabOrder = 2
end
object ImageList1: TImageList
Left = 400
Top = 117
Bitmap = {
494C010102000800140010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000001000000001002000000000000010
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000317A360A2D753207000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000003F3D
ED413B38EB08000000000000000000000000000000000000000000000000211F
E3081E1CE2410000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00003985400A37833DFF317B37FB2E7633070000000000000000000000000000
00000000000000000000000000000000000000000000000000004A47F0414F4C
F2FF403EEDFD3C39EB08000000000000000000000000000000002725E5082422
E4FC312FEAFF1F1DE24100000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000004292
490A408E47FF54A35CFF4F9F57FF327C38FE2E77340800000000000000000000
000000000000000000000000000000000000000000005451F3415856F5FF6361
FAFF5855F6FF413FEDFC3D3AEC080000000000000000302DE7082C2AE6FC413F
F1FF4C4AF6FF312FEAFF1F1DE241000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000004B9E530A499A
51FF5BAC64FF77CA82FF74C87EFF51A059FF337D39FE2F783508000000000000
000000000000000000000000000000000000000000005956F52B5B58F6FF6562
FAFF7170FFFF5956F6FF4240EEFC3E3BEC083937EB083532E9FC4745F2FF6362
FFFF4A48F4FF2F2DE9FF2220E32B000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000053A95C0A51A65AFF63B5
6DFF7ECE89FF7BCC87FF76CA81FF76C981FF52A25AFF347E3AFE307935080000
00000000000000000000000000000000000000000000000000005A57F52B5B59
F6FF6663FAFF7471FFFF5A58F6FF4341EEFC3E3CECFD504DF4FF6867FFFF504E
F5FF3634EBFF2A27E52B00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000005AB4650959B063FF6BBD76FF84D2
90FF7AC985FF60B26AFF63B46DFF78C983FF78CB82FF53A35CFF347F3AFD317A
3608000000000000000000000000000000000000000000000000000000005B58
F62B5C5AF6FF6764FAFF7472FFFF7370FFFF706EFFFF6E6CFFFF5755F7FF3F3D
EEFF3230E82B0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000005EB969465BB566E479C986FF80CE
8DFF51A65AFC4DA1566F499C518B5CAD67FF7CCC86FF79CB85FF54A45DFF3580
3BFC317B37080000000000000000000000000000000000000000000000000000
00005C59F62B5D5BF7FF7976FFFF5956FFFF5754FFFF7270FFFF4846F0FF3C39
EB2B000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000005FBA6A3C5CB666E66DC0
79FF55AC5F6F00000000000000004A9D52915EAE68FF7DCD89FF7CCD87FF56A5
5FFF36813CFC327C380800000000000000000000000000000000000000000000
0000615EF8085D5AF6FD7D79FFFF5E5BFFFF5B58FFFF7674FFFF4643EFFD413F
ED08000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000005FBB6A435CB7
6765000000000000000000000000000000004B9E53915FAF69FF7FCE8AFF7ECE
89FF57A660FF37823DFC337D3908000000000000000000000000000000006967
FB086663F9FC706DFBFF807EFFFF7E7BFFFF7C79FFFF7977FFFF5E5CF7FF4744
EFFC4240EE080000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000004B9F549160B06AFF81CF
8DFF7FCF8BFF58A761FF398540FF347E3A080000000000000000716EFD086E6B
FCFC7774FDFF8682FFFF7673FCFF6462F8FF605DF7FF6D6AFAFF7B79FFFF605D
F7FF4845EFFC4341EE0800000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000004CA0559162B2
6CFF82D18FFF7AC885FF57A660FF38843F7B000000007673FF087471FEFD7D7A
FEFF8A87FFFF7C79FDFF6C69FBFF6361F92B5F5CF72B615EF8FF6E6CFAFF7D7A
FFFF615FF7FF4946F0FC4441EE05000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000004DA1
569163B36DFF5FAF69FF4191497900000000000000007774FF1F7A77FFFF817E
FFFF817EFEFF7471FDFF6C69FB2B0000000000000000605DF72B625FF8FF6F6D
FBFF7E7CFFFF625FF8FF4A47F06F4542EE020000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00004EA257914A9D527F000000000000000000000000000000007774FF1F7A77
FFFF7976FEFF726FFD2B00000000000000000000000000000000615EF82B6461
F8FF6A68F9FF5451F3A84F4DF229000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000007774
FF1F7774FF2B000000000000000000000000000000000000000000000000625F
F82B5D5BF76F5956F53E00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006360F80A0000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000424D3E000000000000003E000000
2800000040000000100000000100010000000000800000000000000000000000
000000000000000000000000FFFFFF00FFFFFFFF00000000F9FFE7E700000000
F0FFC3C300000000E07F818100000000C03F800100000000801FC00300000000
000FE007000000000007F00F000000008603F00F00000000CF01E00700000000
FF80C00300000000FFC0800100000000FFE1818000000000FFF3C3C100000000
FFFFE7E300000000FFFFFFF70000000000000000000000000000000000000000
000000000000}
end
object OpenDialog: TOpenDialog
DefaultExt = '.*.jpg'
Filter = 'JPEG files (*.jpg; *.jpeg)|*.jpg;*.jpeg'
Title = 'Open image file'
Left = 400
Top = 178
end
end

View File

@ -0,0 +1,630 @@
unit rwMain;
{$I ..\..\..\fpExif.inc}
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
interface
uses
{$IFDEF FPC}
LazUtf8,
{$ELSE}
Windows, Messages, ImgList, jpeg,
{$IFDEF UNICODE}
System.ImageList,
{$ENDIF}
{$ENDIF}
Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ComCtrls, ExtCtrls, Variants,
fpeGlobal, fpeTags, fpeMetadata;
type
{ TMainForm }
TMainForm = class(TForm)
BtnTest1: TSpeedButton;
BtnTest2: TSpeedButton;
CbTestfile: TComboBox;
ImageList1: TImageList;
Label1: TLabel;
ListView: TListView;
OpenDialog: TOpenDialog;
Panel1: TPanel;
Panel2: TPanel;
ExifListView: TListView;
ExifTabControl: TTabControl;
BtnBrowse: TSpeedButton;
Splitter1: TSplitter;
procedure CbTestfileEditingDone(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure BtnTest1Click(Sender: TObject);
procedure ExifTabControlChange(Sender: TObject);
procedure BtnBrowseClick(Sender: TObject);
private
ImgInfo: TImgInfo;
OutFile: String;
procedure ExecTest(const AParamsFile: String);
procedure ExifToListview(AImgInfo: TImgInfo; AListView: TListView);
function ReadTagValue(ATagName: String; out ATag: TTag): String; overload;
function ReadTagValue(ATagName: String): String; overload;
function Success(ATag: TTag; ACurrValue, AExpectedValue: String): Boolean;
procedure WriteTagValue(ATagName, ATagValue: String);
procedure AddToHistory(AFilename: String);
procedure ReadFromIni;
procedure WriteToIni;
public
procedure BeforeRun;
end;
var
MainForm: TMainForm;
implementation
{$IFDEF FPC}
{$R *.lfm}
{$ELSE}
{$R *.dfm}
{$ENDIF}
uses
StrUtils, Math, IniFiles,
fpeUtils, fpeExifData;
const
IMGINDEX_SUCCESS = 0;
IMGINDEX_FAIL = 1;
TESTCASES_DIR = 'common\';
type
TStringArray = array of string;
function Split(s: String; AMinCount: Integer; Separator: Char = #9): TStringArray;
const
BLOCK_SIZE = 20;
var
i, j, n, L: Integer;
begin
if s = '' then begin
SetLength(Result, 0);
exit;
end;
s := s + Separator;
L := Length(s);
SetLength(Result, BLOCK_SIZE);
i := 1;
j := 1;
n := 0;
while (i <= L) do begin
if (s[i] = Separator) or (i = L) then begin
Result[n] := Copy(s, j, i-j);
inc(n);
if n mod BLOCK_SIZE = 0 then
SetLength(Result, Length(Result) + BLOCK_SIZE);
j := i+1;
end;
inc(i);
end;
while n < AMinCount do begin
Result[n] := '';
inc(n);
if n mod BLOCK_SIZE = 0 then
SetLength(Result, Length(Result) + BLOCK_SIZE);
end;
SetLength(Result, n);
end;
{ The date/time string is expected in the ISO format "yyyy-mm-dd hh:nn:ss" }
function ExtractDateTime(AValue: String): TDateTime;
var
p: Integer;
yr, mn, dy, h, m, s: Integer;
begin
Result := 0;
p := pos('-', AValue);
if p = 0 then
raise Exception.Create('ISO date/time format expected: "yyyy-mm-dd hh:nn:ss"');
yr := StrToInt(copy(AValue, 1, p-1));
Delete(AValue, 1, p);
p := pos('-', AValue);
if p = 0 then
raise Exception.Create('ISO date/time format expected: "yyyy-mm-dd hh:nn:ss"');
mn := StrToInt(copy(AValue, 1, p-1));
Delete(AValue, 1, p);
p := pos(' ', AValue);
if p = 0 then begin
dy := StrToInt(AValue);
Result := EncodeDate(yr, mn, dy);
exit;
end;
dy := StrToInt(copy(AValue, 1, p-1));
Delete(AValue, 1, p);
p := pos(':', AValue);
if p = 0 then
raise Exception.Create('ISO date/time format expected: "yyyy-mm-dd hh:nn:ss"');
h := StrToInt(copy(AValue, 1, p-1));
Delete(AValue, 1, p);
p := pos(':', AValue);
if p = 0 then begin
m := StrToInt(AValue);
s := 0;
end else begin
m := StrToInt(copy(AValue, 1, p-1));
s := StrToInt(copy(AValue, p+1, MaxInt));
end;
Result := EncodeDate(yr, mn, dy) + EncodeTime(h, m, s, 0);
end;
function DecimalSep: Char;
begin
{$IFDEF FPC}
Result := FormatSettings.DecimalSeparator;
{$ELSE}
{$IFDEF VER150} // Delphi 7
Result := DecimalSeparator;
{$ELSE}
Result := FormatSettings.DecimalSeparator;
{$ENDIF}
{$ENDIF}
end;
function CleanFloatStr(AText: String): String;
var
i: Integer;
begin
Result := '';
i := 1;
while i <= Length(AText) do begin
// case aperture value, e.g. "F/2.8"
if (i < Length(AText)) and (AText[i] in ['f', 'F']) and (AText[i+1] = '/') then
inc(i)
else
if AText[i] in ['0'..'9', '.', '/'] then
Result := Result + AText[i]
else if AText[i] = ',' then
Result := Result + '.';
inc(i);
end;
end;
{ TMainForm }
procedure TMainForm.AddToHistory(AFileName: String);
var
i: Integer;
begin
if (AFileName = '') or (not FileExists(AFileName)) then
exit;
i := CbTestFile.Items.Indexof(AFileName);
if i > -1 then
CbTestfile.Items.Delete(i);
CbTestFile.Items.Insert(0, AFileName);
CbTestFile.ItemIndex := 0;
end;
procedure TMainForm.BeforeRun;
begin
ReadFromIni;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
ImgInfo := TImgInfo.Create;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
WriteToIni;
ImgInfo.Free;
end;
procedure TMainForm.BtnTest1Click(Sender: TObject);
begin
AddToHistory(CbTestFile.Text);
if Sender = BtnTest1 then
ExecTest(TESTCASES_DIR + 'testcases1.txt')
else if Sender = BtnTest2 then
ExecTest(TESTCASES_DIR + 'testcases2.txt')
else
raise Exception.Create('BtnTextClick: Unexpected Sender');
end;
procedure TMainForm.CbTestfileEditingDone(Sender: TObject);
begin
AddToHistory(CbTestFile.Text);
end;
procedure TMainForm.ExecTest(const AParamsFile: String);
var
testCases: TStringList;
i, j, n, p: Integer;
s: String;
testdata: TStringArray;
listitem: TListItem;
lTag: TTag;
tagName: String;
currTagValue: String;
newTagValue: String;
newTagValues: TStringArray;
jpeg: TJpegImage;
{$IFDEF FPC}
stream: TMemorystream;
{$ELSE}
stream: TMemoryStream;
a: ansistring;
{$ENDIF}
begin
Listview.Items.Clear;
if not FileExists(AParamsFile) then begin
showMessage('Parameter file "' + AParamsFile + '" not found.');
exit;
end;
if not FileExists(CbTestfile.Text) then begin
ShowMessage('Test picture file "' + CbTestfile.Text + '" not found.');
exit;
end;
// Read test parameters
testCases := TStringList.Create;
try
{$IFDEF FPC}
// The testcases text files are encoded in ANSI for Delphi7 compatibility
// In Lazarus we must convert to UTF8 }
testCases.LoadFromFile(AParamsFile);
s := testCases.Text;
{$IFDEF FPC3+}
testCases.Text := WinCPToUTF8(s);
{$ELSE}
testCases.Text := AnsiToUTF8(s);
{$ENDIF}
{$ELSE}
stream := TMemoryStream.Create;
try
stream.LoadFromFile(AParamsFile);
SetLength(a, stream.Size);
stream.Read(a[1], Length(a));
testcases.Text := a;
finally
stream.Free;
end;
{$ENDIF}
// Read EXIF tags from image file
ImgInfo.LoadFromFile(CbTestfile.Text);
if not ImgInfo.HasExif then
ImgInfo.CreateExifData(false);
OutFile := 'test-image.jpg'; // File name of the modified test image
ListView.Items.BeginUpdate;
try
j := 0;
n := testCases.Count;
for i:=0 to n-1 do begin
if (testCases[i] = ':quit') then
break;
if (testCases[i] = '') or (testCases[i][1] = ';') then
Continue;
// Extract test parameters
testdata := Split(testCases[i], 2);
tagName := testdata[0];
newTagValue := testdata[1];
newTagValues := Split(newTagValue, 2, '|');
if Length(newTagValues) =0 then begin
SetLength(newTagValues, 1);
newTagValues[0] := '';
end;
// Add test to listview
listitem := ListView.Items.Add;
listItem.Caption := tagname;
// Read current tag value
currTagValue := ReadTagValue(tagName, lTag);
listItem.SubItems.Add(currTagValue);
listItem.Data := lTag;
// Write new tag value into ExifObj
WriteTagValue(tagName, newTagValues[0]);
listItem.SubItems.Add(newTagValue);
end;
finally
ListView.Items.EndUpdate;
end;
// Write new tags to file
ImgInfo.SaveToFile(OutFile);
// read back
ImgInfo.LoadFromFile(OutFile);
if not ImgInfo.HasExif then
raise Exception.Create('No EXIF structure detected in "' + Outfile + '"');
j := 0;
for i:=0 to testCases.Count-1 do begin
if (testcases[i] = ':quit') then
break;
if (testcases[i] = '') or (testcases[i][1] = ';') then
Continue;
testdata := Split(testCases[i], 2);
tagname := testdata[0];
newTagValue := testdata[1];
currTagValue := ReadTagValue(tagname, lTag);
listItem := ListView.Items[j];
listItem.SubItems.Add(currTagValue);
if Success(lTag, currTagValue, newTagValue) then
listItem.ImageIndex := IMGINDEX_SUCCESS else
listItem.ImageIndex := IMGINDEX_FAIL;
inc(j);
end;
jpeg := TJpegImage.Create;
try
try
jpeg.LoadFromFile(OutFile);
listitem := ListView.Items.Add;
listItem.Caption := 'Successfully loaded';
listItem.ImageIndex := IMGINDEX_SUCCESS;
except
listitem := ListView.Items.Add;
listItem.Caption := 'Loading failed.';
listItem.ImageIndex := IMGINDEX_FAIL;
end;
finally
jpeg.Free;
end;
finally
testCases.Free;
end;
ExifTabControlChange(nil);
end;
procedure TMainForm.BtnBrowseClick(Sender: TObject);
var
olddir: String;
begin
olddir := GetCurrentDir;
OpenDialog.FileName := '';
if OpenDialog.Execute then
AddToHistory(OpenDialog.Filename);
SetCurrentDir(oldDir);
end;
function TMainForm.Success(ATag: TTag; ACurrValue, AExpectedValue: String): Boolean;
const
relEPS = 1E-3;
var
p: Integer;
snum, sdenom: String;
valexp, valcurr: Double;
decode: Boolean;
currVal, expVal: String;
begin
Result := ACurrValue = AExpectedValue;
if Result then
exit;
if (ACurrValue = '') or (AExpectedValue = '') then begin
Result := false;
exit;
end;
(*
{ Check for alternative expected value }
p := pos('|', AExpectedValue);
if p > 0 then begin
expected2 := Copy(AExpectedValue, p+1, MaxInt);;
expected1 := Copy(AExpectedValue, 1, p-1);
Result := (ACurrValue = expected1);
if Result then
exit;
Result := (ACurrValue = expected2);
if Result then
exit;
end; *)
{ Check for float values, e.g. 12.0 vs 12 }
if (ATag is TFloatTag) then begin
currVal := CleanFloatStr(ACurrValue);
expVal := CleanFloatStr(AExpectedValue);
Result := currVal = expval;
if Result then
exit;
{ Check for fractional result, e.g. exposure time }
p := pos('/', currVal);
if p > 0 then begin
snum := Copy(currVal, 1, p-1);
sdenom := Copy(currVal, p+1, MaxInt);
valcurr := StrToInt(snum) / StrToInt(sdenom);
end else
valcurr := StrToFloat(currVal, fpExifFmtSettings);
p := pos('/', expVal);
if p > 0 then begin
snum := Copy(expval, 1, p-1);
sdenom := Copy(currval, p+1, MaxInt);
valexp := StrToInt(snum) / StrToInt(sdenom);
end else
valexp := StrToFloat(expval, fpExifFmtSettings);
Result := SameValue(valcurr, valexp, relEPS * valexp);
if Result then
exit;
end;
if (ATag is TIntegerTag) then begin
decode := ATag.DecodeValue;
ATag.DecodeValue := not decode;
currVal := ATag.AsString;
ATag.DecodeValue := decode;
Result := (currVal = AExpectedValue);
if Result then
exit;
end;
end;
procedure TMainForm.ExifToListview(AImgInfo: TImgInfo; AListView: TListView);
var
i: Integer;
lTag: TTag;
item: TListItem;
begin
AListview.Items.BeginUpdate;
try
AListview.Items.Clear;
if not AImgInfo.HasExif then
exit;
for i:=0 to AImgInfo.ExifData.TagCount-1 do begin
lTag := AImgInfo.ExifData.TagByIndex[i];
if lTag = nil then
Continue;
item := AListView.Items.Add;
with item do begin
Caption := lTag.Description;
SubItems.Add(lTag.AsString);
end;
end;
AListView.AlphaSort;
finally
AListview.Items.EndUpdate;
end;
end;
function TMainForm.ReadTagValue(ATagName: String): String;
var
lTag: TTag;
begin
Result := ReadTagValue(ATagName, lTag);
end;
function TMainForm.ReadTagValue(ATagName: String; out ATag: TTag): String;
begin
if ATagName = 'Comment' then begin
Result := ImgInfo.Comment;
ATag := nil;
end else
begin
ATag := ImgInfo.ExifData.FindTagByName(ATagName);
if ATag = nil then
Result := ''
else
Result := ATag.AsString;
end;
end;
procedure TMainForm.ExifTabControlChange(Sender: TObject);
var
data: TImgInfo;
begin
data := TImgInfo.Create;
try
case ExifTabControl.TabIndex of
0: data.LoadFromFile(CbTestfile.Text);
1: data.LoadFromFile(OutFile);
end;
ExifToListView(data, ExifListView);
finally
data.Free;
end;
end;
procedure TMainForm.WriteTagValue(ATagName, ATagValue: String);
var
lTag: TTag;
begin
if ATagName = 'Comment' then
ImgInfo.Comment := ATagValue
else begin
lTag := ImgInfo.ExifData.TagByName[ATagName];
if lTag = nil then
lTag := ImgInfo.ExifData.AddTagByName(ATagName);
lTag.AsString := ATagvalue;
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;
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], ''));
CbTestFile.ItemIndex := 0;
finally
list.Free;
end;
finally
ini.Free;
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);
for i:=0 to CbTestFile.Items.Count-1 do
if (CbTestFile.Items[i] <> '') and FileExists(CbTestFile.Items[i]) then
ini.WriteString('History', 'Item'+IntToStr(i+1), CbTestFile.Items[i]);
ini.UpdateFile;
finally
ini.Free;
end;
end;
end.

View File

@ -0,0 +1,234 @@
object MainForm: TMainForm
Left = 329
Height = 581
Top = 127
Width = 1025
Caption = 'EXIF read/write test'
ClientHeight = 581
ClientWidth = 1025
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.9.0.0'
object BtnTest1: TSpeedButton
Left = 916
Height = 22
Top = 8
Width = 48
Anchors = [akTop, akRight]
Caption = 'Test 1'
OnClick = BtnTest1Click
end
object BtnTest2: TSpeedButton
Left = 969
Height = 22
Top = 8
Width = 48
Anchors = [akTop, akRight]
Caption = 'Test 2'
OnClick = BtnTest1Click
end
object Panel1: TPanel
Left = 8
Height = 482
Top = 40
Width = 1009
Anchors = [akTop, akLeft, akRight, akBottom]
BevelOuter = bvNone
ClientHeight = 482
ClientWidth = 1009
TabOrder = 0
object ListView: TListView
Left = 0
Height = 482
Top = 0
Width = 730
Align = alClient
AutoWidthLastColumn = True
Columns = <
item
AutoSize = True
Caption = 'Tag/property'
Width = 85
end
item
AutoSize = True
Caption = 'Current value'
Width = 86
end
item
AutoSize = True
Caption = 'Value to be written'
Width = 114
end
item
Caption = 'Value read-back'
Width = 441
end>
SmallImages = ImageList1
TabOrder = 0
ViewStyle = vsReport
end
object Splitter1: TSplitter
Left = 730
Height = 482
Top = 0
Width = 5
Align = alRight
ResizeAnchor = akRight
end
object ExifTabControl: TTabControl
Left = 735
Height = 482
Top = 0
Width = 274
OnChange = ExifTabControlChange
TabIndex = 0
Tabs.Strings = (
'Original file'
'Modified'
)
Align = alRight
TabOrder = 2
object ExifListView: TListView
Left = 2
Height = 457
Top = 23
Width = 270
Align = alClient
AutoWidthLastColumn = True
Columns = <
item
Caption = 'Tag name'
Width = 120
end
item
Caption = 'Value'
Width = 146
end>
RowSelect = True
TabOrder = 1
ViewStyle = vsReport
end
end
end
object Panel2: TPanel
Left = 0
Height = 61
Top = 520
Width = 1025
Align = alBottom
AutoSize = True
BevelOuter = bvNone
BorderWidth = 8
ClientHeight = 61
ClientWidth = 1025
TabOrder = 1
object Label1: TLabel
Left = 8
Height = 45
Top = 8
Width = 1009
Align = alClient
Caption = 'Buttons "Test 1" and "Test 2" read test conditions from files "testcases1.txt" and "testcases2.txt", respectively.'#13#10'- Test values expressed as fractions (e.g. exposure times) are evaluated by the program.'#13#10'- Enumerated values can be shown by their index, or by their text followd by | and their index.'
ParentColor = False
end
end
object CbTestfile: TComboBox
Left = 8
Height = 23
Top = 8
Width = 872
Anchors = [akTop, akLeft, akRight]
ItemHeight = 15
OnEditingDone = CbTestfileEditingDone
TabOrder = 2
end
object BtnBrowse: TSpeedButton
Left = 888
Height = 22
Top = 8
Width = 23
Anchors = [akTop, akRight]
Caption = '...'
OnClick = BtnBrowseClick
end
object ImageList1: TImageList
left = 400
top = 117
Bitmap = {
4C69020000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004EA2
57914A9D527FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004DA1569163B3
6DFF5FAF69FF41914979FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004CA0559162B26CFF82D1
8FFF7AC885FF57A660FF38843F7BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004B9F549160B06AFF81CF8DFF7FCF
8BFF58A761FF398540FF347E3A08FFFFFF00FFFFFF005FBB6A435CB76765FFFF
FF00FFFFFF00FFFFFF00FFFFFF004B9E53915FAF69FF7FCE8AFF7ECE89FF57A6
60FF37823DFC337D3908FFFFFF00FFFFFF005FBA6A3C5CB666E66DC079FF55AC
5F6FFFFFFF00FFFFFF004A9D52915EAE68FF7DCD89FF7CCD87FF56A55FFF3681
3CFC327C3808FFFFFF00FFFFFF005EB969465BB566E479C986FF80CE8DFF51A6
5AFC4DA1566F499C518B5CAD67FF7CCC86FF79CB85FF54A45DFF35803BFC317B
3708FFFFFF00FFFFFF00FFFFFF005AB4650959B063FF6BBD76FF84D290FF7AC9
85FF60B26AFF63B46DFF78C983FF78CB82FF53A35CFF347F3AFD317A3608FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0053A95C0A51A65AFF63B56DFF7ECE
89FF7BCC87FF76CA81FF76C981FF52A25AFF347E3AFE30793508FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004B9E530A499A51FF5BAC
64FF77CA82FF74C87EFF51A059FF337D39FE2F783508FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004292490A408E
47FF54A35CFF4F9F57FF327C38FE2E773408FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003985
400A37833DFF317B37FB2E763307FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00317A360A2D753207FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006360
F80AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007774FF1F7774
FF2BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00625FF82B5D5B
F76F5956F53EFFFFFF00FFFFFF00FFFFFF00FFFFFF007774FF1F7A77FFFF7976
FEFF726FFD2BFFFFFF00FFFFFF00FFFFFF00FFFFFF00615EF82B6461F8FF6A68
F9FF5451F3A84F4DF229FFFFFF00FFFFFF007774FF1F7A77FFFF817EFFFF817E
FEFF7471FDFF6C69FB2BFFFFFF00FFFFFF00605DF72B625FF8FF6F6DFBFF7E7C
FFFF625FF8FF4A47F06F4542EE02FFFFFF007673FF087471FEFD7D7AFEFF8A87
FFFF7C79FDFF6C69FBFF6361F92B5F5CF72B615EF8FF6E6CFAFF7D7AFFFF615F
F7FF4946F0FC4441EE05FFFFFF00FFFFFF00FFFFFF00716EFD086E6BFCFC7774
FDFF8682FFFF7673FCFF6462F8FF605DF7FF6D6AFAFF7B79FFFF605DF7FF4845
EFFC4341EE08FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006967FB086663
F9FC706DFBFF807EFFFF7E7BFFFF7C79FFFF7977FFFF5E5CF7FF4744EFFC4240
EE08FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00615E
F8085D5AF6FD7D79FFFF5E5BFFFF5B58FFFF7674FFFF4643EFFD413FED08FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005C59
F62B5D5BF7FF7976FFFF5956FFFF5754FFFF7270FFFF4846F0FF3C39EB2BFFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005B58F62B5C5A
F6FF6764FAFF7472FFFF7370FFFF706EFFFF6E6CFFFF5755F7FF3F3DEEFF3230
E82BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005A57F52B5B59F6FF6663
FAFF7471FFFF5A58F6FF4341EEFC3E3CECFD504DF4FF6867FFFF504EF5FF3634
EBFF2A27E52BFFFFFF00FFFFFF00FFFFFF005956F52B5B58F6FF6562FAFF7170
FFFF5956F6FF4240EEFC3E3BEC083937EB083532E9FC4745F2FF6362FFFF4A48
F4FF2F2DE9FF2220E32BFFFFFF00FFFFFF005451F3415856F5FF6361FAFF5855
F6FF413FEDFC3D3AEC08FFFFFF00FFFFFF00302DE7082C2AE6FC413FF1FF4C4A
F6FF312FEAFF1F1DE241FFFFFF00FFFFFF00FFFFFF004A47F0414F4CF2FF403E
EDFD3C39EB08FFFFFF00FFFFFF00FFFFFF00FFFFFF002725E5082422E4FC312F
EAFF1F1DE241FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003F3DED413B38
EB08FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00211FE3081E1C
E241FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00
}
end
object OpenDialog: TOpenDialog
Title = 'Open image file'
DefaultExt = '.*.jpg'
Filter = 'JPEG files (*.jpg; *.jpeg)|*.jpg;*.jpeg'
Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
left = 400
top = 178
end
end

View File

@ -0,0 +1,32 @@
; IMPORTANT: This file must be stored in ANSI encoding
; Use a TAB character between the two columns
Artist Ansel Adams
Comment This text is in the COMMENT segment.
Artist Ansel Adams
ImageDescription A nice image
UserComment Nice comment!
Make My camera make
Model My camera model
Copyright (c) wp
DateTimeOriginal 2017-01-01 09:00:00
DateTimeDigitized 2017-01-01 12:00:00
DateTime 2017-01-01 18:00:00
ImageWidth 2000
ImageHeight 1000
ExifImageWidth 2000
ExifImageHeight 1000
Orientation 2
FNumber 5.6
ApertureValue 11
MaxApertureValue 1.8
ExposureBiasValue -1
ShutterSpeedValue 1/60
ExposureTime 1/25
ISO 800
ExposureProgram 1
MeteringMode 3
LightSource 3
;GPSLatitude 12� 34' 56" N
;GPSLongitude 1� 23' 45" E

View File

@ -0,0 +1,16 @@
;IMPORTANT: This file must be stored in ANSI encoding
; Use a TAB character between the two columns
Comment ��� in the comment segment.
Artist Hansi M�ller
ImageDescription H�bsches Bild
UserComment Sch�ner Kommentar!
Make ��� camera make
Model ��� camera model
Copyright � wp
Orientation Mirror horizontal
ExposureProgram Manual
MeteringMode Spot
LightSource Cloudy
GPSLatitude
GPSLongitude

View File

@ -0,0 +1,470 @@
unit fetExifBE;
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}
{$I fpexif.inc}
interface
uses
Classes, SysUtils,
{$ifdef FPC}
fpcunit, testutils, testregistry;
{$else}
fetTestUtils, TestFrameWork;
{$endif}
const
// Picture with Exif data (Big Endian)
ExifPic = '..\pictures\originals\ExThBE_Nokia.jpg';
WorkFile_WithExif = 'pictures\with_exif.jpg';
// Picture without Exif data
NoExifPic = '..\pictures\originals\no_metadata.jpg';
WorkFile_NoExif = 'pictures\no_exif.jpg';
type
TstExifBE = class(TTestCase)
protected
procedure SetUp; override;
procedure TearDown; override;
procedure Internal_CheckHasExif(AFileName: String; ExpectExif: Boolean);
published
procedure CheckForPictures;
procedure CheckCreateImgInfo;
procedure CheckHasExif;
procedure ReadExifTest;
procedure CreateExifTest;
procedure WriteExifTest;
procedure ValidFileTest;
end;
implementation
uses
{$IFDEF FPC}
FileUtil,
{$ELSE}
Jpeg,
{$ENDIF}
Graphics,
fpeGlobal, fpeTags, fpeExifData, fpeMetadata;
procedure TstExifBE.SetUp;
begin
if FileExists(Workfile_WithExif) then
DeleteFile(WorkFile_WithExif);
if FileExists(Workfile_NoExif) then
DeleteFile(Workfile_NoExif);
if not FileExists(WorkFile_WithExif) then
if FileExists(ExifPic) then
CopyFile(ExifPic, WorkFile_WithExif);
if not FileExists(WorkFile_NoExif) then
if FileExists(NoExifPic) then
CopyFile(NoExifPic, WorkFile_NoExif);
end;
procedure TstExifBE.TearDown;
begin
if FileExists(WorkFile_NoExif) then
DeleteFile(WorkFile_NoExif);
if FileExists(WorkFile_WithExif) then
DeleteFile(WorkFile_WithExif);
end;
procedure TstExifBE.CheckForPictures;
begin
CheckTrue(FileExists(ExifPic), 'Original test picture file "' + ExifPic + '" does not exist');
CheckTrue(FileExists(NoExifPic), 'Original test picture file "' + NoExifPic + '" does not exist');
CheckTrue(FileExists(WorkFile_WithExif), 'Test picture file "' + WorkFile_WithExif + '" does not exist');
CheckTrue(FileExists(WorkFile_NoExif), 'Test picture file "' + WorkFile_NoExif + '" does not exist');
end;
procedure TstExifBE.CheckCreateImgInfo;
var
imgInfo: TImgInfo;
begin
imgInfo := TImgInfo.Create();
try
CheckIs(imgInfo, TImgInfo,'Is not TImgInfo');
finally
imgInfo.Free;
end;
end;
procedure TstExifBE.Internal_CheckHasExif(AFileName: String; ExpectExif: Boolean);
var
imgInfo: TImgInfo;
begin
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(AFileName);
if ExpectExif then
CheckTrue(imgInfo.HasExif, 'Failure to detect EXIF in test picture file "' + AFileName + '"')
else
CheckFalse(imgInfo.HasExif, 'Unexpected EXIF in test picture file "' + AFileName + '" detected');
finally
imgInfo.Free;
end;
end;
procedure TstExifBE.CheckHasExif;
begin
Internal_CheckHasExif(WorkFile_WithExif, true);
Internal_CheckHasExif(WorkFile_NoExif, false);
end;
procedure TstExifBE.ReadExifTest;
{ EXIF-related Output of ExifTool for the test image with exif using this
commandline:
exiftool -G -H -s with_exif.jpg > with_exif.txt
These values are checked
|
[File] - ExifByteOrder : Big-endian (Motorola, MM)
[EXIF] 0x010f Make : Nokia
[EXIF] 0x0110 Model : 6300
[EXIF] 0x0112 Orientation : Horizontal (normal)
[EXIF] 0x011a XResolution : 72
[EXIF] 0x011b YResolution : 72
[EXIF] 0x0128 ResolutionUnit : inches
[EXIF] 0x0131 Software : V 07.21
[EXIF] 0x0213 YCbCrPositioning : Centered
[EXIF] 0x9000 ExifVersion : 0220
[EXIF] 0x9101 ComponentsConfiguration : Y, Cb, Cr, -
[EXIF] 0xa000 FlashpixVersion : 0100
[EXIF] 0xa001 ColorSpace : sRGB
[EXIF] 0xa002 ExifImageWidth : 200 <--
[EXIF] 0xa003 ExifImageHeight : 267 <--
[EXIF] 0x0103 Compression : JPEG (old-style) <-- called ThumbnailOffset by fpExif
[EXIF] 0x011a XResolution : 72 <-- called ThumbnailXResolution by fpExif
[EXIF] 0x011b YResolution : 72 <-- called ThumbnailYResolution by fpExif
[EXIF] 0x0128 ResolutionUnit : inches <-- called ThumbnailResolutionUnit by fpExif
[EXIF] 0x0201 ThumbnailOffset : 359 <--
[EXIF] 0x0202 ThumbnailLength : 12025 <-- called ThumbnailSize by fpExif
}
var
imgInfo: TImgInfo;
lTag: TTag;
offs: Integer;
begin
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(WorkFile_WithExif);
// This is general information stored within imgImfInfo
CheckEquals('with_exif.jpg', ExtractFileName(imgInfo.FileName), 'Filename mismatch');
// The following pieces of information are obtained from the EXIF segment
CheckTrue(imgInfo.ExifData.BigEndian, 'Exif byte order detection error');
lTag := imgInfo.ExifData.TagByName['Make'];
CheckTrue(lTag <> nil, 'Tag "Make" not found');
CheckEquals('Nokia', lTag.AsString, 'Value mismatch of tag "Make"');
lTag := imgInfo.ExifData.TagByName['Model'];
CheckTrue(lTag <> nil, 'Tag "Model" not found');
CheckEquals('6300', lTag.AsString, 'Value mismatch of tag "Model"');
lTag := imgInfo.ExifData.TagByName['Orientation'];
CheckTrue(lTag <> nil, 'Tag "Orientation" not found');
CheckEquals('Horizontal (normal)', lTag.AsString, 'Value mismatch of tag "Orientation"');
lTag := imgInfo.ExifData.TagByName['XResolution'];
CheckTrue(lTag <> nil, 'Tag "XResolution" not found');
CheckEquals('72', lTag.AsString, 'Value mismatch of tag "XResolution"');
CheckTrue(lTag is TNumericTag, 'Tag "XResolution" is no TNumericTag');
CheckEquals(72, lTag.AsInteger, 'Integer value mismatch of tag "XResolution"');
CheckTrue(lTag is TFloatTag, 'Tag "XResolution" is no TNumericTag');
CheckEquals(72.0, lTag.AsFloat, 'Float value mismatch of tag "XResolution"');
lTag := imgInfo.ExifData.TagByName['YResolution'];
CheckTrue(lTag <> nil, 'Tag "YResolution" not found');
CheckEquals('72', lTag.AsString, 'Value mismatch of tag "YResolution"');
lTag := imgInfo.ExifData.TagByName['ResolutionUnit'];
CheckTrue(lTag <> nil, 'Tag "ResolutionUnit" not found');
CheckEquals('inches', lTag.AsString, 'Value mismatch of tag "ResolutionUnit"');
lTag := imgInfo.ExifData.TagByName['Software'];
CheckTrue(lTag <> nil, 'Tag "Software" not found');
CheckEquals('V 07.21', lTag.AsString, 'Value mismatch of tag "Software"');
lTag := imgInfo.ExifData.TagByName['YCbCrPositioning'];
CheckTrue(lTag <> nil, 'Tag "YCbCrPositioning" not found');
CheckEquals('Centered', lTag.AsString, 'Value mismatch of tag "YCbCrPositioning"');
lTag := imgInfo.ExifData.TagByName['ExifVersion'];
CheckTrue(lTag <> nil, 'Tag "ExifVersion" not found');
CheckTrue(lTag is TVersionTag, 'Tag "ExifVersion" is not TVersionTag');
CheckEquals('0220', lTag.AsString, 'Value mismatch of tag "ExifVersion"');
lTag := imgInfo.ExifData.TagByName['ComponentsConfiguration'];
CheckTrue(lTag <> nil, 'Tag "ComponentsConfiguration" not found');
CheckEquals('YCbCr', lTag.AsString, 'Value mismatch of tag "ComponentsConfiguration"');
// Expected value manually edited from "Y, Cb, Cr, -" to "YCbCr"
lTag := imgInfo.ExifData.TagByName['FlashPixVersion'];
CheckTrue(lTag <> nil, 'Tag "FlashPixVersion" not found');
CheckEquals('0100', lTag.AsString, 'Value mismatch of tag "FlashPixVersion"');
lTag := imgInfo.ExifData.TagByName['ColorSpace'];
CheckTrue(lTag <> nil, 'Tag "ColorSpace" not found');
CheckEquals('sRGB', lTag.AsString, 'Value mismatch of tag "ColorSpace"');
lTag := imgInfo.ExifData.TagByName['ExifImageWidth'];
CheckTrue(lTag <> nil, 'Tag "ExifImageWidth" not found');
CheckEquals(200, lTag.AsInteger, 'Value mismatch of tag "ExifImageWidth"');
lTag := imgInfo.ExifData.TagByName['ExifImageHeight'];
CheckTrue(lTag <> nil, 'Tag "ExifImageHeight" not found');
CheckEquals(267, lTag.AsInteger, 'Value mismatch of tag "ExifImageHeight"');
lTag := imgInfo.ExifData.TagByName['ThumbnailCompression'];
CheckTrue(lTag <> nil, 'Tag "ThumbnailCompression" not found');
CheckEquals('JPEG (old-style)', lTag.AsString, 'Value mismatch of tag "ThumbnailCompression"');
lTag := imgInfo.ExifData.TagByName['ThumbnailXResolution'];
CheckTrue(lTag <> nil, 'Tag "ThumbnailXResolution" not found');
CheckEquals(72, lTag.AsInteger, 'Value mismatch of tag "ThumbnailXResolution"');
lTag := imgInfo.ExifData.TagByName['ThumbnailYResolution'];
CheckTrue(lTag <> nil, 'Tag "ThumbnailYResolution" not found');
CheckEquals(72, lTag.AsInteger, 'Value mismatch of tag "ThumbnailYResolution"');
lTag := imgInfo.ExifData.TagByName['ThumbnailResolutionUnit'];
CheckTrue(lTag <> nil, 'Tag "ThumbnailResolutionUnit" not found');
CheckEquals('inches', lTag.AsString, 'Value mismatch of tag "ThumbnailResolutionUnit"');
lTag := imgInfo.ExifData.TagByName['ThumbnailOffset'];
CheckTrue(lTag <> nil, 'Tag "ThumbnailOffset" not found');
CheckTrue(lTag is TOffsettag, 'Tag "ThumbnailOffset" is not a TOffsetTag');
offs := lTag.AsInteger + TOffsetTag(lTag).TiffHeaderOffset;
// Note: fpExif offset are relativ to the beginning of the TiffHeader,
// ExifTool offsets are relative to the beginning of the file.
CheckEquals(359, offs, 'Value mismatch of tag "ThumbnailOffset"');
lTag := imgInfo.ExifData.TagByName['ThumbnailSize'];
CheckTrue(lTag <> nil, 'Tag "ThumbnailSize" not found');
CheckEquals(12025, lTag.AsInteger, 'Value mismatch of tag "ThumbnailSize"');
finally
imgInfo.Free;
end;
end;
{ This test creates a new empty exif structure, but does not write anything to
file. }
procedure TstExifBE.CreateExifTest;
var
imgInfo: TImgInfo;
begin
imgInfo := TImgInfo.Create;
try
CheckTrue(imgInfo.ExifData = nil, 'EXIF found, but not expected.');
imgInfo.CreateExifData;
CheckTrue(imgInfo.ExifData <> nil, 'EXIF not found.');
finally
imgInfo.Free;
end;
end;
{ This test creates an empty EXIF structure, fills it with some data and saves
it to the No_exif file. After writing the file is read back and compared
with the written data. }
procedure TstExifBE.WriteExifTest;
var
imgInfo: TImgInfo;
lTag: TTag;
begin
imgInfo := TImgInfo.Create;
try
// Create empty EXIF
imgInfo.CreateExifData;
// Add tags
lTag := imgInfo.ExifData.AddTagByName('Make');
CheckTrue(lTag <> nil, 'Tag "Make" not found for writing');
lTag.AsString := 'Nokia';
lTag := imgInfo.ExifData.AddTagByName('Model');
CheckTrue(lTag <> nil, 'Tag "Model" not found for writing');
lTag.AsString := '6300';
lTag := imgInfo.ExifData.AddTagByName('Orientation');
CheckTrue(lTag <> nil, 'Tag "Orientation" not found for writing');
lTag.AsString := 'Horizontal (normal)';
lTag := imgInfo.ExifData.AddTagByName('XResolution');
CheckTrue(lTag <> nil, 'Tag "XResolution" not found for writing');
lTag.AsInteger := 72;
lTag := imgInfo.ExifData.AddTagByName('YResolution');
CheckTrue(lTag <> nil, 'Tag "YResolution" not found for writing');
lTag.AsInteger := 72;
lTag := imgInfo.ExifData.AddTagByName('ResolutionUnit');
CheckTrue(lTag <> nil, 'Tag "ResolutionUnit" not found for writing');
ltag.AsString := 'inches';
lTag := imgInfo.ExifData.AddTagByName('Software');
CheckTrue(lTag <> nil, 'Tag "Software" not found for writing');
lTag.AsString := 'FPC/fpExif';
lTag := imgInfo.ExifData.AddTagByName('YCbCrPositioning');
CheckTrue(lTag <> nil, 'Tag "YCbCrPositioning" not found');
lTag.AsString := 'Centered';
lTag := imgInfo.ExifData.AddTagByName('ExifVersion');
CheckTrue(lTag <> nil, 'Tag "ExifVersion" not found for writing');
CheckTrue(lTag is TVersionTag, 'Tag "ExifVersion" is not TVersionTag');
TVersionTag(lTag).AsString := '0220';
lTag := imgInfo.ExifData.AddTagByName('ComponentsConfiguration');
CheckTrue(lTag <> nil, 'Tag "ComponentsConfiguration" not found');
lTag.AsString := 'YCbCr';
lTag := imgInfo.ExifData.AddTagByName('FlashPixVersion');
CheckTrue(lTag <> nil, 'Tag "FlashPixVersion" not found');
lTag.AsString := '0100';
lTag := imgInfo.ExifData.AddTagByName('ColorSpace');
CheckTrue(lTag <> nil, 'Tag "ColorSpace" not found');
lTag.AsString := 'sRGB';
lTag := imgInfo.ExifData.AddTagByName('ExifImageWidth');
CheckTrue(lTag <> nil, 'Tag "ExifImageWidth" not found for writing');
lTag.AsInteger := 200;
lTag := imgInfo.ExifData.AddTagByName('ExifImageHeight');
CheckTrue(lTag <> nil, 'Tag "ExifImageHeight" not found for writing');
lTag.AsInteger := 267;
// Save to file;
// Takes the image data from WorkFile_WithExif, replaces its EXIF with the
// current EXIF structure and writes to WorkFile_NoExif.
imgInfo.SaveToFile(WorkFile_NoExif, Workfile_WithExif);
finally
imgInfo.Free;
end;
// Read written file and check EXIF
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(Workfile_NoExif);
// Now there should be EXIF
CheckTrue(imgInfo.ExifData <> nil, 'EXIF not found.');
lTag := imgInfo.ExifData.TagByName['Make'];
CheckTrue(lTag <> nil, 'Tag "Make" not found');
CheckEquals('Nokia', lTag.AsString, 'Value mismatch of tag "Make"');
lTag := imgInfo.ExifData.TagByName['Model'];
CheckTrue(lTag <> nil, 'Tag "Model" not found');
CheckEquals('6300', lTag.AsString, 'Value mismatch of tag "Model"');
lTag := imgInfo.ExifData.TagByName['Orientation'];
CheckTrue(lTag <> nil, 'Tag "Orientation" not found');
CheckEquals('Horizontal (normal)', lTag.AsString, 'Value mismatch of tag "Orientation"');
lTag := imgInfo.ExifData.TagByName['XResolution'];
CheckTrue(lTag <> nil, 'Tag "XResolution" not found');
CheckEquals('72', lTag.AsString, 'Value mismatch of tag "XResolution"');
CheckTrue(lTag is TNumericTag, 'Tag "XResolution" is no TNumericTag');
CheckEquals(72, lTag.AsInteger, 'Integer value mismatch of tag "XResolution"');
CheckTrue(lTag is TFloatTag, 'Tag "XResolution" is no TNumericTag');
CheckEquals(72.0, lTag.AsFloat, 'Float value mismatch of tag "XResolution"');
lTag := imgInfo.ExifData.TagByName['YResolution'];
CheckTrue(lTag <> nil, 'Tag "YResolution" not found');
CheckEquals('72', lTag.AsString, 'Value mismatch of tag "YResolution"');
lTag := imgInfo.ExifData.TagByName['ResolutionUnit'];
CheckTrue(lTag <> nil, 'Tag "ResolutionUnit" not found');
CheckEquals('inches', lTag.AsString, 'Value mismatch of tag "ResolutionUnit"');
lTag := imgInfo.ExifData.TagByName['Software'];
CheckTrue(lTag <> nil, 'Tag "Software" not found');
CheckEquals('FPC/fpExif', lTag.AsString, 'Value mismatch of tag "Software"');
lTag := imgInfo.ExifData.TagByName['YCbCrPositioning'];
CheckTrue(lTag <> nil, 'Tag "YCbCrPositioning" not found');
CheckEquals('Centered', lTag.AsString, 'Value mismatch of tag "YCbCrPositioning"');
lTag := imgInfo.ExifData.TagByName['ExifVersion'];
CheckTrue(lTag <> nil, 'Tag "ExifVersion" not found');
CheckTrue(lTag is TVersionTag, 'Tag "ExifVersion" is not TVersionTag');
CheckEquals('0220', lTag.AsString, 'Value mismatch of tag "ExifVersion"');
lTag := imgInfo.ExifData.TagByName['ComponentsConfiguration'];
CheckTrue(lTag <> nil, 'Tag "ComponentsConfiguration" not found');
CheckEquals('YCbCr', lTag.AsString, 'Value mismatch of tag "ComponentsConfiguration"');
// Expected value manually edited from "Y, Cb, Cr, -" to "YCbCr"
lTag := imgInfo.ExifData.TagByName['FlashPixVersion'];
CheckTrue(lTag <> nil, 'Tag "FlashPixVersion" not found');
CheckEquals('0100', lTag.AsString, 'Value mismatch of tag "FlashPixVersion"');
lTag := imgInfo.ExifData.TagByName['ColorSpace'];
CheckTrue(lTag <> nil, 'Tag "ColorSpace" not found');
CheckEquals('sRGB', lTag.AsString, 'Value mismatch of tag "ColorSpace"');
lTag := imgInfo.ExifData.TagByName['ExifImageWidth'];
CheckTrue(lTag <> nil, 'Tag "ExifImageWidth" not found');
CheckEquals(200, lTag.AsInteger, 'Value mismatch of tag "ExifImageWidth"');
lTag := imgInfo.ExifData.TagByName['ExifImageHeight'];
CheckTrue(lTag <> nil, 'Tag "ExifImageHeight" not found');
CheckEquals(267, lTag.AsInteger, 'Value mismatch of tag "ExifImageHeight"');
// No thumbnail in dest file!
finally
imgInfo.Free;
end;
end;
procedure TstExifBE.ValidFileTest;
var
jpg: TJpegImage;
fn: string;
bmp: TBitmap;
success: Boolean;
begin
// Modify the EXIF structure of WorkFile_WithExif;
fn := Workfile_WithExif;
WriteExifTest;
success := false;
jpg := TJpegImage.Create;
try
jpg.LoadFromFile(fn);
bmp := TBitmap.Create;
try
bmp.Width := jpg.Width;
bmp.Height := jpg.Height;
bmp.Canvas.Draw(0, 0, jpg);
success := true;
finally
bmp.Free;
CheckTrue(success, 'Non-readable file');
end;
finally
jpg.Free;
end;
end;
initialization
{$IFDEF FPC}
RegisterTest(TstExifBE);
{$ELSE}
TestFramework.RegisterTest(TstExifBE.Suite);
{$ENDIF}
end.

View File

@ -0,0 +1,727 @@
unit fetExifLE;
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}
interface
uses
Classes, SysUtils,
{$ifdef FPC}
fpcunit, testutils, testregistry;
{$else}
fetTestUtils, TestFrameWork;
{$endif}
const
// JPEG picture with Exif data
ExifJpegPic = '..\pictures\originals\with_exif.jpg';
WorkFile_JpegWithExif = '.\pictures\with_exif.jpg';
// TIFF pPicture with Exif data
ExifTiffPic = '..\pictures\originals\with_exif.tif';
WorkFile_TiffWithExif = '.\pictures\with_exif.tif';
// Picture without Exif data
NoExifPic = '..\pictures\originals\no_metadata.jpg';
WorkFile_NoExif = '.\pictures\no_exif.jpg';
type
TstExifLE = class(TTestCase)
protected
procedure SetUp; override;
procedure TearDown; override;
procedure Internal_CheckHasExif(AFileName: String; ExpectExif: Boolean);
published
procedure CheckForPictures;
procedure CheckCreateImgInfo;
procedure CheckHasExif;
procedure ReadExifTest_Jpeg;
procedure ReadExifTest_Tiff;
procedure ReadGPSTest;
procedure CreateExifTest;
procedure WriteExifTest_Jpeg;
procedure WriteGPSTest_Jpeg;
procedure ValidFileTest_Jpeg;
procedure CreateThumbnail_Jpeg;
end;
implementation
uses
{$IFDEF FPC}
Graphics, FileUtil,
{$ELSE}
Graphics, Jpeg,
{$ENDIF}
Math,
fpeGlobal, fpeTags, fpeUtils, fpeExifData, fpeMetadata;
procedure TstExifLE.SetUp;
var
dir: String;
begin
if FileExists(Workfile_JpegWithExif) then
DeleteFile(WorkFile_JpegWithExif);
if FileExists(Workfile_TiffWithExif) then
DeleteFile(WorkFile_TiffWithExif);
if FileExists(Workfile_NoExif) then
DeleteFile(Workfile_NoExif);
dir := ExtractFileDir(WorkFile_JpegWithExif);
if not DirectoryExists(dir) then
ForceDirectories(dir);
if not FileExists(WorkFile_JpegWithExif) then
if FileExists(ExifJpegPic) then
CopyFile(ExifJpegPic, WorkFile_JpegWithExif);
if not FileExists(WorkFile_TiffWithExif) then
if FileExists(ExifTiffPic) then
CopyFile(ExifTiffPic, WorkFile_TiffWithExif);
if not FileExists(WorkFile_NoExif) then
if FileExists(NoExifPic) then
CopyFile(NoExifPic, WorkFile_NoExif);
end;
procedure TstExifLE.TearDown;
begin
if FileExists(WorkFile_NoExif) then
DeleteFile(WorkFile_NoExif);
if FileExists(WorkFile_JpegWithExif) then
DeleteFile(WorkFile_JpegWithExif);
if FileExists(WorkFile_TiffWithExif) then
DeleteFile(WorkFile_TiffWithExif);
end;
procedure TstExifLE.CheckForPictures;
begin
CheckTrue(FileExists(ExifJpegPic), 'Original test picture file "' + ExifJpegPic + '" does not exist');
CheckTrue(FileExists(ExifTiffPic), 'Original test picture file "' + ExifTiffPic + '" does not exist');
CheckTrue(FileExists(NoExifPic), 'Original test picture file "' + NoExifPic + '" does not exist');
CheckTrue(FileExists(WorkFile_JpegWithExif), 'Test picture file "' + WorkFile_JpegWithExif + '" does not exist');
CheckTrue(FileExists(WorkFile_TiffWithExif), 'Test picture file "' + WorkFile_TiffWithExif + '" does not exist');
CheckTrue(FileExists(WorkFile_NoExif), 'Test picture file "' + WorkFile_NoExif + '" does not exist');
end;
procedure TstExifLE.CheckCreateImgInfo;
var
imgInfo: TImgInfo;
begin
imgInfo := TImgInfo.Create();
try
CheckIs(imgInfo, TImgInfo,'Is not TImgInfo');
finally
imgInfo.Free;
end;
end;
procedure TstExifLE.Internal_CheckHasExif(AFileName: String; ExpectExif: Boolean);
var
imgInfo: TImgInfo;
begin
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(AFileName);
if ExpectExif then
CheckTrue(imgInfo.HasExif, 'Failure to detect EXIF in test picture file "' + AFileName + '"')
else
CheckFalse(imgInfo.HasExif, 'Unexpected EXIF in test picture file "' + AFileName + '" detected');
finally
imgInfo.Free;
end;
end;
procedure TstExifLE.CheckHasExif;
begin
Internal_CheckHasExif(WorkFile_JpegWithExif, true);
Internal_CheckHasExif(WorkFile_TiffWithExif, true);
Internal_CheckHasExif(WorkFile_NoExif, false);
end;
procedure TstExifLE.ReadExifTest_Jpeg;
{ Output of ExifTool for the jpeg test image with exif using this commandline:
exiftool -G -H -s with_exif.jpg > with_exif.txt
These values are checked
|
[ExifTool] - ExifToolVersion : 10.60
[File] - FileName : with_exif.jpg <--
[File] - Directory : .
[File] - FileSize : 5.0 kB <--
[File] - FileModifyDate : 2017:10:16 19:35:01+02:00
[File] - FileAccessDate : 2017:10:16 19:35:01+02:00
[File] - FileCreateDate : 2017:10:16 19:34:46+02:00
[File] - FilePermissions : rw-rw-rw-
[File] - FileType : JPEG
[File] - FileTypeExtension : jpg
[File] - MIMEType : image/jpeg
[File] - ExifByteOrder : Little-endian (Intel, II) <--
[File] - ImageWidth : 200 <--
[File] - ImageHeight : 150 <--
[File] - EncodingProcess : Baseline DCT, Huffman coding
[File] - BitsPerSample : 8
[File] - ColorComponents : 3
[File] - YCbCrSubSampling : YCbCr4:2:0 (2 2)
[EXIF] 0x010d DocumentName : Test image <--
[EXIF] 0x010e ImageDescription : This is just a test image <--
[EXIF] 0x0112 Orientation : Horizontal (normal) <--
[EXIF] 0x011a XResolution : 72 <--
[EXIF] 0x011b YResolution : 72 <--
[EXIF] 0x0128 ResolutionUnit : inches <--
[EXIF] 0x0131 Software : PhotoFiltre 7 <--
[EXIF] 0x0132 ModifyDate : 2017:10:14 23:35:07 <--
[EXIF] 0x9000 ExifVersion : 0210 <--
[EXIF] 0xa002 ExifImageWidth : 200 <--
[EXIF] 0xa003 ExifImageHeight : 150 <--
[EXIF] 0x0000 GPSVersionID : 2.3.0.0 <--
[EXIF] 0x0001 GPSLatitudeRef : South <--
[EXIF] 0x0003 GPSLongitudeRef : West <--
[Composite] - GPSLatitude : 51 deg 33' 48.28" S <-- fpExif coordinates without the S
[Composite] - GPSLongitude : 59 deg 49' 53.55" W <-- fpExif coordinates without the W
[Composite] - GPSPosition : 51 deg 33' 48.28" S, 59 deg 49' 53.55" W
[Composite] - ImageSize : 200x150
[Composite] - Megapixels : 0.030
}
var
imgInfo: TImgInfo;
lTag: TTag;
begin
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(WorkFile_JpegWithExif);
// This is general information stored within imgImfInfo
CheckEquals('with_exif.jpg', ExtractFileName(imgInfo.FileName), 'Filename mismatch');
CheckEquals('5.0', Format('%.1f', [imgInfo.FileSize/1024], fpExifFmtSettings), 'File size mismatch');
// CheckEquals('2017:10:14 23:57:49', FormatDateTime(EXIF_DATETIME_FORMAT, imgInfo.FileDate), 'File access date mismatch');
CheckEquals(200, imgInfo.ImgWidth, 'jpeg image width mismatch');
CheckEquals(150, imgInfo.ImgHeight, 'jpeg image height mismatch');
// The following pieces of information are obtained from the EXIF segment
CheckFalse(imgInfo.ExifData.BigEndian, 'Exif byte order detection error');
lTag := imgInfo.ExifData.TagByName['DocumentName'];
CheckTrue(lTag <> nil, 'Tag "DocumentName" not found');
CheckEquals('Test image', lTag.AsString, 'Value mismatch of tag "DocumentName"');
lTag := imgInfo.ExifData.TagByName['ImageDescription'];
CheckTrue(lTag <> nil, 'Tag "ImageDescription" not found');
CheckEquals('This is just a test image', lTag.AsString, 'Value mismatch of tag "ImageDescription"');
lTag := imgInfo.ExifData.TagByName['Orientation'];
CheckTrue(lTag <> nil, 'Tag "Orientation" not found');
CheckEquals('Horizontal (normal)', lTag.AsString, 'Value mismatch of tag "Orientation"');
lTag := imgInfo.ExifData.TagByName['XResolution'];
CheckTrue(lTag <> nil, 'Tag "XResolution" not found');
CheckEquals('72', lTag.AsString, 'Value mismatch of tag "XResolution"');
CheckTrue(lTag is TNumericTag, 'Tag "XResolution" is no TNumericTag');
CheckEquals(72, lTag.AsInteger, 'Integer value mismatch of tag "XResolution"');
CheckTrue(lTag is TFloatTag, 'Tag "XResolution" is no TNumericTag');
CheckEquals(72.0, lTag.AsFloat, 'Float value mismatch of tag "XResolution"');
lTag := imgInfo.ExifData.TagByName['YResolution'];
CheckTrue(lTag <> nil, 'Tag "YResolution" not found');
CheckEquals('72', lTag.AsString, 'Value mismatch of tag "YResolution"');
lTag := imgInfo.ExifData.TagByName['ResolutionUnit'];
CheckTrue(lTag <> nil, 'Tag "ResolutionUnit" not found');
CheckEquals('inches', lTag.AsString, 'Value mismatch of tag "ResolutionUnit"');
lTag := imgInfo.ExifData.TagByName['Software'];
CheckTrue(lTag <> nil, 'Tag "Software" not found');
CheckEquals('PhotoFiltre 7', lTag.AsString, 'Value mismatch of tag "Software"');
lTag := imgInfo.ExifData.TagByName['DateTime'];
CheckTrue(lTag <> nil, 'Tag "DateTime" not found');
CheckTrue(lTag is TDateTimeTag, 'Tag "DateTime" is no TDateTimeTag');
TDateTimeTag(lTag).FormatStr := EXIF_DATETIME_FORMAT;
CheckEquals('2017:10:14 23:35:07', lTag.AsString, 'Value mismatch of tag "DateTime"');
lTag := imgInfo.ExifData.TagByName['ExifVersion'];
CheckTrue(lTag <> nil, 'Tag "ExifVersion" not found');
CheckTrue(lTag is TVersionTag, 'Tag "ExifVersion" is not TVersionTag');
CheckEquals('0210', lTag.AsString, 'Value mismatch of tag "ExifVersion"');
lTag := imgInfo.ExifData.TagByName['ExifImageWidth'];
CheckTrue(lTag <> nil, 'Tag "ExifImageWidth" not found');
CheckEquals('200', lTag.AsString, 'Value mismatch of tag "ExifImageWidth"');
lTag := imgInfo.ExifData.TagByName['ExifImageHeight'];
CheckTrue(lTag <> nil, 'Tag "ExifImageHeight" not found');
CheckEquals('150', lTag.AsString, 'Value mismatch of tag "ExifImageHeight"');
finally
imgInfo.Free;
end;
end;
procedure TstExifLE.ReadExifTest_Tiff;
{ Output of ExifTool for the tiff test image with exif using this commandline:
exiftool -G -H -s with_exif.tif > with_exif_tif.txt
These values are checked
|
[ExifTool] - ExifToolVersion : 10.60
[File] - FileName : with_exif.tif
[File] - Directory : .
[File] - FileSize : 88 kB
[File] - FileModifyDate : 2017:10:16 10:07:38+02:00
[File] - FileAccessDate : 2017:10:16 10:07:38+02:00
[File] - FileCreateDate : 2017:10:16 10:07:38+02:00
[File] - FilePermissions : rw-rw-rw-
[File] - FileType : TIFF
[File] - FileTypeExtension : tif
[File] - MIMEType : image/tiff
[File] - ExifByteOrder : Little-endian (Intel, II)
[EXIF] 0x0100 ImageWidth : 200
[EXIF] 0x0101 ImageHeight : 150
[EXIF] 0x0102 BitsPerSample : 8 8 8
[EXIF] 0x0103 Compression : Uncompressed
[EXIF] 0x0106 PhotometricInterpretation : RGB
[EXIF] 0x0111 StripOffsets : (Binary data 68 bytes, use -b option to extract)
[EXIF] 0x0115 SamplesPerPixel : 3
[EXIF] 0x0116 RowsPerStrip : 13
[EXIF] 0x0117 StripByteCounts : (Binary data 59 bytes, use -b option to extract)
[EXIF] 0x011a XResolution : 72
[EXIF] 0x011b YResolution : 72
[EXIF] 0x011c PlanarConfiguration : Chunky
[EXIF] 0x0128 ResolutionUnit : inches
[EXIF] 0x0131 Software : LIBFORMAT (c) Pierre-e Gougelet
[EXIF] 0x0132 ModifyDate : 2017:10:14 23:35:07
[EXIF] 0x9000 ExifVersion : 0210
[EXIF] 0xa002 ExifImageWidth : 200
[Composite] - ImageSize : 200x150
[Composite] - Megapixels : 0.030 }
var
imgInfo: TImgInfo;
lTag: TTag;
begin
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(WorkFile_TiffWithExif);
// This is general information stored within imgImfInfo
CheckEquals('with_exif.tif', ExtractFileName(imgInfo.FileName), 'Filename mismatch');
CheckEquals('88', Format('%.0f', [imgInfo.FileSize/1024], fpExifFmtSettings), 'File size mismatch');
// The following pieces of information are obtained from the EXIF segment
CheckFalse(imgInfo.ExifData.BigEndian, 'Exif byte order detection error');
lTag := imgInfo.ExifData.TagByName['ImageWidth'];
CheckTrue(lTag <> nil, 'Tag "ImageWidth" not found');
CheckEquals(200, lTag.AsInteger, 'Value mismatch of tag "ImageWidth"');
lTag := imgInfo.ExifData.TagByName['ImageHeight'];
CheckTrue(lTag <> nil, 'Tag "ImageHeight" not found');
CheckEquals(150, lTag.AsInteger, 'Value mismatch of tag "ImageHeight"');
lTag := imgInfo.ExifData.TagByName['BitsPerSample'];
CheckTrue(lTag <> nil, 'Tag "BitsPerSample" not found');
CheckEquals('8,8,8', lTag.AsString, 'Value mismatch of tag "BitsPerSample"');
lTag := imgInfo.ExifData.TagByName['Compression'];
CheckTrue(lTag <> nil, 'Tag "Compression" not found');
CheckEquals('Uncompressed', lTag.AsString, 'Value mismatch of tag "Compression"');
lTag := imgInfo.ExifData.TagByName['PhotometricInterpretation'];
CheckTrue(lTag <> nil, 'Tag "PhotometricInterpretation" not found');
CheckEquals('RGB', lTag.AsString, 'Value mismatch of tag "PhotometricInterpretation"');
lTag := imgInfo.ExifData.TagByName['SamplesPerPixel'];
CheckTrue(lTag <> nil, 'Tag "SamplesPerPixel" not found');
CheckEquals(3, lTag.AsInteger, 'Value mismatch of tag "SamplesPerPixel"');
lTag := imgInfo.ExifData.TagByName['RowsPerStrip'];
CheckTrue(lTag <> nil, 'Tag "RowsPerStrip" not found');
CheckEquals(13, lTag.AsInteger, 'Value mismatch of tag "RowsPerStrip"');
lTag := imgInfo.ExifData.TagByName['XResolution'];
CheckTrue(lTag <> nil, 'Tag "XResolution" not found');
CheckEquals(72, lTag.AsInteger, 'Integer value mismatch of tag "XResolution"');
lTag := imgInfo.ExifData.TagByName['YResolution'];
CheckTrue(lTag <> nil, 'Tag "YResolution" not found');
CheckEquals(72, lTag.AsInteger, 'Value mismatch of tag "YResolution"');
lTag := imgInfo.ExifData.TagByName['PlanarConfiguration'];
CheckTrue(lTag <> nil, 'Tag "PlanarConfiguration" not found');
CheckEquals('Chunky', lTag.AsString, 'Value mismatch of tag "PlanarConfiguration"');
lTag := imgInfo.ExifData.TagByName['ResolutionUnit'];
CheckTrue(lTag <> nil, 'Tag "ResolutionUnit" not found');
CheckEquals('inches', lTag.AsString, 'Value mismatch of tag "ResolutionUnit"');
lTag := imgInfo.ExifData.TagByName['Software'];
CheckTrue(lTag <> nil, 'Tag "Software" not found');
CheckEquals('LIBFORMAT (c) Pierre-e Gougelet', lTag.AsString, 'Value mismatch of tag "Software"');
lTag := imgInfo.ExifData.TagByName['DateTime'];
CheckTrue(lTag <> nil, 'Tag "DateTime" not found');
CheckTrue(lTag is TDateTimeTag, 'Tag "DateTime" is no TDateTimeTag');
TDateTimeTag(lTag).FormatStr := EXIF_DATETIME_FORMAT;
CheckEquals('2017:10:14 23:35:07', lTag.AsString, 'Value mismatch of tag "DateTime"');
lTag := imgInfo.ExifData.TagByName['ExifVersion'];
CheckTrue(lTag <> nil, 'Tag "ExifVersion" not found');
CheckTrue(lTag is TVersionTag, 'Tag "ExifVersion" is not TVersionTag');
CheckEquals('0210', lTag.AsString, 'Value mismatch of tag "ExifVersion"');
lTag := imgInfo.ExifData.TagByName['ExifImageWidth'];
CheckTrue(lTag <> nil, 'Tag "ExifImageWidth" not found');
CheckEquals(200, lTag.AsInteger, 'Value mismatch of tag "ExifImageWidth"');
finally
imgInfo.Free;
end;
end;
{ This test read the GPS data contained in file "with_exif.jpg". The GPS
data were written there using the service https://www.geoimgr.com/
See expected values in comment of "ReadExifTest". }
procedure TstExifLE.ReadGPSTest;
var
imgInfo: TImgInfo;
lTag: TTag;
begin
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(WorkFile_JpegWithExif);
lTag := imgInfo.ExifData.TagByName['GPSVersionID'];
CheckTrue(lTag <> nil, 'Tag "GPSVersionID" not found');
CheckTrue(lTag is TVersionTag, 'Tag "GPSVersionID" is not TVersionTag');
TVersionTag(lTag).Separator := '.';
CheckEquals('2.3.0.0', lTag.AsString, 'Value mismatch of tag "GPSVersionID"');
lTag := imgInfo.ExifData.TagByName['GPSLatitude'];
CheckTrue(lTag <> nil, 'Tag "GPSLatitude" not found');
CheckTrue(lTag is TGPSPositionTag, 'Tag "GPSLatitude" is not a TGpsPositionTag');
TGpsPositionTag(lTag).FormatStr := '%0:.0f deg %1:.0f'' %2:.2f"';
CheckEquals('51 deg 33'' 48.28"', lTag.AsString, 'Value mismatch of tag "GPSLatitude"');
lTag := imgInfo.ExifData.TagByName['GPSLatitudeRef'];
CheckTrue(lTag <> nil, 'Tag "GPSLatitudeRef" not found');
CheckEquals('South', lTag.AsString, 'Value mismatch of tag "GPSLatitudeRef"');
lTag := imgInfo.ExifData.TagByName['GPSLongitude'];
CheckTrue(lTag <> nil, 'Tag "GPSLongitude" not found');
CheckTrue(lTag is TGPSPositionTag, 'Tag "GPSLongitude" is not a TGpsPositionTag');
TGpsPositionTag(lTag).FormatStr := '%0:.0f deg %1:.0f'' %2:.2f"';
CheckEquals('59 deg 49'' 53.55"', lTag.AsString, 'Value mismatch of tag "GPSLongitude"');
lTag := imgInfo.ExifData.TagByName['GPSLongitudeRef'];
CheckTrue(lTag <> nil, 'Tag "GPSLongitudeRef" not found');
CheckEquals('West', lTag.AsString, 'Value mismatch of tag "GPSLongitudeRef"');
finally
imgInfo.Free;
end;
end;
{ This test creates a new empty exif structure, but does not write anything to
file. }
procedure TstExifLE.CreateExifTest;
var
imgInfo: TImgInfo;
begin
imgInfo := TImgInfo.Create;
try
CheckTrue(imgInfo.ExifData = nil, 'EXIF found, but not expected.');
imgInfo.CreateExifData;
CheckTrue(imgInfo.ExifData <> nil, 'EXIF not found.');
finally
imgInfo.Free;
end;
end;
{ This test creates an empty EXIF structure, fills it with some data and saves
it to the No_exif file. After writing the file is read back and compared
with the written data. }
procedure TstExifLE.WriteExifTest_Jpeg;
var
imgInfo: TImgInfo;
lTag: TTag;
begin
imgInfo := TImgInfo.Create;
try
// Create empty EXIF
imgInfo.CreateExifData;
// Add tags
lTag := imgInfo.ExifData.AddTagByName('Primary.DocumentName');
lTag.AsString := 'Test image';
lTag := imgInfo.ExifData.AddTagByName('ImageDescription');
lTag.AsString := 'This is just a test image';
lTag := imgInfo.ExifData.AddTagByName('Orientation');
CheckTrue(lTag <> nil, 'Tag "Orientation" not found for writing');
lTag.AsString := 'Horizontal (normal)';
lTag := imgInfo.ExifData.AddTagByName('XResolution');
CheckTrue(lTag <> nil, 'Tag "XResolution" not found for writing');
lTag.AsInteger := 72;
lTag := imgInfo.ExifData.AddTagByName('YResolution');
CheckTrue(lTag <> nil, 'Tag "YResolution" not found for writing');
lTag.AsInteger := 72;
lTag := imgInfo.ExifData.AddTagByName('ResolutionUnit');
CheckTrue(lTag <> nil, 'Tag "ResolutionUnit" not found for writing');
ltag.AsString := 'inches';
lTag := imgInfo.ExifData.AddTagByName('Software');
CheckTrue(lTag <> nil, 'Tag "Software" not found for writing');
lTag.AsString := 'FPC/fpExif';
lTag := imgInfo.ExifData.AddTagByName('DateTime');
CheckTrue(lTag <> nil, 'Tag "DateTime" not found for writing');
CheckTrue(lTag is TDateTimeTag, 'Tag "DateTime" is no TDateTimeTag');
TDateTimeTag(lTag).AsDateTime := EncodeDate(2017,10,14) + EncodeTime(23,35,07,0);
lTag := imgInfo.ExifData.AddTagByName('ExifVersion');
CheckTrue(lTag <> nil, 'Tag "ExifVersion" not found for writing');
CheckTrue(lTag is TVersionTag, 'Tag "ExifVersion" is not TVersionTag');
TVersionTag(lTag).AsString := '0210';
lTag := imgInfo.ExifData.AddTagByName('ExifImageWidth');
CheckTrue(lTag <> nil, 'Tag "ExifImageWidth" not found for writing');
lTag.AsInteger := 200;
lTag := imgInfo.ExifData.AddTagByName('ExifImageHeight');
CheckTrue(lTag <> nil, 'Tag "ExifImageHeight" not found for writing');
lTag.AsInteger := 150;
// Save to file;
// Takes the image data from WorkFile_WithExif, replaces its EXIF with the
// current EXIF structure and writes to WorkFile_NoExif.
imgInfo.SaveToFile(WorkFile_NoExif, Workfile_JpegWithExif);
finally
imgInfo.Free;
end;
// Read written file and check EXIF
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(Workfile_NoExif);
// Now there should be EXIF
CheckTrue(imgInfo.ExifData <> nil, 'EXIF not found.');
lTag := imgInfo.ExifData.TagByName['DocumentName'];
CheckTrue(lTag <> nil, 'Tag "DocumentName" not found for reading');
CheckEquals('Test image', lTag.AsString, 'Value mismatch of tag "DocumentName"');
lTag := imgInfo.ExifData.TagByName['ImageDescription'];
CheckTrue(lTag <> nil, 'Tag "ImageDescription" not found for reading');
CheckEquals('This is just a test image', lTag.AsString, 'Value mismatch of tag "ImageDescription"');
lTag := imgInfo.ExifData.TagByName['Orientation'];
CheckTrue(lTag <> nil, 'Tag "Orientation" not found for reading');
CheckEquals('Horizontal (normal)', lTag.AsString, 'Value mismatch of tag "Orientation"');
lTag := imgInfo.ExifData.TagByName['XResolution'];
CheckTrue(lTag <> nil, 'Tag "XResolution" not found for reading');
CheckEquals(72, lTag.AsInteger, 'Integer value mismatch of tag "XResolution"');
lTag := imgInfo.ExifData.TagByName['YResolution'];
CheckTrue(lTag <> nil, 'Tag "YResolution" not found for reading');
CheckEquals('72', lTag.AsString, 'Value mismatch of tag "YResolution"');
lTag := imgInfo.ExifData.TagByName['ResolutionUnit'];
CheckTrue(lTag <> nil, 'Tag "ResolutionUnit" not found for reading');
CheckEquals('inches', lTag.AsString, 'Value mismatch of tag "ResolutionUnit"');
lTag := imgInfo.ExifData.TagByName['Software'];
CheckTrue(lTag <> nil, 'Tag "Software" not found for reading');
CheckEquals('FPC/fpExif', lTag.AsString, 'Value mismatch of tag "Software"');
lTag := imgInfo.ExifData.TagByName['DateTime'];
CheckTrue(lTag <> nil, 'Tag "DateTime" not found for reading');
CheckTrue(lTag is TDateTimeTag, 'Tag "DateTime" is no TDateTimeTag');
TDateTimeTag(lTag).FormatStr := ISO_DATETIME_FORMAT;
CheckEquals('2017-10-14 23:35:07', lTag.AsString, 'Value mismatch of tag "DateTime"');
lTag := imgInfo.ExifData.TagByName['ExifVersion'];
CheckTrue(lTag <> nil, 'Tag "ExifVersion" not found for reading');
CheckTrue(lTag is TVersionTag, 'Tag "ExifVersion" is not TVersionTag');
CheckEquals('0210', lTag.AsString, 'Value mismatch of tag "ExifVersion"');
lTag := imgInfo.ExifData.TagByName['ExifImageWidth'];
CheckTrue(lTag <> nil, 'Tag "ExifImageWidth" not found for reading');
CheckEquals('200', lTag.AsString, 'Value mismatch of tag "ExifImageWidth"');
lTag := imgInfo.ExifData.TagByName['ExifImageHeight'];
CheckTrue(lTag <> nil, 'Tag "ExifImageHeight" not found for reading');
CheckEquals('150', lTag.AsString, 'Value mismatch of tag "ExifImageHeight"');
finally
imgInfo.Free;
end;
end;
{ This test loads the With_Exif and changes the GPS data, saves to the same file,
reads back and checks validity of the GPS data. }
procedure TstExifLE.WriteGpsTest_Jpeg;
var
imgInfo: TImgInfo;
lTag: TTag;
begin
imgInfo := TImgInfo.Create;
try
imgInfo.LoadfromFile(Workfile_JpegWithExif);
// In spite of its name, the file must contain EXIF now, written in prev test.
CheckTrue(imgInfo.ExifData <> nil, 'EXIF not found.');
// Add tags
lTag := imgInfo.ExifData.AddTagByName('GPSVersionID');
CheckTrue(lTag <> nil, 'Tag "GPSVersionID" not found');
CheckTrue(lTag is TVersionTag, 'Tag "GPSVersionID" is not TVersionTag');
TVersionTag(lTag).Separator := '.';
lTag.AsString := '2.3.1.1';
lTag := imgInfo.ExifData.AddTagByName('GPSLatitude');
CheckTrue(lTag <> nil, 'Tag "GPSLatitude" not found');
CheckTrue(lTag is TGPSPositionTag, 'Tag "GPSLatitude" is not a TGpsPositionTag');
TGpsPositionTag(lTag).FormatStr := '%0:.0f deg %1:.0f'' %2:.2f"';
lTag.AsString := '45 deg 30'' 15.32"';
lTag := imgInfo.ExifData.AddTagByName('GPSLatitudeRef');
CheckTrue(lTag <> nil, 'Tag "GPSLatitudeRef" not found');
lTag.AsString := 'North';
lTag := imgInfo.ExifData.AddTagByName('GPSLongitude');
CheckTrue(lTag <> nil, 'Tag "GPSLongitude" not found');
CheckTrue(lTag is TGPSPositionTag, 'Tag "GPSLongitude" is not a TGpsPositionTag');
TGpsPositionTag(lTag).FormatStr := '%0:.0f deg %1:.0f'' %2:.2f"';
lTag.AsString := '15 deg 16'' 17.18"';
lTag := imgInfo.ExifData.AddTagByName('GPSLongitudeRef');
CheckTrue(lTag <> nil, 'Tag "GPSLongitudeRef" not found');
lTag.AsString := 'East';
// Save to file
imgInfo.SaveToFile(WorkFile_JpegWithExif);
finally
imgInfo.Free;
end;
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(Workfile_JpegWithExif);
CheckTrue(imgInfo.ExifData <> nil, 'EXIF not found after writing.');
lTag := imgInfo.ExifData.TagByName['GPSVersionID'];
CheckTrue(lTag <> nil, 'Tag "GPSVersionID" not found');
CheckTrue(lTag is TVersionTag, 'Tag "GPSVersionID" is not TVersionTag');
TVersionTag(lTag).Separator := '.';
CheckEquals('2.3.1.1', lTag.AsString, 'Value mismatch of tag "GPSVersionID"');
lTag := imgInfo.ExifData.TagByName['GPSLatitude'];
CheckTrue(lTag <> nil, 'Tag "GPSLatitude" not found');
CheckTrue(lTag is TGPSPositionTag, 'Tag "GPSLatitude" is not a TGpsPositionTag');
TGpsPositionTag(lTag).FormatStr := '%0:.0f deg %1:.0f'' %2:.2f"';
CheckEquals('45 deg 30'' 15.32"', lTag.AsString, 'Value mismatch of tag "GPSLatitude"');
lTag := imgInfo.ExifData.TagByName['GPSLatitudeRef'];
CheckTrue(lTag <> nil, 'Tag "GPSLatitudeRef" not found');
CheckEquals('North', lTag.AsString, 'Value mismatch of tag "GPSLatitudeRef"');
lTag := imgInfo.ExifData.TagByName['GPSLongitude'];
CheckTrue(lTag <> nil, 'Tag "GPSLongitude" not found');
CheckTrue(lTag is TGPSPositionTag, 'Tag "GPSLongitude" is not a TGpsPositionTag');
TGpsPositionTag(lTag).FormatStr := '%0:.0f deg %1:.0f'' %2:.2f"';
CheckEquals('15 deg 16'' 17.18"', lTag.AsString, 'Value mismatch of tag "GPSLongitude"');
lTag := imgInfo.ExifData.TagByName['GPSLongitudeRef'];
CheckTrue(lTag <> nil, 'Tag "GPSLongitudeRef" not found');
CheckEquals('East', lTag.AsString, 'Value mismatch of tag "GPSLongitudeRef"');
finally
imgInfo.Free;
end;
end;
procedure TstExifLE.ValidFileTest_Jpeg;
var
jpg: TJpegImage;
fn: string;
bmp: TBitmap;
success: Boolean;
begin
// Modify the EXIF structure of WorkFile_WithExif;
fn := Workfile_JpegWithExif;
WriteExifTest_Jpeg;
success := false;
jpg := TJpegImage.Create;
try
jpg.LoadFromFile(fn);
bmp := TBitmap.Create;
try
bmp.Width := jpg.Width;
bmp.Height := jpg.Height;
bmp.Canvas.Draw(0, 0, jpg);
success := true;
finally
bmp.Free;
CheckTrue(success, 'Non-readable file');
end;
finally
jpg.Free;
end;
end;
procedure TstExifLE.CreateThumbnail_Jpeg;
const
THUMBSIZE = 120;
var
imgInfo: TImgInfo;
srcStream, destStream: TMemoryStream;
destStreamSize, currentThumbSize: Int64;
w, h: Integer;
begin
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(Workfile_JpegWithExif);
CheckTrue(imgInfo.ExifData <> nil, 'EXIF not found.');
CheckFalse(imgInfo.ExifData.HasThumbnail, 'Presence of thumbnail not expected');
srcStream := TMemoryStream.Create;
destStream := TMemoryStream.Create;
try
srcStream.LoadFromFile(Workfile_JpegWithExif);
JPEGScaleImage(srcStream, destStream, THUMBSIZE);
destStreamSize := destStream.Size;
destStream.Position := 0;
imgInfo.ExifData.LoadThumbnailFromStream(deststream);
finally
destStream.Free;
srcStream.Free;
end;
CheckTrue(imgInfo.ExifData.HasThumbnail, 'Thumbnail not found.');
w := imgInfo.ExifData.TagByName['ThumbnailWidth'].AsInteger;
h := imgInfo.ExifData.TagByName['ThumbnailHeight'].AsInteger;
currentThumbSize := imgInfo.ExifData.TagByName['ThumbnailSize'].AsInteger;
CheckEquals(THUMBSIZE, Max(w, h), 'Thumbnailsize mismatch');
CheckEquals(destStreamSize, currentThumbSize, 'Thumbnail size mismatch');
finally
imgInfo.Free;
end;
end;
initialization
{$IFDEF FPC}
RegisterTest(TstExifLE);
{$ELSE}
TestFramework.RegisterTest(TstExifLE.Suite);
{$ENDIF}
end.

View File

@ -0,0 +1,815 @@
unit fetIptc;
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}
interface
uses
Classes, SysUtils,
{$ifdef FPC}
fpcunit, testutils, testregistry;
{$else}
fetTestUtils, TestFrameWork;
{$endif}
const
// Picture with Exif data, jpeg and tiff
IptcJpegPic = '..\pictures\originals\with_iptc.jpg';
IptcTiffPic = '..\pictures\originals\with_iptc.tif';
WorkFile_JpegWithIptc = 'pictures\with_iptc.jpg';
WorkFile_TiffWithIptc = 'pictures\with_iptc.tif';
// Picture without Iptc data
NoIptcPic = '..\pictures\originals\no_metadata.jpg';
WorkFile_NoIptc = 'pictures\no_iptc.jpg';
type
TstIptc = class(TTestCase)
protected
procedure SetUp; override;
procedure TearDown; override;
procedure Internal_CheckHasIptc(AFileName: String; ExpectIptc: Boolean);
published
procedure CheckForPictures;
procedure CheckCreateImgInfo;
procedure CheckHasIptc;
procedure ReadIptcTest_Jpeg;
procedure ReadIptcTest_Tiff;
procedure CreateIptcTest;
procedure WriteIptcTest_Jpeg;
end;
implementation
uses
{$IFDEF FPC}
Graphics, FileUtil,
{$ELSE}
Graphics, Jpeg,
{$ENDIF}
fpeGlobal, fpeUtils, fpeTags, fpeIptcData, fpeMetadata;
procedure TstIptc.SetUp;
var
dir: String;
begin
if FileExists(WorkFile_NoIptc) then
DeleteFile(WorkFile_NoIptc);
if FileExists(WorkFile_JpegWithIptc) then
DeleteFile(WorkFile_JpegWithIptc);
if FileExists(WorkFile_TiffWithIptc) then
DeleteFile(WorkFile_TiffWithIptc);
dir := ExtractFileDir(WorkFile_JpegWithIptc);
if not DirectoryExists(dir) then
ForceDirectories(dir);
if not FileExists(WorkFile_JpegWithIptc) then
if FileExists(IptcJpegPic) then
CopyFile(IptcJPegPic, WorkFile_JpegWithIptc);
if not FileExists(WorkFile_TiffWithIptc) then
if FileExists(IptcTiffPic) then
CopyFile(IptcTiffPic, WorkFile_TiffWithIptc);
if not FileExists(WorkFile_NoIptc) then
if FileExists(NoIptcPic) then
CopyFile(NoIptcPic, WorkFile_NoIptc);
end;
procedure TstIptc.TearDown;
begin
if FileExists(WorkFile_NoIptc) then
DeleteFile(WorkFile_NoIptc);
if FileExists(WorkFile_JpegWithIptc) then
DeleteFile(WorkFile_JpegWithIptc);
if FileExists(WorkFile_TiffWithIptc) then
DeleteFile(WorkFile_TiffWithIptc);
end;
procedure TstIptc.CheckForPictures;
begin
CheckTrue(FileExists(IptcJPegPic), 'Original test picture file "' + IptcJpegPic + '" does not exist');
CheckTrue(FileExists(IptcTiffPic), 'Original test picture file "' + IptcTiffPic + '" does not exist');
CheckTrue(FileExists(NoIptcPic), 'Original test picture file "' + NoIptcPic + '" does not exist');
CheckTrue(FileExists(WorkFile_JpegWithIptc), 'Test picture file "' + WorkFile_JpegWithIptc + '" does not exist');
CheckTrue(FileExists(WorkFile_TiffWithIptc), 'Test picture file "' + WorkFile_TiffWithIptc + '" does not exist');
CheckTrue(FileExists(WorkFile_NoIptc), 'Test picture file "' + WorkFile_NoIptc + '" does not exist');
end;
procedure TstIptc.CheckCreateImgInfo;
var
imgInfo: TImgInfo;
begin
imgInfo := TImgInfo.Create();
try
CheckIs(imgInfo, TImgInfo, 'Is not TImgInfo');
finally
imgInfo.Free;
end;
end;
procedure TstIptc.Internal_CheckHasIptc(AFileName: String; ExpectIptc: Boolean);
var
imgInfo: TImgInfo;
begin
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(AFileName);
if ExpectIptc then
CheckTrue(imgInfo.HasIptc, 'Failure to detect IPTC in test picture file "' + AFileName + '"')
else
CheckFalse(imgInfo.HasIptc, 'Unexected IPTC in test picture file "' + AFileName + '" detected');
finally
imgInfo.Free;
end;
end;
procedure TstIptc.CheckHasIptc;
begin
Internal_CheckHasIptc(WorkFile_JpegWithIptc, true);
Internal_CheckHasIptc(WorkFile_TiffWithIptc, true);
Internal_CheckHasIptc(WorkFile_NoIptc, false);
end;
procedure TstIptc.ReadIptcTest_Jpeg;
{ Output of ExifTool for the test image with exif (using parameters -G -H -s):
(All these values are checked)
[IPTC] 0x0005 ObjectName Title of the test image <-- ok
[IPTC] 0x0007 EditStatus finished <-- ok
[IPTC] 0x000a Urgency 5 (normal urgency) <-- ok
[IPTC] 0x000f Category TST <-- ok
[IPTC] 0x0016 FixtureIdentifier JobID_1 <-- is named "FixtureID" by fpExif
[IPTC] 0x0019 Keywords yellow, red, blue, green, rectangles <-- ok
[IPTC] 0x001a ContentLocationCode USA <-- ok
[IPTC] 0x001e ReleaseDate 2017:10:15 <-- ok
[IPTC] 0x0023 ReleaseTime 22:34:47 <-- ok
[IPTC] 0x0028 SpecialInstructions No other comments <-- is named "SpecialInstruct" by fpExif
[IPTC] 0x0037 DateCreated 2017:10:15 <-- ok
[IPTC] 0x003c TimeCreated 12:11:59 <-- ok
[IPTC] 0x0041 OriginatingProgram PhotoFiltre <-- ok
[IPTC] 0x0046 ProgramVersion 7 <-- ok
[IPTC] 0x004b ObjectCycle Both Morning and Evening <-- value is encoded as "both" by fpExif
[IPTC] 0x0050 By-line wp <-- ok
[IPTC] 0x0055 By-lineTitle Staff <-- ok
[IPTC] 0x005a City My hometown <-- ok
[IPTC] 0x005c Sub-location My suburb <-- is named "SubLocation" by fpExif
[IPTC] 0x005f Province-State My province <-- is named "State" by fpexif
[IPTC] 0x0064 Country-PrimaryLocationCode USA <-- is named "LocationCode" by fpExif
[IPTC] 0x0065 Country-PrimaryLocationName My country <-- is named "LocationName" by fpExif
[IPTC] 0x0067 OriginalTransmissionReference requested by myself <-- is named "TransmissionRef" by fpExif
[IPTC] 0x0069 Headline Test image <-- ok
[IPTC] 0x006e Credit FPC <-- is named "ImageCredit" by fpExif
[IPTC] 0x0073 Source self-made <-- ok
[IPTC] 0x0074 CopyrightNotice (c) wp <-- is named "Copyright" by fpExif
[IPTC] 0x0076 Contact w.p@wp.com, +123 4567890 <-- ok
[IPTC] 0x0078 Caption-Abstract Test image <-- is named "ImageCaption" by fpExif
[IPTC] 0x007a Writer-Editor wp <-- is named "ImageCaptionWriter by fpExif
}
var
imgInfo: TImgInfo;
lTag: TTag;
begin
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(WorkFile_JpegWithIptc);
CheckTrue(imgInfo.HasIptc, 'IPTC in test picture file "' + WorkFile_JpegWithIptc + '" not found');
// The following pieces of information are obtained from the IPTC segment
lTag := imgInfo.IptcData.TagByName['ObjectName'];
CheckTrue(lTag <> nil, 'Tag "ObjectName" not found');
CheckEquals('Title of the test image', lTag.AsString, 'Value mismatch in tag "ObjectName"');
lTag := imgInfo.IptcData.TagByName['EditStatus'];
CheckTrue(lTag <> nil, 'Tag "EditStatus" not found');
CheckEquals('finished', lTag.AsString, 'Value mismatch in tag "EditStatus"');
lTag := imgInfo.IptcData.TagByName['Urgency'];
CheckTrue(lTag <> nil, 'Tag "Urgency" not found');
lTag.DecodeValue:= false;
CheckEquals('5', lTag.AsString, 'Value mismatch in tag "Urgency"');
lTag := imgInfo.IptcData.TagByName['Category'];
CheckTrue(lTag <> nil, 'Tag "Category" not found');
CheckEquals('TST', lTag.AsString, 'Value mismatch in tag "Category"');
lTag := imgInfo.IptcData.TagByName['FixtureID'];
CheckTrue(lTag <> nil, 'Tag "FixtureID" not found');
CheckEquals('JobID_1', lTag.AsString, 'Value mismatch in tag "FixtureID"');
lTag := imgInfo.IptcData.TagByName['Keywords'];
CheckTrue(lTag <> nil, 'Tag "Keywords" not found');
CheckEquals('yellow, red, blue, green, rectangles', lTag.AsString, 'Value mismatch of tag "Keywords"');
lTag := imgInfo.IptcData.TagByName['ContentLocCode'];
CheckTrue(lTag <> nil, 'Tag "ContentLocCode" not found');
CheckEquals('USA', lTag.AsString, 'Value mismatch of tag "ContentLocCode"');
lTag := imgInfo.IptcData.TagByName['ReleaseDate'];
CheckTrue(lTag <> nil, 'Tag "ReleaseDate" not found');
CheckEquals(TIptcDateTag, lTag.ClassType, 'Tag "ReleaseDate" is not a TIptcDateTag.');
TIptcDateTag(lTag).FormatStr := EXIF_DATE_FORMAT;
CheckEquals('2017:10:15', TIptcDateTag(lTag).AsString, 'Value mismatch of tag "ReleaseDate"');
lTag := imgInfo.IptcData.TagByName['ReleaseTime'];
CheckTrue(lTag <> nil, 'Tag "ReleaseTime" not found');
CheckEquals(TIptcTimeTag, lTag.ClassType, 'Tag "ReleaseTime" is not a TIptcTimeTag');
TIptcTimeTag(lTag).FormatStr := EXIF_TIME_FORMAT;
CheckEquals('22:34:47', TIptcTimeTag(lTag).AsString, 'Value mismatch of tag "ReleaseTime"');
lTag := imgInfo.IptcData.TagByName['SpecialInstruct'];
CheckTrue(lTag <> nil, 'Tag "SpecialInstruct" not found');
CheckEquals('No other comments', lTag.AsString, 'Value mismatch in tag "SpecialInstruct"');
lTag := imgInfo.IptcData.TagByName['DateCreated'];
CheckTrue(lTag <> nil, 'Tag "DateCreated" not found');
CheckEquals(TIptcDateTag, lTag.ClassType, 'Tag "DateCreated" is not a TIptcDateTag.');
TIptcDateTag(lTag).FormatStr := EXIF_DATE_FORMAT;
CheckEquals('2017:10:15', TIptcDateTag(lTag).AsString, 'Value mismatch of tag "DateCreated"');
lTag := imgInfo.IptcData.TagByName['TimeCreated'];
CheckTrue(lTag <> nil, 'Tag "TimeCreated" not found');
CheckEquals(TIptcTimeTag, lTag.ClassType, 'Tag "TimeCreated" is not a TIptcTimeTag');
TIptcTimeTag(lTag).FormatStr := EXIF_TIME_FORMAT;
CheckEquals('12:11:59', TIptcTimeTag(lTag).AsString, 'Value mismatch of tag "TimeCreated"');
lTag := imgInfo.IptcData.TagByName['OriginatingProgram'];
CheckTrue(lTag <> nil, 'Tag "OriginatingProgram" not found');
CheckEquals('PhotoFiltre', lTag.AsString, 'Value mismatch of tag "OriginatingProgram"');
lTag := imgInfo.IptcData.TagByName['ProgramVersion'];
CheckTrue(lTag <> nil, 'Tag "ProgramVersion" not found');
CheckEquals('7', lTag.AsString, 'Value mismatch of tag "ProgramVersion"');
lTag := imgInfo.IptcData.TagByName['ObjectCycle'];
CheckTrue(lTag <> nil, 'Tag "ObjectCycle" not found');
lTag.DecodeValue := true;
CheckEquals('both', lTag.AsString, 'Value mismatch of tag "ObjectCycle"');
lTag := imgInfo.IptcData.TagByName['ByLine'];
CheckTrue(lTag <> nil, 'Tag "ByLine" not found');
CheckEquals('wp', lTag.AsString, 'Value mismatch of tag "ByLine"');
lTag := imgInfo.IptcData.TagByName['ByLineTitle'];
CheckTrue(lTag <> nil, 'Tag "ByLineTitle" not found');
CheckEquals('Staff', lTag.AsString, 'Value mismatch of tag "ByLineTitle"');
lTag := imgInfo.IptcData.TagByName['City'];
CheckTrue(lTag <> nil, 'Tag "City" not found');
CheckEquals('My hometown', lTag.AsString, 'Value mismatch of tag "City"');
lTag := imgInfo.IptcData.TagByName['SubLocation'];
CheckTrue(lTag <> nil, 'Tag "SubLocation" not found');
CheckEquals('My suburb', lTag.AsString, 'Value mismatch of tag "SubLocation"');
lTag := imgInfo.IptcData.TagByName['State'];
CheckTrue(lTag <> nil, 'Tag "State" not found');
CheckEquals('My province', lTag.AsString, 'Value mismatch of tag "State"');
lTag := imgInfo.IptcData.TagByName['LocationCode'];
CheckTrue(lTag <> nil, 'Tag "LocationCode" not found');
CheckEquals('USA', lTag.AsString, 'Value mismatch of tag "LocationCode"');
lTag := imgInfo.IptcData.TagByName['LocationName'];
CheckTrue(lTag <> nil, 'Tag "LocationName" not found');
CheckEquals('My country', lTag.AsString, 'Value mismatch of tag "LocationName"');
lTag := imgInfo.IptcData.TagByName['TransmissionRef'];
CheckTrue(lTag <> nil, 'Tag "TransmissionRef" not found');
CheckEquals('requested by myself', lTag.AsString, 'Value mismatch of tag "TransmissionRef"');
lTag := imgInfo.IptcData.TagByName['ImageHeadline'];
CheckTrue(lTag <> nil, 'Tag "ImageHeadline" not found');
CheckEquals('Test image', lTag.AsString, 'Value mismatch of tag "ImageHeadline"');
lTag := imgInfo.IptcData.TagByName['ImageCredit'];
CheckTrue(lTag <> nil, 'Tag "ImageCredit" not found');
CheckEquals('FPC', lTag.AsString, 'Value mismatch of tag "ImageCredit"');
lTag := imgInfo.IptcData.TagByName['Source'];
CheckTrue(lTag <> nil, 'Tag "Source" not found');
CheckEquals('self-made', lTag.AsString, 'Value mismatch of tag "Source"');
lTag := imgInfo.IptcData.TagByName['Copyright'];
CheckTrue(lTag <> nil, 'Tag "Copyright" not found');
CheckEquals('(c) wp', lTag.AsString, 'Value mismatch of tag "Copyright"');
lTag := imgInfo.IptcData.TagByName['Contact'];
CheckTrue(lTag <> nil, 'Tag "Contact" not found');
CheckEquals('w.p@wp.com, +123 4567890', lTag.AsString, 'Value mismatch of tag "Contact"');
lTag := imgInfo.IptcData.TagByName['ImageCaption'];
CheckTrue(lTag <> nil, 'Tag "ImageCaption" not found');
CheckEquals('Test image', lTag.AsString, 'Value mismatch of tag "ImageCaption"');
lTag := imgInfo.IptcData.TagByName['ImageCaptionWriter'];
CheckTrue(lTag <> nil, 'Tag "ImageCaptionWriter" not found');
CheckEquals('wp', lTag.AsString, 'Value mismatch of tag "ImageCaptionWriter"');
finally
imgInfo.Free;
end;
end;
procedure TstIptc.ReadIptcTest_Tiff;
{ Output of ExifTool for the test image with IPTC
exiftool -G -H -s with_iptc.tif > with_iptc_tif.txt
(All these values are checked)
[IPTC] 0x0005 ObjectName : Title of the test image
[IPTC] 0x0007 EditStatus : finished
[IPTC] 0x000a Urgency : 5 (normal urgency)
[IPTC] 0x000f Category : TST
[IPTC] 0x0016 FixtureIdentifier : JobID_1
[IPTC] 0x0019 Keywords : yellow, red, blue, green, rectangles
[IPTC] 0x001a ContentLocationCode : USA
[IPTC] 0x001e ReleaseDate : 2017:10:15
[IPTC] 0x0023 ReleaseTime : 22:34:47
[IPTC] 0x0028 SpecialInstructions : No other comments
[IPTC] 0x0037 DateCreated : 2017:10:15
[IPTC] 0x003c TimeCreated : 12:11:59
[IPTC] 0x0041 OriginatingProgram : PhotoFiltre
[IPTC] 0x0046 ProgramVersion : 7
[IPTC] 0x004b ObjectCycle : Both Morning and Evening
[IPTC] 0x0050 By-line : wp
[IPTC] 0x0055 By-lineTitle : Staff
[IPTC] 0x005a City : My hometown
[IPTC] 0x005c Sub-location : My suburb
[IPTC] 0x005f Province-State : My province
[IPTC] 0x0064 Country-PrimaryLocationCode : USA
[IPTC] 0x0065 Country-PrimaryLocationName : My country
[IPTC] 0x0067 OriginalTransmissionReference : requested by myself
[IPTC] 0x0069 Headline : Test image
[IPTC] 0x006e Credit : FPC
[IPTC] 0x0073 Source : self-made
[IPTC] 0x0074 CopyrightNotice : (c) wp
[IPTC] 0x0076 Contact : w.p@wp.com, +123 4567890
[IPTC] 0x0078 Caption-Abstract : Test image
[IPTC] 0x007a Writer-Editor : wp
}
var
imgInfo: TImgInfo;
lTag: TTag;
begin
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(WorkFile_TiffWithIptc);
CheckTrue(imgInfo.HasIptc, 'IPTC in test picture file "' + WorkFile_TiffWithIptc + '" not found');
// The following pieces of information are obtained from the IPTC segment
lTag := imgInfo.IptcData.TagByName['ObjectName'];
CheckTrue(lTag <> nil, 'Tag "ObjectName" not found');
CheckEquals('Title of the test image', lTag.AsString, 'Value mismatch in tag "ObjectName"');
lTag := imgInfo.IptcData.TagByName['EditStatus'];
CheckTrue(lTag <> nil, 'Tag "EditStatus" not found');
CheckEquals('finished', lTag.AsString, 'Value mismatch in tag "EditStatus"');
lTag := imgInfo.IptcData.TagByName['Urgency'];
CheckTrue(lTag <> nil, 'Tag "Urgency" not found');
lTag.DecodeValue:= false;
CheckEquals('5', lTag.AsString, 'Value mismatch in tag "Urgency"');
lTag := imgInfo.IptcData.TagByName['Category'];
CheckTrue(lTag <> nil, 'Tag "Category" not found');
CheckEquals('TST', lTag.AsString, 'Value mismatch in tag "Category"');
lTag := imgInfo.IptcData.TagByName['FixtureID'];
CheckTrue(lTag <> nil, 'Tag "FixtureID" not found');
CheckEquals('JobID_1', lTag.AsString, 'Value mismatch in tag "FixtureID"');
lTag := imgInfo.IptcData.TagByName['Keywords'];
CheckTrue(lTag <> nil, 'Tag "Keywords" not found');
CheckEquals('yellow, red, blue, green, rectangles', lTag.AsString, 'Value mismatch of tag "Keywords"');
lTag := imgInfo.IptcData.TagByName['ContentLocCode'];
CheckTrue(lTag <> nil, 'Tag "ContentLocCode" not found');
CheckEquals('USA', lTag.AsString, 'Value mismatch of tag "ContentLocCode"');
lTag := imgInfo.IptcData.TagByName['ReleaseDate'];
CheckTrue(lTag <> nil, 'Tag "ReleaseDate" not found');
CheckEquals(TIptcDateTag, lTag.ClassType, 'Tag "ReleaseDate" is not a TIptcDateTag.');
TIptcDateTag(lTag).FormatStr := EXIF_DATE_FORMAT;
CheckEquals('2017:10:15', TIptcDateTag(lTag).AsString, 'Value mismatch of tag "ReleaseDate"');
lTag := imgInfo.IptcData.TagByName['ReleaseTime'];
CheckTrue(lTag <> nil, 'Tag "ReleaseTime" not found');
CheckEquals(TIptcTimeTag, lTag.ClassType, 'Tag "ReleaseTime" is not a TIptcTimeTag');
TIptcTimeTag(lTag).FormatStr := EXIF_TIME_FORMAT;
CheckEquals('22:34:47', TIptcTimeTag(lTag).AsString, 'Value mismatch of tag "ReleaseTime"');
lTag := imgInfo.IptcData.TagByName['SpecialInstruct'];
CheckTrue(lTag <> nil, 'Tag "SpecialInstruct" not found');
CheckEquals('No other comments', lTag.AsString, 'Value mismatch in tag "SpecialInstruct"');
lTag := imgInfo.IptcData.TagByName['DateCreated'];
CheckTrue(lTag <> nil, 'Tag "DateCreated" not found');
CheckEquals(TIptcDateTag, lTag.ClassType, 'Tag "DateCreated" is not a TIptcDateTag.');
TIptcDateTag(lTag).FormatStr := EXIF_DATE_FORMAT;
CheckEquals('2017:10:15', TIptcDateTag(lTag).AsString, 'Value mismatch of tag "DateCreated"');
lTag := imgInfo.IptcData.TagByName['TimeCreated'];
CheckTrue(lTag <> nil, 'Tag "TimeCreated" not found');
CheckEquals(TIptcTimeTag, lTag.ClassType, 'Tag "TimeCreated" is not a TIptcTimeTag');
TIptcTimeTag(lTag).FormatStr := EXIF_TIME_FORMAT;
CheckEquals('12:11:59', TIptcTimeTag(lTag).AsString, 'Value mismatch of tag "TimeCreated"');
lTag := imgInfo.IptcData.TagByName['OriginatingProgram'];
CheckTrue(lTag <> nil, 'Tag "OriginatingProgram" not found');
CheckEquals('PhotoFiltre', lTag.AsString, 'Value mismatch of tag "OriginatingProgram"');
lTag := imgInfo.IptcData.TagByName['ProgramVersion'];
CheckTrue(lTag <> nil, 'Tag "ProgramVersion" not found');
CheckEquals('7', lTag.AsString, 'Value mismatch of tag "ProgramVersion"');
lTag := imgInfo.IptcData.TagByName['ObjectCycle'];
CheckTrue(lTag <> nil, 'Tag "ObjectCycle" not found');
lTag.DecodeValue := true;
CheckEquals('both', lTag.AsString, 'Value mismatch of tag "ObjectCycle"');
lTag := imgInfo.IptcData.TagByName['ByLine'];
CheckTrue(lTag <> nil, 'Tag "ByLine" not found');
CheckEquals('wp', lTag.AsString, 'Value mismatch of tag "ByLine"');
lTag := imgInfo.IptcData.TagByName['ByLineTitle'];
CheckTrue(lTag <> nil, 'Tag "ByLineTitle" not found');
CheckEquals('Staff', lTag.AsString, 'Value mismatch of tag "ByLineTitle"');
lTag := imgInfo.IptcData.TagByName['City'];
CheckTrue(lTag <> nil, 'Tag "City" not found');
CheckEquals('My hometown', lTag.AsString, 'Value mismatch of tag "City"');
lTag := imgInfo.IptcData.TagByName['SubLocation'];
CheckTrue(lTag <> nil, 'Tag "SubLocation" not found');
CheckEquals('My suburb', lTag.AsString, 'Value mismatch of tag "SubLocation"');
lTag := imgInfo.IptcData.TagByName['State'];
CheckTrue(lTag <> nil, 'Tag "State" not found');
CheckEquals('My province', lTag.AsString, 'Value mismatch of tag "State"');
lTag := imgInfo.IptcData.TagByName['LocationCode'];
CheckTrue(lTag <> nil, 'Tag "LocationCode" not found');
CheckEquals('USA', lTag.AsString, 'Value mismatch of tag "LocationCode"');
lTag := imgInfo.IptcData.TagByName['LocationName'];
CheckTrue(lTag <> nil, 'Tag "LocationName" not found');
CheckEquals('My country', lTag.AsString, 'Value mismatch of tag "LocationName"');
lTag := imgInfo.IptcData.TagByName['TransmissionRef'];
CheckTrue(lTag <> nil, 'Tag "TransmissionRef" not found');
CheckEquals('requested by myself', lTag.AsString, 'Value mismatch of tag "TransmissionRef"');
lTag := imgInfo.IptcData.TagByName['ImageHeadline'];
CheckTrue(lTag <> nil, 'Tag "ImageHeadline" not found');
CheckEquals('Test image', lTag.AsString, 'Value mismatch of tag "ImageHeadline"');
lTag := imgInfo.IptcData.TagByName['ImageCredit'];
CheckTrue(lTag <> nil, 'Tag "ImageCredit" not found');
CheckEquals('FPC', lTag.AsString, 'Value mismatch of tag "ImageCredit"');
lTag := imgInfo.IptcData.TagByName['Source'];
CheckTrue(lTag <> nil, 'Tag "Source" not found');
CheckEquals('self-made', lTag.AsString, 'Value mismatch of tag "Source"');
lTag := imgInfo.IptcData.TagByName['Copyright'];
CheckTrue(lTag <> nil, 'Tag "Copyright" not found');
CheckEquals('(c) wp', lTag.AsString, 'Value mismatch of tag "Copyright"');
lTag := imgInfo.IptcData.TagByName['Contact'];
CheckTrue(lTag <> nil, 'Tag "Contact" not found');
CheckEquals('w.p@wp.com, +123 4567890', lTag.AsString, 'Value mismatch of tag "Contact"');
lTag := imgInfo.IptcData.TagByName['ImageCaption'];
CheckTrue(lTag <> nil, 'Tag "ImageCaption" not found');
CheckEquals('Test image', lTag.AsString, 'Value mismatch of tag "ImageCaption"');
lTag := imgInfo.IptcData.TagByName['ImageCaptionWriter'];
CheckTrue(lTag <> nil, 'Tag "ImageCaptionWriter" not found');
CheckEquals('wp', lTag.AsString, 'Value mismatch of tag "ImageCaptionWriter"');
finally
imgInfo.Free;
end;
end;
procedure TstIptc.CreateIptcTest;
var
imgInfo: TImgInfo;
begin
imgInfo := TImgInfo.Create;
try
CheckTrue(imgInfo.IptcData = nil, 'IPTC found, but not expected.');
imgInfo.CreateIptcData;
CheckTrue(imgInfo.IptcData <> nil, 'IPTC not found.');
finally
imgInfo.Free;
end;
end;
procedure TstIptc.WriteIptcTest_Jpeg;
var
imgInfo: TImgInfo;
lTag: TTag;
begin
imgInfo := TImgInfo.Create;
try
// Create empty IPTC
imgInfo.CreateIptcData;
// Add tags
lTag := imgInfo.IptcData.AddTagByName('ObjectName');
CheckTrue(lTag <> nil, 'Tag "ObjectName" not found for writing');
lTag.AsString := 'Title of the test image';
lTag := imgInfo.IptcData.AddTagByName('EditStatus');
CheckTrue(lTag <> nil, 'Tag "EditStatus" not found for writing');
lTag.AsString := 'finished';
lTag := imgInfo.IptcData.AddTagByName('Urgency');
CheckTrue(lTag <> nil, 'Tag "Urgency" not found');
lTag.DecodeValue:= false;
lTag.AsString := '5';
lTag := imgInfo.IptcData.AddTagByName('Category');
CheckTrue(lTag <> nil, 'Tag "Category" not found');
lTag.AsString := 'TST';
lTag := imgInfo.IptcData.AddTagByName('FixtureID');
CheckTrue(lTag <> nil, 'Tag "FixtureID" not found');
lTag.AsString := 'JobID_1';
lTag := imgInfo.IptcData.AddTagByName('Keywords');
CheckTrue(lTag <> nil, 'Tag "Keywords" not found');
lTag.AsString := 'yellow, red, blue, green, rectangles';
lTag := imgInfo.IptcData.AddTagByName('ContentLocCode');
CheckTrue(lTag <> nil, 'Tag "ContentLocCode" not found');
lTag.AsString := 'USA';
lTag := imgInfo.IptcData.AddTagByName('ReleaseDate');
CheckTrue(lTag <> nil, 'Tag "ReleaseDate" not found');
CheckEquals(TIptcDateTag, lTag.ClassType, 'Tag "ReleaseDate" is not a TIptcDateTag.');
TIptcDateTag(lTag).FormatStr := EXIF_DATE_FORMAT;
lTag.AsString := '2017:10:15';
lTag := imgInfo.IptcData.AddTagByName('ReleaseTime');
CheckTrue(lTag <> nil, 'Tag "ReleaseTime" not found');
CheckEquals(TIptcTimeTag, lTag.ClassType, 'Tag "ReleaseTime" is not a TIptcTimeTag');
TIptcTimeTag(lTag).FormatStr := EXIF_TIME_FORMAT;
lTag.AsString := '22:34:47';
lTag := imgInfo.IptcData.AddTagByName('SpecialInstruct');
CheckTrue(lTag <> nil, 'Tag "SpecialInstruct" not found');
lTag.AsString := 'No other comments';
lTag := imgInfo.IptcData.AddTagByName('DateCreated');
CheckTrue(lTag <> nil, 'Tag "DateCreated" not found');
CheckEquals(TIptcDateTag, lTag.ClassType, 'Tag "DateCreated" is not a TIptcDateTag.');
TIptcDateTag(lTag).FormatStr := EXIF_DATE_FORMAT;
lTag.AsString := '2017:10:15';
lTag := imgInfo.IptcData.AddTagByName('TimeCreated');
CheckTrue(lTag <> nil, 'Tag "TimeCreated" not found');
CheckEquals(TIptcTimeTag, lTag.ClassType, 'Tag "TimeCreated" is not a TIptcTimeTag');
TIptcTimeTag(lTag).FormatStr := EXIF_TIME_FORMAT;
lTag.AsString := '12:11:59';
lTag := imgInfo.IptcData.AddTagByName('OriginatingProgram');
CheckTrue(lTag <> nil, 'Tag "OriginatingProgram" not found');
lTag.AsString := 'PhotoFiltre';
lTag := imgInfo.IptcData.AddTagByName('ProgramVersion');
CheckTrue(lTag <> nil, 'Tag "ProgramVersion" not found');
lTag.AsString := '7';
lTag := imgInfo.IptcData.AddTagByName('ObjectCycle');
CheckTrue(lTag <> nil, 'Tag "ObjectCycle" not found');
lTag.DecodeValue := true;
lTag.AsString := 'both';
lTag := imgInfo.IptcData.AddTagByName('ByLine');
CheckTrue(lTag <> nil, 'Tag "ByLine" not found');
lTag.AsString := 'wp';
lTag := imgInfo.IptcData.AddTagByName('ByLineTitle');
CheckTrue(lTag <> nil, 'Tag "ByLineTitle" not found');
lTag.AsString := 'Staff';
lTag := imgInfo.IptcData.AddTagByName('City');
CheckTrue(lTag <> nil, 'Tag "City" not found');
lTag.AsString := 'My hometown';
lTag := imgInfo.IptcData.AddTagByName('SubLocation');
CheckTrue(lTag <> nil, 'Tag "SubLocation" not found');
lTag.AsString := 'My suburb';
lTag := imgInfo.IptcData.AddTagByName('State');
CheckTrue(lTag <> nil, 'Tag "State" not found');
lTag.AsString := 'My province';
lTag := imgInfo.IptcData.AddTagByName('LocationCode');
CheckTrue(lTag <> nil, 'Tag "LocationCode" not found');
lTag.AsString := 'USA';
lTag := imgInfo.IptcData.AddTagByName('LocationName');
CheckTrue(lTag <> nil, 'Tag "LocationName" not found');
lTag.AsString := 'My country';
lTag := imgInfo.IptcData.AddTagByName('TransmissionRef');
CheckTrue(lTag <> nil, 'Tag "TransmissionRef" not found');
lTag.AsString := 'requested by myself';
lTag := imgInfo.IptcData.AddTagByName('ImageHeadline');
CheckTrue(lTag <> nil, 'Tag "ImageHeadline" not found');
lTag.AsString := 'Test image';
lTag := imgInfo.IptcData.AddTagByName('ImageCredit');
CheckTrue(lTag <> nil, 'Tag "ImageCredit" not found');
lTag.AsString := 'FPC';
lTag := imgInfo.IptcData.AddTagByName('Source');
CheckTrue(lTag <> nil, 'Tag "Source" not found');
lTag.AsString := 'self-made';
lTag := imgInfo.IptcData.AddTagByName('Copyright');
CheckTrue(lTag <> nil, 'Tag "Copyright" not found');
lTag.AsString := '(c) wp';
lTag := imgInfo.IptcData.AddTagByName('Contact');
CheckTrue(lTag <> nil, 'Tag "Contact" not found');
lTag.AsString := 'w.p@wp.com, +123 4567890';
lTag := imgInfo.IptcData.AddTagByName('ImageCaption');
CheckTrue(lTag <> nil, 'Tag "ImageCaption" not found');
lTag.AsString := 'Test image';
lTag := imgInfo.IptcData.AddTagByName('ImageCaptionWriter');
CheckTrue(lTag <> nil, 'Tag "ImageCaptionWriter" not found');
lTag.AsString := 'wp';
// Save to file;
// Takes the image data from WorkFile_WithIptc, replaces its IPTC with the
// current IPTC structure and writes to WorkFile_NoIptc.
imgInfo.SaveToFile(WorkFile_NoIptc, Workfile_JpegWithIptc);
finally
imgInfo.Free;
end;
// Read written file and check IPTC
imgInfo := TImgInfo.Create;
try
imgInfo.LoadFromFile(Workfile_NoIptc);
// Now there should be IPTC
CheckTrue(imgInfo.IptcData <> nil, 'IPTC not found.');
lTag := imgInfo.IptcData.TagByName['ObjectName'];
CheckTrue(lTag <> nil, 'Tag "ObjectName" not found for reading');
CheckEquals('Title of the test image', lTag.AsString, 'Value mismatch in tag "ObjectName"');
lTag := imgInfo.IptcData.TagByName['EditStatus'];
CheckTrue(lTag <> nil, 'Tag "EditStatus" not found for reading');
CheckEquals('finished', lTag.AsString, 'Value mismatch in tag "EditStatus"');
lTag := imgInfo.IptcData.TagByName['Urgency'];
CheckTrue(lTag <> nil, 'Tag "Urgency" not found');
lTag.DecodeValue:= false;
CheckEquals('5', lTag.AsString, 'Value mismatch in tag "Urgency"');
lTag := imgInfo.IptcData.TagByName['Category'];
CheckTrue(lTag <> nil, 'Tag "Category" not found');
CheckEquals('TST', lTag.AsString, 'Value mismatch in tag "Category"');
lTag := imgInfo.IptcData.TagByName['FixtureID'];
CheckTrue(lTag <> nil, 'Tag "FixtureID" not found');
CheckEquals('JobID_1', lTag.AsString, 'Value mismatch in tag "FixtureID"');
lTag := imgInfo.IptcData.TagByName['Keywords'];
CheckTrue(lTag <> nil, 'Tag "Keywords" not found');
CheckEquals('yellow, red, blue, green, rectangles', lTag.AsString, 'Value mismatch of tag "Keywords"');
lTag := imgInfo.IptcData.TagByName['ContentLocCode'];
CheckTrue(lTag <> nil, 'Tag "ContentLocCode" not found');
CheckEquals('USA', lTag.AsString, 'Value mismatch of tag "ContentLocCode"');
lTag := imgInfo.IptcData.TagByName['ReleaseDate'];
CheckTrue(lTag <> nil, 'Tag "ReleaseDate" not found');
CheckEquals(TIptcDateTag, lTag.ClassType, 'Tag "ReleaseDate" is not a TIptcDateTag.');
TIptcDateTag(lTag).FormatStr := EXIF_DATE_FORMAT;
CheckEquals('2017:10:15', TIptcDateTag(lTag).AsString, 'Value mismatch of tag "ReleaseDate"');
lTag := imgInfo.IptcData.TagByName['ReleaseTime'];
CheckTrue(lTag <> nil, 'Tag "ReleaseTime" not found');
CheckEquals(TIptcTimeTag, lTag.ClassType, 'Tag "ReleaseTime" is not a TIptcTimeTag');
TIptcTimeTag(lTag).FormatStr := EXIF_TIME_FORMAT;
CheckEquals('22:34:47', TIptcTimeTag(lTag).AsString, 'Value mismatch of tag "ReleaseTime"');
lTag := imgInfo.IptcData.TagByName['SpecialInstruct'];
CheckTrue(lTag <> nil, 'Tag "SpecialInstruct" not found');
CheckEquals('No other comments', lTag.AsString, 'Value mismatch in tag "SpecialInstruct"');
lTag := imgInfo.IptcData.TagByName['DateCreated'];
CheckTrue(lTag <> nil, 'Tag "DateCreated" not found');
CheckEquals(TIptcDateTag, lTag.ClassType, 'Tag "DateCreated" is not a TIptcDateTag.');
TIptcDateTag(lTag).FormatStr := EXIF_DATE_FORMAT;
CheckEquals('2017:10:15', TIptcDateTag(lTag).AsString, 'Value mismatch of tag "DateCreated"');
lTag := imgInfo.IptcData.TagByName['TimeCreated'];
CheckTrue(lTag <> nil, 'Tag "TimeCreated" not found');
CheckEquals(TIptcTimeTag, lTag.ClassType, 'Tag "TimeCreated" is not a TIptcTimeTag');
TIptcTimeTag(lTag).FormatStr := EXIF_TIME_FORMAT;
CheckEquals('12:11:59', TIptcTimeTag(lTag).AsString, 'Value mismatch of tag "TimeCreated"');
lTag := imgInfo.IptcData.TagByName['OriginatingProgram'];
CheckTrue(lTag <> nil, 'Tag "OriginatingProgram" not found');
CheckEquals('PhotoFiltre', lTag.AsString, 'Value mismatch of tag "OriginatingProgram"');
lTag := imgInfo.IptcData.TagByName['ProgramVersion'];
CheckTrue(lTag <> nil, 'Tag "ProgramVersion" not found');
CheckEquals('7', lTag.AsString, 'Value mismatch of tag "ProgramVersion"');
lTag := imgInfo.IptcData.TagByName['ObjectCycle'];
CheckTrue(lTag <> nil, 'Tag "ObjectCycle" not found');
lTag.DecodeValue := true;
CheckEquals('both', lTag.AsString, 'Value mismatch of tag "ObjectCycle"');
lTag := imgInfo.IptcData.TagByName['ByLine'];
CheckTrue(lTag <> nil, 'Tag "ByLine" not found');
CheckEquals('wp', lTag.AsString, 'Value mismatch of tag "ByLine"');
lTag := imgInfo.IptcData.TagByName['ByLineTitle'];
CheckTrue(lTag <> nil, 'Tag "ByLineTitle" not found');
CheckEquals('Staff', lTag.AsString, 'Value mismatch of tag "ByLineTitle"');
lTag := imgInfo.IptcData.TagByName['City'];
CheckTrue(lTag <> nil, 'Tag "City" not found');
CheckEquals('My hometown', lTag.AsString, 'Value mismatch of tag "City"');
lTag := imgInfo.IptcData.TagByName['SubLocation'];
CheckTrue(lTag <> nil, 'Tag "SubLocation" not found');
CheckEquals('My suburb', lTag.AsString, 'Value mismatch of tag "SubLocation"');
lTag := imgInfo.IptcData.TagByName['State'];
CheckTrue(lTag <> nil, 'Tag "State" not found');
CheckEquals('My province', lTag.AsString, 'Value mismatch of tag "State"');
lTag := imgInfo.IptcData.TagByName['LocationCode'];
CheckTrue(lTag <> nil, 'Tag "LocationCode" not found');
CheckEquals('USA', lTag.AsString, 'Value mismatch of tag "LocationCode"');
lTag := imgInfo.IptcData.TagByName['LocationName'];
CheckTrue(lTag <> nil, 'Tag "LocationName" not found');
CheckEquals('My country', lTag.AsString, 'Value mismatch of tag "LocationName"');
lTag := imgInfo.IptcData.TagByName['TransmissionRef'];
CheckTrue(lTag <> nil, 'Tag "TransmissionRef" not found');
CheckEquals('requested by myself', lTag.AsString, 'Value mismatch of tag "TransmissionRef"');
lTag := imgInfo.IptcData.TagByName['ImageHeadline'];
CheckTrue(lTag <> nil, 'Tag "ImageHeadline" not found');
CheckEquals('Test image', lTag.AsString, 'Value mismatch of tag "ImageHeadline"');
lTag := imgInfo.IptcData.TagByName['ImageCredit'];
CheckTrue(lTag <> nil, 'Tag "ImageCredit" not found');
CheckEquals('FPC', lTag.AsString, 'Value mismatch of tag "ImageCredit"');
lTag := imgInfo.IptcData.TagByName['Source'];
CheckTrue(lTag <> nil, 'Tag "Source" not found');
CheckEquals('self-made', lTag.AsString, 'Value mismatch of tag "Source"');
lTag := imgInfo.IptcData.TagByName['Copyright'];
CheckTrue(lTag <> nil, 'Tag "Copyright" not found');
CheckEquals('(c) wp', lTag.AsString, 'Value mismatch of tag "Copyright"');
lTag := imgInfo.IptcData.TagByName['Contact'];
CheckTrue(lTag <> nil, 'Tag "Contact" not found');
CheckEquals('w.p@wp.com, +123 4567890', lTag.AsString, 'Value mismatch of tag "Contact"');
lTag := imgInfo.IptcData.TagByName['ImageCaption'];
CheckTrue(lTag <> nil, 'Tag "ImageCaption" not found');
CheckEquals('Test image', lTag.AsString, 'Value mismatch of tag "ImageCaption"');
lTag := imgInfo.IptcData.TagByName['ImageCaptionWriter'];
CheckTrue(lTag <> nil, 'Tag "ImageCaptionWriter" not found');
CheckEquals('wp', lTag.AsString, 'Value mismatch of tag "ImageCaptionWriter"');
finally
imgInfo.Free;
end;
end;
initialization
{$IFDEF FPC}
RegisterTest(TstIptc);
{$ELSE}
TestFramework.RegisterTest(TstIptc.Suite);
{$ENDIF}
end.

View File

@ -0,0 +1,33 @@
unit fetTestUtils;
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}
interface
uses
{$IFDEF FPC}
{$ELSE}
Windows,
{$ENDIF}
Classes, SysUtils;
{$IFDEF FPC}
{$ELSE}
function CopyFile(AFilename1, AFileName2: String): Boolean;
{$ENDIF}
implementation
{$IFDEF FPC}
{$ELSE}
function CopyFile(AFileName1, AFileName2: String): Boolean;
begin
Result := Windows.CopyFile(PChar(AFilename1), PChar(AFilename2), true);
end;
{$ENDIF}
end.

View File

@ -0,0 +1,327 @@
unit fetUtils;
{$IFDEF FPC}
{$mode delphi} //objfpc}{$H+}
{$ENDIF}
interface
uses
Classes, SysUtils,
{$IFDEF FPC}
fpcunit, testutils, testregistry;
{$ELSE}
TestFrameWork;
{$ENDIF}
type
TstUtils = class(TTestCase)
published
procedure TestCountChar;
procedure TestFloatToRational;
procedure TestInsertSpaces;
procedure TestLookup;
procedure TestSplit;
procedure TestSplitGPS;
procedure TestStrToGPS;
procedure TestStrToRational;
end;
implementation
uses
math,
fpeGlobal, fpeUtils;
type
TCountCharParam = record
TestString: String;
ch: Char;
Count: Integer;
end;
TInsertSpacesParam = record
TestString: String;
ResultString: String;
end;
TFloatToRationalParam = record
Value, Precision: Double;
Num, Denom: Integer;
Error: Integer; // 0:ok, 1: Num is wrong, 2: Denom is wrong
end;
TLookupParam = record
SearchForKey: Boolean;
SearchStr: String;
ResultStr: String;
end;
TSplitGpsParam = record
Value: Double;
Degs: Double;
Mins: Double;
Secs: Double
end;
TSplitParam = record
Text: String;
Sep: String;
NumParts: Integer;
Parts: Array[0..2] of string;
end;
TStrToGpsParam = record
Text: String;
Degs: Double;
Valid: Boolean;
end;
TStrToRationalParam = record
Value: String;
Num, Denom: Integer;
end;
const
CountCharParams: array[0..5] of TCountCharParam = (
(TestString:''; ch:'a'; Count:0),
(TestString:'a'; ch:'a'; Count:1),
(TestString:'aa'; ch:'a'; Count:2),
(TestString:'b'; ch:'a'; Count:0),
(TestString:'ab'; ch:'a'; Count:1),
(TestString:'ba'; ch:'a'; Count:1)
);
InsertSpacesParams: array[0..14] of TInsertSpacesParam = (
(TestString: 'Artist'; ResultString: 'Artist'),
(TestString: 'ShutterSpeed'; ResultString: 'Shutter Speed'),
(TestString: 'ThumbnailXResolution'; ResultString: 'Thumbnail X Resolution'),
(TestString: 'YCbCrPositioning'; ResultString: 'Y Cb Cr Positioning'),
(TestString: 'ISO'; ResultString: 'ISO'),
(TestString: 'GPSInfo'; ResultString: 'GPS Info'),
(TestString: 'IPTC/NAA'; ResultString: 'IPTC/NAA'),
(TestString: 'XPTitle'; ResultString: 'XP Title'),
(TestString: 'PrintIM'; ResultString: 'Print IM'),
(TestString: 'ResolutionX'; ResultString: 'Resolution X'),
(TestString: 'XResolution'; ResultString: 'X Resolution'),
(TestString: 'CCD ISO'; ResultString: 'CCD ISO'),
(TestString: 'AE setting'; ResultString: 'AE setting'),
(TestString: 'abc ABC'; ResultString: 'abc ABC'),
(TestString: 'abc Abc'; ResultString: 'abc Abc')
);
FloatToRationalParams: array[0..8] of TFloatToRationalParam = (
(Value:0.0; Precision: 1E-6; Num:0; Denom:1; Error:0), // 0
(Value:1.0; Precision: 1E-6; Num:1; Denom:1; Error:0), // 1
(Value:0.5; Precision: 1E-6; Num:1; Denom:2; Error:0), // 2
(Value:0.01; Precision: 1E-6; Num:1; Denom:100; Error:0), // 3
(Value:0.333333333; Precision: 1E-6; Num:1; Denom:3; Error:0), // 4
(value:1.166666667; Precision: 1E-6; Num:7; Denom:6; Error:0), // 5
(Value:NaN; Precision: 1E-6; Num:1; Denom:0; Error:0), // 6
(Value:0.3333; Precision: 1E-6; Num:1; Denom:3; Error:2), // 7
(Value:0.1; Precision: 1E-6; Num:1; Denom:3; Error:2) // 8
);
LkupTbl: String = '0:Zero,1:One,2:Two';
LookupParams: array[0..8] of TLookupParam = (
(SearchForKey:true; SearchStr:'0'; ResultStr:'Zero'),
(SearchForKey:true; SearchStr:'1'; ResultStr:'One'),
(SearchForKey:true; SearchStr:'2'; ResultStr:'Two'),
(SearchForKey:true; SearchStr:'$2'; ResultStr:'Two'),
(SearchForKey:true; SearchStr:'3'; ResultStr:'3'),
(SearchForKey:false; SearchStr:'Zero'; ResultStr:'0'),
(SearchForKey:false; SearchStr:'One'; ResultStr:'1'),
(SearchForKey:false; SearchStr:'Two'; ResultStr:'2'),
(SearchForKey:false; SearchStr:'Three'; ResultStr:'')
);
SplitGpsParams: array[0..3] of TSplitGpsParam = (
(Value:0.5; Degs: 0; Mins:30; Secs: 0),
(Value:2.777777E-4; Degs: 0; Mins: 0; Secs: 1),
(Value:50.2527777777777; Degs:50; Mins:15; Secs:10),
(Value:50.2583333333333; Degs:50; Mins:15; Secs:30)
);
SplitParams: array[0..3] of TSplitParam = (
(Text:'One'; Sep: ';'; NumParts: 1; Parts:('One', '', '')),
(Text:'One,Two'; Sep: ','; NumParts: 2; Parts:('One', 'Two', '')),
(Text:'One, Two'; Sep: ', '; NumParts: 2; Parts:('One', 'Two', '')),
(Text:'One'#0'Two'; Sep: #0; NumParts: 2; Parts:('One', 'Two', ''))
);
// 1/3600 = 2.77777777777E-4, 1/60 = 0,01666666666666667
StrToGpsParams: array[0..11] of TStrToGpsParam = (
(Text:'0 deg 30'' 0"'; Degs: 0.5; Valid: true),
(Text:'0 deg 0'' 1"'; Degs: 2.777777E-4; Valid: true),
(Text:'50 deg 15'' 10"'; Degs: 50.2527777777777; Valid: true),
(Text:'50 deg 15'' 30"'; Degs: 50.2583333333333; Valid: true),
(Text:'50 deg 15.5'''; Degs: 50.2583333333333; Valid: true),
(Text:'50 deg 60'' 30"'; Degs: NaN; Valid: false),
(Text:'50 deg 15'' 70"'; Degs: NaN; Valid: false),
(Text:'50.1° 15'' 70"'; Degs: NaN; Valid: false),
(Text:'50 deg 15.3'' 50"'; Degs: NaN; Valid: false),
(Text:'50 deg -15'' 50"'; Degs: NaN; Valid: false),
(Text:'50 deg 15'' -50"'; Degs: NaN; Valid: false),
(Text:'-50 deg 15'' 30"'; Degs: 50.2583333333333; Valid: true)
);
StrToRationalParams: array[0..9] of TStrToRationalParam = (
(Value:'0'; Num:0; Denom:1), // 0
(Value:'1'; Num:1; Denom:1), // 1
(Value:'1/2'; Num:1; Denom:2), // 2
(Value:'1/ 2'; Num:1; Denom:2), // 3
(Value:'1 /2'; Num:1; Denom:2), // 4
(Value:'1 / 2'; Num:1; denom:2), // 5
(Value:' 1/2'; Num:1; Denom:2), // 6
(Value:'1/2 '; Num:1; Denom:2), // 7
(Value:' 1/2 '; Num:1; Denom:2), // 8
(value:''; Num:1; Denom:0) // 9
);
procedure TstUtils.TestCountChar;
var
currCount: Integer;
i: Integer;
begin
for i:=Low(CountCharParams) to High(CountCharParams) do begin
currCount := CountChar(CountCharParams[i].ch, CountCharParams[i].TestString);
CheckEquals(CountCharParams[i].Count, currCount,
'CountChar mismatch, test case ' + IntToStr(i));
end;
end;
procedure TstUtils.TestFloatToRational;
var
currR: TExifRational;
i: Integer;
begin
for i:=Low(FloatToRationalParams) to High(FloatToRationalParams) do
with FloatToRationalParams[i] do begin
currR := FloatToRational(Value, Precision);
case Error of
0: begin
CheckEquals(currR.Numerator, Num,
'FloatToRational numerator mismatch, test case ' + IntToStr(i));
CheckEquals(currR.Denominator, Denom,
'FloatToRational denominator mismatch, test case ' + IntToStr(i));
end;
1: CheckNotEquals(currR.Numerator, Num,
'Unexpected FloatToRational numerator match, test case ' + IntToStr(i));
2: CheckNotEquals(currR.Denominator, Denom,
'Unexpected FloatToRational denominator match, test case ' + IntToStr(i));
end;
end;
end;
procedure TstUtils.TestInsertSpaces;
var
currStr: String;
i: Integer;
begin
for i:=Low(InsertSpacesParams) to High(InsertSpacesParams) do begin
currStr := InsertSpaces(InsertSpacesParams[i].TestString);
CheckEquals(InsertSpacesParams[i].ResultString, currStr,
'InsertSpaces mismatch, test case ' + IntToStr(i));
end;
end;
function SameIntegerKey(AKey1, AKey2: String): Boolean;
var
k1, k2: Integer;
begin
Result := TryStrToInt(AKey1, k1) and TryStrToInt(AKey2, k2) and (k1 = k2);
end;
function SameStringKey(AKey1, AKey2: String): Boolean;
begin
Result := SameText(AKey1, AKey2);
end;
procedure TstUtils.TestLookup;
var
currResult: String;
i: Integer;
begin
for i:=Low(LookupParams) to High(LookupParams) do
with LookupParams[i] do begin
if SearchForKey then
currResult := LookupValue(SearchStr, LkupTbl, @SameIntegerKey)
else
currResult := LookupKey(SearchStr, LkupTbl, @SameStringKey);
CheckEquals(ResultStr, currResult,
'Lookup mismatch, test case ' + IntToStr(i));
end;
end;
procedure TstUtils.TestSplit;
var
currResult: TStringArray;
i, j: Integer;
begin
for i:=Low(SplitParams) to High(SplitParams) do
with SplitParams[i] do begin
currResult := Split(Text, Sep);
CheckEquals(NumParts, Length(currResult), 'Split count mismatch');
for j:=0 to NumParts-1 do
CheckEquals(Parts[j], currResult[j], 'Split mismatch in array element #' + IntToStr(j));
end;
end;
procedure TstUtils.TestSplitGPS;
const
EPS = 1E-6;
var
currDeg, currMin, currSec: Double;
i: Integer;
begin
for i:=Low(SplitGPSParams) to High(SplitGPSParams) do
with SplitGPSParams[i] do begin
SplitGPS(Value, currDeg, currMin, currSec);
CheckEquals(Degs, currDeg, EPS, 'Degree value mismatch, test case ' + IntToStr(i));
CheckEquals(Mins, currMin, EPS, 'Minutes mismatch, test case ' + IntToStr(i));
CheckEquals(Secs, currSec, EPS, 'Seconds value mismatch, test case ' + IntToStr(i));
end;
end;
procedure TstUtils.TestStrToGPS;
const
EPS = 1E-8;
var
currDeg: Double;
i: Integer;
currOK: Boolean;
begin
for i:=Low(StrToGpsParams) to High(StrToGpsParams) do begin
with StrToGpsParams[i] do begin
currOK := TryStrToGps(Text, currDeg);
CheckEquals(Valid, currOK, 'GPS result validity mismatch, test case ' + IntToStr(i));
if Valid then
CheckEquals(Degs, currDeg, EPS, 'GPS degress mismatch, test case ' + IntToStr(i));
end;
end;
end;
procedure TstUtils.TestStrToRational;
var
currR: TExifRational;
i: Integer;
begin
for i:=Low(StrToRationalParams) to High(StrToRationalParams) do
with StrToRationalParams[i] do begin
currR := StrToRational(Value);
CheckEquals(currR.Numerator, Num,
'StrToRational numerator mismatch, test case ' + IntToStr(i));
CheckEquals(currR.Denominator, Denom,
'StrToRational denominator mismatch, test case ' + IntToStr(i));
end;
end;
initialization
{$IFDEF FPC}
RegisterTest(TstUtils);
{$ELSE}
TestFramework.RegisterTest(TstUtils.Suite);
{$ENDIF}
end.

View File

@ -0,0 +1,3 @@
For Delphi 7:
Download dunit from http://dunit.sourceforge.net/
and copy the files into this folder.

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,163 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="fpExifTests"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="fpcunittestrunner"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
</RequiredPackages>
<Units Count="18">
<Unit0>
<Filename Value="fpExifTests.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="..\..\fpeexifdata.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeExifData"/>
</Unit1>
<Unit2>
<Filename Value="..\..\fpeexifreadwrite.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeExifReadWrite"/>
</Unit2>
<Unit3>
<Filename Value="..\..\fpeglobal.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeGlobal"/>
</Unit3>
<Unit4>
<Filename Value="..\..\fpeiptcdata.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeIptcData"/>
</Unit4>
<Unit5>
<Filename Value="..\..\fpeiptcreadwrite.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeIptcReadWrite"/>
</Unit5>
<Unit6>
<Filename Value="..\..\fpemakernote.pas"/>
<IsPartOfProject Value="True"/>
</Unit6>
<Unit7>
<Filename Value="..\..\fpemetadata.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeMetadata"/>
</Unit7>
<Unit8>
<Filename Value="..\..\fpestrconsts.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeStrConsts"/>
</Unit8>
<Unit9>
<Filename Value="..\..\fpetags.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeTags"/>
</Unit9>
<Unit10>
<Filename Value="..\..\fpeutils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpeUtils"/>
</Unit10>
<Unit11>
<Filename Value="..\..\fpexif.inc"/>
<IsPartOfProject Value="True"/>
</Unit11>
<Unit12>
<Filename Value="..\..\fpexif_fpc.inc"/>
<IsPartOfProject Value="True"/>
</Unit12>
<Unit13>
<Filename Value="common\fetexifbe.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fetExifBE"/>
</Unit13>
<Unit14>
<Filename Value="common\fetexifle.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fetExifLE"/>
</Unit14>
<Unit15>
<Filename Value="common\fetiptc.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fetIptc"/>
</Unit15>
<Unit16>
<Filename Value="common\fetutils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fetUtils"/>
</Unit16>
<Unit17>
<Filename Value="common\fettestutils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fetTestUtils"/>
</Unit17>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="fpExifTests"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir);..\.."/>
<OtherUnitFiles Value="..\..;common"/>
<UnitOutputDirectory Value="output\dcu\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="5">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="EAssertionFailedError"/>
</Item4>
<Item5>
<Name Value="EConvertError"/>
</Item5>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,19 @@
program fpExifTests;
{$mode objfpc}{$H+}
uses
Interfaces, Forms, GuiTestRunner,
fetutils,
fetexifle,
fetexifbe,
fetiptc;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TGuiTestRunner, TestRunner);
Application.Run;
end.

View File

@ -0,0 +1,30 @@
program fpExifTests_Delphi;
uses
TestFramework,
Forms,
GUITestRunner,
TextTestRunner,
fpeexifdata in '..\..\fpeexifdata.pas',
fpeExifReadWrite in '..\..\fpeexifreadwrite.pas',
fpeGlobal in '..\..\fpeglobal.pas',
fpeIptcData in '..\..\fpeiptcdata.pas',
fpeIptcReadWrite in '..\..\fpeiptcreadwrite.pas',
fpeMakerNote in '..\..\fpemakernote.pas',
fpeMetadata in '..\..\fpemetadata.pas',
fpeStrConsts in '..\..\fpestrconsts.pas',
fpeTags in '..\..\fpetags.pas',
fpeUtils in '..\..\fpeUtils.pas',
fetExifBE in 'common\fetexifbe.pas',
fetExifLE in 'common\fetexifle.pas',
fetIptc in 'common\fetiptc.pas',
fetUtils in 'common\fetutils.pas';
{$R *.res}
begin
Application.Initialize;
GUITestRunner.RunRegisteredTests;
end.

View File

@ -0,0 +1,141 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{2DB98C6D-00C5-4E53-BB9F-D5F4788A994D}</ProjectGuid>
<MainSource>fpExifTests_Delphi.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_E>false</DCC_E>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_N>true</DCC_N>
<DCC_S>false</DCC_S>
<DCC_ImageBase>42200000</DCC_ImageBase>
<DCC_AssertionsAtRuntime>false</DCC_AssertionsAtRuntime>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_Description>TeeChart 2014 Components</DCC_Description>
<DCC_UnitSearchPath>D:\Prog_Lazarus\wp-laz\fpexif;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\common;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_UsePackage>Tee97;TeeUI97;TeeDB97;TeePro97;TeeGL97;TeeImage97;TeeLanguage97;TeeWorld97;$(DCC_UsePackage)</DCC_UsePackage>
<SanitizedProjectName>fpExifTests_Delphi</SanitizedProjectName>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=0.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<Icon_MainIcon>fpExifTests_Delphi7_Icon.ico</Icon_MainIcon>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppEnableHighDPI>true</AppEnableHighDPI>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppEnableHighDPI>true</AppEnableHighDPI>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_MajorVer>1</VerInfo_MajorVer>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\..\fpeexifdata.pas"/>
<DCCReference Include="..\..\fpeexifreadwrite.pas"/>
<DCCReference Include="..\..\fpeglobal.pas"/>
<DCCReference Include="..\..\fpeiptcdata.pas"/>
<DCCReference Include="..\..\fpeiptcreadwrite.pas"/>
<DCCReference Include="..\..\fpemakernote.pas"/>
<DCCReference Include="..\..\fpemetadata.pas"/>
<DCCReference Include="..\..\fpestrconsts.pas"/>
<DCCReference Include="..\..\fpetags.pas"/>
<DCCReference Include="..\..\fpeUtils.pas"/>
<DCCReference Include="common\fetexifbe.pas"/>
<DCCReference Include="common\fetexifle.pas"/>
<DCCReference Include="common\fetiptc.pas"/>
<DCCReference Include="common\fetutils.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">fpExifTests_Delphi.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

View File

@ -0,0 +1,42 @@
-$A8
-$B-
-$C-
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$Y+
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$42200000
-LE"d:\programme\borland\delphi7\Projects\Bpl"
-LN"d:\programme\borland\delphi7\Projects\Bpl"
-U"D:\Prog_Lazarus\wp-laz\fpexif;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\common;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\dunit"
-O"D:\Prog_Lazarus\wp-laz\fpexif;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\common;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\dunit"
-I"D:\Prog_Lazarus\wp-laz\fpexif;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\common;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\dunit"
-R"D:\Prog_Lazarus\wp-laz\fpexif;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\common;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\dunit"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

View File

@ -0,0 +1,145 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=0
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=2
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=1109393408
ExeDescription=TeeChart 2014 Components
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=D:\Prog_Lazarus\wp-laz\fpexif;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\common;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\dunit
Packages=Tee97;TeeUI97;TeeDB97;TeePro97;TeeGL97;TeeImage97;TeeLanguage97;TeeWorld97
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=D:\Programme\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=0
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=0.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=
[Excluded Packages]
D:\Prog_Delphi\common\Components\3rdParty\TeeChart\Sources\Compiled\Delphi7\Bin\DclTeeMaker17.bpl=TeeMaker
D:\Programme\Borland\Delphi7\Lib\HelpCtxD7.bpl=HelpScribble HelpContext Property Editor for Delphi 7
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=2
Item0=D:\Prog_Lazarus\wp-laz\fpexif;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\common;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\dunit
Item1=D:\Prog_Lazarus\wp-laz\fpexif;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\common

View File

@ -0,0 +1,30 @@
program fpExifTests_Delphi7;
uses
TestFramework,
Forms,
GUITestRunner,
TextTestRunner,
fpeexifdata in '..\..\fpeexifdata.pas',
fpeExifReadWrite in '..\..\fpeexifreadwrite.pas',
fpeGlobal in '..\..\fpeglobal.pas',
fpeIptcData in '..\..\fpeiptcdata.pas',
fpeIptcReadWrite in '..\..\fpeiptcreadwrite.pas',
fpeMakerNote in '..\..\fpemakernote.pas',
fpeMetadata in '..\..\fpemetadata.pas',
fpeStrConsts in '..\..\fpestrconsts.pas',
fpeTags in '..\..\fpetags.pas',
fpeUtils in '..\..\fpeUtils.pas',
fetExifBE in 'common\fetexifbe.pas',
fetExifLE in 'common\fetexifle.pas',
fetIptc in 'common\fetiptc.pas',
fetUtils in 'common\fetutils.pas';
{$R *.res}
begin
Application.Initialize;
GUITestRunner.RunRegisteredTests;
end.

View File

@ -0,0 +1,138 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{2DB98C6D-00C5-4E53-BB9F-D5F4788A994D}</ProjectGuid>
<MainSource>fpExifTests_Delphi7.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_E>false</DCC_E>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_N>true</DCC_N>
<DCC_S>false</DCC_S>
<DCC_ImageBase>42200000</DCC_ImageBase>
<DCC_AssertionsAtRuntime>false</DCC_AssertionsAtRuntime>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_Description>TeeChart 2014 Components</DCC_Description>
<DCC_UnitSearchPath>D:\Prog_Lazarus\wp-laz\fpexif;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\common;D:\Prog_Lazarus\wp-laz\fpexif\tests\unittest\dunit;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_UsePackage>Tee97;TeeUI97;TeeDB97;TeePro97;TeeGL97;TeeImage97;TeeLanguage97;TeeWorld97;$(DCC_UsePackage)</DCC_UsePackage>
<SanitizedProjectName>fpExifTests_Delphi7</SanitizedProjectName>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_MajorVer>0</VerInfo_MajorVer>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=0.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<Icon_MainIcon>fpExifTests_Delphi7_Icon.ico</Icon_MainIcon>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppEnableHighDPI>true</AppEnableHighDPI>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppEnableHighDPI>true</AppEnableHighDPI>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="..\..\fpeexifdata.pas"/>
<DCCReference Include="..\..\fpeexifreadwrite.pas"/>
<DCCReference Include="..\..\fpeglobal.pas"/>
<DCCReference Include="..\..\fpeiptcdata.pas"/>
<DCCReference Include="..\..\fpeiptcreadwrite.pas"/>
<DCCReference Include="..\..\fpemakernote.pas"/>
<DCCReference Include="..\..\fpemetadata.pas"/>
<DCCReference Include="..\..\fpestrconsts.pas"/>
<DCCReference Include="..\..\fpetags.pas"/>
<DCCReference Include="..\..\fpeUtils.pas"/>
<DCCReference Include="common\fetexifbe.pas"/>
<DCCReference Include="common\fetexifle.pas"/>
<DCCReference Include="common\fetiptc.pas"/>
<DCCReference Include="common\fetutils.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">fpExifTests_Delphi7.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

View File

@ -0,0 +1,2 @@
Place the program exiftool.exe into this directory, it is needed by the
test program "multiread".