diff --git a/components/fpexif/fpEXIF.pas b/components/fpexif/fpEXIF.pas new file mode 100644 index 000000000..7b931b3d9 --- /dev/null +++ b/components/fpexif/fpEXIF.pas @@ -0,0 +1,3597 @@ +unit fpeExif; + +//////////////////////////////////////////////////////////////////////////////// +// unit dEXIF - Copyright 2001-2006, Gerry McGuire +//-------------------------------------------------------------------------- +// Program to pull the information out of various types of EXIF digital +// camera files and show it in a reasonably consistent way +// +// This module parses the very complicated exif structures. +// +// Matthias Wandel, Dec 1999 - August 2000 (most of the comments) +// +// Translated to Delphi: +// Gerry McGuire, March - April 2001 - Currently - read only +// May 2001 - add EXIF to jpeg output files +// September 2001 - read TIF files, IPTC data +// June 2003 - First (non-beta) Release +//-------------------------------------------------------------------------- +// In addition to the basic information provided by Matthias, the +// following web page contains reference informtion regarding the +// exif standard: http://www.pima.net/standards/iso/tc42/wg18/WG18_POW.htm +// (the documents themselves are PDF). +//-------------------------------------------------------------------------- +// 17.05.2002 MS Corrections/additions M. Schwaiger +//-------------------------------------------------------------------------- + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I fpExif.inc} + +interface + +uses + SysUtils, Classes, Math, Variants, + {$IFDEF FPC} + LazUTF8, + {$ELSE} + {$IFNDEF dExifNoJpeg} jpeg, {$ENDIF} + {$ENDIF} + fpeGlobal, fpeUtils, fpeTags, fpeIptc; + +const + { + ExifTag = 1; // default tag Types + GpsTag = 2; + ThumbTag = 4; + } + + // To be used in Exifobj.IterateFoundTags + GenericEXIF = 0; + CustomEXIF = 1; + +// AllEXIF = -1; + GenNone = 0; + GenAll = 255; + GenString = 2; + GenList = 4; +// VLMin = 0; +// VLMax = 1; + +type + { TEndInd } + + TEndInd = class + private + FData: ansistring; + public + MotorolaOrder: boolean; + function Get16u(AOffs: integer): word; + function Get32s(AOffs: integer): Longint; + function Get32u(AOffs: integer): Longword; + function Put32s(data: Integer): AnsiString; + procedure WriteInt16(var buff: AnsiString; int,posn: integer); + procedure WriteInt32(var buff: AnsiString; int,posn: longint); + function GetDataBuff: Ansistring; + procedure SetDataBuff(const Value: AnsiString); + property DataBuff: AnsiString read GetDataBuff write SetDataBuff; + end; + + { TImageInfo } + + TImageInfo = class(tEndInd) + private + FParent: TObject; // must be cast to TImgData, can't be done here due to unit circular reference + FExifVersion: string; + + FITagArray: array of TTagEntry; + FITagCount: integer; + + FIThumbArray: array of TTagEntry; + FIThumbCount: integer; + + FThumbStart: integer; + FThumbLength: integer; + FThumbType: integer; + + FThumbnailBuffer: TBytes; + FThumbnailStartOffset: Integer; + FThumbnailSize: Integer; + + FIterator: integer; + FThumbIterator: integer; + + // Getter / setter + function GetDateTimeOriginal: TDateTime; + procedure SetDateTimeOriginal(const AValue: TDateTime); + + function GetDateTimeDigitized: TDateTime; + procedure SetDateTimeDigitized(const AValue: TDateTime); + + function GetDateTimeModified: TDateTime; + procedure SetDateTimeModified(const AValue: TDateTime); + + function GetArtist: String; + procedure SetArtist(v: String); + + function GetExifComment: String; overload; + procedure SetExifComment(AValue: String); + function GetUserComment(const ATag: TTagEntry): String; overload; + + function GetImageDescription: String; + procedure SetImageDescription(const AValue: String); + + function GetCameraMake: String; + procedure SetCameraMake(const AValue: String); + + function GetCameraModel: String; + procedure SetCameraModel(const AValue: String); + + function GetCopyright: String; + procedure SetCopyright(const AValue: String); + + function GetGPSCoordinate(ATagName: String; + ACoordType: TGpsCoordType): Extended; + procedure SetGPSCoordinate(ATagName: String; const AValue: Extended; + ACoordType: TGpsCoordType); + function GetGPSLatitude: Extended; + procedure SetGPSLatitude(const AValue: Extended); + function GetGPSLongitude: Extended; + procedure SetGPSLongitude(const AValue: Extended); + + function GetHeight: Integer; + procedure Setheight(AValue: Integer); + function GetWidth: Integer; + procedure SetWidth(AValue: Integer); + + function GetVersion(ATag: TTagEntry): String; + + function GetTagByID(ATagID: Word): TTagEntry; + procedure SetTagByID(ATagID: Word; const AValue: TTagEntry); + function GetTagByIndex(AIndex: Integer): TTagEntry; + procedure SetTagByIndex(AIndex: Integer; const AValue: TTagEntry); + function GetTagByName(ATagName: String): TTagEntry; + procedure SetTagByName(ATagName: String; const AValue: TTagEntry); + function GetTagValue(ATagName: String): variant; + procedure SetTagValue(ATagName: String; AValue: variant); + function GetTagValueAsString(ATagName: String): String; + procedure SetTagValueAsString(ATagName: String; AValue: String); + + function GetThumbTagByID(ATagID: Word): TTagEntry; + procedure SetThumbTagByID(ATagID: Word; const AValue: TTagEntry); + function GetThumbTagByIndex(AIndex: Integer): TTagEntry; + procedure SetThumbTagByIndex(AIndex: Integer; const AValue: TTagEntry); + function GetThumbTagByName(ATagName: String): TTagEntry; + procedure SetThumbTagByName(ATagName: String; const AValue: TTagEntry); + function GetThumbTagValue(ATagName: String): Variant; + procedure SetThumbTagValue(ATagName: String; AValue: variant); + function GetThumbTagValueAsString(ATagName: String): string; + procedure SetThumbTagValueAsString(ATagName: String; AValue: String); + + procedure InternalGetBinaryTagValue(const ATag: TTagEntry; var ABuffer: ansistring); + function InternalGetTagValue(const ATag: TTagEntry): Variant; + function InternalGetTagValueAsString(const ATag: TTagEntry): String; + procedure InternalSetTagValue(const ATagName: String; AValue: Variant; + ATagTypes: TTagTypes; ABinaryData: Pointer = nil; ABinaryDataCount: Word = 0); + function BinaryTagToStr(const ATag: TTagEntry): String; + function BinaryTagToVar(const ATag: TTagEntry): Variant; + function NumericTagToVar(ABuffer: Pointer; ATagType: Integer): Variant; + procedure VarToNumericTag(AValue:variant; ATag: PTagEntry); + + // misc + function CreateTagPtr(const ATagDef: TTagEntry; IsThumbTag: Boolean; AParentID: Word = 0): PTagEntry; + function FindTagPtr(const ATagDef: TTagEntry; IsThumbTag: Boolean): PTagEntry; + + (* + function GetTagPtr(ATagTypes: TTagTypes; ATagID: Word; AForceCreate: Boolean=false; + AParentID: word=0; ATagType: word=65535): PTagEntry; + *) + procedure RemoveTag(ATagTypes: TTagTypes; ATagID: Word; AParentID: Word=0); + + procedure ClearDirStack; + procedure PushDirStack(dirStart, offsetbase: Integer); + function TestDirStack(dirStart, offsetbase: Integer): boolean; + + protected + function AddTagToArray(ANewTag: iTag): integer; + function AddTagToThumbArray(ANewTag: iTag): integer; + procedure Calc35Equiv; + function CvtInt(ABuffer: Pointer; ABufferSize: Integer): Longint; + function Decode: Boolean; + function ExifDateToDateTime(ARawStr: ansistring): TDateTime; +// procedure ExtractThumbnail; + function FormatNumber(ABuffer: PByte; ABufferSize: Integer; + AFmt: integer; AFmtStr: string; ADecodeStr: string=''): String; + function GetNumber(ABuffer: PByte; ABufferSize: Integer; + AFmt: integer): double; + function LookupRatio: double; + + public + MaxTag: integer; +// Height, Width, HPosn, WPosn: integer; + FlashUsed: integer; + BuildList: integer; + MakerNote: ansistring; + TiffFmt: boolean; +// Add support for thumbnail + ThumbTrace: ansistring; + MaxThumbTag: integer; +// Added the following elements to make the structure a little more code-friendly + TraceLevel: integer; + TraceStr: ansistring; + msTraceStr: ansistring; + msAvailable: boolean; + msName:ansistring; + MakerOffset : integer; + + public + constructor Create(AParent: TObject; ABigEndian: Boolean; + ABuildCode: integer = GenAll); + procedure Assign(source: TImageInfo); + destructor Destroy; override; + + // Reader interface + procedure AddTagFromReader(ATag: TTagEntry); + procedure AddThumbnailFromReader(ABuffer: TBytes); + + // Date/time routines + procedure AdjDateTime(ADays, AHours, AMins, ASecs: integer); + function GetImgDateTime: TDateTime; + + // Manufacturer-specific + procedure AddMSTag(ATagName: String; ARawStr: ansistring; AType: word); + + // Iterate through found tags + procedure ResetIterator; + procedure ResetThumbIterator; + function IterateFoundTags(TagId:integer; var retVal:TTagEntry):boolean; + function IterateFoundThumbTags(TagId: integer; + var retVal: TTagEntry): boolean; + + // Collective output + procedure EXIFArrayToXML(AList: TStrings); overload; + function ToShortString: String; // Summarizes in a single line + function ToLongString(ALabelWidth: Integer = 15): String; + + // Special actions + procedure AdjExifSize(AHeight, AWidth: Integer); + + // Looking up tags and tag values + function GetRawFloat(ATagName: String): double; + function GetRawInt(ATagName: String): integer; + function GetTagByDesc(SearchStr: String): TTagEntry; + function LookupTagIndex(ATagName: String): integer; virtual; +// function LookupTagVal(ATagName: String): String; virtual; + function LookupTagDefn(ATagName: String): integer; + function LookupTagByDesc(ADesc: String): integer; + function LookupTagInt(ATagName: String): integer; + + // Tag values as variant + property TagValue[ATagName: String]: Variant + read GetTagValue write SetTagValue; default; + + // Tag values as string + property TagValueAsString[ATagName: String]: String + read GetTagValueAsString write SetTagValueAsString; + + // Accessing entire tag record + property TagByID[ATagID: Word]: TTagEntry + read GetTagByID write SetTagByID; + property TagByIndex[AIndex: Integer]: TTagEntry + read GetTagByIndex write SetTagByIndex; + property TagByName[ATagName: String]: TTagEntry + read GetTagByName write SetTagByName; + property TagCount: Integer + read fiTagCount; + + property Artist: String + read GetArtist write SetArtist; + property CameraMake: String + read GetCameraMake write SetCameraMake; + property CameraModel: String + read GetCameraModel write SetCameraModel; + property Copyright: String + read GetCopyright write SetCopyright; + property DateTimeOriginal: TDateTime + read GetDateTimeOriginal write SetDateTimeOriginal; + property DateTimeDigitized: TDateTime + read GetDateTimeDigitized write SetDateTimeDigitized; + property DateTimeModified: TDateTime + read GetDateTimeModified write SetDateTimeModified; + property ExifComment: String + read GetExifComment write SetExifComment; + property ExifVersion: String + read FExifVersion; + property GPSLatitude: Extended + read GetGPSLatitude write SetGPSLatitude; + property GPSLongitude: Extended + read GetGPSLongitude write SetGPSLongitude; + property ImageDescription: String + read GetImageDescription write SetImageDescription; + property Height: Integer + read GetHeight write SetHeight; + property Width: Integer + read GetWidth write SetWidth; + + public + // General processing, called internally + procedure ProcessExifDir(DirStart, OffsetBase, ExifLength: LongInt; + ATagType: TTagType = ttExif; APrefix: string=''; AParentID: word=0); + procedure ProcessHWSpecific(AMakerBuff: ansistring; + TagTbl: array of TTagEntry; ADirStart, AMakerOffset: Longint; + spOffset: integer = 0); + + public + // Thumbnail + procedure CreateThumbnail(AThumbnailSize: Integer = DEFAULT_THUMBNAIL_SIZE); + function HasThumbnail: boolean; +// procedure ProcessThumbnail; + procedure RemoveThumbnail; + procedure LoadThumbnailFromStream(AStream: TStream); + procedure SaveThumbnailToStream(AStream: TStream); + property ThumbnailBuffer: TBytes + read FThumbnailBuffer; + property ThumbTagByID[ATagID: Word]: TTagEntry + read GetThumbTagByID write SetThumbTagByID; + property ThumbTagByIndex[AIndex: Integer]: TTagEntry + read GetThumbTagByIndex write SetThumbTagByIndex; + property ThumbTagCount: Integer + read fiThumbCount; + property ThumbTagValue[ATagName: String]: variant + read GetThumbTagValue write SetThumbTagValue; + property ThumbTagValueAsString[ATagName: String]: String + read GetThumbTagValueAsString; + + property Parent: TObject + read FParent; + end; // TInfoData + +var + CurTagArray: TImageInfo = nil; + fmtInt: tfmtInt = defIntFmt; + fmtReal: tfmtReal = defRealFmt; + fmtFrac: tfmtFrac = defFracFmt; + + ExifNonThumbnailLength : integer; + ShowTags: integer; + ExifTrace: integer = 0; + +function FindExifTagDefByID(ATagID: Word): PTagEntry; +function FindGPSTagDefByID(ATagID: Word): PTagEntry; + +function FindExifTagDefByName(ATagName: String): PTagEntry; +function FindGPSTagDefByName(ATagName: String): PTagEntry; + +function LookupType(idx: integer): String; + + +implementation + +uses + fpeMetadata, fpeMsData; + +const +// Compression Type Constants + JPEG_COMP_TYPE = 6; + TIFF_COMP_TYPE = 1; + + GPSCnt = 32; + ExifTagCnt = 251; // NOTE: was 250 before, but "count" is 251 + TotalTagCnt = GPSCnt + ExifTagCnt; + +{ Many tags added based on Php4 source... + http://lxr.php.net/source/php4/ext/exif/exif.c + + See also: https://sno.phy.queensu.ca/~phil/exiftool/TagNames/EXIF.html } +var + TagTable : array [0..ExifTagCnt-1] of TTagEntry = +// TagTable : array of TTagEntry = +// TagTable : TTagDefArray [0..ExifTagCnt] = +// TagTable: TTagDefArray = + ((TID:0; TType:2; Tag:$0001; Count:1; Name:'InteroperabilityIndex' ), {0} + (TID:0; TType:7; Tag:$0002; Count:1; Name:'InteroperabilityVersion'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:''; Size:4; Callback:VersionCallback), + (TID:0; TType:2; Tag:$000B; Count:1; Name:'ACDComment' ), + (TID:0; TType:4; Tag:$00FE; Count:1; Name:'NewSubfileType' ), + (TID:0; TType:3; Tag:$00FF; Count:1; Name:'SubfileType' ), + (TID:0; TType:4; Tag:$0100; ParentID:$0000; Count:1; Name:'ImageWidth'), + (TID:0; TType:4; Tag:$0101; ParentID:$0000; Count:1; Name:'ImageLength'), + (TID:0; TType:3; Tag:$0102; ParentID:$0000; Count:3; Name:'BitsPerSample'), + (TID:0; TType:3; Tag:$0103; ParentID:$0000; Count:1; Name:'Compression'; + Desc:''; Code:'6:Jpeg,3:Uncompressed,1:TIFF'), + (TID:0; TType:3; Tag:$0106; ParentID:$0000; Count:1; Name:'PhotometricInterpretation'; + Desc:''; Code:'1:Monochrome, 2:RGB, 6:YCbCr'), + (TID:0; TType:3; Tag:$010A; ParentID:$0000; Count:1; Name:'FillOrder'), {10} + (TID:0; TType:2; Tag:$010D; ParentID:$0000; Count:1; Name:'DocumentName'), + (TID:0; TType:2; Tag:$010E; ParentID:$0000; Count:1; Name:'ImageDescription'), + (TID:0; TType:2; Tag:$010F; ParentID:$0000; Count:1; Name:'Make'), + (TID:0; TType:2; Tag:$0110; ParentID:$0000; Count:1; Name:'Model'), + (TID:0; TType:4; Tag:$0111; ParentID:$0000; Count:1; Name:'StripOffsets'), + (TID:0; TType:3; Tag:$0112; ParentID:$0000; Count:1; Name:'Orientation'; + Desc:''; Code:'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'), + (TID:0; TType:3; Tag:$0115; ParentID:$0000; Count:1; Name:'SamplesPerPixel'), + (TID:0; TType:4; Tag:$0116; ParentID:$0000; Count:1; Name:'RowsPerStrip'), + (TID:0; TType:4; Tag:$0117; ParentID:$0000; Count:1; Name:'StripByteCounts'), + (TID:0; TType:3; Tag:$0118; ParentID:$0000; Count:1; Name:'MinSampleValue'), {20} + (TID:0; TType:3; Tag:$0119; ParentID:$0000; Count:1; Name:'MaxSampleValue'), + (TID:0; TType:5; Tag:$011A; ParentID:$0000; Count:1; Name:'XResolution'), +// Desc:''; Code:''; Data:''; Raw:''; FormatS:'%f'), + (TID:0; TType:5; Tag:$011B; ParentID:$0000; Count:1; Name:'YResolution'), +// Desc:''; Code:''; Data:''; Raw:''; FormatS:'%f'), + (TID:0; TType:3; Tag:$011C; ParentID:$0000; Count:1; Name:'PlanarConfiguration'), + (TID:0; TType:2; Tag:$011D; ParentID:$0000; Count:1; Name:'PageName'), + (TID:0; TType:5; Tag:$011E; ParentID:$0000; Count:1; Name:'XPosition'), + (TID:0; TType:5; Tag:$011F; ParentID:$0000; Count:1; Name:'YPosition'), + (TID:0; TType:0; Tag:$0120; ParentID:$0000; Count:1; Name:'FreeOffsets'), + (TID:0; TType:0; Tag:$0121; ParentID:$0000; Count:1; Name:'FreeByteCounts'), + (TID:0; TType:3; Tag:$0122; ParentID:$0000; Count:1; Name:'GrayReponseUnit'), {30} + (TID:0; TType:0; Tag:$0123; ParentID:$0000; Count:1; Name:'GrayReponseCurve'), + (TID:0; TType:0; Tag:$0124; ParentID:$0000; Count:1; Name:'T4Options'), + (TID:0; TType:0; Tag:$0125; ParentID:$0000; Count:1; Name:'T6Options'), + (TID:0; TType:3; Tag:$0128; ParentID:$0000; Count:1; Name:'ResolutionUnit'; + Desc:''; Code:'1:None specified,2:inches,3:cm'), + (TID:0; TType:3; Tag:$0129; ParentID:$0000; Count:2; Name:'PageNumber'), + (TID:0; TType:3; Tag:$012D; ParentID:$0000; Count:768; Name:'TransferFunction'), + (TID:0; TType:2; Tag:$0131; ParentID:$0000; Count:1; Name:'Software'), + (TID:0; TType:2; Tag:$0132; ParentID:$0000; Count:1; Name:'DateTime'), + (TID:0; TType:2; Tag:$013B; ParentID:$0000; Count:1; Name:'Artist'), + (TID:0; TType:2; Tag:$013C; ParentID:$0000; Count:1; Name:'HostComputer'), {40} + (TID:0; TType:3; Tag:$013D; ParentID:$0000; Count:1; Name:'Predictor'), + (TID:0; TType:5; Tag:$013E; ParentID:$0000; Count:2; Name:'WhitePoint'), + (TID:0; TType:5; Tag:$013F; ParentID:$0000; Count:6; Name:'PrimaryChromaticities'), + (TID:0; TType:0; Tag:$0140; ParentID:$0000; Count:1; Name:'ColorMap'), + (TID:0; TType:3; Tag:$0141; ParentID:$0000; Count:2; Name:'HalfToneHints'), + (TID:0; TType:4; Tag:$0142; ParentID:$0000; Count:1; Name:'TileWidth'), + (TID:0; TType:4; Tag:$0143; ParentID:$0000; Count:1; Name:'TileLength'), + (TID:0; TType:0; Tag:$0144; ParentID:$0000; Count:1; Name:'TileOffsets'), + (TID:0; TType:0; Tag:$0145; ParentID:$0000; Count:1; Name:'TileByteCounts'), + (TID:0; TType:0; Tag:$014A; ParentID:$0000; Count:1; Name:'SubIFDs'), {50} + (TID:0; TType:3; Tag:$014C; ParentID:$0000; Count:1; Name:'InkSet'), + (TID:0; TType:0; Tag:$014D; ParentID:$0000; Count:1; Name:'InkNames'), + (TID:0; TType:0; Tag:$014E; ParentID:$0000; Count:1; Name:'NumberOfInks'), + (TID:0; TType:0; Tag:$0150; ParentID:$0000; Count:1; Name:'DotRange'), + (TID:0; TType:2; Tag:$0151; ParentID:$0000; Count:1; Name:'TargetPrinter'), + (TID:0; TType:0; Tag:$0152; ParentID:$0000; Count:1; Name:'ExtraSample'), + (TID:0; TType:0; Tag:$0153; ParentID:$0000; Count:1; Name:'SampleFormat'), + (TID:0; TType:0; Tag:$0154; ParentID:$0000; Count:1; Name:'SMinSampleValue'), + (TID:0; TType:0; Tag:$0155; ParentID:$0000; Count:1; Name:'SMaxSampleValue'), + (TID:0; TType:0; Tag:$0156; ParentID:$0000; Count:1; Name:'TransferRange'), {60} + (TID:0; TType:0; Tag:$0157; ParentID:$0000; Count:1; Name:'ClipPath'), + (TID:0; TType:0; Tag:$0158; ParentID:$0000; Count:1; Name:'XClipPathUnits'), + (TID:0; TType:0; Tag:$0159; ParentID:$0000; Count:1; Name:'YClipPathUnits'), + (TID:0; TType:0; Tag:$015A; ParentID:$0000; Count:1; Name:'Indexed'), + (TID:0; TType:0; Tag:$015B; ParentID:$0000; Count:1; Name:'JPEGTables'), + (TID:0; TType:0; Tag:$015F; ParentID:$0000; Count:1; Name:'OPIProxy'), + (TID:0; TType:0; Tag:$0200; ParentID:$0000; Count:1; Name:'JPEGProc'), + (TID:0; TType:4; Tag:$0201; ParentID:$0000; Count:1; Name:'JPEGInterchangeFormat'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:''; Size:4), + (TID:0; TType:4; Tag:$0202; ParentID:$0000; Count:1; Name:'JPEGInterchangeFormatLength'), + (TID:0; TType:0; Tag:$0203; ParentID:$0000; Count:1; Name:'JPEGRestartInterval'), {70} + (TID:0; TType:0; Tag:$0205; ParentID:$0000; Count:1; Name:'JPEGLosslessPredictors'), + (TID:0; TType:0; Tag:$0206; ParentID:$0000; Count:1; Name:'JPEGPointTransforms'), + (TID:0; TType:0; Tag:$0207; ParentID:$0000; Count:1; Name:'JPEGQTables'), + (TID:0; TType:0; Tag:$0208; ParentID:$0000; Count:1; Name:'JPEGDCTables'), + (TID:0; TType:0; Tag:$0209; ParentID:$0000; Count:1; Name:'JPEGACTables'), + (TID:0; TType:5; Tag:$0211; ParentID:$0000; Count:3; Name:'YCbCrCoefficients'), + (TID:0; TType:3; Tag:$0212; ParentID:$0000; Count:2; Name:'YCbCrSubSampling'), + (TID:0; TType:3; Tag:$0213; ParentID:$0000; Count:1; Name:'YCbCrPositioning'; + Desc:''; Code:'1:Centered,2:Co-sited'), + (TID:0; TType:5; Tag:$0214; ParentID:$0000; Count:6; Name:'ReferenceBlackWhite'), + (TID:0; TType:1; Tag:$02BC; ParentID:$0000; Count:1; Name:'ExtensibleMetadataPlatform'), {80} + (TID:0; TType:0; Tag:$0301; ParentID:$0000; Count:1; Name:'Gamma'), + (TID:0; TType:0; Tag:$0302; ParentID:$0000; Count:1; Name:'ICCProfileDescriptor'), + (TID:0; TType:0; Tag:$0303; ParentID:$0000; Count:1; Name:'SRGBRenderingIntent'), + (TID:0; TType:0; Tag:$0304; ParentID:$0000; Count:1; Name:'ImageTitle'), + (TID:0; TType:2; Tag:$1000; ParentID:$0000; Count:1; Name:'RelatedImageFileFormat'), + (TID:0; TType:3; Tag:$1001; ParentID:$0000; Count:1; Name:'RelatedImageWidth'), + (TID:0; TType:3; Tag:$1002; ParentID:$0000; Count:1; Name:'RelatedImageHeight'), + (TID:0; TType:0; Tag:$5001; ParentID:$0000; Count:1; Name:'ResolutionXUnit'), + (TID:0; TType:0; Tag:$5002; ParentID:$0000; Count:1; Name:'ResolutionYUnit'), + (TID:0; TType:0; Tag:$5003; ParentID:$0000; Count:1; Name:'ResolutionXLengthUnit'), {90} + (TID:0; TType:0; Tag:$5004; ParentID:$0000; Count:1; Name:'ResolutionYLengthUnit'), + (TID:0; TType:0; Tag:$5005; ParentID:$0000; Count:1; Name:'PrintFlags'), + (TID:0; TType:0; Tag:$5006; ParentID:$0000; Count:1; Name:'PrintFlagsVersion'), + (TID:0; TType:0; Tag:$5007; ParentID:$0000; Count:1; Name:'PrintFlagsCrop'), + (TID:0; TType:0; Tag:$5008; ParentID:$0000; Count:1; Name:'PrintFlagsBleedWidth'), + (TID:0; TType:0; Tag:$5009; ParentID:$0000; Count:1; Name:'PrintFlagsBleedWidthScale'), + (TID:0; TType:0; Tag:$500A; ParentID:$0000; Count:1; Name:'HalftoneLPI'), + (TID:0; TType:0; Tag:$500B; ParentID:$0000; Count:1; Name:'HalftoneLPIUnit'), + (TID:0; TType:0; Tag:$500C; ParentID:$0000; Count:1; Name:'HalftoneDegree'), + (TID:0; TType:0; Tag:$500D; ParentID:$0000; Count:1; Name:'HalftoneShape'), {100} + (TID:0; TType:0; Tag:$500E; ParentID:$0000; Count:1; Name:'HalftoneMisc'), + (TID:0; TType:0; Tag:$500F; ParentID:$0000; Count:1; Name:'HalftoneScreen'), + (TID:0; TType:0; Tag:$5010; ParentID:$0000; Count:1; Name:'JPEGQuality'), + (TID:0; TType:0; Tag:$5011; ParentID:$0000; Count:1; Name:'GridSize'), + (TID:0; TType:0; Tag:$5012; ParentID:$0000; Count:1; Name:'ThumbnailFormat'), + (TID:0; TType:0; Tag:$5013; ParentID:$0000; Count:1; Name:'ThumbnailWidth'), + (TID:0; TType:0; Tag:$5014; ParentID:$0000; Count:1; Name:'ThumbnailHeight'), + (TID:0; TType:0; Tag:$5015; ParentID:$0000; Count:1; Name:'ThumbnailColorDepth'), + (TID:0; TType:0; Tag:$5016; ParentID:$0000; Count:1; Name:'ThumbnailPlanes'), + (TID:0; TType:0; Tag:$5017; ParentID:$0000; Count:1; Name:'ThumbnailRawBytes'), {110} + (TID:0; TType:0; Tag:$5018; ParentID:$0000; Count:1; Name:'ThumbnailSize'), + (TID:0; TType:0; Tag:$5019; ParentID:$0000; Count:1; Name:'ThumbnailCompressedSize'), + (TID:0; TType:0; Tag:$501A; ParentID:$0000; Count:1; Name:'ColorTransferFunction'), + (TID:0; TType:0; Tag:$501B; ParentID:$0000; Count:1; Name:'ThumbnailData'), + (TID:0; TType:0; Tag:$5020; ParentID:$0000; Count:1; Name:'ThumbnailImageWidth'), + (TID:0; TType:0; Tag:$5021; ParentID:$0000; Count:1; Name:'ThumbnailImageHeight'), + (TID:0; TType:0; Tag:$5022; ParentID:$0000; Count:1; Name:'ThumbnailBitsPerSample'), + (TID:0; TType:0; Tag:$5023; ParentID:$0000; Count:1; Name:'ThumbnailCompression'), + (TID:0; TType:0; Tag:$5024; ParentID:$0000; Count:1; Name:'ThumbnailPhotometricInterp'), + (TID:0; TType:0; Tag:$5025; ParentID:$0000; Count:1; Name:'ThumbnailImageDescription'), {120} + (TID:0; TType:2; Tag:$5026; ParentID:$0000; Count:1; Name:'ThumbnailEquipMake'), + (TID:0; TType:2; Tag:$5027; ParentID:$0000; Count:1; Name:'ThumbnailEquipModel'), + (TID:0; TType:0; Tag:$5028; ParentID:$0000; Count:1; Name:'ThumbnailStripOffsets'), + (TID:0; TType:0; Tag:$5029; ParentID:$0000; Count:1; Name:'ThumbnailOrientation'), + (TID:0; TType:0; Tag:$502A; ParentID:$0000; Count:1; Name:'ThumbnailSamplesPerPixel'), + (TID:0; TType:0; Tag:$502B; ParentID:$0000; Count:1; Name:'ThumbnailRowsPerStrip'), + (TID:0; TType:0; Tag:$502C; ParentID:$0000; Count:1; Name:'ThumbnailStripBytesCount'), + (TID:0; TType:0; Tag:$502D; ParentID:$0000; Count:1; Name:'ThumbnailResolutionX'), + (TID:0; TType:0; Tag:$502E; ParentID:$0000; Count:1; Name:'ThumbnailResolutionY'), + (TID:0; TType:0; Tag:$502F; ParentID:$0000; Count:1; Name:'ThumbnailPlanarConfig'), {130} + (TID:0; TType:0; Tag:$5030; ParentID:$0000; Count:1; Name:'ThumbnailResolutionUnit'), + (TID:0; TType:0; Tag:$5031; ParentID:$0000; Count:1; Name:'ThumbnailTransferFunction'), + (TID:0; TType:2; Tag:$5032; ParentID:$0000; Count:1; Name:'ThumbnailSoftwareUsed'), + (TID:0; TType:2; Tag:$5033; ParentID:$0000; Count:1; Name:'ThumbnailDateTime'), + (TID:0; TType:2; Tag:$5034; ParentID:$0000; Count:1; Name:'ThumbnailArtist'), + (TID:0; TType:0; Tag:$5035; ParentID:$0000; Count:1; Name:'ThumbnailWhitePoint'), + (TID:0; TType:0; Tag:$5036; ParentID:$0000; Count:1; Name:'ThumbnailPrimaryChromaticities'), + (TID:0; TType:0; Tag:$5037; ParentID:$0000; Count:1; Name:'ThumbnailYCbCrCoefficients'), + (TID:0; TType:0; Tag:$5038; ParentID:$0000; Count:1; Name:'ThumbnailYCbCrSubsampling'), + (TID:0; TType:0; Tag:$5039; ParentID:$0000; Count:1; Name:'ThumbnailYCbCrPositioning'), {140} + (TID:0; TType:0; Tag:$503A; ParentID:$0000; Count:1; Name:'ThumbnailRefBlackWhite'), + (TID:0; TType:2; Tag:$503B; ParentID:$0000; Count:1; Name:'ThumbnailCopyRight'), + (TID:0; TType:0; Tag:$5090; ParentID:$0000; Count:1; Name:'LuminanceTable'), + (TID:0; TType:0; Tag:$5091; ParentID:$0000; Count:1; Name:'ChrominanceTable'), + (TID:0; TType:0; Tag:$5100; ParentID:$0000; Count:1; Name:'FrameDelay'), + (TID:0; TType:0; Tag:$5101; ParentID:$0000; Count:1; Name:'LoopCount'), + (TID:0; TType:0; Tag:$5110; ParentID:$0000; Count:1; Name:'PixelUnit'), + (TID:0; TType:0; Tag:$5111; ParentID:$0000; Count:1; Name:'PixelPerUnitX'), + (TID:0; TType:0; Tag:$5112; ParentID:$0000; Count:1; Name:'PixelPerUnitY'), + (TID:0; TType:0; Tag:$5113; ParentID:$0000; Count:1; Name:'PaletteHistogram'), {150} + (TID:0; TType:0; Tag:$800D; ParentID:$0000; Count:1; Name:'ImageID'), + (TID:0; TType:0; Tag:$80E3; ParentID:$0000; Count:1; Name:'Matteing'), //* obsoleted by ExtraSamples */ + (TID:0; TType:0; Tag:$80E4; ParentID:$0000; Count:1; Name:'DataType'), //* obsoleted by SampleFormat */ + (TID:0; TType:0; Tag:$80E5; ParentID:$0000; Count:1; Name:'ImageDepth'), + (TID:0; TType:0; Tag:$80E6; ParentID:$0000; Count:1; Name:'TileDepth'), + (TID:0; TType:3; Tag:$828D; ParentID:$0000; Count:2; Name:'CFARepeatPatternDim'), + (TID:0; TType:1; Tag:$828E; ParentID:$0000; Count:1; Name:'CFAPattern'), //count: ??? + (TID:0; TType:0; Tag:$828F; ParentID:$0000; Count:1; Name:'BatteryLevel'), + (TID:0; TType:2; Tag:$8298; ParentID:$0000; Count:1; Name:'Copyright'), + (TID:0; TType:5; Tag:$829A; ParentID:$8769; Count:1; Name:'ExposureTime'; + Desc:'Exposure time'; Code:''; Data:''; Raw:''; FormatS:'%s sec'; Size:8; Callback:nil), //SSpeedCallback), {160} + (TID:0; TType:5; Tag:$829D; ParentID:$8769; Count:1; Name:'FNumber'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:'F%0.1f'), + (TID:0; TType:4; Tag:$83BB; ParentID:$0000; Count:1; Name:'IPTC/NAA'; + Desc:'IPTC/NAA'), + (TID:0; TType:0; Tag:$84E3; ParentID:$0000; Count:1; Name:'IT8RasterPadding'), + (TID:0; TType:0; Tag:$84E5; ParentID:$0000; Count:1; Name:'IT8ColorTable'), + (TID:0; TType:0; Tag:$8649; ParentID:$0000; Count:1; Name:'ImageResourceInformation'), + (TID:0; TType:4; Tag:$8769; ParentID:$0000; Count:1; Name:'ExifOffset'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:''; Size:4), + (TID:0; TType:0; Tag:$8773; ParentID:$0000; Count:1; Name:'InterColorProfile'), + (TID:0; TType:3; Tag:$8822; ParentID:$8769; Count:1; Name:'ExposureProgram'; + Desc:''; Code:'0:Not denfined,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'), + (TID:0; TType:2; Tag:$8824; ParentID:$8769; Count:1; Name:'SpectralSensitivity'), + (TID:0; TType:4; Tag:$8825; ParentID:$0000; Count:1; Name:'GPSInfo'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:''; Size:4), {170} + (TID:0; TType:3; Tag:$8827; ParentID:$8769; Count:1; Name:'ISOSpeedRatings'), {171} + (TID:0; TType:0; Tag:$8828; ParentID:$8769; Count:1; Name:'OECF'), + (TID:0; TType:0; Tag:$8829; ParentID:$8769; Count:1; Name:'Interlace'), + (TID:0; TType:8; Tag:$882A; ParentID:$8769; Count:1; Name:'TimeZoneOffset'), + (TID:0; TType:3; Tag:$882B; ParentID:$8769; Count:1; Name:'SelfTimerMode'), + (TID:0; TType:7; Tag:$9000; ParentID:$8769; Count:1; Name:'ExifVersion'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:''; Size:4; Callback:VersionCallback), + (TID:0; TType:2; Tag:$9003; ParentID:$8769; Count:1; Name:'DateTimeOriginal'), + (TID:0; TType:2; Tag:$9004; ParentID:$8769; Count:1; Name:'DateTimeDigitized'), + (TID:0; TType:7; Tag:$9101; ParentID:$8769; Count:1; Name:'ComponentsConfiguration'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:''; Size:0; Callback:CompCfgCallBack), + (TID:0; TType:5; Tag:$9102; ParentID:$8769; Count:1; Name:'CompressedBitsPerPixel'), {180} + (TID:0; TType:10; Tag:$9201; ParentID:$8769; Count:1; Name:'ShutterSpeedValue'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:''; Size:0; Callback:SSpeedCallBack), + (TID:0; TType:5; Tag:$9202; ParentID:$8769; Count:1; Name:'ApertureValue'; + Desc:'Aperture value'; Code:''; Data:''; Raw:''; FormatS:'F%0.1f'), + (TID:0; TType:10;Tag:$9203; ParentID:$8769; Count:1; Name:'BrightnessValue'), + (TID:0; TType:10;Tag:$9204; ParentID:$8769; Count:1; Name:'ExposureBiasValue'), + (TID:0; TType:5; Tag:$9205; ParentID:$8769; Count:1; Name:'MaxApertureValue'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:'F%0.1f'), + (TID:0; TType:5; Tag:$9206; ParentID:$8769; Count:1; Name:'SubjectDistance'), + (TID:0; TType:3; Tag:$9207; ParentID:$8769; Count:1; Name:'MeteringMode'; + Desc:''; + Code:'0:Unknown,1:Average,2:Center,3:Spot,4:Multi-spot,5:Multi-segment,6:Partial'), + (TID:0; TType:3; Tag:$9208; ParentID:$8769; Count:1; Name:'LightSource'; + Desc:''; + Code:'0:Unknown,1:Daylight,2:Fluorescent,3:Tungsten,10:Flash,17:Std A,18:Std B,19:Std C'), + (TID:0; TType:3; Tag:$9209; ParentID:$8769; Count:1; Name:'Flash'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:FlashCallBack), + (TID:0; TType:5; Tag:$920A; ParentID:$8769; Count:1; Name:'FocalLength'; + Desc:'Focal length'; Code:''; Data:''; Raw:''; FormatS:'%0.1f mm'), {190} + (TID:0; TType:0; Tag:$920B; ParentID:$8769; Count:1; Name:'FlashEnergy'), + (TID:0; TType:0; Tag:$920C; ParentID:$8769; Count:1; Name:'SpatialFrequencyResponse'), + (TID:0; TType:0; Tag:$920D; ParentID:$8769; Count:1; Name:'Noise'), + (TID:0; TType:0; Tag:$920E; ParentID:$8769; Count:1; Name:'FocalPlaneXResolution'; + Desc:''; code:''; Data:''; Raw:''; FormatS:'%f'; Size:0; CallBack:nil), + (TID:0; TType:0; Tag:$920F; ParentID:$8769; Count:1; Name:'FocalPlaneYResolution'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:'%f'; Size:0; CallBack:nil), + (TID:0; TType:0; Tag:$9210; ParentID:$8769; Count:1; Name:'FocalPlaneResolutionUnit'; + Desc:''; Code:'1:None specified,2:inches,3:cm'), + (TID:0; TType:4; Tag:$9211; ParentID:$8769; Count:1; Name:'ImageNumber'), + (TID:0; TType:2; Tag:$9212; ParentID:$8769; Count:1; Name:'SecurityClassification'), + (TID:0; TType:2; Tag:$9213; ParentID:$8769; Count:1; Name:'ImageHistory'), + (TID:0; TType:3; Tag:$9214; ParentID:$8769; Count:2; Name:'SubjectLocation'), {200} + (TID:0; TType:0; Tag:$9215; ParentID:$8769; Count:1; Name:'ExposureIndex'), + (TID:0; TType:0; Tag:$9216; ParentID:$8769; Count:1; Name:'TIFF/EPStandardID'), + (TID:0; TType:0; Tag:$9217; ParentID:$8769; Count:1; Name:'SensingMethod'), + (TID:0; TType:0; Tag:$923F; ParentID:$8769; Count:1; Name:'StoNits'), + (TID:0; TType:7; Tag:$927C; ParentID:$8769; Count:1; Name:'MakerNote'), + (TID:0; TType:7; Tag:$9286; ParentID:$8769; Count:1; Name:'UserComment'), + (TID:0; TType:2; Tag:$9290; ParentID:$8769; Count:1; Name:'SubSecTime'), + (TID:0; TType:2; Tag:$9291; ParentID:$8769; Count:1; Name:'SubSecTimeOriginal'), + (TID:0; TType:2; Tag:$9292; ParentID:$8769; Count:1; Name:'SubSecTimeDigitized'), + (TID:0; TType:0; Tag:$953C; ParentID:$0000; Count:1; Name:'ImageSourceData'), // "Adobe Photoshop Document Data Block": 8BIM... {210} + (TID:0; TType:0; Tag:$9C9B; ParentID:$0000; Count:1; Name:'Title'; + Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:xpTranslate), // Win XP specific, Unicode + (TID:0; TType:0; Tag:$9C9C; ParentID:$0000; Count:1; Name:'Comments'; + Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:xpTranslate), // Win XP specific, Unicode + (TID:0; TType:0; Tag:$9C9D; ParentID:$0000; Count:1; Name:'Author'; + Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:xpTranslate), // Win XP specific, Unicode + (TID:0; TType:0; Tag:$9C9E; ParentID:$0000; Count:1; Name:'Keywords'; + Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:xpTranslate), // Win XP specific, Unicode + (TID:0; TType:0; Tag:$9C9F; ParentID:$0000; Count:1; Name:'Subject'; + Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:xpTranslate), // Win XP specific, Unicode + (TID:0; TType:0; Tag:$A000; ParentID:$8769; Count:1; Name:'FlashPixVersion'), + (TID:0; TType:3; Tag:$A001; ParentID:$8769; Count:1; Name:'ColorSpace'; + Desc:''; Code:'0:sBW,1:sRGB'), + (TID:0; TType:3; Tag:$A002; ParentID:$8769; Count:1; Name:'ExifImageWidth'), + (TID:0; TType:3; Tag:$A003; ParentID:$8769; Count:1; Name:'ExifImageLength'), + (TID:0; TType:2; Tag:$A004; ParentID:$8769; Count:1; Name:'RelatedSoundFile'), {220} + (TID:0; TType:0; Tag:$A005; ParentID:$8769; Count:1; Name:'InteroperabilityOffset'), + (TID:0; TType:5; Tag:$A20B; ParentID:$8769; Count:1; Name:'FlashEnergy'), // TID:0;TType:0;ICode: 2;Tag: $920B in TIFF/EP + (TID:0; TType:0; Tag:$A20C; ParentID:$8769; Count:1; Name:'SpatialFrequencyResponse'), // TID:0;TType:0;ICode: 2;Tag: $920C - - + (TID:0; TType:5; Tag:$A20E; ParentID:$8769; Count:1; Name:'FocalPlaneXResolution'; + Desc:''; code:''; Data:''; Raw:''; FormatS:'%f'; Size:0; CallBack:nil), + (TID:0; TType:5; Tag:$A20F; ParentID:$8769; Count:1; Name:'FocalPlaneYResolution'; + Desc:''; code:''; Data:''; Raw:''; FormatS:'%f'; Size:0; CallBack:nil), + (TID:0; TType:3; Tag:$A210; ParentID:$8769; Count:1; Name:'FocalPlaneResolutionUnit'; + Desc:''; Code:'1:None specified,2:inches,3:cm'), // TID:0;TType:0;ICode: 2;Tag: $9210 - - + (TID:0; TType:0; Tag:$A211; ParentID:$8769; Count:1; Name:'ImageNumber'), + (TID:0; TType:0; Tag:$A212; ParentID:$8769; Count:1; Name:'SecurityClassification'), + (TID:0; TType:0; Tag:$A213; ParentID:$8769; Count:1; Name:'ImageHistory'), + (TID:0; TType:3; Tag:$A214; ParentID:$8769; Count:2; Name:'SubjectLocation'), {230} + (TID:0; TType:5; Tag:$A215; ParentID:$8769; Count:1; Name:'ExposureIndex'), + (TID:0; TType:0; Tag:$A216; ParentID:$8769; Count:1; Name:'TIFF/EPStandardID'; + Desc:'TIFF/EPStandardID'), + (TID:0; TType:3; Tag:$A217; ParentID:$8769; Count:1; Name:'SensingMethod'; Desc:''; + Code:'0:Unknown,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'), + (TID:0; TType:1; Tag:$A300; ParentID:$8769; Count:1; Name:'FileSource'; Desc:''; + Code:'0:Unknown,1:Film scanner,2:Reflection print scanner,3:Digital camera'), + (TID:0; TType:7; Tag:$A301; ParentID:$8769; Count:1; Name:'SceneType'; + Desc:''; Code:'0:Unknown,1:Directly Photographed'), + (TID:0; TType:7; Tag:$A302; ParentID:$8769; Count:1; Name:'CFAPattern'), + (TID:0; TType:3; Tag:$A401; ParentID:$8769; Count:1; Name:'CustomRendered'; + Desc:''; Code:'0:Normal,1:Custom'), + (TID:0; TType:3; Tag:$A402; ParentID:$8769; Count:1; Name:'ExposureMode'; + Desc:''; Code:'0:Auto,1:Manual,2:Auto bracket'), + (TID:0; TType:3; Tag:$A403; ParentID:$8769; Count:1; Name:'WhiteBalance'; + Desc:''; Code:'0:Auto,1:Manual'), + (TID:0; TType:5; Tag:$A404; ParentID:$8769; Count:1; Name:'DigitalZoomRatio'), {240} + (TID:0; TType:3; Tag:$A405; ParentID:$8769; Count:1; Name:'FocalLengthIn35mmFilm'; + Desc:'Focal Length in 35mm Film'; Code:''; Data:''; Raw:''; FormatS:'%.1f mm'), + (TID:0; TType:3; Tag:$A406; ParentID:$8769; Count:1; Name:'SceneCaptureType'; + Desc:''; Code:'0:Standard,1:Landscape,2:Portrait,3:Night scene'), + (TID:0; TType:3; Tag:$A407; ParentID:$8769; Count:1; Name:'GainControl'; Desc:''; + Code:'0:None,1:Low gain up,2:High gain up,3:Low gain down,4:High gain down'), + (TID:0; TType:3; Tag:$A408; ParentID:$8769; Count:1; Name:'Contrast'; + Desc:''; Code:'0:Normal,1:Soft,2:Hard'), + (TID:0; TType:3; Tag:$A409; ParentID:$8769; Count:1; Name:'Saturation'; + Desc:''; Code:'0:Normal,1:Low,2:High'), + (TID:0; TType:3; Tag:$A40A; ParentID:$8769; Count:1; Name:'Sharpness'; + Desc:''; Code:'0:Normal,1:Soft,2:Hard'), + (TID:0; TType:0; Tag:$A40B; ParentID:$8769; Count:1; Name:'DeviceSettingDescription'), + (TID:0; TType:3; Tag:$A40C; ParentID:$8769; Count:1; Name:'SubjectDistanceRange'; {250} + Desc:''; Code:'0:Unknown,1:Macro,2:Close view,3:Distant view'), + (TID:0; TType:2; Tag:$A420; ParentID:$8769; Count:1; Name:'ImageUniqueID'; + Desc:''; Code:'0:Close view,1:Distant view'), + (TID:0; TType:0; Tag:0; ParentID:$0000; Count:1; Name:'Unknown') +); + + GPSTable : array [0..GPSCnt-1] of TTagEntry = ( + (TID:0; TType:1; Tag:$000; ParentID:$8825; Count:4; Name:'GPSVersionID'; + Desc:''; Code:''; Data:''; RAw:''; FormatS:''; Size:0; CallBack:GpsVersionID), + (TID:0; TType:2; Tag:$001; ParentID:$8825; Count:2; Name:'GPSLatitudeRef'; Desc:''), + (TID:0; TType:5; Tag:$002; ParentID:$8825; Count:3; Name:'GPSLatitude'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:GpsPosn), + (TID:0; TType:2; Tag:$003; ParentID:$8825; Count:2; Name:'GPSLongitudeRef';Desc:''), + (TID:0; TType:5; Tag:$004; ParentID:$8825; Count:3; Name:'GPSLongitude'; + Desc:''; Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:GpsPosn), + (TID:0; TType:1; Tag:$005; ParentID:$8825; Count:1; Name:'GPSAltitudeRef'; Desc:''; + Code:'0:Above Sealevel,1:Below Sealevel'), + (TID:0; TType:5; Tag:$006; ParentID:$8825; Count:1; Name:'GPSAltitude'; Desc:''; + Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:GpsAltitude), + (TID:0; TType:5; Tag:$007; ParentID:$8825; Count:3; Name:'GPSTimeStamp'; Desc:''; + Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:CvtTime), + (TID:0; TType:2; Tag:$008; ParentID:$8825; Count:1; Name:'GPSSatellites'; Desc:''), + (TID:0; TType:2; Tag:$009; ParentID:$8825; Count:2; Name:'GPSStatus'; + Desc:''; Code:'A:Active;V:Void'), + (TID:0; TType:2; Tag:$00A; ParentID:$8825; Count:2; Name:'GPSMeasureMode'; + Desc:''; Code:'2:2D,3:3D'), + (TID:0; TType:5; Tag:$00B; ParentID:$8825; Count:1; Name:'GPSDOP'; Desc:''), + (TID:0; TType:2; Tag:$00C; ParentID:$8825; Count:2; Name:'GPSSpeedRef'; + Desc:''; Code:'K:km/h,M:mph,N:knots'), + (TID:0; TType:5; Tag:$00D; ParentID:$8825; Count:1; Name:'GPSSpeed'; Desc:''), + (TID:0; TType:2; Tag:$00E; ParentID:$8825; Count:2; Name:'GPSTrackRef'; + Desc:''; Code:'M:Magnetic North,T:True North'), + (TID:0; TType:5; Tag:$00F; ParentID:$8825; Count:1; Name:'GPSTrack'; Desc:''), + (TID:0; TType:2; Tag:$010; ParentID:$8825; Count:2; Name:'GPSImageDirectionRef'; + Desc:''; Code:'M:Magnetic North,T:True North'), + (TID:0; TType:5; Tag:$011; ParentID:$8825; Count:1; Name:'GPSImageDirection'; Desc:''), + (TID:0; TType:2; Tag:$012; ParentID:$8825; Count:1; Name:'GPSMapDatum'; Desc:''), + (TID:0; TType:2; Tag:$013; ParentID:$8825; Count:2; Name:'GPSDestLatitudeRef'; + Desc:''; Code:'N:North,S:South'), + (TID:0; TType:5; Tag:$014; ParentID:$8825; Count:3; Name:'GPSDestLatitude'; Desc:''; + Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:GpsPosn), + (TID:0; TType:2; Tag:$015; ParentID:$8825; Count:2; Name:'GPSDestLongitudeRef'; + Desc:''; Code: 'E:East,W:West'), + (TID:0; TType:5; Tag:$016; ParentID:$8825; Count:3; Name:'GPSDestLongitude'; Desc:''; + Code:''; Data:''; Raw:''; FormatS:''; Size:0; CallBack:GpsPosn), + (TID:0; TType:2; Tag:$017; ParentID:$8825; Count:2; Name:'GPSDestBearingRef'; + Desc:''; Code:'M:Magnetic North,T:True North'), + (TID:0; TType:5; Tag:$018; ParentID:$8825; Count:1; Name:'GPSDestBearing'; Desc:''), + (TID:0; TType:2; Tag:$019; ParentID:$8825; Count:2; Name:'GPSDestDistanceRef'; + Desc:''; Code:'K:Kilometers,M:Miles,N:Nautic Miles'), + (TID:0; TType:5; Tag:$01A; ParentID:$8825; Count:1; Name:'GPSDestDistance'; Desc:''), + (TID:0; TType:7; Tag:$01B; ParentID:$8825; Count:1; Name:'GPSProcessingMode'; Desc:''), + (TID:0; TType:7; Tag:$01C; ParentID:$8825; Count:1; Name:'GPSAreaInformation'; Desc:''), + (TID:0; TType:2; Tag:$01D; ParentID:$8825; Count:7; Name:'GPSDateStamp'; Desc:''), + (TID:0; TType:3; Tag:$01E; ParentID:$8825; Count:1; Name:'GPSDifferential'; + Desc:''; Code:'0:No Correction,1:Differential Correction'), + (TID:0; TType:5; Tag:$01F; ParentID:$8825; Count:1; Name:'GPSHPositioningError'; Desc:'') + ); + + tagInit : boolean = false; + +function FindExifTagDefByName(ATagName: String): PTagEntry; +var + i: Integer; +begin + for i:=0 to High(TagTable) do begin + Result := @TagTable[i]; + if AnsiSameText(Result^.Name, ATagName) then + exit; + end; + Result := nil; +end; + +function FindExifTagDefByID(ATagID: word): PTagEntry; +var + i: Integer; +begin + for i:=0 to High(TagTable) do begin + Result := @TagTable[i]; + if Result^.Tag = ATagID then + exit; + end; + Result := nil; +end; + +function FindGpsTagDefByName(ATagName: String): PTagEntry; +var + i: Integer; +begin + for i:=0 to High(GpsTable) do begin + Result := @GpsTable[i]; + if AnsiSameText(Result^.Name, ATagName) then + exit; + end; + Result := nil; +end; + +function FindGpsTagDefByID(ATagID: word): PTagEntry; +var + i: Integer; +begin + for i:=0 to High(GpsTable) do begin + Result := @GpsTable[i]; + if Result^.Tag = ATagID then + exit; + end; + Result := nil; +end; + +Procedure FixTagTable(var tags:array of TTagEntry); +var i:integer; +begin + for i := low(tags) to high(tags) do + begin + if Length(tags[i].Desc) <= 0 then + tags[i].Desc := tags[i].Name; + end; +end; + +Procedure FixTagTableParse(var tags:array of TTagEntry); +var i:integer; +begin + for i := low(tags) to high(tags) do + begin + if Length(tags[i].Desc) <= 0 then + tags[i].Desc := InsertSpaces(tags[i].Name); + end; +end; + +procedure LoadTagDescs(fancy:boolean = false); +begin + if tagInit + then exit + else tagInit := true; + if fancy then + begin + FixTagTableParse(TagTable); + FixTagTableParse(GPSTable); + end + else + begin + FixTagTable(TagTable); + FixTagTable(GPSTable); + end; +end; + +function LookupMTagID(idx:integer; ManuTable: array of TTagEntry):integer; +var + i: integer; +begin + result := -1; + for i := 0 to high(ManuTable) do + if ManuTable[i].Tag = idx then + begin + result := i; + break; + end; +end; + +function LookupType(idx: integer): String; +var + i: integer; +begin + result := 'Unknown'; +// for i := 0 to (Sizeof(ProcessTable) div SizeOf(TTagEntry))-1 do + for i := 0 to High(ProcessTable) do + if ProcessTable[i].Tag = idx then begin + Result := ProcessTable[i].Desc; + exit; + end; +end; + +function LookupTagDefByID(idx: integer; ATagType: TTagType = ttExif): integer; +var + i:integer; +begin + Result := -1; + case ATagType of + ttExif, ttThumb: + for i := 0 to ExifTagCnt-1 do + if TagTable[i].Tag = idx then begin + Result := i; + break; + end; + ttGps: + for i := 0 to GPSCnt-1 do + if GPSTable[i].Tag = idx then begin + Result := i; + break; + end; + end; +end; + +function FetchTagDefByID(idx: integer; ATagType: TTagType = ttExif): TTagEntry; +var + i: integer; +begin + Result := TagTable[ExifTagCnt-1]; + case ATagType of + ttExif, ttThumb: + for i := 0 to ExifTagCnt-1 do + if TagTable[i].Tag = idx then begin + result := TagTable[i]; + break; + end; + ttGps: + for i := 0 to GPSCnt-1 do + if GPSTable[i].Tag = idx then begin + result := GPSTable[i]; + break; + end; + end; +end; + +function LookupCode(ATagID: Word; ATagType: TTagType=ttExif): String; overload; +var + i:integer; +begin + Result := ''; + case ATagType of + ttExif, ttThumb: + for i := 0 to ExifTagCnt-1 do + if TagTable[i].Tag = ATagID then begin + Result := TagTable[i].Code; + break; + end; + ttGps: + for i := 0 to GPSCnt-1 do + if GPSTable[i].Tag = ATagID then begin + Result := GPSTable[i].Code; + break; + end; + end; +end; + +function LookupCode(ATagID: Word; TagTbl: array of TTagEntry): String; overload; +var + i: integer; +begin + Result := ''; + for i := 0 to High(TagTbl) do + if TagTbl[i].Tag = ATagID then begin + Result := TagTbl[i].Code; + break; + end; +end; + +{ Tries to find the string AValue within TTagEntry.Code and + returns the numerical value assigned to the Code (before the colon). + + Example: + The codes defined for the Tag "ResolutionUnits" are + '1:None Specified,2:Inch,3:Centimeter'. + If AValue is 'Inch' then the value 2 is returned. } +function GetTagCode(ATag: TTagEntry; AValue: String): Integer; +var + i: Integer; +begin + if ATag.Code <> '' then + Result := FindTextIndexInCode(AValue, ATag.Code) + else + if TryStrToInt(AValue, i) then + Result := i + else + Result := -1; +end; + + +//------------------------------------------------------------------------------ +// TEndInd +// +// Here we implement the Endian Independent layer. Outside of these methods +// we don't care about endian issues. +//------------------------------------------------------------------------------ + +function TEndInd.GetDataBuff: AnsiString; +begin + result := FData; +end; + +procedure TEndInd.SetDataBuff(const Value: AnsiString); +begin + FData := Value; +end; + +procedure TEndInd.WriteInt16(var buff: AnsiString; int,posn: integer); +begin + if MotorolaOrder then + begin + buff[posn+1] := ansichar(int mod 256); + buff[posn] := ansichar(int div 256); + end + else + begin + buff[posn] := ansichar(int mod 256); + buff[posn+1] := ansichar(int div 256); + end +end; + +procedure TEndInd.WriteInt32(var buff: ansistring; int, posn: longint); +begin + if MotorolaOrder then + begin + buff[posn+3] := ansichar(int mod 256); + buff[posn+2] := ansichar((int shr 8) mod 256); + buff[posn+1] := ansichar((int shr 16) mod 256); + buff[posn] := ansichar((int shr 24) mod 256); + end + else + begin + buff[posn] := ansichar(int mod 256); + buff[posn+1] := ansichar((int shr 8) mod 256); + buff[posn+2] := ansichar((int shr 16) mod 256); + buff[posn+3] := ansichar((int shr 24) mod 256); + end +end; + +// Convert a 16 bit unsigned value from file's native byte order +function TEndInd.Get16u(AOffs: integer):word; +// var hibyte,lobyte:byte; +begin +// To help debug, uncomment the following two lines +// hibyte := byte(llData[oset+1]); +// lobyte := byte(llData[oset]); + if MotorolaOrder then + result := (byte(FData[AOffs]) shl 8) or byte(FData[AOffs+1]) + else + result := (byte(FData[AOffs+1]) shl 8) or byte(FData[AOffs]); +end; + +// Convert a 32 bit signed value from file's native byte order +function TEndInd.Get32s(AOffs: integer):Longint; +begin + if MotorolaOrder then + result := (byte(FData[AOffs]) shl 24) + or (byte(FData[AOffs+1]) shl 16) + or (byte(FData[AOffs+2]) shl 8) + or byte(FData[AOffs+3]) + else + result := (byte(FData[AOffs+3]) shl 24) + or (byte(FData[AOffs+2]) shl 16) + or (byte(FData[AOffs+1]) shl 8) + or byte(FData[AOffs]); +end; + +// Convert a 32 bit unsigned value from file's native byte order +function TEndInd.Put32s(data: Longint): AnsiString; +var + data2: integer; + // buffer: string[4] absolute data2; + // bbuff: AnsiChar; +begin + data2 := data; + if MotorolaOrder then + data2 := NtoBE(data) else + data2 := NtoLE(data); + SetLength(Result, 4); + Move(data2, Result[1], 4); + { + begin + bbuff := buffer[1]; + buffer[1] := buffer[4]; + buffer[4] := bbuff; + bbuff := buffer[2]; + buffer[2] := buffer[3]; + buffer[3] := bbuff; + end; + } +// Result := buffer; +end; + +// Convert a 32 bit unsigned value from file's native byte order +function TEndInd.Get32u(AOffs: integer): Longword; +begin + result := Longword(Get32S(AOffs)) and $FFFFFFFF; +end; + + +{------------------------------------------------------------------------------} +{ TImageInfo } +{------------------------------------------------------------------------------} + +constructor TImageInfo.Create(AParent: TObject; ABigEndian: Boolean; + ABuildCode: integer = GenAll); +begin + inherited Create; + FParent := AParent; + MotorolaOrder := ABigEndian; + LoadTagDescs(True); // initialize global structures + FITagCount := 0; + BuildList := ABuildCode; + ClearDirStack; +end; + +// These destructors provided by Keith Murray of byLight Technologies - Thanks! +destructor TImageInfo.Destroy; +begin + SetLength(fITagArray, 0); + inherited; +end; + +// To be called by the reader. +procedure TImageInfo.AddTagFromReader(ATag: TTagEntry); +begin + ATag.Data := InternalGetTagValueAsString(ATag); + if ATag.ParentID = 1 then + SetThumbTagByID(ATag.Tag, ATag) + else + SetTagByID(ATag.Tag, ATag); +end; + +// To be called by the reader. +procedure TImageInfo.AddThumbnailFromReader(ABuffer: TBytes); +begin + SetLength(FThumbnailBuffer, Length(ABuffer)); + if Length(ABuffer) > 0 then + Move(ABuffer[0], FThumbnailBuffer[0], Length(ABuffer)); +end; + +procedure TImageInfo.Assign(Source: TImageInfo); +begin +// FCameraMake := Source.FCameraMake; +// FCameraModel := Source.FCameraModel; +// DateTime := Source.DateTime; + Height := Source.Height; + Width := Source.Width; + FlashUsed := Source.FlashUsed; +// Comments := Source.Comments; + MakerNote := Source.MakerNote; + TraceStr := Source.TraceStr; + msTraceStr := Source.msTraceStr; + msAvailable := Source.msAvailable; + msName := Source.msName; +end; + +function TImageInfo.GetTagByDesc(SearchStr: String): TTagEntry; +var + i: integer; +begin + i := LookupTagByDesc(SearchStr); + if i >= 0 then + Result := fiTagArray[i] + else + Result := EmptyEntry; +end; + + +// This function returns the index of a tag name in the tag buffer. +function TImageInfo.LookupTagIndex(ATagName: String): integer; +var + i: integer; +begin + ATagName := UpperCase(ATagName); + for i := 0 to fiTagCount-1 do + if UpperCase(fiTagArray[i].Name) = ATagName then + begin + Result := i; + Exit; + end; + Result := -1; +end; + +(* +// This function returns the data value for a given tag name. +function TImageInfo.LookupTagVal(ATagName: String): String; +var + i: integer; +begin + ATagName := UpperCase(ATagName); + for i := 0 to fiTagCount-1 do + if UpperCase(fiTagArray[i].Name) = ATagName then + begin + Result := fiTagArray[i].Data; + Exit; + end; + Result := ''; +end; + *) + +// This function returns the integer data value for a given tag name. +function TImageInfo.LookupTagInt(ATagName: String):integer; +var + i: integer; + x: Double; + {$IFDEF FPC} + fs: TFormatSettings; + {$ELSE} + res: Integer; + {$ENDIF} +begin + ATagName := UpperCase(ATagName); + for i := 0 to fiTagCount-1 do + if UpperCase(fiTagArray[i].Name) = ATagName then + begin + if not TryStrToInt(fiTagArray[i].Data, Result) then + begin + if TryStrToFloat(fiTagArray[i].Data, x) then + Result := Round(x) + else + begin + {$IFDEF FPC} + fs := FormatSettings; + if fs.DecimalSeparator = '.' then fs.DecimalSeparator := ',' else + fs.DecimalSeparator := '.'; + if TryStrToFloat(fiTagArray[i].Data, x, fs) then + Result := Round(x) + else + Result := -1; + {$ELSE} + val(fiTagArray[i].Data, x, res); + if res = 0 then + Result := Round(x) + else + Result := -1; + {$ENDIF} + end; + end; + Exit; + end; + Result := -1; +end; + +// This function returns the index of a tag in the tag buffer. +// It searches by the description which is most likely to be used as a label +Function TImageInfo.LookupTagByDesc(ADesc: String):integer; +var + i: integer; +begin + ADesc := UpperCase(ADesc); + for i := 0 to FITagCount-1 do + if UpperCase(fiTagArray[i].Desc) = ADesc then + begin + Result := i; + Exit; + end; + Result := -1; +end; + +// This function returns the index of a tag definition for a given tag name. +function TImageInfo.LookupTagDefn(ATagName: String): integer; +var + i: integer; +begin + for i := 0 to ExifTagCnt-1 do + begin + if LowerCase(ATagName) = LowerCase(TagTable[i].Name) then + begin + Result := i; + Exit; + end; + end; + Result := -1; +end; + +function TImageInfo.ExifDateToDateTime(ARawStr: ansistring): TDateTime; +type + TConvert= packed record + year: Array [1..4] of ansichar; f1:ansichar; + mon: Array [1..2] of ansichar; f2:ansichar; + day: Array [1..2] of ansichar; f3:ansichar; + hr: Array [1..2] of ansichar; f4:ansichar; + min: Array [1..2] of ansichar; f5:ansichar; + sec: Array [1..2] of ansichar; + end; + PConvert= ^TConvert; +var + yr, mn, dy, h, m, s: Integer; + d: TDateTime; + t: TDateTime; +begin + Result := 0; + if Length(ARawStr) >= SizeOf(TConvert) then + with PConvert(@ARawStr[1])^ do + if TryStrToInt(year, yr) and + TryStrToInt(mon, mn) and + TryStrToInt(day, dy) and + TryEncodeDate(yr, mn, dy, d) + and + TryStrToInt(hr, h) and + TryStrToInt(min, m) and + TryStrToInt(sec, s) and + TryEncodeTime(h, m, s, 0, t) + then + Result := d + t; +end; + + +function TImageInfo.GetImgDateTime: TDateTime; +begin + Result := GetDateTimeOriginal; + if Result = 0 then + Result := GetDateTimeDigitized; + if Result = 0 then + Result := GetDateTimeModified; + if Result = 0 then + Result := TImgData(Parent).FileDatetime; +end; + +function TImageInfo.GetDateTimeOriginal: TDateTime; +var + t: TTagEntry; +begin + Result := 0.0; + t := TagByName['DateTimeOriginal']; + if t.Tag <> 0 then + Result := ExifDateToDateTime(t.Raw); +end; + +procedure TImageInfo.SetDateTimeOriginal(const AValue: TDateTime); +var + v: Variant; +begin + v := FormatDateTime(EXIF_DATETIME_FORMAT, AValue); + SetTagValue('DateTimeOriginal', v); +end; +function TImageInfo.GetDateTimeDigitized: TDateTime; +var + t: TTagEntry; +begin + Result := 0.0; + t := TagByName['DateTimeDigitized']; + if t.Tag <> 0 then + Result := ExifDateToDateTime(t.Raw); +end; + +procedure TImageInfo.SetDateTimeDigitized(const AValue: TDateTime); +var + v: Variant; +begin + v := FormatDateTime(EXIF_DATETIME_FORMAT, AValue); + SetTagValue('DateTimeDigitized', v); +end; + +function TImageInfo.GetDateTimeModified: TDateTime; +var + t: TTagEntry; +begin + Result := 0.0; + t := TagByName['DateTime']; + if t.Tag <> 0 then + Result := ExifDateToDateTime(t.Raw); +end; + +procedure TImageInfo.SetDateTimeModified(const AValue: TDateTime); +var + v: Variant; +begin + v := FormatDateTime(EXIF_DATETIME_FORMAT, AValue); + SetTagValue('DateTime', v); +end; + +Procedure TImageInfo.AdjDateTime(ADays, AHours, AMins, ASecs: Integer); +var + delta: double; + dt: TDateTime; +begin + // hrs/day min/day sec/day + delta := ADays + (AHours/24) + (AMins/1440) + (ASecs/86400); + + dt := GetDateTimeOriginal; + if dt > 0 then SetDateTimeOriginal(dt + delta); + + dt := GetDateTimeDigitized; + if dt > 0 then SetDateTimeDigitized(dt + delta); + + dt := GetDateTimeModified; + if dt > 0 then SetDateTimeModified(dt + delta); +end; + +function TImageInfo.AddTagToArray(ANewTag:iTag):integer; +begin + if not ((ANewTag.Name = '') or (ANewTag.Name = 'Unknown')) then // Empty fields are masked out + begin + if fITagCount >= MaxTag-1 then + begin + inc(MaxTag, TagArrayGrowth); + SetLength(fITagArray, MaxTag); + end; + fITagArray[fITagCount] := ANewTag; + inc(fITagCount); + end; + result := fITagCount-1; +end; + +function TImageInfo.AddTagToThumbArray(ANewTag: iTag): integer; +begin + if ANewTag.Tag <> 0 then // Empty fields are masked out + begin + if fIThumbCount >= MaxThumbTag-1 then + begin + inc(MaxThumbTag, TagArrayGrowth); + SetLength(fIThumbArray, MaxThumbTag); + end; + fIThumbArray[fIThumbCount] := ANewTag; + inc(fIThumbCount); + end; + result := fIThumbCount-1; +end; + +function TImageInfo.CvtInt(ABuffer: Pointer; ABufferSize: Integer): Longint; +var + i: integer; + r: Int64; + P: PByte; +begin + r := 0; + if MotorolaOrder then begin + P := PByte(ABuffer); + for i := 1 to ABufferSize do begin + r := r*256 + P^; + inc(P); + end; + end else begin + P := PByte(ABuffer); + inc(P, ABufferSize - 1); + for i := 1 to ABufferSize do begin + r := r*256 + P^; + dec(P); + end; + end; + Result := LongInt(r); +end; + +function TImageInfo.Decode: Boolean; +begin + Result := TImgData(FParent).Decode; +end; + +function TImageInfo.FormatNumber(ABuffer: PByte; ABufferSize: Integer; + AFmt: integer; AFmtStr: String; ADecodeStr: String=''): String; +var + P: PByte; + i, len: integer; + tmp, tmp2: longint; + dv: double; +begin + Result := ''; + len := BYTES_PER_FORMAT[AFmt]; + if len = 0 then + exit; + + P := ABuffer; + for i := 0 to min(ABufferSize div len, 128) - 1 do + begin + if Result <> '' then + Result := Result + dExifDataSep; // Used for data display + case AFmt of + FMT_SBYTE, + FMT_BYTE, + FMT_USHORT, + FMT_ULONG, + FMT_SSHORT, + FMT_SLONG: + begin + tmp := CvtInt(P, len); + if (ADecodeStr = '') or not Decode then + Result := Result + defIntFmt(tmp) + else + Result := Result + DecodeField(ADecodeStr, IntToStr(tmp)); + end; + FMT_URATIONAL, + FMT_SRATIONAL: + begin + tmp := CvtInt(P, 4); + inc(P, 4); + tmp2 := CvtInt(P, 4); + dec(P, 4); + Result := Result + defFracFmt(tmp, tmp2); + if (ADecodeStr <> '') or not Decode then + Result := Result + DecodeField(ADecodeStr, Result); + end; + FMT_SINGLE, + FMT_DOUBLE: + begin + // not used anyway; not sure how to interpret endian issues + Result := Result + '-9999.99'; + end; + FMT_BINARY: + if ABufferSize = 1 then begin + tmp := CvtInt(P, 1); + if (ADecodeSTr = '') or not Decode then + Result := Result + DefIntFmt(tmp) + else + Result := Result + DecodeField(ADecodeStr, IntToStr(tmp)); + end else + Result := Result + '?'; + else + Result := Result + '?'; + end; + inc(P, len); + end; + + if AFmtStr <> '' then + begin + if Pos('%s', AFmtStr) > 0 then + Result := Format(AFmtStr, [Result], dExifFmtSettings) + else begin + dv := GetNumber(ABuffer, ABufferSize, AFmt); // wp: Will this always work? + Result := Format(AFmtStr, [dv], dExifFmtSettings); + end; + end; +end; + +function TImageInfo.GetNumber(ABuffer: PByte; ABufferSize: Integer; + AFmt:integer): Double; +var + tmp: Longint; + tmp2: Longint; +begin + Result := 0; + try + case AFmt of + FMT_SBYTE, + FMT_BYTE, + FMT_USHORT, + FMT_ULONG, + FMT_SSHORT, + FMT_SLONG: + Result := CvtInt(ABuffer, ABufferSize); + FMT_URATIONAL, + FMT_SRATIONAL: + begin + tmp := CvtInt(ABuffer, 4); + inc(ABuffer, 4); + tmp2 := CvtInt(ABuffer, 4); + Result := tmp / tmp2; + end; + FMT_SINGLE: + Result := PSingle(ABuffer)^; + FMT_DOUBLE: + Result := PDouble(ABuffer)^; + end; + except + end; +end; + +var + dirStack: String = ''; + +procedure TImageInfo.ClearDirStack; +begin + dirStack := ''; +end; + +procedure TImageInfo.PushDirStack(dirStart, offsetbase:longint); +var + ts: String; +begin + ts := '[' + IntToStr(offsetbase) + ':' + IntToStr(dirStart) + ']'; + dirStack := dirStack + ts; +end; + +function TImageInfo.TestDirStack(dirStart, offsetbase: Longint): boolean; +var + ts: String; +begin + ts := '[' + IntToStr(offsetbase) + ':' + IntToStr(dirStart) + ']'; + result := Pos(ts,dirStack) > 0; +end; + (* +//{$DEFINE CreateExifBufDebug} // uncomment to see written Exif data +{$ifdef CreateExifBufDebug}var CreateExifBufDebug : String;{$endif} + +function TImageInfo.CreateExifBuf(ParentID:word=0; OffsetBase:integer=0): AnsiString; + {offsetBase required, because the pointers of subIFD are referenced from parent IFD (WTF!!)} + // msta Creates APP1 block with IFD0 only +var + i, f, n: integer; + size, pDat, p: Cardinal; + head: ansistring; + + function Check (const t: TTagEntry; pid: word): Boolean; //inline; + var + i: integer; + begin + if (t.parentID <> pid) or (t.TType >= Length(BYTES_PER_FORMAT)) or + (BYTES_PER_FORMAT[t.TType] = 0) + then + Result := false + else begin + Result := Length(whitelist) = 0; + for i := 0 to Length(whitelist)-1 do if (whitelist[i] = t.Tag) then begin + Result := true; + break; + end; + end; + end; + + function CalcSubIFDSize(pid : integer) : integer; + var + i: integer; + begin + Result := 6; + for i := 0 to Length(fiTagArray)-1 do begin + if (not check(fiTagArray[i], pid)) then continue; + Result := Result + 12; + if (fiTagArray[i].id <> 0) then + Result := Result + calcSubIFDSize(fiTagArray[i].id) + else + if (Length(fiTagArray[i].Raw) > 4) then + Result := Result + Length(fiTagArray[i].Raw); // calc size + end; + end; + +begin + {$ifdef CreateExifBufDebug} + if (parentID = 0) then CreateExifBufDebug := ''; + {$endif} + + if (parentID = 0) then + head := #0#0 // APP1 block size (calculated later) + + 'Exif' + #$00+#$00 // Exif Header + + 'II' + #$2A+#$00 + #$08+#$00+#$00+#$00 // TIFF Header (Intel) + else + head := ''; + n := 0; + size := 0; +// for i := 0 to Length(fiTagArray)-1 do begin + for i := 0 to fiTagCount-1 do begin + if (not Check(fiTagArray[i], parentID)) then + continue; + n := n + 1; // calc number of Tags in current IFD + if (fiTagArray[i].id <> 0) then + size := size + CalcSubIFDSize(fiTagArray[i].id) + else + if (Length(fiTagArray[i].Raw) > 4) then + size := size + Length(fiTagArray[i].Raw); // calc size + end; + pDat := Length(head) + 2 + n*12 + 4; // position of data area + p := pDat; + size := size + pDat; + SetLength(Result, size); + if (parentID = 0) then begin + head[1] := ansichar(size div 256); + head[2] := ansichar(size mod 256); + move(head[1], Result[1], Length(head)); // write header + end; + PWord(@Result[1+Length(head)])^ := n; // write tag count + PCardinal(@Result[1+Length(head)+2+12*n])^ := 0; // write offset to next IFD (0, because just IFD0 is included) + n := 0; + for f := 0 to 1 do for i := 0 to Length(fiTagArray)-1 do begin // write tags + if (not check(fiTagArray[i], parentID)) then continue; + if (f = 0) and (fiTagArray[i].Tag <> TAG_EXIF_OFFSET) then + continue; // Sub-IFD must be first data block... more or less (WTF) + if (f = 1) and (fiTagArray[i].Tag = TAG_EXIF_OFFSET) then + continue; + PWord(@Result[1+Length(head)+2+12*n+0])^ := fiTagArray[i].Tag; + if (fiTagArray[i].Tag = TAG_EXIF_OFFSET) then begin + PWord(@Result[1+Length(head)+2+12*n+2])^ := 4; // Exif-Pointer is not a real data block but really a pointer (WTF) + PCardinal(@Result[1+Length(head)+2+12*n+4])^ := 1; + end + else begin + PWord(@Result[1+Length(head)+2+12*n+2])^ := fiTagArray[i].TType; + PCardinal(@Result[1+Length(head)+2+12*n+4])^ := Length(fiTagArray[i].Raw) div BYTES_PER_FORMAT[fiTagArray[i].TType]; + end; + {$ifdef CreateExifBufDebug}CreateExifBufDebug := CreateExifBufDebug + ' ' + fiTagArray[i].Name;{$endif} + if (Length(fiTagArray[i].Raw) <= 4) and (fiTagArray[i].id = 0) then begin + PCardinal(@Result[1+Length(head)+2+12*n+8])^ := 0; + if (Length(fiTagArray[i].Raw) > 0) then + move(fiTagArray[i].Raw[1], Result[1+Length(head)+2+12*n+8], Length(fiTagArray[i].Raw)); + end + else begin + PCardinal(@Result[1+Length(head)+2+12*n+8])^ := p - 8 + offsetBase; + if (fiTagArray[i].id <> 0) then begin + {$ifdef CreateExifBufDebug}CreateExifBufDebug := CreateExifBufDebug + ' { ';{$endif} + fiTagArray[i].Raw := CreateExifBuf(fiTagArray[i].id, p); // create sub IFD + fiTagArray[i].Size := Length(fiTagArray[i].Raw); + {$ifdef CreateExifBufDebug}CreateExifBufDebug := CreateExifBufDebug + ' } ';{$endif} + end; + move(fiTagArray[i].Raw[1], Result[1+p], Length(fiTagArray[i].Raw)); + p := p + Length(fiTagArray[i].Raw); + end; + n := n+1; + end; + {$ifdef CreateExifBufDebug}if (parentID = 0) then ShowMessage(CreateExifBufDebug);{$endif} +end; *) + +//-------------------------------------------------------------------------- +// Process one of the nested EXIF directories. +//-------------------------------------------------------------------------- +procedure TImageInfo.ProcessExifDir(DirStart, OffsetBase, ExifLength: longint; + ATagType: TTagType = ttExif; APrefix: string=''; AParentID: word = 0); +var + byteCount: integer; + tag, tagFormat, tagComponents: integer; + de, dirEntry, offsetVal, numDirEntries, valuePtr, subDirStart: Longint; + value: Integer; + rawStr, fStr, transStr: ansistring; + msInfo: TMsInfo; + lookupEntry, newEntry: TTagEntry; + tmpTR: ansistring; + tagID: word; +begin + PushDirStack(DirStart, OffsetBase); + numDirEntries := Get16u(DirStart); + if (ExifTrace > 0) then + TraceStr := TraceStr + crlf + + Format('Directory: Start, entries = %d, %d', [DirStart, numDirEntries]); + if (DirStart + 2 + numDirEntries*12) > (DirStart + OffsetBase + ExifLength) then + begin + TImgData(FParent).SetError('Illegally sized directory'); + exit; + end; + + // Uncomment to trace directory structure + { + Parent.ErrStr:= + Format('%d,%d,%d,%d+%s', [DirStart, numDirEntries,OffsetBase,ExifLength, parent.ErrStr]); + } + + if (ATagType = ttExif) and (FThumbStart = 0) and not TiffFmt then + begin + DirEntry := DirStart + 2 + 12*numDirEntries; + FThumbStart := Get32u(DirEntry); + FThumbLength := OffsetBase + ExifLength - FThumbStart; + end; + + for de := 0 to numDirEntries-1 do + begin + tagID := 0; + dirEntry := DirStart + 2 + 12*de; + tag := Get16u(dirEntry); + tagFormat := Get16u(dirEntry + 2); + tagComponents := Get32u(dirEntry + 4); + byteCount := tagComponents * BYTES_PER_FORMAT[tagFormat]; + if byteCount = 0 then + Continue; + if byteCount > 4 then + begin + offsetVal := Get32u(dirEntry+8); + valuePtr := OffsetBase + offsetVal; + end + else + valuePtr := dirEntry + 8; + rawStr := Copy(TImgData(FParent).EXIFsegment^.Data, valuePtr, byteCount); + + fStr := ''; + if BuildList in [GenString, GenAll] then + begin + lookUpEntry := FetchTagDefByID(tag, ATagType); + + with lookUpEntry do + begin + case tagFormat of + FMT_UNDEFINED: + fStr := '"' + StrBefore(rawStr, #0) + '"'; + FMT_STRING: + begin + fStr := Copy(TImgData(FParent).EXIFsegment^.Data, valuePtr, byteCount); + if fStr[byteCount] = #0 then + Delete(fStr, byteCount, 1); + end; + else + fStr := FormatNumber(@rawStr[1], Length(rawStr), tagFormat, FormatS, Code); + end; + if ((tag > 0) or (lookupEntry.Name <> 'Unknown')) and Assigned(Callback) and Decode then + fStr := Callback(fStr) + else + fStr := MakePrintable(fStr); + transStr := Desc; + end; + + case tag of + TAG_USERCOMMENT: + // strip off comment header + fStr := trim(Copy(rawStr, 9, byteCount-8)); + TAG_DATETIME_MODIFY, + TAG_DATETIME_ORIGINAL, + TAG_DATETIME_DIGITIZED: + fStr := FormatDateTime(TImgData(FParent).DateTimeFormat, ExifDateToDateTime(fStr)); + end; + + // Update trace strings + tmpTR := crlf + + siif(ExifTrace > 0, 'tag[$' + IntToHex(tag,4) + ']: ', '') + + transStr + dExifDelim + fStr + + siif(ExifTrace > 0, ' [size: ' + IntToStr(byteCount) + ']', '') + + siif(ExifTrace > 0, ' [start: ' + IntToStr(valuePtr) + ']', ''); + + if ATagType = ttThumb then + Thumbtrace := ThumbTrace + tmpTR + else + TraceStr := TraceStr + tmpTR; + end; + + // Additional processing done here: + case tag of + TAG_SUBIFD_OFFSET, + TAG_EXIF_OFFSET, + TAG_INTEROP_OFFSET: + begin + try + value := Get32u(valuePtr); + subdirStart := OffsetBase + LongInt(value); + // some mal-formed images have recursive references... + // if (subDirStart <> DirStart) then + if not TestDirStack(subDirStart, OffsetBase) then begin + tagID := tag; + ProcessExifDir(subdirStart, OffsetBase, ExifLength, ttExif, '', tagID); + end; + except + end; + end; + TAG_GPS_OFFSET: + begin + try + subdirStart := OffsetBase + LongInt(Get32u(ValuePtr)); + if not TestDirStack(subDirStart, OffsetBase) then begin + tagID := tag; + ProcessExifDir(subdirStart, OffsetBase, ExifLength, ttGps, '', tagID); + end; + except + end; + end; + + TAG_EXIFVERSION: + FExifVersion := rawstr; + + TAG_MAKERNOTE: + begin + MakerNote := rawStr; + MakerOffset := valuePtr; + msInfo := TMsInfo.Create(TiffFmt, self); + msAvailable := msInfo.ReadMSData(self); + FreeAndNil(msInfo); + end; + TAG_FLASH: + FlashUsed := round(getNumber(@rawStr[1], Length(rawSTr), tagFormat)); + (* + TAG_IMAGELENGTH, + TAG_EXIF_IMAGELENGTH: + begin + HPosn := DirEntry + 8; + Height := round(GetNumber(rawStr, tagFormat)); + end; + TAG_IMAGEWIDTH, + TAG_EXIF_IMAGEWIDTH: + begin + WPosn := DirEntry + 8; + Width := round(GetNumber(rawStr, tagFormat)); + end; + *) + TAG_THUMBSTARTOFFSET: + FThumbnailStartOffset := Get32u(ValuePtr); + TAG_THUMBSIZE: + FThumbnailSize := Get32u(ValuePtr); + TAG_COMPRESSION: + if ATagType = ttThumb then + FThumbType := round(GetNumber(@rawStr[1], Length(rawStr), tagFormat)); + end; + + if BuildList in [GenList,GenAll] then + begin + try + NewEntry := LookupEntry; + NewEntry.Data := fStr; + NewEntry.Raw := rawStr; + NewEntry.Size := Length(rawStr); + NewEntry.TType := tagFormat; + NewEntry.Count := tagComponents; + NewEntry.ParentID := AParentID; + NewEntry.TID := GenericEXIF; // 0 + if ATagType = ttThumb then + AddTagToThumbArray(newEntry) + else + AddTagToArray(newEntry); + except + // if we're here: unknown tag. + // item is recorded in trace string + end; + end; + end; + + if (ATagType = ttExif) and + ((TImgData(FParent).ErrStr = '') or (TImgData(FParent).ErrStr = NO_ERROR)) + then + Calc35Equiv(); +end; + +procedure TImageInfo.ProcessHWSpecific(AMakerBuff: ansistring; + TagTbl: array of TTagEntry; ADirStart, AMakerOffset: Longint; + spOffset: Integer = 0); +var + NumDirEntries: integer; + de, ByteCount, tagID: integer; + DirEntry, tag, tagFormat, tagComponents: integer; + OffsetVal, ValuePtr: Longint; + rawStr: ansistring; + tagStr: String; + fStr, fStr2, ds: ansistring; + OffsetBase: longint; + NewEntry: TTagEntry; +begin + ADirStart := ADirStart+1; + OffsetBase := ADirStart - AMakerOffset + 1; + SetDataBuff(AMakerBuff); + try + NumDirEntries := Get16u(ADirStart); + for de := 0 to NumDirEntries-1 do + begin + DirEntry := ADirStart + 2 + 12*de; + tag := Get16u(DirEntry); + tagFormat := Get16u(DirEntry+2); + tagComponents := Get32u(DirEntry+4); + ByteCount := tagComponents * BYTES_PER_FORMAT[tagFormat]; + OffsetVal := 0; + if ByteCount > 4 then + begin + OffsetVal := Get32u(DirEntry + 8); + ValuePtr := OffsetBase + OffsetVal; + end + else + ValuePtr := DirEntry + 8; + + // Adjustment needed by Olympus Cameras + if ValuePtr + ByteCount > Length(AMakerBuff) then + rawStr := Copy(TImgData(FParent).DataBuff, OffsetVal + spOffset, ByteCount) + else + rawStr := copy(AMakerBuff, ValuePtr, ByteCount); + + tagID := LookupMTagID(tag, TagTbl); + if tagID < 0 then + tagStr := 'Unknown' + else + tagStr := TagTbl[tagID].Desc; + + fstr := ''; + if UpperCase(tagStr) = 'SKIP' then + continue; + + if BuildList in [GenList, GenAll] then + begin + case tagFormat of + FMT_STRING: + fStr := '"' + StrBefore(rawStr, #0) + '"'; + FMT_UNDEFINED: + fStr := '"' + rawStr + '"'; + else + try + ds := siif(Decode, LookupCode(tag, TagTbl), ''); + if tagID < 0 then + fStr := FormatNumber(@rawStr[1], Length(rawStr), tagFormat, '', '') + else + fStr := FormatNumber(@rawStr[1], Length(rawStr), tagFormat, TagTbl[tagID].FormatS, ds); + except + fStr := '"' + rawStr + '"'; + end; + end; + + rawDefered := false; + if (tagID > 0) and Assigned(TagTbl[tagID].CallBack) and Decode then + fstr2 := TagTbl[tagID].CallBack(fstr) + else + fstr2 := MakePrintable(fstr); + + if (ExifTrace > 0) then + begin + if not rawDefered then + msTraceStr := msTraceStr + crlf + + 'tag[$' + IntToHex(tag, 4) + ']: ' + + TagStr + dExifDelim + fstr2 + + ' [size: ' + IntToStr(ByteCount) + ']' + + ' [raw: ' + MakeHex(rawStr) + ']' + + ' [start: ' + IntToStr(ValuePtr) + ']' + else + msTraceStr := msTraceStr + crlf + + 'tag[$' + IntToHex(tag, 4) + ']: '+ + TagStr + dExifDelim + + ' [size: ' + IntToStr(ByteCount) + ']' + + ' [raw: ' + MakeHex(RawStr) + ']' + + ' [start: '+ IntToStr(ValuePtr) + ']' + + fstr2; + end else + begin + if not rawDefered then + msTraceStr := msTraceStr + crlf + + tagStr + dExifDelim + fstr2 + else + msTraceStr := msTraceStr + + fstr2 + // has cr/lf as first element + crlf + TagStr + dExifDelim + fstr; + end; + end; + + if (BuildList in [GenList, GenAll]) and (tagID > 0) then + begin + try + NewEntry := TagTbl[tagID]; + + if rawdefered then + NewEntry.Data := fStr + else + NewEntry.Data := fStr2; + + NewEntry.Raw := rawStr; + NewEntry.TType := tagFormat; + NewEntry.Count := tagComponents; + NewEntry.TID := CustomEXIF; // = 1 --> Manufacturer-specific + + AddTagToArray(NewEntry); + except + // if we're here: unknown tag. + // item is recorded in trace string + end; + end; + + end; + + except + on E: Exception do + TImgData(FParent).SetError('Error detected: ' + E.Message); + end; + + SetDataBuff(TImgData(FParent).DataBuff); +end; + +procedure TImageInfo.AddMSTag(ATagName: String; ARawStr: ansistring; AType: word); +var + newEntry: TTagEntry; +begin + if BuildList in [GenList,GenAll] then + begin + try + InitTagEntry(newEntry); + newEntry.Name := ATagName; + newEntry.Desc := InsertSpaces(ATagName); + newEntry.Data := ARawStr; + newEntry.Raw := ARawStr; + newEntry.Size := Length(ARawStr); + NewEntry.TType:= AType; + NewEntry.Count := 1; + newEntry.ParentID := 0; + newEntry.TID := CustomEXIF; // = 1 --> manufacturer-specific + AddTagToArray(newEntry); + except + // if we're here: unknown tag. + // item is recorded in trace string + end; + end; +end; + +{ Creates a thumbnail image from the main image loaded. The size of the thumbnail + (width or height whichever is longer) is specified as AThumbnailSize. + The current thumbnail image is replaced by the new one, or, if the image did + not have a thumbnail image so far it is added to the image. } +procedure TImageInfo.CreateThumbnail(AThumbnailSize: Integer = DEFAULT_THUMBNAIL_SIZE); +var + srcStream, destStream: TMemoryStream; +begin + srcStream := TMemoryStream.Create; + destStream := TMemoryStream.Create; + try + srcStream.LoadFromFile(TImgData(FParent).FileName); + JpegScaleImage(srcStream, destStream, AThumbnailSize); + destStream.Position := 0; + LoadThumbnailFromStream(destStream); + finally + destStream.Free; + srcStream.Free; + end; +end; + +function TImageInfo.HasThumbnail: boolean; +begin + Result := Length(FThumbnailBuffer) > 0; +end; + (* +procedure TImageInfo.ProcessThumbnail; +var + start: Integer; +begin + exit; + + + FiThumbCount := 0; + start := FThumbStart + 9; + ProcessExifDir(start, 9, FThumbLength - 12, ttThumb, 'Thumbnail', 1); + ExtractThumbnail; +end; + +procedure TImageInfo.ExtractThumbnail; +begin + if FThumbnailStartOffset > 0 then begin + SetLength(FThumbnailBuffer, FThumbnailSize); + Move(TImgData(FParent).ExifSegment^.Data[FThumbnailStartOffset + 9], FThumbnailBuffer[0], FThumbnailSize); + end else + FThumbnailBuffer := nil; +end; + *) +procedure TImageInfo.LoadThumbnailFromStream(AStream: TStream); +var + n: Integer; + w, h: Integer; +begin + RemoveThumbnail; + + // Check whether the image is a jpeg, and extract size of the thrumbnail image + if not JPEGImageSize(AStream, w, h) then + exit; + + // Write the image from the stream into the thumbnail buffer + n := AStream.Size; + if n > 65000 then // limit probably still too high, thumbnail must fit into a 64k segment along with all other tags... + raise Exception.Create('Thumbnail too large.'); + + SetLength(FThumbnailBuffer, n); + if AStream.Read(FThumbnailBuffer[0], n) < n then + raise Exception.Create('Could not read thumbnail image.'); + + // Make sure that the IFD1 tags for the thumbnail are correct + SetThumbTagValue('Compression', 6); // 6 = JPEG - this was checked above. + SetThumbTagValue('ImageWidth', w); + SetThumbTagValue('ImageLength', h); + SetThumbTagValue('JPEGInterchangeFormat', 0); // to be replaced by the offset to the thumbnail + SetThumbTagValue('JPEGInterchangeFormatLength', n); +end; + +procedure TImageInfo.RemoveThumbnail; +var + newSize: integer; +begin + SetLength(FThumbnailBuffer, 0); + fiThumbCount := 0; + + if FThumbStart > 1 then begin + newSize := FThumbStart - 6; + with TImgData(FParent) do + begin + SetLength(ExifSegment^.Data, newSize); + ExifSegment^.Size := newSize; + // size calculations should really be moved to save routine + ExifSegment^.data[1] := ansichar(newSize div 256); + ExifSegment^.data[2] := ansichar(newSize mod 256); + end; + + FThumbStart := 0; + end; +end; + +procedure TImageInfo.SaveThumbnailToStream(AStream: TStream); +var + n: Int64; +begin + if HasThumbnail then + begin + n := Length(FThumbnailBuffer); + if AStream.Write(FThumbnailBuffer[0], n) <> n then + raise Exception.Create('Cannot write Thumbnail image to stream.'); + end; +end; + +function TImageInfo.ToLongString(ALabelWidth: Integer = 15): String; +var + tmpStr: String; + FileDateTime: String; + L: TStringList; + W: Integer; + lParent: TImgData; +begin + lParent := TImgData(FParent); + W := ALabelWidth; + L := TStringList.Create; + try + (* + if parent.ExifSegment = nil then + Result := '' + else + *) + if lParent.ErrStr <> NO_ERROR then + begin + L.Add(Format('File Name: %s', [ExtractFileName(lParent.Filename)])); + L.Add(Format('Exif Error: %s', [lParent.ErrStr])); + Result := L.Text; + end else + begin + FileDateTime := FormatDateTime(lParent.DateTimeFormat, lParent.FileDateTime); + + L.Add(Format('%-*s %s', [w, 'File name:', ExtractFileName(lParent.Filename)])); + L.Add(Format('%-*s %dkB', [w, 'File size:', lParent.FileSize div 1024])); + L.Add(Format('%-*s %s', [w, 'File date:', FileDateTime])); + L.Add(Format('%-*s %s', [w, 'Photo date:', FormatDateTime(lParent.DateTimeFormat, GetImgDateTime)])); + L.Add(Format('%-*s %s (%s)', [w, 'Make (model):', CameraMake, CameraModel])); + L.Add(Format('%-*s %d x %d', [w, 'Dimensions:', Width, Height])); + + if BuildList in [GenString,GenAll] then + begin + tmpStr := TagValueAsString['ExposureTime']; + if tmpStr <> '' then + L.Add(Format('%-*s %s', [w, 'Exposure time:', tmpStr])) + else + begin + tmpStr := TagValueAsstring['ShutterSpeedValue']; + if tmpStr <> '' then + L.Add(Format('%-*s %s', [w, 'Exposure time:', tmpStr])); + end; + + tmpStr := TagValueAsString['FocalLength']; + if tmpStr <> '' then + L.Add(Format('%-*s %s', [w, 'Focal length:', tmpStr])); + + tmpStr := TagValueAsString['FocalLengthIn35mm']; + if tmpStr <> '' then + L.Add(Format('%-*s %s', [w, 'Focal length (35mm):', tmpStr])); + + tmpStr := TagValueAsString['FNumber']; + if tmpStr <> '' then + L.Add(Format('%-*s %s', [w, 'F number', tmpStr])); + + tmpStr := TagValueAsString['ISOSpeedRatings']; + if tmpStr <> '' then + L.Add(Format('%-*s %s', [w, 'ISO:', tmpStr])); + end; + + L.Add(Format('%-*s %s', [w, 'Flash fired:', siif(odd(FlashUsed),'Yes','No')])); + Result := L.Text; + end; + finally + L.Free; + end; +end; + +function TImageInfo.ToShortString: String; +var + lParent: TImgData; +begin + lParent := TImgData(FParent); + if lParent.ErrStr <> NO_ERROR then + Result := ExtractFileName(lParent.Filename) + ' Exif Error: ' + lParent.ErrStr + else + Result := ExtractFileName(lParent.Filename) + ' ' + + IntToStr(lParent.FileSize div 1024) + 'kB '+ + FormatDateTime(lParent.DateTimeFormat, GetImgDateTime) + ' ' + + IntToStr(Width) + 'w ' + IntToStr(Height) + 'h '+ + siif(odd(FlashUsed),' Flash', ''); +end; + +procedure TImageInfo.AdjExifSize(AHeight, AWidth: Integer); +begin + TagValue['ImageWidth'] := AWidth; + TagValue['ImageLength'] := AHeight; +end; + +procedure TImageInfo.InternalGetBinaryTagValue(const ATag: TTagEntry; + var ABuffer: ansistring); +begin + ABuffer := ''; + + if ATag.Tag = 0 then + exit; + + if ATag.TType = FMT_BINARY then begin + SetLength(ABuffer, Length(ATag.Raw)); + Move(ATag.Raw[1], ABuffer[1], Length(ATag.Raw)); + end; +end; + +function TImageInfo.InternalGetTagValue(const ATag: TTagEntry): Variant; +var + s: String; + r: TExifRational; + i: Integer; + intValue: Integer; + floatValue: Extended; +begin + Result := Null; + if ATag.Tag = 0 then + exit; + + // Handle strings + case ATag.TType of + FMT_STRING: + begin + {$IFDEF FPC} + {$IFDEF FPC3+} + s := ATag.Raw; + {$ELSE} + s := AnsiToUTF8(ATag.Raw); + {$ENDIF} + {$ELSE} + s := ATag.Raw; + {$ENDIF} + while (s <> '') and (s[Length(s)] = #0) do + Delete(s, Length(s), 1); + Result := s; + exit; + end; + FMT_BINARY: + begin + Result := BinaryTagToVar(ATag); + exit; + end; + end; + + // Handle numeric data. Be aware that they may be arrays + if ATag.Count = 1 then +// Result := NumericTagToInt(@ATag.Raw[1], ATag.TType) + Result := NumericTagToVar(@ATag.Raw[1], ATag.TType) + else begin + case ATag.TType of + FMT_BYTE, FMT_USHORT, FMT_ULONG: + Result := VarArrayCreate([0, ATag.Count-1], varInteger); + FMT_URATIONAL, FMT_SRATIONAL: + Result := VarArrayCreate([0, ATag.Count-1], varDouble); + end; + for i:=0 to ATag.Count-1 do + Result[i] := NumericTagToVar(@ATag.Raw[1 + BYTES_PER_FORMAT[ATag.TType]*i], ATag.TType); + end; + + // Correction for some special cases + case ATag.Tag of + TAG_SHUTTERSPEED: + // Is stored as -log2 of exposure time + Result := power(2.0, -Result); + end; +end; + +function TImageInfo.BinaryTagToStr(const ATag: TTagEntry): String; +begin + Result := ATag.Raw; +end; + +function TImageInfo.BinaryTagToVar(const ATag: TTagEntry): Variant; +var + s: String; +begin + case ATag.Tag of + TAG_EXIFVERSION, + TAG_FLASHPIXVERSION, + TAG_INTEROPVERSION: + begin + SetLength(s, Length(ATag.Raw)); + Move(ATag.Raw[1], s[1], Length(s)); + Result := s; + end; + TAG_USERCOMMENT: + begin + Result := GetExifComment; + end; + else + Result := ''; + end; +end; + +{ ABuffer points into the raw buffer of a tag. The number pointed to will be + converted to a numeric value; its type depends on ATagType. } +function TImageInfo.NumericTagToVar(ABuffer: Pointer; ATagType: Integer): Variant; +var + r: TExifRational; +begin + case ATagType of + FMT_BYTE: + Result := PByte(ABuffer)^; + FMT_USHORT: + if MotorolaOrder then + Result := BEToN(PWord(ABuffer)^) else + Result := LEToN(PWord(ABuffer)^); + FMT_ULONG: + if MotorolaOrder then + Result := BEToN(PDWord(ABuffer)^) else + Result := LEToN(PDWord(ABuffer)^); + FMT_URATIONAL, + FMT_SRATIONAL: + begin + r := PExifRational(ABuffer)^; + if MotorolaOrder then begin + r.Numerator := LongInt(BEToN(DWord(r.Numerator))); // Type cast needed for D7 + r.Denominator := LongInt(BEToN(DWord(r.Denominator))); + end else begin + r.Numerator := LongInt(LEToN(DWord(r.Numerator))); + r.Denominator := LongInt(LEtoN(DWord(r.Denominator))); + end; + if ATagType = FMT_SRATIONAL then begin + r.Numerator := LongInt(r.Numerator); + r.Denominator := LongInt(r.Denominator); + end; + Result := Extended(r.Numerator / r.Denominator); + end; + { + FMT_BINARY: + if ATag.Size = 1 then + Result := PByte(@ATag.Raw[1])^ + else + Result := ''; + } + else + raise Exception.CreateFmt('NumericTagToVar does not handle Tag type %d', [ord(ATagType)]); + end; +end; + +{ Central routine for writing data to a tag. + ATagName ........... Name of the tag + AValue ............. Value to be written to the tag if the tag is not binary + ABinaryData ........ Data to be written to the tag if it is binary + ABinaryDataCount ... Number of bytes to be written to a binary tag. + ATagTypes .......... Determines in which list the tag definition is found + (Exif&Thumb, or GPS), and which list will get the new tag + (Exif&GPS, or thumb } +procedure TImageInfo.InternalSetTagValue(const ATagName: String; AValue: Variant; + ATagTypes: TTagTypes; ABinaryData: Pointer = nil; ABinaryDataCount: Word = 0); +const + IGNORE_PARENT = $FFFF; +var + P: PTagEntry; + tagDef: PTagEntry; + tagID: Word; + parentID: Word; + strValue: String; + i: Integer; +begin + // Find the tag's ID from the lists of tag definitions. + // Note: Normal ("Exif") and thumbnail tags share the same list, gps tags + // are separate. + if (ATagTypes * [ttExif, ttThumb] <> []) then + tagDef := FindExifTagDefByName(ATagName) else + tagDef := nil; + if (tagDef = nil) and (ttGps in ATagTypes) then + tagDef := FindGpsTagDefByName(ATagName); + if tagDef = nil then + raise Exception.CreateFmt('Tag "%s" not found.', [ATagName]); + tagID := tagDef.Tag; + + // Delete this tag if the provided value is varNull or varEmpty + if tagDef.TType = FMT_BINARY then begin + if ABinaryData = nil then begin + RemoveTag(ATagTypes, tagID, tagDef^.ParentID); + exit; + end; + end else begin + if VarIsNull(AValue) or VarIsEmpty(AValue) then begin + RemoveTag(ATagTypes, tagID, tagDef^.ParentID); + exit; + end; + end; + + // Find the pointer to the tag + P := FindTagPtr(tagDef^, (ttThumb in ATagTypes)); +// P := GetTagPtr(ATagTypes, tagID, false, IGNORE_PARENT); + if P = nil then begin + // The tag does not yet exist --> create a new one. + // BUT: The TagTable does not show the ParentIDs... + // Until somebody updates this we put the new tag into the root directory + // (IFD0). Since this may not be allowed there's a risk that the EXIF in the + // modified file cannot be read correctly... + { + if(ttGps in ATagTypes) then + parentID := TAG_GPS_OFFSET + else + parentID := 0; + } + P := CreateTagPtr(tagDef^, (ttThumb in ATagTypes), tagDef^.ParentID); + end; + if P = nil then + raise Exception.CreateFmt('Failure to create tag "%s"', [ATagName]); + + // Handle string data + if P^.TType = FMT_STRING then begin + strValue := VarToStr(AValue); + {$IFDEF FPC} + P^.Raw := UTF8ToAnsi(strValue) + #0; + {$ELSE} + P^.Raw := AnsiString(strValue) + #0; + {$ENDIF} + p^.Size := Length(p^.Raw); + P^.Data := P^.Raw; + exit; + end; + + // Handle binary data + if P^.TType = FMT_BINARY then begin + SetLength(P^.Raw, ABinaryDataCount); + Move(ABinaryData^, P^.Raw[1], ABinaryDataCount); + P^.Size := ABinaryDataCount; + P^.Data := ''; + exit; + end; + + // NOTE: Since hardware-specific data are not yet decoded the element Raw + // is still in the endianness of the source! + + // Handle some special cases + case tagID of + TAG_SHUTTERSPEED: + begin + strValue := VarToStr(AValue); + if pos('/', strValue) > 0 then + AValue := CvtRational(ansistring(strValue)); + // The shutter speed value is stored as -log2 of exposure time + AValue := -log2(AValue); + end; + TAG_EXPOSURETIME: + begin + strValue := VarToStr(AValue); + if pos('/', strValue) > 0 then + AValue := CvtRational(ansistring(strValue)); + end; + end; + + p^.Raw := ''; + p^.Data := ''; + p^.Size := 0; + if VarIsArray(AValue) then + for i:=VarArrayLowBound(AValue, 1) to VarArrayHighBound(AValue, 1) do + VarToNumericTag(AValue[i], p) + else + VarToNumericTag(AValue, p); +end; + +procedure TImageInfo.VarToNumericTag(AValue:variant; ATag: PTagEntry); +var + intValue: Integer; + fracvalue: TExifRational; + len: Integer; + s: String; + w: Word; + dw: DWord; + ok: Boolean; +begin + if VarIsArray(AValue) then + raise Exception.Create('No variant arrays allowed in VarToTag'); + + // fractional data + if (ATag^.TType in [FMT_URATIONAL, FMT_SRATIONAL]) then + begin + fracvalue := DoubleToRational(AValue); + if MotorolaOrder then begin + fracvalue.Numerator := LongInt(NToBE(DWord(fracValue.Numerator))); // Type-cast needed for D7 + fracValue.Denominator := LongInt(NToBE(DWord(fracValue.Denominator))); + end else begin + fracValue.Numerator := LongInt(NtoLE(DWord(fracValue.Numerator))); + fracValue.Denominator := LongInt(NtoLE(DWord(fracValue.Denominator))); + end; + len := Length(ATag^.Raw); + SetLength(ATag^.Raw, len + 8); + Move(fracValue, ATag^.Raw[len + 1], 8); + ATag^.Size := Length(ATag^.Raw); + s := FormatNumber(@ATag^.Raw[1], Length(ATag^.Raw), ATag^.TType, ATag^.FormatS, ATag^.Code); + { + if Assigned(ATag.Callback) and Parent.Decode then + s := ATag.Callback(s); + } + ATag^.Data := s; //siif(len = 0, s, ATag^.Data + dExifDataSep + s); + exit; + end; + + // integer data + if VarIsType(AValue, vtInteger) then begin + case ATag^.TType of + FMT_BYTE : ok := (AValue >= 0) and (AValue <= 255); + FMT_USHORT : ok := (AValue >= 0) and (AValue <= Word($FFFF)); + FMT_ULONG : ok := (AValue >= 0) and (AValue <= DWord($FFFFFFFF)); + FMT_SBYTE : ok := (AValue >= -128) and (AValue <= 127); + FMT_SSHORT : ok := (AValue >= -32768) and (AValue <= 32767); + FMT_SLONG : ok := (AValue >= -2147483647) and (AValue <= 2147483647); + { NOTE: D7 does not run with the correct lower limit -2147483648 } + end; + if not ok then + raise Exception.CreateFmt('Tag "%s": Value "%s" is out of range.', [ATag^.Name, VarToStr(AValue)]); + end; + + if not TryStrToInt(VarToStr(AValue), intValue) then begin + intValue := GetTagCode(ATag^, VarToStr(AValue)); + if (intValue = -1) then + raise Exception.CreateFmt('Lookup value "%s" of tag "%s" not found', [VarToStr(AValue), ATag^.Name]); + end; + + len := Length(ATag^.Raw); + SetLength(ATag^.Raw, len + BYTES_PER_FORMAT[ATag^.TType]); + case ATag^.TType of + FMT_BYTE: + Move(intValue, ATag^.Raw[1+len], 1); + FMT_USHORT: + begin + if MotorolaOrder then w := NtoBE(word(intValue)) else w := NtoLE(word(intvalue)); + Move(w, ATag^.Raw[1+len], 2); + end; + FMT_ULONG: + begin + if MotorolaOrder then + dw := NtoBE(DWord(intValue)) else + dw := NtoLE(DWord(intValue)); + Move(dw, ATag^.Raw[1+len], 4); + end; + else + raise Exception.Create('Unhandled data format in VarToNumericTag'); + end; + ATag^.Size := Length(ATag^.Raw); + s := FormatNumber(@ATag^.Raw[1], Length(ATag^.Raw), ATag^.TType, ATag^.FormatS, ATag^.Code); + ATag^.Data := siif(len = 0, s, ATag^.Data + dExifDataSep + s); +end; + +function TImageInfo.GetTagByID(ATagID: Word): TTagEntry; +var + i: Integer; +begin + for i:= 0 to fiTagCount - 1 do + if (fiTagArray[i].Tag = ATagID) and (fiTagArray[i].TID = GenericEXIF) then + begin + Result := fiTagArray[i]; + exit; + end; + Result := EmptyEntry; +end; + +procedure TImageInfo.SetTagByID(ATagID: Word; const AValue: TTagEntry); +var + i: Integer; + P: PTagEntry; +begin + for i:=0 to fiTagCount-1 do + if (fITagArray[i].Tag = ATagID) and (fiTagArray[i].TID = GenericEXIF) then + begin + fITagArray[i] := AValue; + exit; + end; + + // If not found: add it as a new tag to the array + P := FindExifTagDefByID(ATagID); + if P = nil then begin + P := FindGpsTagDefByID(ATagID); + if P = nil then + raise Exception.CreateFmt('TagID $%.4x unknown.', [ATagID]); + end; + AddTagToArray(AValue); +end; + +function TImageInfo.GetTagByIndex(AIndex: Integer): TTagEntry; +begin + Result := fiTagArray[AIndex]; +end; + +procedure TImageInfo.SetTagByIndex(AIndex: Integer; const AValue: TTagEntry); +begin + FITagArray[AIndex] := AValue; +end; + + +function TImageInfo.GetTagByName(ATagName: String): TTagEntry; +var + i: integer; +begin + i := LookupTagIndex(ATagName); + if i >= 0 then + Result := fITagArray[i] + else + Result := EmptyEntry; +end; + +procedure TImageInfo.SetTagByName(ATagName: String; const AValue: TTagEntry); +var + i: integer; + P: PTagEntry; +begin + i := LookupTagIndex(ATagName); + if i >= 0 then + fITagArray[i] := AValue + else + begin + // If not found: add it as a new tag to the array + P := FindExifTagDefByName(ATagName); + if P = nil then begin + P := FindGpsTagDefByName(ATagName); + if P = nil then + raise Exception.Create('Tag "' + ATagName + '" unknown.'); + end; + AddTagToArray(AValue); + end; +end; + +function TImageInfo.GetTagValue(ATagName: String): Variant; +var + tag: TTagEntry; +begin + Result := Null; + tag := GetTagByName(ATagName); + if (tag.Name = '') or (tag.Name = 'Unknown') then + exit; + Result := InternalGetTagValue(tag); +end; + +procedure TImageInfo.SetTagValue(ATagName: String; AValue: Variant); +begin + InternalSetTagValue(ATagName, AValue, [ttExif, ttGps]); +end; + +function TImageInfo.GetTagValueAsString(ATagName: String): String; +var + tag: TTagEntry; +begin + Result := ''; + tag := GetTagByName(ATagName); + if (tag.Name = '') or (tag.Name = 'Unknown') then + exit; + Result := InternalGetTagValueAsString(tag); +end; + +function TImageInfo.InternalGetTagValueAsString(const ATag: TTagEntry): String; +var + s: String; +begin + if ATag.TType = FMT_STRING then + begin + {$IFDEF FPC} + {$IFDEF FPC3+} + s := ATag.Raw; + {$ELSE} + s := AnsiToUTF8(ATag.Raw); + {$ENDIF} + {$ELSE} + s := ATag.Raw; + {$ENDIF} + while (s <> '') and ((s[Length(s)] = #0) or (s[Length(s)] = ' ')) do + Delete(s, Length(s), 1); + Result := s; + end else + if ATag.TType = FMT_BINARY then + begin + if (ATag.Size=1) then begin + Result := FormatNumber(@ATag.Raw[1], Length(ATag.Raw), ATag.TType, ATag.FormatS, ATag.Code); + if Assigned(ATag.Callback) and Decode then + Result := ATag.Callback(Result); + end else + if ATag.Name = 'ExifVersion' then + Result := GetVersion(ATag) + else if ATag.Name = 'FlashPixVersion' then + Result := GetVersion(ATag) + else if ATag.Name = 'InteroperabilityVersion' then + Result := GetVersion(ATag) + else if ATag.Name = 'UserComment' then + Result := GetExifComment + else begin + Result := BinaryTagToStr(ATag); + if Assigned(ATag.Callback) and Decode then + Result := ATag.Callback(Result); + end; + end else + begin + Result := FormatNumber(@ATag.Raw[1], Length(ATag.Raw), ATag.TType, ATag.FormatS, ATag.Code); + if Assigned(ATag.Callback) and Decode then + Result := ATag.Callback(Result) + end; +end; + +procedure TImageInfo.SetTagValueAsString(ATagName: String; AValue: String); +var + v: Variant; +begin + v := AValue; + SetTagValue(ATagName, v); +end; + +function TImageInfo.GetThumbTagByID(ATagID: Word): TTagEntry; +var + i: Integer; +begin + for i:= 0 to fiThumbCount - 1 do + if (fiThumbArray[i].Tag = ATagID) then + begin + Result := fiThumbArray[i]; + exit; + end; + Result := EmptyEntry; +end; + +procedure TImageInfo.SetThumbTagByID(ATagID: Word; const AValue: TTagEntry); +var + i: Integer; + P: PTagEntry; +begin + for i:=0 to fiThumbCount-1 do + if fIThumbArray[i].Tag = ATagID then begin + fIThumbArray[i] := AValue; + exit; + end; + + // If not found: add it as a new tag to the array + P := FindExifTagDefByID(ATagID); // Thumb tags are stored in Exif table + if P = nil then + raise Exception.CreateFmt('TagID $%.4x unknown.', [ATagID]); + AddTagToThumbArray(AValue); +end; + +function TImageInfo.GetThumbTagByIndex(AIndex: Integer): TTagEntry; +begin + Result := fiThumbArray[AIndex]; +end; + +procedure TImageInfo.SetThumbTagByIndex(AIndex: Integer; const AValue: TTagEntry); +begin + fiThumbArray[AIndex] := AValue; +end; + +function TImageInfo.GetThumbTagByName(ATagName: String): TTagEntry; +var + i: integer; +begin + ATagName := Uppercase(ATagName); + for i:= 0 to fiThumbCount - 1 do + if Uppercase(fiThumbArray[i].Name) = ATagName then begin + Result := fiThumbArray[i]; + exit; + end; + Result := EmptyEntry; +end; + +procedure TImageInfo.SetThumbTagByName(ATagName: String; const AValue: TTagEntry); +var + i: Integer; + P: PTagEntry; +begin + ATagName := Uppercase(ATagName); + for i:=0 to fiThumbCount-1 do + if Uppercase(fIThumbArray[i].Name) = ATagName then begin + fIThumbArray[i] := AValue; + exit; + end; + { + // If not found: add it as a new tag to the array + P := FindExifTagDefByName(ATagName); // Thumb tags are stored in Exif table + if P = nil then + raise Exception.Create('Tag "' + ATagName + '" unknown.'); + AddTagToThumbArray(AValue); + } +end; + +function TImageInfo.GetThumbTagValue(ATagName: String): Variant; +var + tag: TTagEntry; +begin + tag := GetThumbTagByName(ATagName); + Result := InternalGetTagValue(tag); +end; + +procedure TImageInfo.SetThumbTagValue(ATagName: String; AValue: Variant); +begin + InternalSetTagValue(ATagName, AValue, [ttThumb]); +end; + +function TImageInfo.GetThumbTagValueAsString(ATagName: String): String; +var + tag: TTagEntry; +begin + Result := ''; + tag := GetThumbTagByName(ATagName); + if (tag.Name = '') or (tag.Name = 'Unknown') then + exit; + Result := InternalGetTagValueAsString(tag); +end; + +procedure TImageInfo.SetThumbTagValueAsString(ATagName: String; AValue: String); +var + v: Variant; +begin + v := AValue; + SetThumbTagValue(ATagName, v); +end; + +function TImageInfo.GetWidth: Integer; +var + v: Variant; +begin + Result := 0; + v := TagValue['ImageWidth']; + if VarIsNull(v) then begin + v := TagValue['ExifImageWidth']; + if VarIsNull(v) then + exit; + end; + Result := v; +end; + +procedure TImageInfo.SetWidth(AValue: Integer); +begin + TagValue['ImageWidth'] := AValue; +end; + +function TImageInfo.GetHeight: Integer; +var + v: Variant; +begin + Result := 0; + v := TagValue['ImageLength']; + if VarIsNull(v) then begin + v := TagValue['ExifImageLength']; + if VarIsNull(v) then + exit; + end; + Result := v; +end; + +procedure TImageInfo.SetHeight(AValue: Integer); +begin + TagValue['ImageLength'] := AValue; +end; + +procedure TImageInfo.RemoveTag(ATagTypes: TTagTypes; ATagID: Word; AParentID: Word=0); +var + i: Integer; +begin + i := 0; + if ttThumb in ATagTypes then + begin + while i < fiThumbCount do + begin + if (fiThumbArray[i].Tag = ATagID) and (fiThumbArray[i].ParentID = AParentID) then + begin + while (i < fiThumbCount-1) do begin + fiThumbArray[i] := fiThumbArray[i+1]; + inc(i); + end; + dec(fiThumbCount); + break; + end else + inc(i); + end; + end else + begin + while i < fiTagCount do + begin + if (fiTagArray[i].Tag = ATagID) and (fiTagArray[i].ParentID = AParentID) then + begin + while (i < fiTagCount-1) do begin + fiTagArray[i] := fiTagArray[i+1]; + inc(i); + end; + dec(fiTagCount); + break; + end else + inc(i); + end; + end; +end; + (* +procedure TImageInfo.RemoveTag(ATagTypes: TTagTypes; ATagID: Word; AParentID: Word=0); +var + i, j: integer; +begin + j := 0; + if ttThumb in ATagTypes then begin + for i := 0 to fiThumbCount-1 do begin + if (j <> 0) then + fiThumbArray[i-j] := fiThumbArray[i]; + if (fiThumbArray[i].ParentID = AParentID) and (fiThumbArray[i].Tag = ATagID) then + inc(j); + end; + if (j <> 0) and (fiThumbCount > 0) then + dec(fiThumbCount); + end else + begin + for i := 0 to fiTagCount-1 do begin + if (j <> 0) then + fiTagArray[i-j] := fiTagArray[i]; + if (fiTagArray[i].ParentID = AParentID) and (fiTagArray[i].Tag = ATagID) then + inc(j); + end; + if (j <> 0) and (fiTagCount > 0) then + dec(fiTagCount); + end; +end; + *) +function TImageInfo.CreateTagPtr(const ATagDef: TTagEntry; IsThumbTag: Boolean; + AParentID: Word = 0): PTagEntry; +var + pTag: PTagEntry; + tag: TTagEntry; + idx: Integer; +begin + tag := ATagDef; + if tag.Size > 0 then + tag.Raw := StringOfChar(#0, tag.Size); + if IsThumbTag then + begin + tag.ParentID := 1; + idx := AddTagToThumbArray(tag); + Result := @fiThumbArray[idx]; + end else + begin + // Create the parent tag if it does not exist, yet. + if (AParentID <> 0) and (GetTagByID(AParentID).Tag = 0) then begin + pTag := FindExifTagDefByID(AParentID); + if pTag = nil then + raise Exception.CreateFmt('Definition for tag $%.4x not found.', [AParentID]); + pTag^.ParentID := 0; + pTag^.Raw := StringOfChar(#0, pTag^.Size); + AddTagToArray(pTag^); + end; + tag.ParentID := AParentID; + idx := AddTagToArray(tag); + Result := @fiTagArray[idx]; + end; +end; + +function TImageInfo.FindTagPtr(const ATagDef: TTagEntry; IsThumbTag: Boolean): PTagEntry; +var + i: Integer; +begin + if IsThumbTag then + begin + for i:=0 to fiThumbCount-1 do + if (fiThumbArray[i].Tag = ATagDef.Tag) and (fiThumbArray[i].Name = ATagDef.Name) then + begin + Result := @fiThumbArray[i]; + exit; + end; + end else + begin + for i:=0 to fiTagCount-1 do + if (fiTagArray[i].Tag = ATagDef.Tag) and (fiTagArray[i].Name = ATagDef.Name) then + begin + Result := @fiTagArray[i]; + exit; + end; + end; + Result := nil; +end; + (* +function TImageInfo.GetTagPtr(ATagTypes: TTagTypes; ATagID: word; + AForceCreate: Boolean=false; AParentID:word=0; ATagType: word=65535): PTagEntry; +var + i, j: integer; + tag: TTagEntry; +begin + Result := nil; + + if (ttThumb in ATagTypes) then begin + if AParentID = $FFFF then // $FFFF: ignore parent + for i:= 0 to fiThumbCount-1 do + if (fiThumbArray[i].Tag = ATagID) then begin + Result := @fiThumbArray[i]; + exit; + end; + for i := 0 to fiThumbCount-1 do + if (fiThumbArray[i].ParentID = AParentID) and (fiThumbArray[i].Tag = ATagID) then + begin + Result := @fiThumbArray[i]; + exit; + end; + end else + begin + if AParentID = $FFFF then // $FFFF: ignore parent + for i := 0 to fiTagCount - 1 do + if (fiTagArray[i].Tag = ATagID) then begin + Result := @fiTagArray[i]; + exit; + end; + for i := 0 to fiTagCount-1 do + if (fiTagArray[i].ParentID = AParentID) and (fiTagArray[i].Tag = ATagID) then + begin + Result := @fiTagArray[i]; + exit; + end; + end; + + if AForceCreate then begin + tag := FindExifTagDefByID(ATagID)^; + if ATagType <> 65535 then + tag.TType := ATagType; + tag.Id := 0; + if tag.Size > 0 then + tag.Raw := StringOfChar(#0, tag.Size); + if (ttThumb in ATagTypes) then begin + tag.ParentID := 1; + i := AddTagToThumbArray(tag); + Result := @fiThumbArray[i]; + end; + if ([ttExif, ttGps] * ATagTypes <> []) then begin + tag.parentID := AParentID; + i := AddTagToArray(tag); + Result := @fiTagArray[i]; + end; + end; +end; + *) +function TImageInfo.GetArtist: String; +begin + Result := GetTagValueAsString('Artist'); +end; + +procedure TImageInfo.SetArtist(v: String); +begin + SetTagValue('Artist', v); +end; + +function TImageInfo.GetUserComment(const ATag: TTagEntry): String; +var + buf: ansistring; + w: widestring; + a: ansistring; + n: Integer; +begin + Result := ''; + + InternalGetBinaryTagValue(ATag, buf); + if buf = '' then + exit; + + if pos('UNICODE', buf) = 1 then begin + SetLength(w, (Length(buf) - 8) div SizeOf(WideChar)); + Move(buf[9], w[1], Length(w) * Sizeof(WideChar)); + {$IFDEF FPC} + Result := UTF8Encode(w); + {$ELSE} + Result := w; + {$ENDIF} + end else + if pos('ASCII', buf) = 1 then begin + a := Copy(buf, 9, MaxInt); + while (a <> '') and ((a[Length(a)] = #0) or (a[Length(a)] = ' ')) do + Delete(a, Length(a), 1); + Result := a; + end else + if pos(#0#0#0#0#0#0#0#0, buf) = 1 then begin + a := Copy(buf, 9, MaxInt); + while (a <> '') and ((a[Length(a)] = #0) or (a[Length(a)] = ' ')) do + Delete(a, Length(a), 1); + {$IFDEF FPC} + {$IFDEF FPC3+} + Result := WinCPToUTF8(a); + {$ELSE} + Result := SysToUTF8(a); + {$ENDIF} + {$ELSE} + Result := a; + {$ENDIF} + end else + if Pos('JIS', buf) = 1 then + raise Exception.Create('JIS-encoded user comment is not supported.'); +end; + +function TImageInfo.GetExifComment: String; +var + tag: TTagEntry; +begin + tag := GetTagByName('UserComment'); + if tag.Tag <> 0 then + Result := GetUserComment(tag) + else + Result := ''; +end; + +(* +function TImageInfo.GetExifComment: String; +var + p : PTagEntry; + w : WideString; + n: Integer; + sa: AnsiString; +begin + Result := ''; + w := ''; + p := GetTagPtr([ttExif], TAG_EXIF_OFFSET); + if (p = nil) then + exit; + p := GetTagPtr([ttExif], TAG_USERCOMMENT, false, TAG_EXIF_OFFSET); + if (p = nil) or (Length(p^.Raw) <= 10) then + exit; + + if Pos('UNICODE', p^.Raw) = 1 then begin + SetLength(w, (Length(p^.Raw) - 8) div SizeOf(WideChar)); + Move(p^.Raw[9], w[1], Length(w) * SizeOf(WideChar)); + {$IFDEF FPC} + Result := UTF8Encode(w); + {$ELSE} + Result := w; + {$ENDIF} + end else + if Pos('ASCII', p^.Raw) = 1 then begin + SetLength(Result, Length(p^.Raw)-9); + sa := p^.Raw; + Delete(sa, 1, 8); + Result := sa; + end else + if Pos(#0#0#0#0#0#0#0#0, p^.Raw) = 1 then begin + SetLength(sa, Length(p^.Raw) - 9); + Move(p^.raw[9], sa[1], Length(sa)); + {$IFDEF FPC} + {$IFNDEF FPC3+} + Result := SysToUTF8(sa); + {$ELSE} + Result := WinCPToUTF8(sa); + {$ENDIF} + {$ELSE} + Result := sa; + {$ENDIF} + end else + if Pos('JIS', p^.Raw) = 1 then + raise Exception.Create('JIS-encoded user comment is not supported.'); +end; +*) + +procedure TImageInfo.SetExifComment(AValue: String); +var + p: PTagEntry; + i: integer; + w: WideString; + a: AnsiString; + u: Boolean; + buf: array of byte; + len: Integer; +begin + if AValue = '' then + SetLength(buf, 0) + else + begin + u := false; + for i:=1 to Length(AValue) do + if byte(AValue[i]) > 127 then begin + u := true; + break; + end; + + if u then begin + {$IFDEF FPC} + w := UTF8Decode(AValue); + {$ELSE} + w := AValue; + {$ENDIF} + SetLength(buf, 8 + Length(w) * SizeOf(WideChar)); // +8 for header + a := 'UNICODE'#0; + Move(a[1], buf[0], 8); + Move(w[1], buf[8], Length(w) * Sizeof(WideChar)); + end else + begin + SetLength(buf, 8 + Length(AValue)); + a := 'ASCII'#0#0#0; + Move(a[1], buf[0], 8); + a := ansistring(AValue); + Move(a[1], buf[8], Length(a)); + end; + end; + InternalSetTagValue('UserComment', NULL, [ttExif, ttGps], @buf[0], Length(buf)); + +(* + p := GetTagPtr([ttExif], TAG_EXIF_OFFSET, true, 0, FMT_ULONG{, true}); + if (v = '') then begin + RemoveTag([ttExif], TAG_USERCOMMENT, TAG_EXIF_OFFSET); + exit; + end; + + p := GetTagPtr([ttExif], TAG_USERCOMMENT, true, TAG_EXIF_OFFSET, FMT_BINARY); + u := false; + for i:=1 to Length(v) do + if byte(v[i]) > 127 then begin + u := true; + break; + end; + + if u then begin + p^.Raw := 'UNICODE'#0; + // According to docs: no need to add a trailing zero byte + {$IFDEF FPC} + w := UTF8Decode(v); + {$ELSE} + w := v; + {$ENDIF} + SetLength(p^.Raw, Length(w) * SizeOf(WideChar) + 8); + Move(w[1], p^.Raw[9], Length(w) * SizeOf(WideChar)); + end else begin + p^.Raw := 'ASCII'#0#0#0; + // According to docs: no need to add a trailing zero byte + a := AnsiString(v); + SetLength(p^.Raw, Length(a) + 8); + i := Length(p^.Raw); + Move(a[1], p^.Raw[9], Length(a)); + end; + p^.Size := Length(p^.Raw); + p^.Data := v; + *) +end; + +function TImageInfo.GetImageDescription: String; +begin + Result := GetTagValueAsString('ImageDescription'); +end; + +procedure TImageInfo.SetImageDescription(const AValue: String); +begin + SetTagValue('ImageDescription', AValue); +end; + +function TImageInfo.GetCameraMake: String; +begin + Result := GetTagValueAsString('Make'); +end; + +procedure TImageInfo.SetCameraMake(const AValue: String); +begin + SetTagValue('Make', AValue); +end; + +function TImageInfo.GetCameraModel: String; +begin + Result := GetTagValueAsString('Model'); +end; + +procedure TImageInfo.SetCameraModel(const AValue: String); +begin + SetTagValue('Model', AValue); +end; + +function TImageInfo.GetCopyright: String; +begin + Result := GetTagValueAsString('Copyright'); +end; + +procedure TImageInfo.SetCopyright(const AValue: String); +begin + SetTagValue('Copyright', AValue); +end; + +function TImageInfo.GetGPSCoordinate(ATagName: String; + ACoordType: TGPSCoordType): Extended; +var + vDeg, vSgn: Variant; +begin + Result := NaN; + vDeg := GetTagValue(ATagName); + if VarIsNull(vDeg) then + exit; + if not VarIsArray(vDeg) then + exit; + + Result := vDeg[0] + vDeg[1]/60 + vDeg[2]/3600; + vSgn := GetTagValue(ATagName + 'Ref'); + if VarIsNull(vSgn) then + exit; + case ACoordType of + ctLatitude : if VarToStr(vSgn)[1] in ['S', 's'] then Result := -Result; + ctLongitude : if VarToStr(vSgn)[1] in ['W', 'w'] then Result := -Result; + end; +end; + +procedure TImageInfo.SetGPSCoordinate(ATagName: String; const AValue: Extended; + ACoordType: TGPSCoordType); +const + Ref: array[TGPSCoordType] of string[2] = ('NS', 'EW'); +var + v: Variant; + degs, mins, secs: double; + val: Extended; +begin + if IsNaN(AValue) then + v := NULL + else begin + val := abs(AValue); + degs := trunc(val); + mins := trunc(frac(val) * 60); + secs := (frac(val) * 60 - mins) * 60; + v := VarArrayOf([degs, mins, secs]); + end; + InternalSetTagValue(ATagName, v, [ttGps]); + if IsNaN(AValue) then + InternalSetTagValue(ATagName + 'Ref', NULL, [ttGps]) + else + if AValue > 0 then + InternalSetTagValue(ATagName + 'Ref', Ref[ACoordType, 1], [ttGps]) + else + InternalSetTagValue(ATagName + 'Ref', Ref[ACoordType, 2], [ttGps]); + VarClear(v); +end; + +function TImageInfo.GetGPSLatitude: Extended; +begin + Result := GetGPSCoordinate('GPSLatitude', ctLatitude); +end; + +procedure TImageInfo.SetGPSLatitude(const AValue: Extended); +begin + SetGPSCoordinate('GPSLatitude', AValue, ctLatitude); +end; + +function TImageInfo.GetGPSLongitude: Extended; +begin + Result := GetGPSCoordinate('GPSLongitude', ctLongitude); +end; + +procedure TImageInfo.SetGPSLongitude(const AValue: Extended); +begin + SetGPSCoordinate('GPSLongitude', AValue, ctLongitude); +end; + +{ The version of the supported Exif or FlashPix standard. + + All four bytes should be interpreted as ASCII values. The first two bytes + encode the upper part of the standard version, the next two bytes encode the + lower part. For example, the byte sequence 48, 50, 50, 48, is the equivalent + of the ASCII value "0220", and denotes version 2.20. + + http://www.awaresystems.be/imaging/tiff/tifftags/privateifd/exif/exifversion.html + http://www.awaresystems.be/imaging/tiff/tifftags/privateifd/exif/flashpixversion.html +} +function TImageInfo.GetVersion(ATag: TTagEntry): String; +var + s: AnsiString; +begin + Result := ''; + InternalGetBinaryTagValue(ATag, s); + Result := s; +end; + +function TImageInfo.IterateFoundTags(TagId: integer; var RetVal: TTagEntry): boolean; +begin + InitTagEntry(Retval); + + while (FIterator < FITagCount) and (FITagArray[FIterator].TID <> TagId) do + inc(FIterator); + if (FIterator < FITagCount) then + begin + RetVal := FITagArray[FIterator]; + inc(FIterator); + Result := true; + end + else + Result := false; +end; + +procedure TImageInfo.ResetIterator; +begin + FIterator := 0; +end; + +function TImageInfo.IterateFoundThumbTags(TagId: integer; + var RetVal: TTagEntry): boolean; +begin + InitTagEntry(RetVal); + + while (FThumbIterator < FIThumbCount) and (FITagArray[FThumbIterator].TID <> TagId) do + inc(FThumbIterator); + if (FThumbIterator < FIThumbCount) then + begin + RetVal := FIThumbArray[FThumbIterator]; + inc(FThumbIterator); + Result := true; + end + else + Result := false; +end; + +procedure TImageInfo.ResetThumbIterator; +begin + FThumbIterator := 0; +end; + +function TImageInfo.GetRawFloat(ATagName: String): Double; +var + tiq: TTagEntry; +begin + tiq := GetTagByName(ATagName); + if tiq.Tag = 0 then // EmptyEntry + Result := 0.0 + else + Result := GetNumber(@tiq.Raw[1], Length(tiq.Raw), tiq.TType); +end; + +function TImageInfo.GetRawInt(ATagName: String): Integer; +var + tiq: TTagEntry; +begin + tiq := GetTagByName(ATagName); + if tiq.Tag = 0 then // EmptyEntry + Result := -1 + else + if (tiq.TType = FMT_BINARY) and (tiq.Size = 1) then + Result := byte(tiq.Raw[1]) + else + result := round(GetNumber(@tiq.Raw[1], Length(tiq.Raw), tiq.TType)); +end; + +// Unfortunatly if we're calling this function there isn't +// enough info in the EXIF to calculate the equivalent 35mm +// focal length and it needs to be looked up on a camera +// by camera basis. - next rev - maybe +function TImageInfo.LookupRatio: double; +var + estRatio: double; + upMake, upModel: String; +begin + upMake := Uppercase(copy(CameraMake, 1, 5)); + upModel := Uppercase(copy(Cameramodel, 1, 5)); + estRatio := 4.5; // ballpark for *my* camera - + Result := estRatio; +end; + +procedure TImageInfo.Calc35Equiv; +const + Diag35mm : double = 43.26661531; // sqrt(sqr(24)+sqr(36)) +var + tmp: integer; + CCDWidth, CCDHeight, fpu, fl, fl35, ratio: double; + NewE, LookUpE: TTagEntry; + w: Word; +begin + if LookUpTagIndex('FocalLengthin35mmFilm') >= 0 then + exit; // no need to calculate - already have it + + CCDWidth := 0.0; + CCDHeight := 0.0; + tmp := GetRawInt('FocalPlaneResolutionUnit'); + if (tmp <= 0) then + tmp := GetRawInt('ResolutionUnit'); + case tmp of + 2: fpu := 25.4; // inch + 3: fpu := 10; // centimeter + else + fpu := 0.0 + end; + + fl := GetRawFloat('FocalLength'); + if (fpu = 0.0) or (fl = 0.0) then + exit; + + tmp := GetRawInt('FocalPlaneXResolution'); + if (tmp <= 0) then + exit; + CCDWidth := Width * fpu / tmp; + + tmp := GetRawInt('FocalPlaneYResolution'); + if (tmp <= 0) then + exit; + + CCDHeight := Height * fpu / tmp; + + if CCDWidth*CCDHeight <= 0 then // if either is zero + begin + if not estimateValues then + exit; + ratio := LookupRatio() + end + else + ratio := Diag35mm / sqrt (sqr (CCDWidth) + sqr (CCDHeight)); + + fl35 := fl * ratio; + w := Round(fl35); + +// now load it into the tag array + tmp := LookupTagDefn('FocalLengthIn35mmFilm'); + if tmp = -1 then + exit; + + LookUpE := TagTable[tmp]; + NewE := LookupE; + NewE.Data := ansistring(Format('%0.2f',[fl35])); + NewE.FormatS := '%s mm'; + SetLength(NewE.Raw, 2); + Move(w, NewE.Raw[1], 2); + NewE.TType := FMT_USHORT; + AddTagToArray(NewE); + + TraceStr := TraceStr + crlf + + siif(ExifTrace > 0, 'tag[$' + IntToHex(tmp,4) + ']: ', '') + + NewE.Desc + dExifDelim + NewE.Data + + siif(ExifTrace > 0,' [size: 0]', '') + + siif(ExifTrace > 0,' [start: 0]', ''); +end; + +procedure TImageInfo.EXIFArrayToXML(AList: TStrings); +var + i: integer; +begin + Assert(AList <> nil, 'TImageInfo.ExifArrayToXML called with AList=nil.'); + AList.Add(' '); + for i := 0 to fiTagCount-1 do + with fITagArray[i] do + begin + AList.Add(' <' + Name + '>'); + if Tag in [105, 120] // headline and image caption // wp: ?? 105 = $0069, 120 = $0078 -- there are no such tags! + then AList.Add(' ') + else AList.Add(' ' + Data); + AList.Add(' '); + end; + AList.Add(' '); +end; + + +end. + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/fpexif/fpeexifdata.pas b/components/fpexif/fpeexifdata.pas new file mode 100644 index 000000000..2187d190c --- /dev/null +++ b/components/fpexif/fpeexifdata.pas @@ -0,0 +1,1664 @@ +unit fpeExifData; + +{$IFDEF FPC} + {$mode objfpc}{$H+} +{$ENDIF} + +{$I fpexif.inc} + +interface + +uses + Classes, SysUtils, + fpeGlobal, fpeTags; + +const + // Constants for tag IDs used explicitly somewhere + TAG_IMAGEWIDTH = $0100; + TAG_IMAGELENGTH = $0101; + TAG_IMAGEHEIGHT = $0101; + TAG_COMPRESSION = $0103; + TAG_MAKE = $010F; + TAG_MODEL = $0110; + TAG_THUMBSTARTOFFSET = $0201; + TAG_THUMBSIZE = $0202; + TAG_EXIFVERSION = $9000; + TAG_FOCALLENGTH35MM = $A405; + + // Parent's ID tag's ID + FULLTAG_IMAGEWIDTH = TAGPARENT_PRIMARY or TAG_IMAGEWIDTH; + FULLTAG_IMAGELENGTH = TAGPARENT_PRIMARY or TAG_IMAGELENGTH; + FULLTAG_COMPRESSION = TAGPARENT_PRIMARY or TAG_COMPRESSION; + FULLTAG_MAKE = TAGPARENT_PRIMARY or TAG_MAKE; + FULLTAG_MODEL = TAGPARENT_PRIMARY or TAG_MODEL; + FULLTAG_THUMBSTARTOFFSET = TAGPARENT_THUMBNAIL or TAG_THUMBSTARTOFFSET; + FULLTAG_THUMBSIZE = TAGPARENT_THUMBNAIL or TAG_THUMBSIZE; + FULLTAG_THUMBCOMPRESSION = TAGPARENT_THUMBNAIL or TAG_COMPRESSION; + FULLTAG_THUMBWIDTH = TAGPARENT_THUMBNAIL or TAG_IMAGEWIDTH; + FULLTAG_THUMBHEIGHT = TAGPARENT_THUMBNAIL or TAG_IMAGEHEIGHT; + FULLTAG_THUMBLENGTH = TAGPARENT_THUMBNAIL or TAG_IMAGELENGTH; + FULLTAG_EXIFVERSION = TAGPARENT_EXIF or TAG_EXIFVERSION; + FULLTAG_FOCALLENGTH35mm = TAGPARENT_EXIF or TAG_FOCALLENGTH35mm; + +type + TExifBeginReadingEvent = procedure of object; + TExifEndReadingEvent = procedure of object; + + { TExifData } + + TExifData = class + private + FTagList: TTagList; + FBigEndian: Boolean; + FThumbnailBuffer: TBytes; + FReadFlag: Integer; + FExportOptions: TExportOptions; + FOnBeginReading: TExifBeginReadingEvent; + FOnEndReading: TExifEndReadingEvent; + function GetImgHeight: Integer; + function GetImgWidth: Integer; + function GetTagByID(ATagID: TTagID): TTag; + function GetTagByIndex(AIndex: Integer): TTag; + function GetTagByName(AFullTagName: String): TTag; + function GetTagCount: Integer; + procedure SetExportOptions(const AValue: TExportOptions); + procedure SetTagByID(ATagID: TTagID; ATag: TTag); + procedure SetTagByIndex(AIndex: Integer; ATag: TTag); + procedure SetTagByName(AFullTagName: String; ATag: TTag); + protected + FTiffHeaderOffset: Int64; + procedure CheckFocalLengthIn35mm; + procedure DoBeginReading; + procedure DoEndReading; + function InternalAddTag(ATagDef: TTagDef): TTag; + public + constructor Create(ABigEndian: Boolean); + destructor Destroy; override; + + function AddMakerNoteTag(AIndex: Integer; ATagID: TTagID; ATagName: String; + ADataValue: Integer; ALkupTbl: String = ''; AFormatStr: String = ''; + ATagType: TTagType = ttUInt16): Integer; overload; + function AddMakerNoteTag(AIndex: Integer; ATagID: TTagID; ATagName: String; + ADataValue: Double; AFormatStr: String = ''; + ATagType: TTagType = ttURational): Integer; overload; + function AddOrReplaceTag(ATag: TTag): Integer; + function AddTag(ATag: TTag): Integer; + function AddTagByID(ATagID: TTagID): TTag; + function AddTagByName(AFullTagName: String): TTag; + procedure Clear; + function ExportOptionsToTagOptions: TTagOptions; + procedure ExportToStrings(AList: TStrings; ASeparator: String = '='; + AGroup: TTagGroup = tgUnknown); + function FindTagByID(ATagID: TTagID): TTag; + function FindTagByName(AFullTagName: String): TTag; + function GetParentTag(ATag: TTag): TTag; + function HasTagsOfGroup(AGroup: TTagGroup): Boolean; + function IndexOfTagID(ATagID: TTagID): Integer; + function IndexOfTagName(AFullTagName: String): Integer; + + // Reading + procedure BeginReading; + procedure EndReading; + function IsReading: Boolean; + property TiffHeaderOffset: Int64 read FTiffHeaderOffset; + + // Thumbnail + procedure LoadThumbnailFromStream(AStream: TStream; ASize: Integer = -1; + AUpdateThumbnailTags: Boolean = true); + function HasThumbnail: Boolean; + procedure RemoveThumbnail; + procedure SaveThumbnailToStream(AStream: TStream); + function ThumbnailSize: Integer; + + // Properties + property BigEndian: Boolean + read FBigEndian; + property ExportOptions: TExportOptions + read FExportOptions write SetExportOptions; + 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; + + property ImgHeight: Integer + read GetImgHeight; + property ImgWidth: Integer + read GetImgWidth; + + property OnBeginReading: TExifBeginReadingEvent + read FOnBeginReading write FOnBeginReading; + property OnEndReading: TExifEndReadingEvent + read FOnEndReading write FOnEndReading; + end; + + TVersionTag = class(TBinaryTag) + private + FSeparator: String; + protected + function GetAsString: String; override; + procedure SetAsString(const AValue: String); override; + public + property Separator: String read FSeparator write FSeparator; + end; + + TComponentsConfigTag = class(TBinaryTag) + protected + function GetAsString: String; override; + procedure SetAsString(const AValue: String); override; + end; + + TDateTimeTag = class(TStringTag) + private + function GetDateTime: TDateTime; + function GetFormat: String; + procedure SetDateTime(const AValue: TDateTime); + protected + function ExifDateToDateTime(AStr: string): TDateTime; + function GetAsString: String; override; + procedure SetAsString(const AValue: String); override; + public + procedure AdjustBy(ADays, AHours, AMinutes, ASeconds: Integer); + property AsDateTime: TDateTime read GetDateTime write SetDateTime; + property FormatStr; // e.g.: 'yyyy-mm-dd hh:nn:ss' + end; + + TGPSPositionTag = class(TFloatTag) + protected + function GetAsFloat: Double; override; + function GetAsString: String; override; + procedure SetAsFloat(const AValue: Double); override; + procedure SetAsString(const AValue: String); override; + end; + + TMakerNoteIntegerTag = class(TIntegerTag) + public + constructor Create(ATagID, {%H-}AIndex: Integer; AName: String; AValue: Integer; + ALkupTbl, AFormatStr: String; ATagType: TTagType; AOptions: TTagOptions); reintroduce; + end; + + TMakerNoteFloatTag = class(TFloatTag) + public + constructor Create(ATagID, {%H-}AIndex: Integer; AName: String; AValue: Double; + AFormatStr: String; ATagType: TTagType; AOptions: TTagOptions); reintroduce; + end; + + TExposureTimeTag = class(TFloatTag) + protected + function GetAsString: String; override; + procedure SetAsString(const AValue: String); override; + public + property FormatStr; + end; + + TShutterSpeedTag = class(TExposureTimeTag) + protected +// function GetFloat(AIndex: Integer; out AValue: Double): Boolean; override; + function GetRational(AIndex: Integer; out AValue: TExifRational): Boolean; override; + procedure SetFloat(AIndex: Integer; const AValue: Double); override; + procedure SetRational(AIndex: Integer; const AValue: TExifRational); override; + (* + function GetAsFloat: Double; override; + function GetAsRational: TExifRational; override; + procedure SetAsFloat(const AValue: Double); override; + procedure SetAsRational(const AValue: TExifRational); override; + *) + end; + + TApertureTag = class(TFloatTag) + protected + function GetFloat(AIndex: Integer; out AValue: Double): Boolean; override; + function GetRational(AIndex: Integer; out AValue: TExifRational): Boolean; override; + procedure SetFloat(AIndex: Integer; const AValue: Double); override; + procedure SetRational(AIndex: Integer; const AValue: TExifRational); override; + end; + + TUserCommentTag = class(TBinaryTag) + protected + function GetAsString: String; override; + procedure SetAsString(const AValue: String); override; + end; + + TXPTag = class(TBinaryTag) + protected + function GetAsString: String; override; + end; + + +procedure BuildExifTagDefs; +procedure FreeExifTagDefs; +function FindExifTagDef(ATagID: TTagID): TTagDef; overload; +function FindExifTagDef(AFullTagName: String): TTagDef; overload; +function FindExifTagDefWithoutParent(ATagID: word): TTagDef; + + +implementation + +uses + {$IFDEF FPC} + LazUTF8, + {$ENDIF} + Math, DateUtils, StrUtils, + fpeStrConsts, fpeUtils; + +//============================================================================== +// Tag definitions (TagDef) +//============================================================================== +var + ExifTagDefs: TTagDefList = nil; + +procedure BuildExifTagDefs; +const + I = TAGPARENT_INTEROP; // for shorter lines... + P = TAGPARENT_PRIMARY; + T = TAGPARENT_THUMBNAIL; + E = TAGPARENT_EXIF; + G = TAGPARENT_GPS; +begin + if ExifTagDefs = nil then + ExifTagDefs := TTagDefList.Create; + + with ExifTagDefs do begin + Clear; + AddStringTag (I+$0001, 'InterOpIndex', 1, rsInterOpIndex); + AddBinaryTag (I+$0002, 'InterOpVersion', 1, rsInterOpVersion, '', '', TVersionTag); + AddULongTag (P+$00FE, 'SubfileType', 1, '', rsSubfileTypeLkup, '', nil, true); + AddULongTag (P+$0100, 'ImageWidth', 1, rsImageWidth); + AddULongTag (T+$0100, 'ThumbnailWidth', 1, rsThumbnailWidth); + AddULongTag (P+$0101, 'ImageHeight', 1, rsImageHeight); // official: "Image length" + AddULongTag (T+$0101, 'ThumbnailHeight', 1, rsThumbnailHeight); // official: "Image length" + AddULongTag (P+$0101, 'ImageLength', 1, rsImageHeight); + AddULongTag (T+$0101, 'ThumbnailLength', 1, rsThumbnailHeight); + AddUShortTag (P+$0102, 'BitsPerSample', 1, rsBitsPerSample); + AddUShortTag (P+$0103, 'Compression', 1, rsCompression, rsCompressionLkup); + AddUShortTag (T+$0103, 'ThumbnailCompression', 1, rsCompression, rsCompressionLkup); + AddUShortTag (P+$0106, 'PhotometricInterpretation', 1, rsPhotometricInt, rsPhotometricIntLkup); + AddUShortTag (P+$0107, 'Thresholding', 1, rsThresholding, rsThresholdingLkup); + AddUShortTag (P+$0108, 'CellWidth', 1, rsCellWidth); + AddUShortTag (P+$0109, 'CellHeight', 1, rsCellHeight); + AddUShortTag (P+$010A, 'FillOrder', 1, rsFillOrder, rsFillOrderLkup); + AddStringTag (P+$010D, 'DocumentName', 1, rsDocumentName); + AddStringTag (P+$010E, 'ImageDescription', 1, rsImageDescr); + AddStringTag (P+$010F, 'Make', 1, rsMake); + AddStringTag (P+$0110, 'Model', 1, rsModel); + AddULongTag (P+$0111, 'StripOffsets', 1, rsStripOffsets); + AddUShortTag (P+$0112, 'Orientation', 1, rsOrientation, rsOrientationLkup); + AddUShortTag (T+$0112, 'Orientation', 1, rsOrientation, rsOrientationLkup); + AddUShortTag (P+$0115, 'SamplesPerPixel', 1, rsSamplesPerPixel); + AddULongTag (P+$0116, 'RowsPerStrip', 1, rsRowsPerStrip); + AddULongTag (P+$0117, 'StripByteCounts', 1, rsStripByteCounts); + AddUShortTag (P+$0118, 'MinSampleValue', 1, rsMinSampleValue); + AddUShortTag (P+$0119, 'MaxSampleValue', 1, rsMaxSampleValue); + AddURationalTag(P+$011A, 'XResolution', 1, rsXResolution); + AddURationalTag(T+$011A, 'ThumbnailXResolution', 1, rsXResolution); + AddURationalTag(P+$011B, 'YResolution', 1, rsYResolution); + AddURationalTag(T+$011B, 'ThumbnailYResolution', 1, rsYResolution); + AddUShortTag (P+$011C, 'PlanarConfiguration', 1, rsPlanarConfiguration, rsPlanarConfigurationLkup); + AddStringTag (P+$011D, 'PageName', 1, rsPageName); + AddURationalTag(P+$011E, 'XPosition', 1, rsXPosition); + AddURationalTag(P+$011F, 'YPosition', 1, rsYPosition); + AddUShortTag (P+$0128, 'ResolutionUnit', 1, rsResolutionUnit, rsResolutionUnitLkup); + AddUShortTag (T+$0128, 'ThumbnailResolutionUnit', 1, rsResolutionUnit, rsResolutionUnitLkup); + AddUShortTag (P+$0129, 'PageNumber', 2, rsPageNumber); + AddUShortTag (P+$012D, 'TransferFunction', 768, rsTransferFunction); + AddStringTag (P+$0131, 'Software', 1, rsSoftware); + AddStringTag (P+$0132, 'DateTime', 1, rsDateTime, '', TDateTimeTag); + AddStringTag (P+$013B, 'Artist', 1, rsArtist); + AddStringTag (P+$013C, 'HostComputer', 1, rsHostComputer); + AddUShortTag (P+$013D, 'Predictor', 1, rsPredictor, rsPredictorLkup); + AddURationalTag(P+$013E, 'WhitePoint', 2, rsWhitePoint); + AddURationaltag(P+$013F, 'PrimaryChromaticities', 6, rsPrimaryChromaticities); + AddUShortTag (P+$0141, 'HalftoneHints', 2, rsHalftoneHints); + AddULongTag (P+$0142, 'TileWidth', 1, rsTileWidth); + AddULongTag (P+$0143, 'TileLength', 1, rsTileLength); + AddULongTag (P+$014C, 'InkSet', 1, rsInkSet, rsInkSetLkup); + AddUShortTag (P+$0151, 'TargetPrinter', 1, rsTargetPrinter); + AddULongTag (T+$0201, 'ThumbnailOffset', 1, rsThumbnailOffset, '', '', TOffsetTag); + AddULongTag (T+$0202, 'ThumbnailSize', 1, rsThumbnailSize); + AddURationaltag(P+$0211, 'YCbCrCoefficients', 3, rsYCbCrCoefficients); + AddUShortTag (P+$0212, 'YCbCrSubsamping', 2, rsYCbCrSubsampling); + AddUShortTag (P+$0213, 'YCbCrPositioning', 1, rsYCbCrPositioning, rsYCbCrPosLkup); + AddUShortTag (T+$0213, 'YCbCrPositioning', 1, rsYCbCrPositioning, rsYCbCrPosLkup); + AddURationalTag(P+$0214, 'ReferenceBlackWhite', 6, rsRefBlackWhite); +// AddByteTag(P+$02BC, 'ExtensibleMetadataPlatform', 1, rsExtensibleMetadataPlatform); + AddStringTag (P+$02BC, 'ExtensibleMetadataPlatform',1, rsExtensibleMetadataPlatform); + AddStringTag (I+$1000, 'RelatedImageFileFormat', 1, rsRelatedImageFileFormat); + AddUShortTag (I+$1001, 'RelatedImageWidth', 1, rsRelatedImageWidth); + AddUShortTag (I+$1002, 'RelatedImageHeight', 1, rsRelatedImageHeight); + AddStringTag (P+$8298, 'Copyright', 1, rsCopyright); + AddURationalTag(E+$829A, 'ExposureTime', 1, rsExposureTime, '', '', TExposureTimeTag); //, nil, '%0:.0f/%1:.0f s'); + AddURationalTag(E+$829D, 'FNumber', 1, rsFNumber); //, nil, 'F/%2:.1f'); + AddULongTag (P+$83BB, 'IPTC/NAA', 1, rsIPTCNAA); + AddStringTag (P+$8546, 'SEMInfo', 1, rsSEMInfo); + AddBinaryTag (P+$8649, 'PhotoShopSettings', 1, ''); + AddULongTag (P+$8769, 'ExifOffset', 1, rsExifOffset, '', '', TSubIFDTag, true); + AddBinaryTag (P+$83BB, 'IPTC', 1, rsIPTCNAA); + AddUShortTag (E+$8822, 'ExposureProgram', 1, rsExposureProgram, rsExposureProgramLkup); + AddStringTag (E+$8824, 'SpectralSensitivity', 1, rsSpectralSensitivity); + AddULongTag (P+$8825, 'GPSInfo', 1, rsGPSInfo, '', '', TSubIFDTag); + AddULongTag (E+$8827, 'ISO', 1, rsISO); + AddUShortTag (E+$882A, 'TimeZoneOffset', 2, rsTimeZoneOffset); + AddUShortTag (E+$882B, 'SelfTimerMode', 1, rsSelfTimerMode); + AddUShortTag (E+$8830, 'SensitivityType', 1, rsSensitivityType, rsSensitivityTypeLkup); + AddULongTag (E+$8831, 'StandardOutputSensitivity', 1, rsStdOutputSens); + AddULongTag (E+$8832, 'RecommendedExposureIndex', 1, rsRecExpIndex); + AddULongTag (E+$8833, 'ISOSpeed', 1, rsIsoSpeed); + AddULongTag (E+$8834, 'ISOSpeedLatitudeYYY', 1, rsIsoSpeedLatitudeYYY); + AddULongTag (E+$8835, 'ISOSpeedLatitudeZZZ', 1, rsIsoSpeedLatitudeZZZ); + AddBinaryTag (E+$9000, 'ExifVersion', 4, rsExifVersion, '', '', TVersionTag); + AddStringTag (E+$9003, 'DateTimeOriginal', 1, rsDateTimeOriginal, '', TDateTimeTag); + AddStringTag (E+$9004, 'DateTimeDigitized', 1, rsDateTimeDigitized, '', TDateTimeTag); + AddStringTag (E+$9010, 'OffsetTime', 1, rsOffsetTime); + AddStringTag (E+$9011, 'OffsetTimeOriginal', 1, rsOffsetTimeOriginal); + AddStringTag (E+$9012, 'OffsetTimeDigitized', 1, rsOffsetTimeDigitized); + AddBinaryTag (E+$9101, 'ComponentsConfiguration', 1, rsComponentsConfig, '', '', TComponentsConfigTag, true); + AddURationalTag(E+$9102, 'CompressedBitsPerPixel', 1, rsCompressedBitsPerPixel); + AddSRationalTag(E+$9201, 'ShutterSpeedValue', 1, rsShutterSpeedValue, '', '', TShutterSpeedTag); + AddURationalTag(E+$9202, 'ApertureValue', 1, rsApertureValue, '', 'F/%2:.1f', TApertureTag); + AddSRationalTag(E+$9203, 'BrightnessValue', 1, rsBrightnessValue); + AddSRationalTag(E+$9204, 'ExposureBiasValue', 1, rsExposureBiasValue); + AddURationalTag(E+$9205, 'MaxApertureValue', 1, rsMaxApertureValue, '', 'F/%2:.1f', TApertureTag); + AddURationalTag(E+$9206, 'SubjectDistance', 1, rsSubjectDistance); + AddUShortTag (E+$9207, 'MeteringMode', 1, rsMeteringMode, rsMeteringModeLkup); + AddUShortTag (E+$9208, 'LightSource', 1, rsLightSource, rsLightSourceLkup); + AddUShortTag (E+$9209, 'Flash', 1, rsFlash, rsFlashLkup); + AddURationalTag(E+$920A, 'FocalLength', 1, rsFocalLength, '', '%2:.1f mm'); + AddULongTag (E+$9211, 'ImageNumber', 1, rsImageNumber); + AddStringTag (E+$9212, 'SecurityClassification', 1, rsSecurityClassification); + AddStringTag (E+$9213, 'ImageHistory', 1, rsImageHistory); + AddUShortTag (E+$9214, 'SubjectArea', 4, rsSubjectArea); + AddBinaryTag (E+$927C, 'MakerNote', 1, rsMakerNote, '', '', TMakerNoteTag, true); + AddBinaryTag (E+$9286, 'UserComment', 1, rsUserComment, '', '', TUserCommentTag); + AddStringTag (E+$9286, 'SubSecTime', 1, rsSubSecTime); + AddStringTag (E+$9291, 'SubSecTimeOriginal', 1, rsSubSecTimeOriginal); + AddStringTag (E+$9292, 'SubSecTimeDigitized', 1, rsSubSecTimeDigitized); + AddURationalTag(E+$9400, 'Temperature', 1, rsTemperature); + AddURationalTag(E+$9401, 'Humidity', 1, rsHumidity); + AddURationalTag(E+$9402, 'Pressure', 1, rsPressure); + AddSRationalTag(E+$9403, 'WaterDepth', 1, rsWaterDepth); + AddURationalTag(E+$9404, 'Acceleration', 1, rsAcceleration); + AddURationalTag(E+$9405, 'CameraElevationAngle', 1, rsCameraElevationAngle); + AddBinaryTag (P+$9C9B, 'XPTitle', 1, '', '', '', TXPTag); + AddBinaryTag (P+$9C9C, 'XPComment', 1, '', '', '', TXPTag); + AddBinaryTag (P+$9C9D, 'XPAuthor', 1, '', '', '', TXPTag); + AddBinaryTag (P+$9C9E, 'XPKeywords', 1, '', '', '', TXPTag); + AddBinaryTag (P+$9C9F, 'XPSubject', 1, '', '', '', TXPTag); + AddBinaryTag (E+$A000, 'FlashPixVersion', 1, rsFlashPixVersion, '', '', TVersionTag); + AddUShortTag (E+$A001, 'ColorSpace', 1, rsColorSpace, rsColorSpaceLkup); + AddUShortTag (E+$A002, 'ExifImageWidth', 1, rsExifImageWidth); + AddUShortTag (E+$A003, 'ExifImageHeight', 1, rsExifImageHeight); // is called "ExifImageLength" in Specs + AddStringTag (E+$A004, 'RelatedSoundFile', 1, rsRelatedSoundFile); + AddULongTag (E+$A005, 'InterOperabilityOffset', 1, rsInterOpOffset, '', '', TSubIFDTag, true); + AddURationalTag(E+$A20B, 'FlashEnergy', 1, rsFlashEnergy); + AddBinaryTag (E+$A20C, 'SpatialFrequencyResponse', 1, rsSpatialFrequResponse); + AddURationalTag(E+$A20E, 'FocalPlaneXResolution', 1, rsFocalPlaneXRes, '', '%2:f'); + AddURationalTag(E+$A20F, 'FocalPlaneYResolution', 1, rsFocalPlaneYRes, '', '%2:f'); + AddUShortTag (E+$A210, 'FocalPlaneResolutionUnit', 1, rsFocalPlaneResUnit, rsFocalPlaneResUnitLkup); + AddBinaryTag (E+$A211, 'ImageNumber', 1, rsImageNumber); + AddStringTag (E+$A212, 'SecurityClassification', 1, rsSecurityClassification); + AddBinaryTag (E+$A213, 'ImageHistory', 1, rsImageHistory); + AddUShortTag (E+$A214, 'SubjectLocation', 2, rsSubjectLocation); + AddURationalTag(E+$A215, 'ExposureIndex', 1, rsExposureIndex); + AddUShortTag (E+$A217, 'SensingMethod', 1, rsSensingMethod, rsSensingMethodLkup); + AddBinaryTag (E+$A300, 'FileSource', 1, rsFileSource, rsFileSourceLkup); + AddBinaryTag (E+$A301, 'SceneType', 1, rsSceneType, rsSceneTypeLkup); + AddBinaryTag (E+$A302, 'CFAPattern', 1, rsCFAPattern); + AddUShortTag (E+$A401, 'CustomRendered', 1, rsCustomRendered, rsCustomRenderedLkup); + AddUShortTag (E+$A402, 'ExposureMode', 1, rsExposureMode, rsExposureModeLkup); + AddUShortTag (E+$A403, 'WhiteBalance', 1, rsWhiteBalance, rsAutoManual); + AddURationalTag(E+$A404, 'DigitalZoomRatio', 1, rsDigitalZoomRatio); + AddUShortTag (E+$A405, 'FocalLengthIn35mmFilm', 1, rsFocalLengthIn35mm, '', '%d mm'); + AddUShortTag (E+$A406, 'SceneCaptureType', 1, rsSceneCaptureType, rsSceneCaptureTypeLkup); + AddUShortTag (E+$A407, 'GainControl', 1, rsGainControl, rsGainControlLkup); + AddUShortTag (E+$A408, 'Contrast', 1, rsContrast, rsNormalLowHigh); + AddUShortTag (E+$A409, 'Saturation', 1, rsSaturation, rsNormalLowHigh); + AddUShortTag (E+$A40A, 'Sharpness', 1, rsSharpness, rsNormalSoftHard); + AddBinaryTag (E+$A40B, 'DeviceSettingDescription', 1, rsDeviceSettingDescription); + AddUShortTag (E+$A40C, 'SubjectDistanceRange', 1, rsSubjectDistancerange, rsSubjectDistanceRangeLkup); + AddStringTag (E+$A420, 'ImgeUniqueID', 1, rsImageUniqueID); + AddStringTag (E+$A430, 'OwnerName', 1, rsOwnerName); + AddStringTag (E+$A431, 'SerialNumber', 1, rsSerialNumber); + AddURationalTag(E+$A432, 'LensInfo', 4, rsLensInfo); + AddStringTag (E+$A433, 'LensMake', 1, rsLensMake); + AddStringTag (E+$A434, 'LensModel', 1, rsLensModel); + AddStringTag (E+$A435, 'LensSerialNumber', 1, rsLensSerialNumber); + AddURationalTag(E+$A500, 'Gamma', 1, rsGamma); + AddBinaryTag (P+$C4A5, 'PrintIM', $FFFF, '', '', '', nil, true); + AddBinaryTag (P+$C6D2, 'PanasonicTitle', $FFFF, '', '', '', nil, true); + AddBinaryTag (P+$C6D3, 'PanasonicTitle2', $FFFF, '', '', '', nil, true); + AddBinaryTag (E+$EA1C, 'Padding', $FFFF, '', '', '', nil, true); + AddSLongTag (E+$EA1D, 'OffsetSchema', 1, '', '', '', nil, true); + AddByteTag (G+$0000, 'GPSVersionID', 4, rsGpsVersionID, '', '', TVersionTag); + AddStringTag (G+$0001, 'GPSLatitudeRef', 2, rsGPSLatitudeRef, rsGPSLatitudeRefLkup); + AddURationalTag(G+$0002, 'GPSLatitude', 3, rsGPSLatitude, '', '%0:.0f° %1:.0f'' %2:.3f"', TGPSPositionTag); + AddStringTag (G+$0003, 'GPSLongitudeRef', 2, rsGPSLongitudeRef, rsGPSLongitudeRefLkup); + AddURationalTag(G+$0004, 'GPSLongitude', 3, rsGPSLongitude, '', '%0:.0f° %1:.0f'' %2:.3f"', TGPSPositionTag); + AddByteTag (G+$0005, 'GPSAltitudeRef', 1, rsGPSAltitudeRef, rsGPSAltitudeRefLkup); + AddURationalTag(G+$0006, 'GPSAltitude', 1, rsGPSAltitude); + AddURationalTag(G+$0007, 'GPSTimeStamp', 3, rsGPSTimeStamp); // !!!!!!!!!!!, nil, '', @CvtTime); + AddStringTag (G+$0008, 'GPSSatellites', 1, rsGPSSatellites); + AddStringTag (G+$0009, 'GPSStatus', 2, rsGPSStatus); + AddStringTag (G+$000A, 'GPSMeasureMode', 2, rsGPSMeasureMode, rsGPSMeasureModeLkup); + AddURationalTag(G+$000B, 'GPSDOP', 1, rsGPSDOP); + AddStringTag (G+$000C, 'GPSSpeedRef', 2, rsGPSSpeedRef, rsGPSSpeedRefLkup); + AddURationalTag(G+$000D, 'GPSSpeed', 1, rsGPSSpeed); + AddStringTag (G+$000E, 'GPSTrackRef', 2, rsGPSTrackRef, rsGPSTrackRefLkup); + AddURationalTag(G+$000F, 'GPSTrack', 1, rsGPSTrack); + AddStringTag (G+$0010, 'GPSImageDirectionRef', 2, rsGPSImageDirectionRef, rsGPSTrackRefLkup); // same option texts + AddURationalTag(G+$0011, 'GPSImageDirection', 1, rsGPSImageDirection); + AddStringTag (G+$0012, 'GPSMapDatum', 1, rsGPSMapDatum); + AddStringTag (G+$0013, 'GPSDestLatitudeRef', 2, rsGPSDestLatitudeRef, rsGPSLatitudeRefLkup); + AddURationalTag(G+$0014, 'GPSDestLatitude', 3, rsGPSDestLatitude, '', '%0:.0f° %1:.0f'' %2:.3f"', TGPSPositionTag); + AddStringTag (G+$0015, 'GPSDestLongitudeRef', 2, rsGPSDestLongitudeRef, rsGPSLongitudeRefLkup); + AddURationalTag(G+$0016, 'GPSDestLongitude', 3, rsGPSDestLongitude, '', '%0:.0f° %1:.0f'' %2:.3f"', TGPSPositionTag); + AddStringTag (G+$0017, 'GPSDestBearingRef', 2, rsGPSDestBearingRef, rsGPSTrackRefLkup); + AddURationalTag(G+$0018, 'GPSDestBearing', 1, rsGPSDestBearing); + AddStringTag (G+$0019, 'GPSDestDistanceRef', 2, rsGPSDestDistanceRef, rsGPSDistanceRefLkup); + AddURationalTag(G+$001A, 'GPSDestDistance', 1, rsGPSDestDistance); + AddBinaryTag (G+$001B, 'GPSProcessingMode', 1, rsGPSProcessingMode); + AddBinaryTag (G+$001C, 'GPSAreaInformation', 1, rsGPSAreaInformation); + AddStringTag (G+$001D, 'GPSDateStamp', 11, rsGPSDateStamp); + AddUShortTag (G+$001E, 'GPSDifferential', 1, rsGPSDateDifferential, rsGPSDateDifferentialLkup); + AddURationalTag(G+$001F, 'GPSHPositioningError', 1, rsGPSHPositioningError); + end; +end; + +function FindExifTagDef(ATagID: TTagID): TTagDef; +begin + if ExifTagDefs = nil then + BuildExifTagDefs; + Result := ExifTagDefs.FindByID(ATagID); +end; + +function FindExifTagDef(AFullTagName: String): TTagDef; +begin + if ExifTagDefs = nil then + BuildExifTagDefs; + Result := ExifTagDefs.FindByName(AFullTagName); +end; + +{ seeks for the definition of the tag specified by the given id of the tag part + only, the parent ID is ignored. } +function FindExifTagDefWithoutParent(ATagID: Word): TTagDef; +begin + if ExifTagDefs = nil then + BuildExifTagDefs; + Result := ExifTagDefs.FindByIDWithoutParent(ATagID); +end; + +procedure FreeExifTagDefs; +begin + FreeAndNil(ExifTagDefs); +end; + + +//============================================================================== +// TExifData +//============================================================================== + +constructor TExifData.Create(ABigEndian: Boolean); +begin + BuildExifTagDefs; + FTagList := TTagList.Create; + FBigEndian := ABigEndian; + FExportOptions := [eoShowTagName, eoDecodeValue, eoTruncateBinary]; +end; + +destructor TExifData.Destroy; +begin + FTagList.Free; + inherited; +end; + +function TExifData.AddMakerNoteTag(AIndex: Integer; ATagID: TTagID; ATagName: String; + ADataValue: Integer; ALkupTbl: String = ''; AFormatStr: String = ''; + ATagType: TTagType = ttUInt16): Integer; +var + tag: TTag; +begin + tag := TMakerNoteIntegerTag.Create(ATagID, AIndex, ATagName, ADataValue, + ALkupTbl, AFormatStr, ATagType, ExportOptionsToTagOptions); + Result := FTagList.Add(tag); +end; + +function TExifData.AddMakerNoteTag(AIndex: Integer; ATagID: TTagID; ATagName: String; + ADataValue: Double; AFormatStr: String = ''; + ATagType: TTagType = ttURational): Integer; +var + tag: TTag; +begin + tag := TMakerNoteFloatTag.Create(ATagID, AIndex, ATagName, ADataValue, + AFormatStr, ATagType, ExportOptionsToTagOptions); + Result := FTagList.Add(tag); +end; + +function TExifData.AddOrReplaceTag(ATag: TTag): Integer; +begin + Result := IndexOfTagID(ATag.TagID); + if Result <> -1 then begin + FTagList.Delete(Result); + FTagList.Insert(Result, ATag); + end else + Result := AddTag(ATag); +end; + +function TExifData.AddTag(ATag: TTag): Integer; +var + parentID: TTagID; + parentTag: TTag; + parentTagDef: TTagDef; +begin + parentID := ATag.TagID and $FFFF0000; + if not ((parentID = TAGPARENT_PRIMARY) or (parentID = TAGPARENT_THUMBNAIL)) + then begin + // Make sure that the parent directories of the new tag already exist. + // If not, create them. + repeat + // Look if the parent tag already exists. + parentTag := GetParentTag(ATag); + if parentTag <> nil then + break; + + // No - not found... + // The tagID of the tag which defines the subIFD is encoded in the high-word + // of the tagID + parentID := TTagIDRec(ATag.TagID).Parent; + // Just to make sure: the primary and thumbnail IFDs are always existing... + if (parentID = TAG_PRIMARY) or (parentID = TAG_THUMBNAIL) then + break; + // Find definition of the sub-ifd tag + parentTagDef := FindExifTagDefWithoutParent(parentID); + // ... create tag for it + parentTag := TSubIFDTag.Create(parentTagDef, FBigEndian); + // ... and add it to the list (recursively, i.e. it will check for parents again) + AddOrReplaceTag(parentTag); + until false; + end; + + // Add the new tag + Result := FTagList.Add(ATag); +end; + +function TExifData.AddTagByID(ATagID: TTagID): TTag; +var + idx: Integer; + tagDef: TTagDef; +begin + idx := IndexOfTagID(ATagID); + if idx > -1 then + Result := FTagList[idx] + else begin + tagDef := FindExifTagDef(ATagID); + Result := InternalAddTag(tagDef); + end; +end; + +function TExifData.AddTagByName(AFullTagName: String): TTag; +var + idx: Integer; + tagdef: TTagDef; +begin + idx := IndexOfTagName(AFullTagName); + if idx > -1 then + Result := FTagList[idx] + else begin + tagDef := FindExifTagDef(AFullTagName); + Result := InternalAddTag(tagDef); + end; +end; + +procedure TExifData.BeginReading; +begin + inc(FReadFlag); + if FReadFlag = 1 then + DoBeginReading; +end; + +{ Checks whether the tag "FocalLengthIn35mm" is available. Otherwise it is + created as a volatile, readonly tag. } +procedure TExifData.CheckFocalLengthIn35mm; +var + tag: TTag; + fpu, flen, resol: Double; + ccdwidth, ccdheight, ratio: Double; + tagdef: TTagDef; + optns: TTagOptions; +begin + tag := TagByID[FULLTAG_FOCALLENGTH35mm]; + if tag <> nil then + exit; + + tag := TagByName['Exif.FocalLength']; + if tag = nil then + exit; + flen := tag.AsFloat; + if IsNaN(flen) or (flen <= 0.0) then + exit; + + tag := TagByName['Exif.FocalPlaneResolutionUnit']; + if tag = nil then + tag := TagByName['ResolutionUnit']; + if tag = nil then + exit; + fpu := tag.AsFloat; + if IsNaN(fpu) or (fpu <= 0) then + exit; + + tag := TagByName['Exif.FocalPlaneResolutionX']; + if tag = nil then + exit; + resol := tag.AsFloat; + if IsNaN(resol) or (resol <= 0.0) then + exit; + ccdwidth := GetImgWidth() * fpu/resol; + + tag := TagByName['Exif.FocalPlaneResolutionY']; + if tag = nil then + exit; + resol := tag.AsFloat; + if IsNaN(resol) or (resol <= 0.0) then + exit; + ccdheight := GetImgHeight() * fpu/resol; + + ratio := sqrt(sqr(24) + sqr(36)) / sqrt(sqr(CCDWidth) + sqr(CCDHeight)); + + optns := [toReadOnly, toVolatile]; + if BigEndian then optns := optns + [toBigEndian]; + + tagDef := FindExifTagDef(FULLTAG_FOCALLENGTH35mm); + tag := TFloatTag.Create(tagDef, optns); + tag.AsFloat := flen * ratio; + AddOrReplaceTag(tag); +end; + +procedure TExifData.Clear; +begin + FTagList.Clear; +end; + +procedure TExifData.DoBeginReading; +begin + if Assigned(FOnBeginReading) then FOnBeginReading(); +end; + +procedure TExifData.DoEndReading; +begin + if Assigned(FOnEndReading) then FOnEndReading(); +end; + +procedure TExifData.EndReading; +begin + dec(FReadFlag); + if FReadFlag = 0 then begin + CheckFocalLengthIn35mm; + DoEndReading; + end; +end; + +function TExifData.ExportOptionsToTagOptions: TTagOptions; +begin + Result := []; + if eoDecodeValue in FExportOptions then + Include(Result, toDecodeValue); + if eoTruncateBinary in FExportOptions then + Include(Result, toTruncateBinary); + if eoBinaryAsASCII in FExportOptions then + Include(Result, toBinaryAsASCII); +end; + +procedure TExifData.ExportToStrings(AList: TStrings; ASeparator: String = '='; + AGroup: TTagGroup = tgUnknown); +var + i: Integer; + tag: TTag; + nam: String; + tagval: String; + usedExportOptions: TExportOptions; +begin + Assert(AList <> nil); + if AGroup = tgUnknown then begin + ExportToStrings(AList, ASeparator, tgExifPrimary); + ExportToStrings(AList, ASeparator, tgExifThumbnail); + ExportToStrings(AList, ASeparator, tgExifSub); + ExportToStrings(AList, ASeparator, tgExifGps); + ExportToStrings(AList, ASeparator, tgExifInterop); + ExportToStrings(AList, ASeparator, tgExifMakerNote); + exit; + end; + + if not HasTagsOfGroup(AGroup) then + exit; + + if AList.Count > 0 then + AList.Add(''); + AList.Add('*** ' + NiceGroupNames[AGroup] + ' ***'); + + for i := 0 to TagCount-1 do begin + tag := TagByIndex[i]; + if tag.Group = AGroup then begin + usedExportOptions := FExportOptions * [eoShowDecimalTagID, eoShowHexTagID]; + if usedExportOptions = [eoShowDecimalTagID] then + nam := Format('[%d %d] %s', [ + tag.TagIDRec.Parent, tag.TagIDRec.Tag, tag.Description + ]) + else + if usedExportOptions = [eoShowHexTagID] then + nam := Format('[$%.4x %.4x] %s', [ + tag.TagIDRec.Parent, tag.TagIDRec.Tag, tag.Description + ]) + else + nam := tag.Description; + tagval := tag.AsString; + if tagval <> '' then + AList.Add(nam + ASeparator + tagval); + end; + end; +end; + +{ Seeks the tag list for the tag with the specified (full) TagID. + The function returns nil if the tag is not found. } +function TExifData.FindTagByID(ATagID: TTagID): TTag; +var + i: Integer; +begin + for i:=0 to FTagList.Count-1 do + begin + Result := FTagList[i]; + if (Result.TagID = ATagID) then + exit; + end; + Result := nil; +end; + +{ Seeks the tag list for the tag with the specified name. The name must be + composed of the name of the tag group and the name of the tag, i.e. + 'EXIF.FNumber'. If the group is not specified (i.e. 'FNumber' only) the + first matching tag is returned (in spite of other tags possibly having the + same name in other groups). + The function returns nil if the tag is not found. } +function TExifData.FindTagByName(AFullTagName: String): TTag; +var + idx: Integer; +begin + idx := IndexOfTagName(AFullTagName); + if idx = -1 then + Result := nil + else + Result := FTagList[idx]; +end; + +function TExifData.GetImgHeight: Integer; +var + tag: TTag; +begin + tag := TagByName['ImageHeight']; + if tag = nil then + tag := TagByName['Exif.ExifImageHeight']; + if tag = nil then + result := 0 + else + Result := tag.AsInteger; +end; + +function TExifData.GetImgWidth: Integer; +var + tag: TTag; +begin + tag := TagByName['ImageWidth']; + if tag = nil then + tag := TagByName['Exif.ExifImageWidth']; + if tag = nil then + Result := 0 + else + Result := tag.AsInteger; +end; + +{ Finds the tag which defines the sub-IFD to which the specified tag belongs } +function TExifData.GetParentTag(ATag: TTag): TTag; +var + idx: Integer; +begin + Result := nil; + if ATag <> nil then begin + idx := FTagList.IndexOfParentByID(ATag.TagID); + if idx <> -1 then + Result := FTagList[idx]; + end; +end; + +{ Seeks the tag list for the tag with the specified TagID and the specified + tag group } +function TExifData.GetTagByID(ATagID: TTagID): TTag; +var + idx: Integer; +begin + idx := IndexOfTagID(ATagID); + if idx = -1 then + Result := nil + else + Result := FTagList.Items[idx]; +end; + +function TExifData.GetTagByIndex(AIndex: Integer): TTag; +begin + Result := FTagList[AIndex]; +end; + +{ Seeks the tag list for the tag with the specified name. The name must be + composed of the name of the tag group and the name of the tag, i.e. + 'EXIF.FNumber'. If the group is not specified (i.e. 'FNumber' only) the + first matching tag is returned (in spite of other tags possibly having the + same name in other groups). } +function TExifData.GetTagByName(AFullTagName: String): TTag; +var + idx: Integer; +begin + idx := IndexOfTagName(AFullTagName); + if idx > -1 then + Result := FTagList[idx] + else + Result := nil +end; + +function TExifData.GetTagCount: Integer; +begin + Result := FTagList.Count; +end; + +function TExifData.HasTagsOfGroup(AGroup: TTagGroup): Boolean; +var + i: Integer; + tag: TTag; +begin + Result := true; + for i:=0 to FTagList.Count-1 do begin + tag := FTagList[i]; + if (tag.Group = AGroup) then + exit; + end; + Result := false; +end; + +function TExifData.HasThumbnail: Boolean; +begin + Result := Length(FThumbnailBuffer) > 0; +end; + +function TExifData.IndexOfTagID(ATagID: TTagID): Integer; +begin + Result := FTagList.IndexOfTagByID(ATagID); +end; + +function TExifData.IndexOfTagName(AFullTagName: String): Integer; +var + gname: String; + tname: String; + p: Integer; + g: TTagGroup; + i: Integer; + tag: TTag; +begin + p := pos('.', AFullTagName); + if p <> 0 then + begin + gname := copy(AFullTagName, 1, p-1); + tname := copy(AFullTagName, p+1, MaxInt); + for g := Low(TTagGroup) to High(TTagGroup) do + if SameText(gname, GroupNames[g]) or SameText(gname, NiceGroupNames[g]) then begin + for i:=0 to FTagList.Count-1 do begin + tag := FTagList[i]; + if SameText(tag.Name, tname) and (tag.Group = g) then begin + Result := i; + exit; + end; + end; + end; + end else + begin + for i:=0 to FTagList.Count-1 do begin + tag := FTagList[i]; + if SameText(tag.Name, AFullTagName) then begin + Result := i; + exit; + end; + end; + end; + Result := -1; +end; + +function TExifData.InternalAddTag(ATagDef: TTagDef): TTag; +var + optns: TTagOptions; +begin + if ATagDef <> nil then begin + optns := ExportOptionsToTagOptions; + if FBigEndian then Include(optns, toBigEndian); + Result := ATagDef.TagClass.Create(ATagDef, optns); + AddTag(Result); + end else + Result := nil +end; + +function TExifData.IsReading: Boolean; +begin + Result := FReadFlag > 0; +end; + +procedure TExifData.LoadThumbnailFromStream(AStream: TStream; + ASize: Integer = -1; AUpdateThumbnailTags: Boolean = true); +var + n: Integer; + w, h: Integer; +begin + SetLength(FThumbnailBuffer, 0); + if AUpdateThumbnailTags then + RemoveThumbnail; + + // Check whether the image is a jpeg, and extract size of the thrumbnail image + if not JPEGImageSize(AStream, w, h) then + raise EFpExif.Create('Only jpeg images accepted for thumbnail.'); + + // Write the image from the stream into the thumbnail buffer + if ASize < 0 then + n := AStream.Size else + n := ASize; + if n > 65000 then // limit probably still too high, thumbnail must fit into a 64k segment along with all other tags... + raise EFpExif.Create('Thumbnail too large.'); + + SetLength(FThumbnailBuffer, n); + if AStream.Read(FThumbnailBuffer[0], n) < n then + raise EFpExif.Create('Could not read thumbnail image.'); + + if AUpdateThumbnailTags then + begin + // Make sure that the IFD1 tags for the thumbnail are correct + AddTagByID(FULLTAG_THUMBCOMPRESSION).AsInteger := 6; // 6 = JPEG - this was checked above. + AddTagByID(FULLTAG_THUMBWIDTH).AsInteger := w; + AddTagByID(FULLTAG_THUMBLENGTH).AsInteger := h; + AddTagByID(FULLTAG_THUMBSTARTOFFSET).AsInteger := 0; // to be replaced by the offset to the thumbnail when writing + AddTagByID(FULLTag_THUMBSIZE).AsInteger := n; + end; +end; + +procedure TExifData.RemoveThumbnail; +var + tag: TTag; + i: Integer; +begin + SetLength(FThumbnailBuffer, 0); + + for i:=FTagList.Count-1 downto 0 do begin + tag := FTagList[i]; + if tag.Group = tgExifThumbnail then + FTagList.Delete(i) + end; +end; + +procedure TExifData.SaveThumbnailToStream(AStream: TStream); +var + n: Int64; +begin + if HasThumbnail then + begin + n := Length(FThumbnailBuffer); + if AStream.Write(FThumbnailBuffer[0], n) <> n then + raise EFpExif.Create('Error writing thumbnail image to stream.'); + end; +end; + +procedure TExifData.SetExportOptions(const AValue: TExportOptions); +var + i: Integer; + tag: TTag; + decodeVal, truncBin, binASCII: Boolean; + needUpdate: Boolean; + optns: set of TExportOption; +begin + optns := [eoDecodeValue, eoTruncateBinary, eoBinaryAsASCII]; + needUpdate := (optns * FExportOptions <> optns * AValue); + FExportOptions := AValue; + if not needUpdate then + exit; + + decodeVal := eoDecodeValue in FExportOptions; + truncBin := eoTruncateBinary in FExportOptions; + binASCII := eoBinaryAsASCII in FExportOptions; + for i:=0 to TagCount-1 do + begin + tag := TagByIndex[i]; + tag.DecodeValue := decodeVal; + tag.TruncateBinary := truncBin; + tag.BinaryAsASCII := binASCII; + end; +end; + +procedure TExifData.SetTagByID(ATagID: TTagID; ATag: TTag); +var + idx: Integer; +begin + if (ATag <> nil) and ATag.ReadOnly then + exit; + + idx := IndexOfTagID(ATagID); + SetTagByIndex(idx, ATag); +end; + +procedure TExifData.SetTagByIndex(AIndex: Integer; 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 + AddOrReplaceTag(ATag); +end; + +procedure TExifData.SetTagByName(AFullTagName: String; ATag: TTag); +var + idx: Integer; +begin + if (ATag <> nil) and ATag.ReadOnly then + exit; + + idx := IndexOfTagName(AFullTagName); + SetTagByIndex(idx, ATag); +end; + +function TExifData.ThumbnailSize: Integer; +begin + Result := Length(FThumbnailBuffer); +end; + + +//============================================================================== +// TVersionTag +//============================================================================== + +function TVersionTag.GetAsString: String; +var + i: Integer; + ch: Char; +begin + for i:=0 to High(FRawData) do begin + if (FType = ttUInt8) then + ch := char(ord('0') + FRawData[i]) + else + ch := char(FRawData[i]); + if i = 0 then + Result := ch + else + if FSeparator = #0 then + Result := Result + ch + else + Result := Result + FSeparator + ch; + end; +end; + +procedure TVersionTag.SetAsString(const AValue: String); +var + i, n: Integer; + sa: ansistring; + b: Byte; +begin + sa := ansistring(AValue); + SetLength(FRawData, Length(sa)); + i := 1; + n := 0; + while i <= Length(sa) do begin + if sa[i] <> FSeparator then + begin + if (FType = ttUInt8) then + b := ord(sa[i]) - ord('0') + else + b := ord(sa[i]); + FRawData[n] := b; + inc(n); + end; + inc(i); + end; + SetLength(FRawData, n); + FCount := n; +end; + + +//============================================================================== +// TComponentsConfigTag +//============================================================================== +function TComponentsConfigTag.GetAsString: String; +var + i: Integer; +begin + Result := ''; + for i:=0 to 3 do + case FRawData[i] of + 1: Result := Result + 'Y'; + 2: Result := Result + 'Cb'; + 3: Result := Result + 'Cr'; + 4: Result := Result + 'R'; + 5: Result := Result + 'G'; + 6: Result := Result + 'B'; + end; +end; + +procedure TComponentsConfigTag.SetAsString(const AValue: String); +var + i, j: Integer; + s: String; + elem: String; +begin + SetLength(FRawData, 4); + FCount := 4; + s := InsertSpaces(AValue) + ' '; + elem := ''; + j := 0; + for i:=1 to Length(s) do begin + if (s[i] >= 'A') and (s[i] <= 'Z') then + elem := s[i] + else + if (s[i] = ' ') then begin + if elem = 'Y' then + FRawData[j] := 1 + else + if elem = 'Cb' then + FRawData[j] := 2 + else + if elem = 'Cr' then + FRawData[j] := 3 + else + if elem = 'R' then + FRawdata[j] := 4 + else + if elem = 'G' then + FRawData[j] := 5 + else + if elem = 'B' then + FRawData[j] := 6 + else + continue; + inc(j); + if j = 4 then + exit; + end else + elem := elem + s[i]; + end; +end; + + +//============================================================================== +// TDateTimeTag +//============================================================================== + +procedure TDateTimeTag.AdjustBy(ADays, AHours, AMinutes, ASeconds: Integer); +var + dt: TDateTime; +begin + dt := GetDateTime; + dt := dt + ADays + AHours/24 + AMinutes/(24*60) + ASeconds/(24*60*60); + SetDateTime(dt); +end; + +function TDateTimeTag.ExifDateToDateTime(AStr: string): TDateTime; +type + TConvert= packed record + year: Array [1..4] of char; f1:char; + mon: Array [1..2] of char; f2:char; + day: Array [1..2] of char; f3:char; + hr: Array [1..2] of char; f4:char; + min: Array [1..2] of char; f5:char; + sec: Array [1..2] of char; + end; + PConvert= ^TConvert; +var + yr, mn, dy, h, m, s: Integer; + d: TDateTime; + t: TDateTime; +begin + Result := 0; + if Length(AStr) = 10 then + AStr := AStr + ' 00:00:00'; + if Length(AStr) * SizeOf(Char) >= SizeOf(TConvert) then // take care of Delphi's WideChars + with PConvert(@AStr[1])^ do + if TryStrToInt(year, yr) and + TryStrToInt(mon, mn) and + TryStrToInt(day, dy) and + TryEncodeDate(yr, mn, dy, d) + and + TryStrToInt(hr, h) and + TryStrToInt(min, m) and + TryStrToInt(sec, s) and + TryEncodeTime(h, m, s, 0, t) + then + Result := d + t; +end; + +function TDateTimeTag.GetAsString: String; +var + dt: TDateTime; + i: Integer; +begin + dt := GetDateTime; + Result := FormatDateTime(GetFormat, dt); + if dt = 0 then + for i:= 1 to Length(Result) do + if Result[i] in ['1'..'9'] then Result[i] := '0'; +end; + +function TDateTimeTag.GetDateTime: TDateTime; +var + s: String; +begin + s := inherited GetAsString; + Result := ExifDateToDateTime(s); +end; + +function TDateTimeTag.GetFormat: String; +begin + Result := IfThen(FFormatStr = '', + fpExifFmtSettings.ShortDateFormat + ' ' + fpExifFmtSettings.LongTimeFormat, + FFormatStr + ); +end; + +procedure TDateTimeTag.SetAsString(const AValue: String); +var + d: TDateTime; + {$IFNDEF FPC} + fs: TFormatSettings; + p: Integer; + fmt: String; + {$ENDIF} +begin + {$IFDEF FPC} + d := ScanDateTime(GetFormat, AValue); + {$ELSE} + fmt := GetFormat; + fs := fpExifFmtSettings; + p := pos(' ', fmt); + if p <> 0 then begin + fs.ShortDateFormat := Copy(fmt, 1, p-1); + fs.LongTimeFormat := Copy(fmt, p+1, MaxInt); + d := StrToDateTime(AValue, fs); + end else begin + fs.ShortDateFormat := fmt; + d := StrToDate(AValue, fs); + end; + {$ENDIF} + SetDateTime(d); +end; + +procedure TDateTimeTag.SetDateTime(const AValue: TDateTime); +var + s: string; +begin + s := FormatDateTime(EXIF_DATETIME_FORMAT, AValue); + inherited SetAsString(s); +end; + + +//============================================================================== +// TGPSPositionTag +//============================================================================== + +function TGPSPositionTag.GetAsFloat: Double; +var + arr: TExifDoubleArray; +begin + arr := GetAsFloatArray; + Result := arr[0] + arr[1]/60 + arr[2]/3600; +end; + +{ Parmeters in the FormatString are expected to be in this order + #0 degrees as integer + #1 minutes as integer + #2 seconds as float + #3 minutes + seconds as float (mins) + #4 degrees + minutes + seconds as float (degs) + Example: '%0:d° %3:.6'' --> 45° 12.123456' } +function TGPSPositionTag.GetAsString: String; +var + arr: TExifDoubleArray; + degs: Double; + mins: Double; +begin + arr := GetAsFloatArray; + if Length(arr) = 0 then begin + Result := ''; + exit; + end; + + degs := arr[0] + arr[1]/60 + arr[2]/3600; // Fix me: consider the case that all may be floats + mins := arr[1] + arr[2]/60; + Result := Format(FFormatStr, [arr[0], arr[1], arr[2], mins, degs], FpExifFmtSettings); +end; + +procedure TGPSPositionTag.SetAsFloat(const AValue: Double); +var + arr: TExifDoubleArray; +begin + SetLength(arr, 3); + SplitGps(AValue, arr[0], arr[1], arr[2]); + SetAsFloatArray(arr); +end; + +procedure TGPSPositionTag.SetAsString(const AValue: String); +var + deg: Double; +begin + if TryStrToGps(AValue, deg) then + SetAsFloat(deg) + else + raise EFpExif.CreateFmt('"%s" is not a valid GPS position string.', [AValue]); +end; + + +//============================================================================== +// TMakerNoteTag +//============================================================================== +constructor TMakerNoteIntegerTag.Create(ATagID, AIndex: Integer; AName: String; + AValue: Integer; ALkupTbl, AFormatStr: String; ATagType: TTagType; + AOptions: TTagOptions); +begin + if not (ATagType in [ttUInt8, ttUInt16, ttUInt32, ttSInt8, ttSInt16, ttSInt32]) then + raise EFpExif.Create('Tag type not allowed for TMakerNoteIntegerTag'); + + FTagID := ATagID; //AIndex; + FGroup := tgExifMakerNote; + FName := AName; + FDesc := ''; + FType := ATagType; + FLkupTbl := ALkupTbl; + FFormatStr := AFormatStr; + FOptions := [toReadOnly, toVolatile] + AOptions; + FCount := 1; + SetLength(FRawData, TagElementSize[ord(FType)]); + SetInteger(0, AValue, false); // false: MakeNote tags are poorly defined -> don't crash +end; + +constructor TMakerNoteFloatTag.Create(ATagID, AIndex: Integer; AName: String; + AValue: Double; AFormatStr: String; ATagType: TTagType; + AOptions: TTagOptions); +begin + if not (ATagType in [ttURational, ttSRational]) then + raise EFpExif.Create('Tag type not allowed for TMakerNoteFloatTag'); + + FTagID := ATagID; //AIndex; + FGroup := tgExifMakerNote; + FName := AName; + FDesc := ''; + FType := ATagType; + FFormatStr := AFormatStr; + FOptions := [toReadOnly, toVolatile] + AOptions; + + AsFloat := AValue; +end; + + +//============================================================================== +// TExposureTimeTag +//============================================================================== +{ The FormatStr of the ExposureTag consists of 2 sections separated by a colon: + - 1st part for times < 1s, using reciprocal exposure time + - 2nd part for times >= 1s, using (non-reciprocal) exposure time + If only a single section is used then it is applied to all + (non-reciprocal) exposure times. + Example: '1/%.0f;%.0f' } +function TExposureTimeTag.GetAsString: String; +var + floatVal: Double; + fmt1, fmt2: String; + p: Integer; +begin + floatVal := GetAsFloat; + if FFormatStr = '' then begin + if IsNaN(floatVal) then + Result := '' + else if floatVal >= 10 then + Result := Format('%.0fs', [floatVal]) + else if floatVal >= 1 then + Result := Format('%.1fs', [floatVal]) + else + Result := Format('1/%.0fs', [1.0/floatVal]); + end else + begin + p := pos(';', FFormatStr); + if p > 0 then begin + fmt1 := copy(FFormatStr, 1, p-1); + fmt2 := copy(FFormatStr, p+1, MaxInt); + if floatVal < 1.0 then + Result := Format(fmt1, [1.0/floatVal]) + else + Result := Format(fmt2, [floatVal]); + end else + Result := Format(FFormatStr, [floatVal]); + end; +end; + +procedure TExposureTimeTag.SetAsString(const AValue: String); +var + i: Integer; + s, sNum, sDenom: String; + r: TExifRational; + floatVal: Double; + code: Integer; +begin + s := ''; + snum := ''; + sdenom := ''; + for i:=1 to Length(AValue) do + if AValue[i] in ['0'..'9','.'] then + s := s + AValue[i] + else + if AValue[i] = ',' then + s := s + '.' + else + if AValue[i] = '/' then begin + snum := s; + s := ''; + end; + if snum <> '' then begin + sdenom := s; + r.Numerator := StrToInt(snum); + r.Denominator := StrToInt(sdenom); + SetAsRational(r); + end else begin + val(s, floatVal, code); + SetAsFloat(floatVal); + end; +end; + + +//============================================================================== +// TShutterSpeedTag +// +// Sputter speed value (Tv) is stored in APEX units: +// Tv := -log2(t), t = exposure time in seconds +// http://www.cipa.jp/std/documents/e/DC-008-2012_E.pdf +//============================================================================== + +function TShutterSpeedTag.GetRational(AIndex: Integer; + out AValue: TExifRational): Boolean; +var + r: TExifRational; + dbl: double; +begin + Result := inherited GetRational(AIndex, r); + if Result then begin + dbl := r.Numerator / r.Denominator; + AValue := FloatToRational(Power(2.0, -dbl), 1E-9); + end; +end; + +procedure TShutterSpeedTag.SetFloat(AIndex: integer; const AValue: Double); +begin + inherited SetFloat(AIndex, -log2(AValue)); +end; + +procedure TShutterSpeedTag.SetRational(AIndex: Integer; const AValue: TExifRational); +begin + SetFloat(AIndex, AValue.Numerator / AValue.Denominator); +end; + + +//============================================================================== +// TApertureTag +// +// Aperture value (AV) is stored in APEX units: +// AV = 2 log2(FNumber) +// see http://www.cipa.jp/std/documents/e/DC-008-2012_E.pdf +//============================================================================== + +function TApertureTag.GetFloat(AIndex: Integer; out AValue: Double): Boolean; +var + dbl: Double; +begin + Result := inherited GetFloat(AIndex, dbl); + AValue := Power(2.0, dbl * 0.5); +end; + +function TApertureTag.GetRational(AIndex: Integer; + out AValue: TExifRational): Boolean; +var + r: TExifRational; + dbl: Double; +begin + Result := inherited GetRational(AIndex, r); + dbl := r.Numerator / r.Denominator; + AValue := FloatToRational(Power(2.0, dbl/2), 1E-9); +end; + +procedure TApertureTag.SetFloat(AIndex: integer; const AValue: Double); +begin + inherited SetFloat(AIndex, 2.0 * log2(AValue)); +end; + +procedure TApertureTag.SetRational(AIndex: Integer; const AValue: TExifRational); +begin + SetFloat(AIndex, AValue.Numerator / AValue.Denominator); +end; + + +//============================================================================== +// TUserCommentTag +//============================================================================== + +function TUserCommentTag.GetAsString: String; +var + sw: WideString; + sa: AnsiString; +begin + Result := ''; + + if PosInBytes('UNICODE', FRawData) = 0 then begin + SetLength(sw, (Length(FRawData) - 8) div SizeOf(WideChar)); + Move(FRawData[8], sw[1], Length(sw) * SizeOf(WideChar)); + if BigEndian then sw := BEtoN(sw) else sw := LEtoN(sw); + {$IFDEF FPC} + Result := UTF8Encode(sw); + {$ELSE} + Result := sw; + {$ENDIF} + end else + if PosInBytes('ASCII', FRawData) = 0 then begin + SetLength(sa, Length(FRawData) - 8); + Move(FRawData[8], sa[1], Length(sa)); + Result := sa; + end else + if PosInBytes(#0#0#0#0#0#0#0#0, FRawData) = 0 then begin + SetLength(sa, Length(FRawData) - 8); + Move(FRawData[8], sa[1], Length(sa)); + {$IFDEF FPC} + {$IFDEF FPC3+} + Result := WinCPToUTF8(sa); + {$ELSE} + Result := SysToUTF8(sa); + {$ENDIF} + {$ELSE} + Result := sa; + {$ENDIF} + end else + if PosInBytes('JIS', FRawData) = 0 then + raise EFpExif.Create('JIS-encoded user comment is not supported.'); + + while (Result <> '') and (Result[Length(Result)] = #0) do + Delete(Result, Length(Result), 1); +end; + +// Note: No trailing zero needed here. +procedure TUserCommentTag.SetAsString(const AValue: String); +var + i: integer; + sw: WideString; + sa: AnsiString; + isASCII: Boolean; +begin + if AValue = '' then + SetLength(FRawData, 0) + else + begin + isASCII := true; + for i:=1 to Length(AValue) do + if AValue[i] > #127 then begin + isASCII := false; + break; + end; + + if isASCII then + begin + SetLength(FRawData, 8 + Length(AValue)); + sa := 'ASCII'#0#0#0; + Move(sa[1], FRawData[0], 8); + sa := ansistring(AValue); + Move(sa[1], FRawData[8], Length(sa)); + end else + begin + {$IFDEF FPC} + sw := UTF8Decode(AValue); + {$ELSE} + sw := AValue; + {$ENDIF} + if BigEndian then sw := NtoBE(sw) else sw := NtoLE(sw); + SetLength(FRawData, 8 + Length(sw) * SizeOf(WideChar)); // +8 for header + sa := 'UNICODE'#0; + Move(sa[1], FRawData[0], 8); + Move(sw[1], FRawData[8], Length(sw) * SizeOf(WideChar)); + end; + end; + FCount := Length(FRawData); +end; + + +//============================================================================== +// TXPTag +// +// tag used by Windows, encoded in UCS2 +// See http://www.exiv2.org/tags.html +//============================================================================== + +function TXPTag.GetAsString: String; +var + ws: WideString; +begin + SetLength(ws, Length(FRawData) div SizeOf(WideChar)); + Move(FRawData[0], ws[1], Length(FRawData)); + Result := UTF8Encode(ws); +end; + + +initialization + +finalization + FreeExifTagDefs; + +end. + diff --git a/components/fpexif/fpeexifreadwrite.pas b/components/fpexif/fpeexifreadwrite.pas new file mode 100644 index 000000000..634dbb2ac --- /dev/null +++ b/components/fpexif/fpeexifreadwrite.pas @@ -0,0 +1,1146 @@ +{ Writer for EXIF data + + Writes the TIFF part of the APP0 segment. + In a JPEG image, the header of the APP0 segment must have been written before. +} + +unit fpeExifReadWrite; + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +interface + +uses + Classes, SysUtils, + fpeGlobal, fpeUtils, fpeMetadata, fpeTags, fpeExifData; + +type + TTiffHeader = packed record + BOM: Array[0..1] of AnsiChar; // 'II' for little endian, 'MM' for big endian + Signature: Word; // Signature (42) + IFDOffset: DWord; // Offset where image data begin, from start of TIFF header + end; + + TIFDRecord = packed record + TagID: Word; + DataType: Word; + DataCount: DWord; + DataValue: DWord; + end; + { A note on DataCount, from the EXIF specification: + "Count - The number of values. It should be noted carefully that the count + is not the sum of the bytes. In the case of one value of SHORT (16 bits), + for example, the count is '1' even though it is 2 Bytes." } + + TBasicExifReader = class(TBasicMetadataReader) + protected + FStartPosition: Int64; // Beginning of TIFF header + FBigEndian: Boolean; + function AddTag(AStream: TStream; const AIFDRecord: TIFDRecord; + const AData: TBytes; AParent: TTagID): Integer; virtual; + function FindTagDef(ATagID: TTagID): TTagDef; virtual; + function FixEndian16(AValue: Word): Word; + function FixEndian32(AValue: DWord): DWord; +// procedure ReadIFD(AStream: TStream; AGroup: TTagGroup); virtual; //overload; + procedure ReadIFD(AStream: TStream; AParent: TTagID); virtual; + end; + + TExifReader = class(TBasicExifReader) + private + FThumbPosition: Int64; + FThumbSize: Integer; + FExifVersion: AnsiString; + protected + FMake: String; + FModel: String; + function AddTag(AStream: TStream; const AIFDRecord: TIFDRecord; + const AData: TBytes; AParent: TTagID): Integer; override; + function FindTagDef(ATagID: TTagID): TTagDef; override; + procedure ReadIFD(AStream: TStream; AParent: TTagID); override; + public + constructor Create(AImgInfo: TImgInfo); override; + function ReadExifHeader(AStream: TStream): Boolean; + procedure ReadFromStream(AStream: TStream; AImgFormat: TImgFormat); override; + function ReadTiffHeader(AStream: TStream; out ABigEndian: Boolean): Boolean; + property BigEndian: Boolean read FBigEndian; + end; + + TMakerNoteReader = class(TBasicExifReader) + private + FExifVersion: string; + protected + FMake: String; + FModel: String; + FTagDefs: TTagDefList; + FDataStartPosition: Int64; + procedure Error(const AMsg: String); override; + function FindTagDef(ATagID: TTagID): TTagDef; override; + procedure GetTagDefs(AStream: TStream; AImgFormat: TImgFormat); virtual; + function Prepare(AStream: TStream): Boolean; virtual; + public + constructor Create(AImgInfo: TImgInfo; AStartPos: Int64; + const AMake, AModel, AExifVersion: string; ABigEndian: Boolean); reintroduce; + destructor Destroy; override; + procedure ReadFromStream(AStream: TStream; AImgFormat: TImgFormat); override; + end; + + TMakerNoteReaderClass = class of TMakerNoteReader; + + TExifWriter = class(TBasicMetadataWriter) + private + FBigEndian: Boolean; + FTiffHeaderPosition: Int64; + FExifSegmentStartPos: Int64; + protected + function CalcOffsetFromTiffHeader(APosition: Int64): DWord; + function CanWriteTag(ATag: TTag): Boolean; + function FixEndian16(AValue: Word): Word; + function FixEndian32(AValue: DWord): DWord; + procedure WriteExifHeader(AStream: TStream); + procedure WriteIFD(AStream: TStream; ASubIFDList: TInt64List; AParentID: TTagID); + procedure WriteSubIFDs(AStream: TStream; ASubIFDList: TInt64List); + procedure WriteTag(AStream, AValueStream: TStream; ADataStartOffset: Int64; + ATag: TTag); + procedure WriteTiffHeader(AStream: TStream); + public + constructor Create(AImgInfo: TImgInfo); override; + procedure WriteToStream(AStream: TStream; AImgFormat: TImgFormat); override; + property BigEndian: Boolean read FBigEndian write FBigEndian; + end; + +procedure RegisterMakerNoteReader(AClass: TMakerNoteReaderClass; AMake, AModel: String); +function GetMakerNoteReaderClass(AMake, AModel: String): TMakerNoteReaderClass; + + +implementation + +uses + Math, Contnrs, + fpeStrConsts, fpeMakerNote, fpeIptcReadWrite; + +const + EXIF_SIGNATURE: array[0..5] of AnsiChar = ('E', 'x', 'i', 'f', #0, #0); + LITTLE_ENDIAN_BOM: array[0..1] of AnsiChar = ('I', 'I'); + BIG_ENDIAN_BOM: array[0..1] of AnsiChar = ('M', 'M'); + +type + TReaderItem = class + ReaderClass: TMakerNoteReaderClass; + Make: String; + Model: String; + end; + +var + RegisteredReaders: TObjectList = nil; + +function GetRegisteredReader(AMake, AModel: String): Integer; +var + item: TReaderItem; + ucMake: String; + Makes: TStrings; + j: Integer; +begin + if RegisteredReaders <> nil then + begin + Makes := TStringList.Create; + try + ucMake := Uppercase(AMake); + for Result:=0 to RegisteredReaders.Count-1 do begin + item := TReaderItem(RegisteredReaders[Result]); + Makes.Text := item.Make; + for j := 0 to Makes.Count-1 do begin + if pos(Uppercase(Makes[j]), ucMake) <> 0 then + if (item.Model = '') or (AModel = '') or SameText(item.Model, AModel) then + exit; + end; + end; + finally + Makes.Free; + end; + end; + Result := -1; +end; + +procedure RegisterMakerNoteReader(AClass: TMakerNoteReaderClass; AMake: String; + AModel: String); +var + item: TReaderItem; + idx: Integer; +begin + if RegisteredReaders = nil then + RegisteredReaders := TObjectList.Create; + + idx := GetRegisteredReader(AMake, AModel); + if idx = -1 then begin + item := TReaderItem.Create; + item.ReaderClass := AClass; + item.Make := AMake; + item.Model := AModel; + idx := RegisteredReaders.Add(item); + end else begin + item := TReaderItem(RegisteredReaders[idx]); + item.ReaderClass := AClass; + item.Make := AMake; + item.Model := AModel; + end; +end; + +function GetMakerNoteReaderClass(AMake, AModel: String): TMakerNoteReaderClass; +var + idx: Integer; +begin + idx := GetRegisteredReader(AMake, AModel); + if idx = -1 then + Result := TMakerNoteReader + else + Result := TReaderItem(RegisteredReaders[idx]).ReaderClass; +end; + + +//============================================================================== +// TBasicExifReader +//============================================================================== + +//------------------------------------------------------------------------------ +// Creates a tag from the IFD record and its data, and adds it to the tag list +// of the Exif. +// AParent is the ID of the sub-IFD to which the tag will belong (ID must already +// be left-shifted by 16 bits) +//------------------------------------------------------------------------------ +function TBasicExifReader.AddTag(AStream: TStream; const AIFDRecord: TIFDRecord; + const AData: TBytes; AParent: TTagID): Integer; +var + tag: TTag; + tagDef: TTagDef; + newTagDef: TTagDef; + optns: TTagOptions; + tagIDRec: TTagIDRec; +begin + Unused(AStream); + + Result := -1; + + // Find the definition of the tag as specified by the ifd record + tagDef := FindTagDef(AIFDRecord.TagID or AParent); + if tagDef = nil then + begin + if (AIFDRecord.DataType < 1) or (AIFDRecord.DataType > 10) then begin + Error(Format('Unknown tag $%.4x has invalid datatype (%d)', [AIFDRecord.TagID, AIFDRecord.DataType])); + exit; + end; + + tagIDRec.Tag := AIFDRecord.TagID; + tagIDRec.Parent := TTagIDRec(AParent).Parent; + + newTagDef := TTagDef.Create; + newTagDef.TagIDRec := tagIDRec; + newTagDef.TagType := TTagType(AIFDRecord.DataType); + newTagDef.TagClass := DefaultTagClasses[newTagDef.TagType]; + newTagDef.ReadOnly := true; + tagDef := newTagDef; + end else + newTagDef := nil; + + // Populate the tag + optns := []; + if FBigEndian then Include(optns, toBigEndian); + if (eoTruncateBinary in FImgInfo.ExifData.ExportOptions) then + Include(optns, toTruncateBinary); + if (eoDecodeValue in FImgInfo.ExifData.ExportOptions) then + Include(optns, toDecodeValue); + tag := tagDef.TagClass.Create(tagDef, optns); + tag.TagType := TTagType(AIFDRecord.DataType); + tag.RawData := AData; + tag.Count := AIFDRecord.DataCount; // must be after setting RawData, its calculation of Count may be wrong! + + // Add the tag to the EXIF tag list + Result := FImgInfo.ExifData.AddOrReplaceTag(tag); + + newTagDef.Free; +end; + +//------------------------------------------------------------------------------ +// Looks for the tag with specified TagID and Group. Must be overridden by +// descendant classes. +//------------------------------------------------------------------------------ +function TBasicExifReader.FindTagDef(ATagID: TTagID): TTagDef; +begin + Unused(ATagID); + Result := nil; +end; + +//------------------------------------------------------------------------------ +// Converts a 2-byte integer from big endian byte order to system endianness. +//------------------------------------------------------------------------------ +function TBasicExifReader.FixEndian16(AValue: Word): Word; +begin + if FBigEndian then + Result := BEtoN(AValue) + else + Result := LEtoN(AValue); +end; + +//------------------------------------------------------------------------------ +// Converts a 4-byte integer from big endian byte order to system endianness. +//------------------------------------------------------------------------------ +function TBasicExifReader.FixEndian32(AValue: DWord): DWord; +begin + if FBigEndian then + Result := BEtoN(AValue) + else + Result := LEtoN(AValue); +end; + +//------------------------------------------------------------------------------ +// Reads the image file directory (IFD) starting at the current stream position +// and adds the found tags to the specified group +//------------------------------------------------------------------------------ +//procedure TBasicExifReader.ReadIFD(AStream: TStream; AGroup: TTagGroup); +procedure TBasicExifReader.ReadIFD(AStream: TStream; AParent: TTagID); +var + numRecords: Word; + i: Integer; + ifdRec: TIFDRecord; + byteCount: Integer; + data: TBytes; + n: Int64; + tagPos: Int64; + newPos: Int64; +begin + // Read count of directory entries + numRecords := FixEndian16(ReadWord(AStream)); + if (AParent = TAGPARENT_THUMBNAIL) and (numRecords > 10) then begin + Warning(rsMoreThumbnailTagsThanExpected); + exit; + end; + + tagPos := AStream.Position; + for i:=1 to numRecords do begin + AStream.Position := tagPos; + // Read directory entry... + n := SizeOf(ifdRec); + if AStream.Read(ifdRec{%H-}, n) < n then begin + Error(Format(rsReadIncompleteIFDRecord, [tagPos])); + exit; + end; + + ifdRec.TagID := FixEndian16(ifdRec.TagID); + ifdRec.DataType := FixEndian16(ifdRec.DataType); + if not (ifdRec.DataType in [1..ord(High(TTagType))]) then begin + Error(Format(rsIncorrectTagType, [ifdRec.DataType, i, ifdRec.TagID, FImgInfo.Filename])); + exit; + end; + + ifdRec.DataCount := FixEndian32(ifdRec.DataCount); + // ifRec.DataValue will be converted later. + byteCount := Integer(ifdRec.DataCount) * TagElementSize[ifdRec.DataType]; + SetLength(data, bytecount); + if byteCount <= 4 then + Move(ifdRec.DataValue, data[0], byteCount) + else begin + AStream.Position := FStartPosition + FixEndian32(ifdRec.DataValue); + AStream.Read(data[0], byteCount); + end; + AddTag(AStream, ifdRec, data, AParent); + + if ifdRec.DataType = ord(ttIFD) then begin + newPos := FStartPosition + FixEndian32(ifdRec.DataValue); + if newPos < AStream.Size then begin + AStream.Position := newPos; + ReadIFD(AStream, ifdRec.TagID shl 16); + end; + end; + + tagPos := tagPos + SizeOf(TIFDRecord); + end; + AStream.Position := tagPos; +end; + + +//============================================================================== +// TExifReader +//============================================================================== + +//------------------------------------------------------------------------------ +// Constructor of the EXIF reader +//------------------------------------------------------------------------------ +constructor TExifReader.Create(AImgInfo: TImgInfo); +begin + inherited; + FStartPosition := -1; +end; + +//------------------------------------------------------------------------------ +// Creates a tag from the specified IFD record and its data, and adds it to the +// corresponding tag list of the EXIF object. +//------------------------------------------------------------------------------ +function TExifReader.AddTag(AStream: TStream; const AIFDRecord: TIFDRecord; + const AData: TBytes; AParent: TTagID): Integer; +var + p: Int64; + iptcreader: TIPTCReader; + makernotereader: TMakerNoteReader; + readerClass: TMakerNoteReaderClass; + tag: TTag; +begin + Result := inherited AddTag(AStream, AIFDRecord, AData, AParent); + if Result = -1 then + exit; + + tag := FImgInfo.ExifData.TagByIndex[Result]; + if (tag is TOffsetTag) then + TOffsetTag(tag).TiffHeaderOffset := FStartPosition; + + // Special handling for some tags + case tag.TagID of + FULLTAG_MAKE: + FMake := tag.AsString; + FULLTAG_MODEL: + FModel := tag.AsString; + FULLTAG_THUMBSTARTOFFSET: + FThumbPosition := FStartPosition + FixEndian32(AIFDRecord.DataValue); + FULLTAG_THUMBSIZE: + FThumbSize := FixEndian32(AIFDRecord.DataValue); + FULLTAG_EXIFVERSION: + begin + SetLength(FExifVersion, Length(AData)); + Move(AData[0], FExifVersion[1], Length(FExifVersion)); + end; + FULLTAG_MAKERNOTE: + begin + // The stream is at the end of the makernote data area --> rewind it to start + AStream.Position := AStream.Position - Length(AData); + readerClass := GetMakerNoteReaderClass(FMake, FModel); + makernotereader := readerClass.Create(FImgInfo, FStartPosition, FMake, FModel, FExifVersion, FBigEndian); + try + makernotereader.ReadFromStream(AStream, FImgFormat); + finally + makernotereader.Free; + end; + end; + FULLTAG_IPTC: // Reads the IPTC tags as used in TIFF files. + if Length(tag.RawData) <> 0 then + begin + FImgInfo.CreateIptcData; + iptcReader := TIptcReader.Create(FImgInfo); + try + iptcReader.ReadIPTCData(tag.RawData); + finally + iptcReader.Free; + end; + end; + end; + + // Some tags define a subdirectory --> Read it recursively + if (tag is TSubIFDTag) then begin + p := AStream.Position; + try + AStream.Position := FStartPosition + FixEndian32(AIFDRecord.DataValue); + ReadIFD(AStream, tag.TagID shl 16); + finally + AStream.Position := p; + end; + end; +end; + +function TExifReader.FindTagDef(ATagID: TTagID): TTagDef; +begin + Result := FindExifTagDef(ATagID); +end; + +//------------------------------------------------------------------------------ +// For JPEG files only: +// Reads the header of the APP1 jpeg segment ("EXIF segment") +// Note that the segment marker and the segment size already have been read. +// The function returns FALSE if the header is not valid. +// Call ReadFromStream immediately afterwards +//------------------------------------------------------------------------------ +function TExifReader.ReadExifHeader(AStream: TStream): Boolean; +var + hdr: array[0..5] of ansichar; +begin + AStream.Read({%H-}hdr[0], SizeOf(hdr)); + Result := CompareMem(@hdr[0], @EXIF_SIGNATURE[0], SizeOf(hdr)); +end; + +//------------------------------------------------------------------------------ +// Public method for reading the IFDs of the EXIF structure. +// +// IT IS REQUIRED THAT THE METHOD IS CALLED WHEN THE STREAM IS RIGHT AFTER +// THE TIFF HEADER. +//------------------------------------------------------------------------------ +procedure TExifReader.ReadFromStream(AStream: TStream; AImgFormat: TImgFormat); +begin + FThumbPosition := -1; + FThumbSize := 0; + FImgFormat := AImgFormat; + + FImgInfo.ExifData.BeginReading; + try + // Read IFD0 (primary directory). This routine will recursively also read + // the thumbnail directory (IFD1) and any subdirectories. + ReadIFD(AStream, TAGPARENT_PRIMARY); + finally + FImgInfo.ExifData.EndReading; + end; +end; + +//------------------------------------------------------------------------------ +// Read an image file directory (IFD) from the stream. +// The directory is specified by the parameter AGroup. +//------------------------------------------------------------------------------ +procedure TExifReader.ReadIFD(AStream: TStream; AParent: TTagID); +var + p: Int64; + // thumbBuff: TBytes; +begin + inherited ReadIFD(AStream, AParent); + + // The primary directory has the offset to the thumbnail directory (IFD1) as + // last DWord entry + if AParent = TAGPARENT_PRIMARY then + begin + // Read the offset from the stream + p := FixEndian32(ReadDWord(AStream)); + if p > 0 then begin + // Move stream to beginning of IFD1... + p := FStartPosition + p; + if p < AStream.Size then begin + AStream.Position := p; + // ... and read IFD1 + ReadIFD(AStream, TAGPARENT_THUMBNAIL); + end; + end; + end; + + // In case of the thumbnail directory we read the thumbnail if available. + if (AParent = TAGPARENT_THUMBNAIL) and + (FThumbPosition > -1) and (FThumbSize > 0) and + (FThumbPosition < FThumbSize) then + begin + // Move stream to beginning of thumbnail... + AStream.Position := FThumbPosition; + // ... and read thumbnail from stream to EXIF + FImgInfo.ExifData.LoadThumbnailFromStream(AStream, FThumbsize, false); + end; +end; + + +//------------------------------------------------------------------------------ +// Reads the TIFF header which is before the EXIF structure and returns the +// endianness used in this file. +// NOTE: ReadFromStream must be called immediately afterwards +//------------------------------------------------------------------------------ +function TExifReader.ReadTiffHeader(AStream: TStream; + out ABigEndian: Boolean): Boolean; +var + hdr: TTiffHeader; +begin + Result := false; + + // The stream is at the beginning of the TIFF header. We store this + // position because all offsets within the EXIF segment are relative to + // the beginning of the TIFF header. + FStartPosition := AStream.Position; + + // Determine endianness + AStream.Read(hdr{%H-}, SizeOf(hdr)); + if CompareMem(@hdr.BOM[0], @BIG_ENDIAN_BOM[0], SizeOf(BIG_ENDIAN_BOM)) then + FBigEndian := true + else + if CompareMem(@hdr.BOM[0], @LITTLE_ENDIAN_BOM[0], SizeOf(LITTLE_ENDIAN_BOM)) then + FBigEndian := false + else + exit; + + ABigEndian := FBigEndian; + + // Check signature byte + hdr.Signature := FixEndian16(hdr.Signature); + if hdr.Signature <> 42 then + exit; + + // Determine where the first directory (IFD0) begins... + hdr.IFDOffset := FixEndian32(hdr.IFDOffset); + + // ... and move stream to there. + AStream.Position := FStartPosition + hdr.IFDOffset; + + Result := true; +end; + + +//============================================================================== +// TMakerNoteReader +//============================================================================== +constructor TMakerNoteReader.Create(AImgInfo: TImgInfo; AStartPos: Int64; + const AMake, AModel, AExifVersion: String; ABigEndian: Boolean); +begin + inherited Create(AImgInfo); + FTagDefs := TTagDefList.Create; + FStartPosition := AStartPos; + FDataStartPosition := -1; + FMake := AMake; + FModel := AModel; + FExifVersion := AExifVersion; + FBigEndian := ABigEndian; +end; + +destructor TMakerNoteReader.Destroy; +begin + FTagDefs.Free; + inherited; +end; + +{ Since the MakerNotes are not well-defined we don't want to abort reading of + the entire file by an incorrectly interpreted MakeNote tag. + IMPORTANT: All methods calling Error() must be exited afterwards because + the faulty file structure may lead to crashes. } +procedure TMakerNoteReader.Error(const AMsg: String); +begin + Warning(AMsg); +end; + +function TMakerNoteReader.FindTagDef(ATagID: TTagID): TTagDef; +var + i: Integer; +begin + if FTagDefs <> nil then + begin + for i:=0 to FTagDefs.Count-1 do begin + Result := FTagDefs[i]; + if Result.TagID = ATagID then + exit; + end; + end; + Result := nil; +end; + +procedure TMakerNoteReader.GetTagDefs(AStream: TStream; AImgFormat: TImgFormat); +var + UCMake, {%H-}UCModel: String; + tmp, tmp2: String; + p: Integer; + streamPos: Int64; +begin + UCMake := Uppercase(FMake); + UCModel := Uppercase(FModel); + + if UCMake = 'CANON' then + BuildCanonTagDefs(FTagDefs) + else + if UCMake = 'SEIKO' then + BuildEpsonTagDefs(FTagDefs) + else + if UCMake = 'SANYO' then + BuildSanyoTagDefs(FTagDefs) + else + if pos('MINOLTA', UCMake) = 1 then + BuildMinoltaTagDefs(FTagDefs) + else + if UCMake = 'FUJI' then begin + FBigEndian := false; + BuildFujiTagDefs(FTagDefs) + end else + (* + if pos('OLYMP', UCMake) = 1 then + //BuildOlympusTagDefs(FTagDefs) -- is done by specific Olympus reader + else + if UCMake = 'CASIO' then + { + streamPos := AStream.Position; + if PosInStream('QVC', AStream, streamPos) <> -1 then begin + FTagDefs := @Casio1Table; + FNumTagDefs := Length(Casio1Table); + end else begin + FTagDefs := @Casio12Table; + FNumTagDefs := Length(Casio2Table); + end; + } + BuildCasio1TagDefs(FTagDefs) + else + *) + if UCMake = 'NIKON' then begin + SetLength(tmp, 5); + streamPos := AStream.Position; + AStream.Read(tmp[1], 5); + AStream.Position := streamPos; + p := Max(0, Pos(' ', FModel)); + tmp2 := FModel[p+1]; + if (FExifVersion > '0210') or + ((FExifVersion = '') and (tmp2 = 'D') and (AImgFormat = ifTiff)) + then + BuildNikon2TagDefs(FTagDefs) + else + if (tmp = 'Nikon') then + BuildNikon1TagDefs(FTagDefs) + else + BuildNikon2TagDefs(FTagDefs); + end; +end; + +function TMakerNoteReader.Prepare(AStream: TStream): Boolean; +begin + Unused(AStream); + Result := true; +end; + +procedure TMakerNoteReader.ReadFromStream(AStream: TStream; AImgFormat: TImgFormat); +begin + if FDataStartPosition = -1 then + FDataStartPosition := AStream.Position; + FImgFormat := AImgFormat; + GetTagDefs(AStream, AImgFormat); + if FTagDefs.Count = 0 then + exit; + AStream.Position := FDataStartPosition; + if not Prepare(AStream) then + exit; + ReadIFD(AStream, TAGPARENT_MAKERNOTE); +end; + + +//============================================================================== +// TExifWriter +//============================================================================== + +//------------------------------------------------------------------------------ +// Constructor of the EXIF writer +//------------------------------------------------------------------------------ +constructor TExifWriter.Create; +begin + inherited; + FExifSegmentStartPos := -1; +end; + +//------------------------------------------------------------------------------ +// Calculates the difference of the specified stream position to the position +// where the TIFF header starts. +//------------------------------------------------------------------------------ +function TExifWriter.CalcOffsetFromTiffHeader(APosition: Int64): DWord; +begin + if APosition > FTiffHeaderPosition then + Result := DWord(APosition - FTiffHeaderPosition) + else + Error('Incorrect stream position'); +end; + +//------------------------------------------------------------------------------ +// Returns false if the specified tag must not be written to the stream. +// This happens if the option toVolatile of the tag's Options is set. +//------------------------------------------------------------------------------ +function TExifWriter.CanWriteTag(ATag: TTag): Boolean; +begin + Result := (ATag <> nil) and (not ATag.IsVolatile); +end; + +//------------------------------------------------------------------------------ +// Converts a 2-byte integer to BigEndian format if required +//------------------------------------------------------------------------------ +function TExifWriter.FixEndian16(AValue: Word): Word; +begin + if FBigEndian then + Result := NtoBE(AValue) + else + Result := NtoLE(AValue); +end; + +//------------------------------------------------------------------------------ +// Converts a 4-byte integer to BigEndian format if required +//------------------------------------------------------------------------------ +function TExifWriter.FixEndian32(AValue: DWord): DWord; +begin + if FBigEndian then + Result := NtoBE(AValue) + else + Result := NtoLE(AValue); +end; + +//------------------------------------------------------------------------------ +// Writes the Exif header needed by JPEG files. +// Call WriteToStream immediately afterwards +//------------------------------------------------------------------------------ +procedure TExifWriter.WriteExifHeader(AStream: TStream); +const + SEGMENT_MARKER: array[0..1] of byte = ($FF, $E1); + SIZE: Word = 0; +begin + FExifSegmentStartPos := AStream.Position; + AStream.WriteBuffer(SEGMENT_MARKER[0], 2); + // Next two zero bytes are the size of the entire Exif segiment, they will be + // replaced when the segment is completely written. For this, we store the + // offset to the beginning of the EXIF segment in FExifSegmentStartPos. + AStream.WriteBuffer(SIZE, 2); + AStream.WriteBuffer(EXIF_SIGNATURE[0], 6); +end; + +//------------------------------------------------------------------------------ +// Writes all IFD records belonging to the same directory specified by the +// TagID of the tag which defines it. +// ASubIFDList is provided to collect all stream index positions with tags +// defining a sub-IFD; these sub-IFDs will be written later in WriteSubIFDs +// Data, in general, are written in the following order +// |<--- SubIFD records --->|<--- SubIFD data --->| +// In case of thumbnail directory (IFD1): +// |<--- IFD1 records --->|<--- Thumbnail image --->|<--- IFD1 data --->| +// +// ----------------------------------------------------------------------------- +procedure TExifWriter.WriteIFD(AStream: TStream; ASubIFDList: TInt64List; + AParentID: TTagID); +var + valueStream: TMemoryStream; + i: Integer; + count: Integer; + tag: TTag; + startPos: Int64; + sizeOfTagPart: DWord; + dataStartOffset: Int64; + thumbStartOffset: Int64; + offsetToIFD1: Int64; + w: Word; + dw: DWord; +begin + // Don't write MakerNote sub-tags, they are already contained in the data of + // the MAKERNOTE tag itself. + if AParentID = TAGPARENT_MAKERNOTE then + exit; + + valueStream := TMemoryStream.Create; + try + // Count IFD records in this directory + count := 0; + for i:=0 to FImgInfo.ExifData.TagCount-1 do begin + tag := FImgInfo.ExifData.TagByIndex[i]; + if (tag.TagID and $FFFF0000 = AParentID) and not (tag.IsVolatile) and tag.HasData then + inc(count); + end; + + // The IFD begins at the current stream position... + startPos := AStream.Position; + // ... and, knowing the size of the tag part of the subdirectory, we can + // calculate where the data part of the subdirectory will begin. + // This is needed as the offset from the beginning of the TIFF header. + sizeOfTagPart := SizeOf(Word) + // count of tags in IFD as 16bit integer + count * SizeOf(TIFDRecord) + // each tag occupies an IFDRecord + SizeOf(DWord); // 32-bit offset to next IFD, or terminating zero + dataStartOffset := startPos + sizeOfTagPart - FTiffHeaderPosition; + + // In case of IFD1 (Thumbnail group) the thumbnail will be written + // immediately after all tags of IFD1. This offset position must be noted + // in the tag. We calculate and store this value here for usage later. + if (AParentID = TAGPARENT_THUMBNAIL) and FImgInfo.HasThumbnail then begin + thumbStartOffset := dataStartOffset; + dataStartOffset := dataStartOffset + FImgInfo.ExifData.ThumbnailSize; + end else + thumbStartOffset := 0; + + // Write IFD record count as 16-bit integer + w := FixEndian16(count); + AStream.WriteBuffer(w, SizeOf(w)); + + // Now write all the records in this directory + if count > 0 then begin + for i:=0 to FImgInfo.ExifData.TagCount-1 do begin + tag := FImgInfo.ExifData.TagByIndex[i]; + + // Skip tags which do not belong to the requested group + if (tag.TagID and $FFFF0000 <> AParentID) or tag.IsVolatile or not tag.HasData then + Continue; + + // Offset to the thumbnail image + if tag.TagID = FULLTAG_THUMBSTARTOFFSET then begin + dw := FixEndian32(thumbStartOffset); + tag.AsInteger := dw; + end else + // Some tags will link to subdirectories. The offset to the start of + // a subdirectory must be specified in the DataValue field of the + // written ifd record. Since it is not clear at this moment where the + // subdirectory will begin we store the offset to the ifd record in + // ASubIFDlist for later correction. + if (tag is TSubIFDTag) and (tag.TagID <> FULLTAG_MAKERNOTE) + then + ASubIFDList.Add(AStream.Position); + + // Now write the tag + WriteTag(AStream, valueStream, datastartOffset, tag); + end; + end; + + // The last entry of the directory is the offset to the next IFD, or 0 + // if not other IFD follows at the same level. This affects only IFD0 + // where IFD1 can follow if an embedded thumbnail image exists. + if (AParentID = TAGPARENT_PRIMARY) and FImgInfo.HasThumbnail then begin + offsetToIFD1 := AStream.Position + SizeOf(DWord) + valuestream.Size; + dw := CalcOffsetFromTiffHeader(offsetToIFD1); + end else + dw := 0; + dw := FixEndian32(dw); + AStream.WriteBuffer(dw, SizeOf(dw)); + + // Write the thumbnail + if AParentID = TAGPARENT_THUMBNAIL then + FImgInfo.ExifData.SaveThumbnailToStream(AStream); + + // Copy the valuestream to the end of the tag stream (AStream) + valueStream.Seek(0, soFromBeginning); + AStream.CopyFrom(valueStream, valueStream.Size); + + // Rewind the stream to its end + AStream.Seek(0, soFromEnd); + finally + valueStream.Free; + end; +end; + +//------------------------------------------------------------------------------ +// The integer list ASubIFDList contains all the stream positions (in AStream) +// where tags begin which link to a subdirectory. +// WriteSubIFDs will read back the TagID of the subdirectory, write the tags +// of the subdirectory and write the position where the subdirectory starts +// to the tag's DataValue field in AStream. +//------------------------------------------------------------------------------ +procedure TExifWriter.WriteSubIFDs(AStream: TStream; ASubIFDList: TInt64List); +var + subIFDStartPos: Int64; + tagPos: Int64; + i: Integer; + tagid: TTagID; + rec: TIFDRecord; + offs: DWord; +begin + i := 0; + while i < ASubIFDList.Count do begin + // The current stream position is where the subdirectory tags will be + // begin. It must be written to the subdirectory tag's DataValue field. + subIFDStartPos := AStream.Position; + + // Extract the ID of the tag linking to the first subdirectory in the list + // from the already written stream. Use the offset stored in ASubIFDList + // to find it. + tagPos := ASubIFDList[0]; + AStream.Position := tagPos; + + // Read the tag's IFD record + AStream.ReadBuffer(rec{%H-}, SizeOf(rec)); + + // Get the TagID of the subdirectory (note: this might be written as big-endian) + // Then get the TagGroup corresponding to this tag; this is needed when calling WriteIFD + if FBigEndian then tagid := BEToN(rec.TagID) else tagid := LEtoN(rec.TagID); + + // Write the correct subdirectory start position to the IFD record + offs := CalcOffsetFromTiffHeader(subIFDStartPos); + rec.DataValue := FixEndian32(offs); + + // Write the IFD record back to the stream. Don't forget to return to + // where the tag starts! + AStream.Position := tagPos; + AStream.WriteBuffer(rec, SizeOf(rec)); + + // Now return the stream to the end (i.e. where the subdirectory should be) + // and write the tags of the subdirectory. + AStream.Seek(0, soFromEnd); + WriteIFD(AStream, ASubIFDList, tagID shl 16); + + // Delete the current SubIFDList entry because it has been handled now. + ASubIFDList.Delete(0); + end; +end; + +//------------------------------------------------------------------------------ +// Writes a tag and all its related elements to the stream as an IFDRecord. +// +// AStream: stream to which the tag is written +// AValueStream: Since the data of tags being longer than 4 bytes are written +// after the tag part of the streasm, but AStream has not seen all tags yet +// we temporarily write the data part into a separate "value stream". +// ADataStartOffset: Indiates the offset of the first data bytes in the +// value stream once it has been appended to the output stream (AStream). +// It is measureed from the beginning of the TIFF header. +// ATag: Tag entry to be written +//------------------------------------------------------------------------------ +procedure TExifWriter.WriteTag(AStream, AValueStream: TStream; + ADataStartOffset: Int64; ATag: TTag); +var + rec: TIFDRecord; + len: Integer; +begin + if (ATag = nil) or (not CanWriteTag(ATag)) or (not ATag.HasData) then + exit; + + // Calculate number of data bytes + len := ATag.Count * TagElementSize[ord(ATag.TagType)]; + + // Populate elements of the IFD record + rec.TagID := FixEndian16(TTagIDRec(ATag.TagID).Tag); + rec.DataType := FixEndian16(ord(ATag.TagType)); + rec.DataCount := FixEndian32(ATag.Count); + if len <= 4 then begin + rec.DataValue := 0; + Move(ATag.RawData[0], rec.DataValue, len); + end else + begin + rec.DataValue := FixEndian32(DWord(ADataStartOffset + AValueStream.Position)); + AValueStream.WriteBuffer(ATag.RawData[0], Length(ATag.RawData)); + end; + + // Write out + AStream.Write(rec, SizeOf(Rec)); +end; + (* +procedure TExifWriter.WriteTag(AStream, AValueStream: TStream; + ADataStartOffset: Int64; ATag: TTagEntry); +var + rec: TIFDRecord; + rat: TExifRational; + s: ansistring; + n: DWord; +begin + rec.TagID := FixEndian16(ATag.Tag); + rec.DataType := FixEndian16(ATag.TType); + if ATag.TType = FMT_STRING then + begin + s := ATag.Raw; + if s[Length(s)] <> #0 then s := s + #0; + rec.DataCount := FixEndian32(Length(s)); + if Length(s) <= 4 then begin + n := 0; + Move(s[1], n, Length(s)); + rec.DataValue := n; // tag.Raw is already has the endianness needed //FixEndian32(n); + end else begin + rec.DataValue := FixEndian32(DWord(ADataStartOffset + AValueStream.Position)); + AValueStream.WriteBuffer(s[1], Length(s)); + end; + end else + if ATag.TType = FMT_BINARY then begin + rec.DataCount := FixEndian32(Length(ATag.Raw)); + if Length(ATag.Raw) <= 4 then begin + n := 0; + Move(ATag.Raw[1], n, Length(ATag.Raw)); + rec.DataValue := n; // tag.Raw is already has the endianness needed //FixEndian32(n); +// rec.DataValue := FixEndian32(n); + end else begin + rec.DataValue := FixEndian32(DWord(ADataStartOffset + AValueStream.Position)); + AValueStream.WriteBuffer(ATag.Raw[1], Length(ATag.Raw)); + end; + end else + if BYTES_PER_FORMAT[ATag.TType] > 4 then begin + // If the value requires mote than 4 bytes the data bytes are written to + // the ValueStream, and the DataValue field gets the offset to the begin + // of data, counted from the start of the TIFF header. Since the stream + // with all the IDFRecords is not complete at this moment we store the + // offsets to these fields in the OffsetList for correction later. + // For this reason, we do not take care of endianness here as well. + rec.DataCount := FixEndian32(Length(ATag.Raw) div BYTES_PER_FORMAT[ATag.TType]); + rec.DataValue := FixEndian32(DWord(ADataStartOffset + AValueStream.Position)); + case ATag.TType of + FMT_URATIONAL, FMT_SRATIONAL: + begin + AValueStream.WriteBuffer(ATag.Raw[1], Length(ATag.Raw)); + { + // Note: ATag.Raw already has the correct endianness! + rat := PExifRational(@ATag.Raw[1])^; +// rat.Numerator := FixEndian32(rat.Numerator); +// rat.Denominator := FixEndian32(rat.Denominator); + rat.Numerator := rat.Numerator; + rat.Denominator := rat.Denominator; + AValueStream.WriteBuffer(rat, SizeOf(TExifRational)); + } + end; + FMT_DOUBLE: + begin + AValueStream.WriteBuffer(ATag.Raw[1], Length(ATag.Raw)); + end; + end; + end else + begin + // If the size of the data field is not larger than 4 bytes + // then the data value is written to the rec.DataValue field directly. + // Note: ATag.Raw already has the correct endianness + rec.DataCount := FixEndian32(Length(ATag.Raw) div BYTES_PER_FORMAT[ATag.TType]); + rec.DataValue := 0; + Move(ATag.Raw[1], rec.DataValue, Length(ATag.Raw)); + { + rec.DataValue : + case ATag.TType of + FMT_BYTE, FMT_SBYTE: + rec.DataValue := byte(ATag.Raw[1]); + FMT_USHORT, FMT_SSHORT: + rec.DataValue := PWord(@ATag.Raw[1])^; + //rec.DataValue := FixEndian32(PWord(@ATag.Raw[1])^); + FMT_ULONG, FMT_SLONG: + rec.DataValue := PDWord(@ATag.Raw[1])^; + //rec.DataValue := FixEndian32(PDWord(@ATag.Raw[1])^); + FMT_SINGLE: + Move(ATag.Raw[1], rec.DataValue, SizeOf(Single)); + end; + } + end; + + // Write out + AStream.Write(rec, SizeOf(Rec)); +end; + *) + +procedure TExifWriter.WriteTiffHeader(AStream: TStream); +var + header: TTiffHeader; + offs: DWord; +begin + if FBigEndian then + Move(BIG_ENDIAN_BOM[0], {%H-}header.BOM[0], 2) + else + Move(LITTLE_ENDIAN_BOM[0], header.BOM[0], 2); + header.Signature := FixEndian16(42); // magic number + offs := SizeOf(header); + header.IFDOffset := FixEndian32(offs); // Offset to start of IFD0, from begin of TIFF header + + // Write out + AStream.WriteBuffer(header, SizeOf(header)); +end; + +procedure TExifWriter.WriteToStream(AStream: TStream; AImgFormat: TImgFormat); +var + subIFDList: TInt64List; +begin + FImgFormat := AImgFormat; + case FImgFormat of + ifJpeg: + WriteExifHeader(AStream); + else + Error('Image format not supported.'); + end; + + subIFDList := TInt64List.Create; + try + // Tiff header + FTiffHeaderPosition := AStream.Position; + WriteTiffHeader(AStream); + + // Write IFD0 + WriteIFD(AStream, subIFDList, TAGPARENT_PRIMARY); + + // Write IFD1 + if FImgInfo.HasThumbnail then + WriteIFD(AStream, subIFDList, TAGPARENT_THUMBNAIL); + + // Write special subIFDs collected in subIFDList + WriteSubIFDs(AStream, subIFDList); + + // If WriteToStream is called within a JPEG structure we must update the + // size of the EXIF segment. + UpdateSegmentSize(AStream, FExifSegmentStartPos); + + finally + subIFDList.Free; + end; +end; + +initialization + +finalization + RegisteredReaders.Free; + +end. + diff --git a/components/fpexif/fpeglobal.pas b/components/fpexif/fpeglobal.pas new file mode 100644 index 000000000..a14ead2c9 --- /dev/null +++ b/components/fpexif/fpeglobal.pas @@ -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. + + + + diff --git a/components/fpexif/fpeiptcdata.pas b/components/fpexif/fpeiptcdata.pas new file mode 100644 index 000000000..12202a8bc --- /dev/null +++ b/components/fpexif/fpeiptcdata.pas @@ -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. diff --git a/components/fpexif/fpeiptcreadwrite.pas b/components/fpexif/fpeiptcreadwrite.pas new file mode 100644 index 000000000..36d413306 --- /dev/null +++ b/components/fpexif/fpeiptcreadwrite.pas @@ -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. + diff --git a/components/fpexif/fpemakernote.pas b/components/fpexif/fpemakernote.pas new file mode 100644 index 000000000..72a31b545 --- /dev/null +++ b/components/fpexif/fpemakernote.pas @@ -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. diff --git a/components/fpexif/fpemetadata.pas b/components/fpexif/fpemetadata.pas new file mode 100644 index 000000000..d643bbe70 --- /dev/null +++ b/components/fpexif/fpemetadata.pas @@ -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. + diff --git a/components/fpexif/fpestrconsts.pas b/components/fpexif/fpestrconsts.pas new file mode 100644 index 000000000..fe302e147 --- /dev/null +++ b/components/fpexif/fpestrconsts.pas @@ -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. + diff --git a/components/fpexif/fpetags.pas b/components/fpexif/fpetags.pas new file mode 100644 index 000000000..d56e12947 --- /dev/null +++ b/components/fpexif/fpetags.pas @@ -0,0 +1,1712 @@ +unit fpeTags; + +{$IFDEF FPC} + {$MODE DELPHI} + //{$mode objfpc}{$H+} +{$ENDIF} + +interface + +uses + Classes, SysUtils, Contnrs, + fpeGlobal; + +const + // Tag constants for subIFDs as defined by EXIF standard + TAG_EXIF_OFFSET = $8769; + TAG_GPS_OFFSET = $8825; + TAG_INTEROP_OFFSET = $A005; + TAG_SUBIFD_OFFSET = $014A; + TAG_IPTC = $83BB; + TAG_MAKERNOTE = $927C; + // Auxiliary tags to identity IFD0 and IFD1 as parents. + TAG_PRIMARY = $0001; + TAG_THUMBNAIL = $0002; + + // Using these TagIDs as ParentIDs + TAGPARENT_PRIMARY = TTagID(TAG_PRIMARY shl 16); // $00010000; + TAGPARENT_THUMBNAIL = TTagID(TAG_THUMBNAIL shl 16); // $00020000; + TAGPARENT_EXIF = TTagID(TAG_EXIF_OFFSET shl 16); // $87690000; + TAGPARENT_GPS = TTagID(TAG_GPS_OFFSET shl 16); // $88250000; + TAGPARENT_INTEROP = TTagID(TAG_INTEROP_OFFSET shl 16); // $A0050000; + TAGPARENT_MAKERNOTE = TTagID(TAG_MAKERNOTE shl 16); // $927C0000; + TAGPARENT_IPTC = TTagID(TAG_IPTC shl 16); // $83BB0000; + + // Full tagID: hi-word = tagID of parent, lo-word = tagID of tag. + // Parent's ID tag's ID + FULLTAG_EXIF_OFFSET = TTagID(TAGPARENT_PRIMARY or TAG_EXIF_OFFSET); + FULLTAG_IPTC = TTagID(TAGPARENT_PRIMARY or TAG_IPTC); + FULLTAG_GPS_OFFSET = TTagID(TAGPARENT_EXIF or TAG_GPS_OFFSET); + FULLTAG_INTEROP_OFFSET = TTagID(TAGPARENT_EXIF or TAG_INTEROP_OFFSET); + FULLTAG_MAKERNOTE = TTagID(TAGPARENT_EXIF or TAG_MAKERNOTE); + +type + TTag = class; + TTagClass = class of TTag; + + TTagDef = class + private + function GetTagID: TTagID; + procedure SetTagID(const AValue: TTagID); + public + TagIDRec: TTagIDRec; // ID of the tag + Group: TTagGroup; // Group to which the tag belongs + Name: String; // Name of the tag + Desc: String; // Tag description + TagType: TTagType; // Tag type + Count: Word; // Number of elements of which the tag consists + LkUpTbl: String; // Lookup table for enumerated values + FormatStr: String; // Format string + TagClass: TTagClass; // Class of the tag instance to be created from this definition + ReadOnly: Boolean; // true: tag cannot be edited by user + property TagID: TTagID read GetTagID write SetTagID; + end; + + TTagDefList = class(TObjectList) + private + function GetItem(AIndex: Integer): TTagDef; + procedure SetItem(AIndex: Integer; AValue: TTagDef); + protected + procedure AddTag(ATagID: TTagID; AName: String; AType: TTagType; + ACount: Word = 1; ADesc: String = ''; ALkUpTbl: String = ''; + AFormatStr: String = ''; AClass: TTagClass = nil; AReadOnly: Boolean = false); + function GetGroupOfTag(ATagID: TTagID): TTagGroup; virtual; + function IndexOfParentByID(ATagID: TTagID): Integer; + public + procedure AddBinaryTag(ATagID: TTagID; AName: String; ACount: Word = 1; + ADesc: String = ''; ALkupTbl: String = ''; AFormatStr: String = ''; + AClass: TTagClass = nil; AReadOnly: Boolean = false); + procedure AddByteTag(ATagID: TTagID; AName: String; ACount: Word = 1; + ADesc: String = ''; ALkupTbl: String = ''; AFormatStr: String = ''; + AClass: TTagClass = nil; AReadOnly: Boolean = false); + procedure AddIFDTag(ATagID: TTagID; AName: String; ADesc: String = ''; + AClass: TTagClass = nil; AReadOnly: Boolean = false); + procedure AddSLongTag(ATagID: TTagID; AName: String; ACount: Word = 1; + ADesc: String = ''; ALkupTbl: String = ''; AFormatStr: String = ''; + AClass: TTagClass = nil; AReadOnly: Boolean = false); + procedure AddSShortTag(ATagID: TTagID; AName: String; ACount: Word = 1; + ADesc: String = ''; ALkupTbl: String = ''; AFormatStr: String = ''; + AClass: TTagClass = nil; AReadOnly: Boolean = false); + procedure AddStringTag(ATagID: TTagID; AName: String; ACount: Word = 1; + ADesc: String = ''; ALkupTbl: String = ''; AClass: TTagClass = nil; + AReadOnly: Boolean = false); + procedure AddUShortTag(ATagID: TTagID; AName: String; ACount: Word = 1; + ADesc: String = ''; ALkupTbl: String = ''; AFormatStr: String = ''; + AClass: TTagClass = nil; AReadOnly: Boolean = false); + procedure AddULongTag(ATagID: TTagID; AName: String; ACount: Word = 1; + ADesc: String = ''; ALkupTbl: String = ''; AFormatStr: String = ''; + AClass: TTagClass = nil; AReadOnly: Boolean = false); + procedure AddURationalTag(ATagID: TTagID; AName: String; ACount: Word = 1; + ADesc: String = ''; ALkupTbl: String = ''; AFormatStr: String = ''; + AClass: TTagClass = nil; AReadOnly: Boolean = false); + procedure AddSRationalTag(ATagID: TTagID; AName: String; ACount: Word = 1; + ADesc: String = ''; ALkupTbl: String = ''; AFormatStr: String = ''; + AClass: TTagClass = nil; AReadOnly: Boolean = false); + + function FindByID(ATagID: TTagID): TTagDef; + function FindByIDWithoutParent(ATagID: Word): TTagDef; + function FindByName(AFullTagName: String): TTagDef; + + property Items[AIndex: Integer]: TTagDef read GetItem write SetItem; default; + end; + + TTag = class + private + function GetBigEndian: Boolean; + function GetBinaryAsASCII: Boolean; + function GetDecodeValue: Boolean; + function GetDescription: String; + function GetIsVolatile: Boolean; + function GetReadOnly: Boolean; + function GetTagIDRec: TTagIDRec; + function GetTruncBinary: Boolean; + procedure SetBinaryAsASCII(const AValue: Boolean); + procedure SetDecodeValue(const AValue: Boolean); + procedure SetRawData(const AValue: TBytes); + procedure SetTruncBinary(const AValue: Boolean); + protected + FTagID: TTagID; + FDesc: String; + FGroup: TTagGroup; + FName: String; + FType: TTagType; + FCount: Integer; + FRawData: TBytes; + FFormatStr: String; + FLkupTbl: String; + FListSeparator: Char; + FOptions: TTagOptions; + function GetAsFloat: Double; virtual; + function GetAsFloatArray: TExifDoubleArray; virtual; + function GetAsInteger: Integer; virtual; + function GetAsIntegerArray: TExifIntegerArray; virtual; + function GetAsRational: TExifRational; virtual; + function GetAsRationalArray: TExifRationalArray; virtual; + function GetAsString: String; virtual; + function Lookup(const AKey, ALookupTbl: String; ASameKeyFunc: TLookupCompareFunc): String; + function LookupValue(const AValue, ALookupTbl: String): String; + procedure SetAsFloat(const AValue: Double); virtual; + procedure SetAsFloatArray(const AValue: TExifDoubleArray); virtual; + procedure SetAsInteger(const AValue: Integer); virtual; + procedure SetAsIntegerArray(const AValue: TExifIntegerArray); virtual; + procedure SetAsRational(const AValue: TExifRational); virtual; + procedure SetAsRationalArray(const AValue: TExifRationalArray); virtual; + procedure SetAsString(const AValue: String); virtual; + property FormatStr: String read FFormatStr write FFormatStr; + property LkupTbl: String read FLkupTbl write FLkupTbl; + public + constructor Create(ATagDef: TTagDef; AIsBigEndian: Boolean); overload; + constructor Create(ATagDef: TTagDef; AOptions: TTagOptions); overload; virtual; +// procedure GetTagIDOfGroup(out ATagIDOfGroup: TTagID; out AGroupOfGroup: TTagGroup); + function HasData: Boolean; + { Tag value as a float value } + property AsFloat: Double read GetAsFloat write SetAsFloat; + { Tag value as a float array } + property AsFloatArray: TExifDoubleArray read GetAsFloatArray write SetAsFloatArray; + { Tag value as an integer } + property AsInteger: Integer read GetAsInteger write SetAsInteger; + { Tag value as an integer array (if Count > 1) } + property AsIntegerArray: TExifIntegerArray read GetAsIntegerArray write SetAsIntegerArray; + { Tag value as a rational value } + property AsRational: TExifRational read GetAsRational write SetAsRational; + { Tag value as a rational array } + property AsRationalArray: TExifRationalArray read GetAsRationalArray write SetAsRationalArray; + { Returns the tag value as a string } + property AsString: String read GetAsString write SetAsString; + { Make AsString return binary tag bytes as ASCII characters, otherwise as decimal numbers } + property BinaryAsASCII: Boolean read GetBinaryAsASCII write SetBinaryAsASCII; + { Returns the name of the tag. To be used when accessing the tag. } + property Name: String read FName; + { Returns a better-readable or even localized description of the tag } + property Description: String read GetDescription; + { Returns the numeric ID of the tag } + property TagID: TTagID read FTagID; + property TagIDRec: TTagIDRec read GetTagIDRec; + { Identifies the group to which the tag belongs. The tag is unique only within its group. } + property Group: TTagGroup read FGroup; + { Defines the data type of the tag } + property TagType: TTagType read FType write FType; + { Determines the number of elements of which the tag value consists } + property Count: Integer read FCount write FCount; + { Raw data of the tag value as read from the file or to be written to the file } + property RawData: TBytes read FRawData write SetRawData; + { Indicates wheter the raw data are in little endian or big endian byte order } + property BigEndian: Boolean read GetBigEndian; + { Determines whether the meaning of numberical values will be decoded. } + property DecodeValue: Boolean read GetDecodeValue write SetDecodeValue; + { Character used separate array elements, usually for binary tags } + property ListSeparator: Char read FListSeparator write FListSeparator; + { Is true when this tag cannot be altered by fpExif. } + property ReadOnly: Boolean read GetReadOnly; + { In AsString, return only the first MaxBinaryBytes of binary tag values } + property TruncateBinary: Boolean read GetTruncBinary write SetTruncBinary; + { Tag is not written to file } + property IsVolatile: Boolean read GetIsVolatile; + end; + + TNumericTag = class(TTag) + public + constructor Create(ATagDef: TTagDef; AOptions: TTagOptions); overload; override; + property FormatStr; + property LkupTbl; + end; + + TIntegerTag = class(TNumericTag) + protected + function GetAsFloat: Double; override; + function GetAsFloatArray: TExifDoubleArray; override; + function GetAsInteger: Integer; override; + function GetAsIntegerArray: TExifIntegerArray; override; + function GetAsRational: TExifRational; override; + function GetAsRationalArray: TExifRationalArray; override; + function GetAsString: String; override; + procedure SetAsInteger(const AValue: Integer); override; + procedure SetAsIntegerArray(const AValue: TExifIntegerArray); override; + procedure SetAsString(const AValue: String); override; + protected + function GetInteger(AIndex: Integer; out AValue: Integer): Boolean; + procedure SetInteger(const AIndex, AValue: Integer; + WithRangeCheck: Boolean = true); + end; + + TFloatTag = class(TNumericTag) + private +// FValidDigits: Integer; + protected + function GetAsFloat: Double; override; + function GetAsFloatArray: TExifDoubleArray; override; + function GetAsInteger: Integer; override; + function GetAsIntegerArray: TExifIntegerArray; override; + function GetAsRational: TExifRational; override; + function GetAsRationalArray: TExifRationalArray; override; + function GetAsString: String; override; + procedure SetAsFloat(const AValue: Double); override; + procedure SetAsFloatArray(const AValue: TExifDoubleArray); override; + procedure SetAsInteger(const AValue: Integer); override; + procedure SetAsIntegerArray(const AValue: TExifIntegerArray); override; + procedure SetAsRational(const AValue: TExifRational); override; + procedure SetAsRationalArray(const AValue: TExifRationalArray); override; + procedure SetAsString(const AValue: String); override; + protected + function GetFloat(AIndex: Integer; out AValue: Double): Boolean; virtual; + function GetRational(AIndex: Integer; out AValue: TExifRational): Boolean; virtual; + procedure InternalSetRational(AIndex: Integer; AValue: TExifRational); + function IsInt(AValue: Double): Boolean; + procedure SetFloat(AIndex: Integer; const AValue: Double); virtual; + procedure SetRational(AIndex: Integer; const AValue: TExifRational); virtual; + public +// constructor Create(ATagDef: TTagDef; AOptions: TTagOptions); override; + property AsFloat: Double read GetAsFloat write SetAsFloat; + property AsFloatArray: TExifDoubleArray read GetAsFloatArray write SetAsFloatArray; + property AsRational: TExifRational read GetAsRational write SetAsRational; + property AsRationalArray: TExifRationalArray read GetAsRationalArray write SetAsRationalArray; +// property ValidDigits: Integer read FValidDigits write FValidDigits; + end; + + TStringTag = class(TTag) + protected + function GetAsString: String; override; + procedure SetAsString(const AValue: String); override; + public + constructor Create(ATagDef: TTagDef; AOptions: TTagOptions); override; + property AsString: String read GetAsString write SetAsString; + property LkupTbl; + end; + + TBinaryTag = class(TTag) + protected + function GetAsString: String; override; + procedure SetAsString(const AValue: String); override; + public + property LkupTbl; + end; + + TOffsetTag = class(TIntegerTag) + private + FTiffHeaderOffset: Int64; + public + property TiffHeaderOffset: Int64 read FTiffHeaderOffset write FTiffHeaderOffset; + end; + + // Tag which contains the offset to a new sub-IFD (IFD = "image file directory") + TSubIFDTag = class(TOffsetTag) + public + constructor Create(ATagDef: TTagDef; AOptions: TTagOptions); overload; override; + end; + + TMakerNoteTag = class(TBinaryTag) + end; + + TTagList = class(TObjectList) + private + function GetItem(AIndex: Integer): TTag; + procedure SetItem(AIndex: integer; const AValue: TTag); + public + function GetGroupOfTag(ATagID: TTagID): TTagGroup; virtual; + function IndexOfParentByID(ATagID: TTagID): Integer; + function IndexOfTagByID(ATagID: TTagID): Integer; + property Items[AIndex: Integer]: TTag read GetItem write SetItem; default; + end; + + +const + DefaultTagClasses: array[TTagType] of TTagClass = ( + TIntegerTag, TIntegerTag, TIntegerTag, TFloatTag, // UInt8, UInt16, UInt32, URational + TIntegerTag, TIntegerTag, TIntegerTag, TFloatTag, // SInt8, SInt16, SInt32, SRational + TStringTag, // String + TBinaryTag, // Binary + TFloatTag, TFloatTag, // Single, Double + TSubIFDTag // IFD + ); + + (* +{ TTagGroups } + +function GetGroupFromGeneratingTagID(ATagID: TTagID): TTagGroup; + *) + +implementation + +uses + Math, StrUtils, + fpeUtils; + (* +type + TGroupRecord = record + TagID: TTagID; + Group: TTagGroup; + end; + +var + // This list collects in which IFD rags referring to subIFDs are found. } + TagsOfGroups: array[TTagGroup] of TGroupRecord = ( + (TagID:$FFFF; Group: tgUnknown), // tgUnknown + (TagID:$FFFF; Group: tgUnknown), // tgJFIF + (TagID:0; Group: tgExifPrimary), // tgExifPrimary + (TagID:1; Group: tgExifPrimary), // tgExifThumbnail + (TagID:TAG_EXIF_OFFSET; Group: tgExifPrimary), // tgExifSub + (TagID:Tag_INTEROP_OFFSET; Group: tgExifSub), // tgExifInterOp + (TagID:Tag_GPS_OFFSET; Group: tgExifPrimary), // tgExifGps + (TagID:Tag_MAKERNOTE; Group: tgExifSub), // tgExifMakerNote + (TagID:$FFFF; Group: tgExifMakerNote), // tgExifMakerNoteSub + (TagID:$FFFF; Group: tgUnknown) // tgIPTC + ); + *) +//============================================================================== +// Utilities +//============================================================================== +function SameIntegerFunc(AKey1, AKey2: String): Boolean; +var + k1, k2: Integer; +begin + Result := TryStrToInt(AKey1, k1) and TryStrToInt(AKey2, k2) and (k1 = k2); +end; + +function SameStringFunc(AKey1, AKey2: String): Boolean; +begin + Result := SameText(AKey1, AKey2); +end; + + +//============================================================================== +// TTagDef +//============================================================================== +function TTagDef.GetTagID: TTagID; +begin + Result := TTagID(TagIDRec); +end; + +procedure TTagDef.SetTagID(const AValue: TTagID); +begin + TagIDRec := TTagIDRec(AValue); +end; + +//============================================================================== +// TTagDefList +//============================================================================== + +procedure TTagDefList.AddBinaryTag(ATagID: TTagID; AName: String; + ACount: Word = 1; ADesc: String = ''; ALkupTbl: String = ''; + AFormatStr: String = ''; AClass: TTagClass = nil; AReadOnly: Boolean = false); +begin + AddTag(ATagID, AName, ttBinary, ACount, ADesc, ALkupTbl, AFormatStr, + AClass, AReadOnly); +end; + +procedure TTagDefList.AddByteTag(ATagID: TTagID; AName: String; + ACount: Word = 1; ADesc: String = ''; ALkupTbl: String = ''; + AFormatStr: String = ''; AClass: TTagClass = nil; AReadOnly: Boolean = false); +begin + AddTag(ATagID, AName, ttUInt8, ACount, ADesc, ALkupTbl, AFormatStr, + AClass, AReadOnly); +end; + +procedure TTagDefList.AddIFDTag(ATagID: TTagID; AName: String; + ADesc: String = ''; AClass: TTagClass = nil; AReadOnly: Boolean = false); +begin + AddTag(ATagID, AName, ttIFD, 1, ADesc, '', '', AClass, AReadOnly); +end; + +procedure TTagDefList.AddSLongTag(ATagID: TTagID; AName: String; + ACount: Word = 1; ADesc: String = ''; ALkupTbl: String = ''; + AFormatStr: String = ''; AClass: TTagClass = nil; AReadOnly: Boolean = false); +begin + AddTag(ATagID, AName, ttSInt32, ACount, ADesc, ALkupTbl, AFormatStr, + AClass, AReadOnly); +end; + +procedure TTagDefList.AddSRationalTag(ATagID: TTagID; AName: String; + ACount: Word =1; ADesc: String = ''; ALkupTbl: String = ''; + AFormatStr: String = ''; AClass: TTagClass = nil; AReadOnly: Boolean = false); +begin + AddTag(ATagID, AName, ttSRational, ACount, ADesc, ALkupTbl, AFormatStr, + AClass, AReadOnly); +end; + +procedure TTagDefList.AddSShortTag(ATagID: TTagID; AName: String; + ACount: Word = 1; ADesc: String = ''; ALkupTbl: String = ''; + AFormatStr: String = ''; AClass: TTagClass = nil; AReadOnly: Boolean = false); +begin + AddTag(ATagID, AName, ttSInt16, ACount, ADesc, ALkupTbl, AFormatStr, + AClass, AReadOnly); +end; + +procedure TTagDefList.AddStringTag(ATagID: TTagID; AName: String; + ACount: Word = 1; ADesc: String = ''; ALkupTbl: String = ''; + AClass: TTagClass = nil; AReadOnly: Boolean = false); +begin + AddTag(ATagID, AName, ttString, ACount, ADesc, ALkupTbl, '', + AClass, AReadOnly); +end; + +procedure TTagDefList.AddTag(ATagID: TTagID; AName: String; + AType: TTagType; ACount: Word = 1; ADesc: String = ''; ALkUpTbl: String = ''; + AFormatStr: String = ''; AClass: TTagClass = nil; AReadOnly: Boolean = false); +var + tagdef: TTagDef; +begin + tagdef := TTagDef.Create; + tagdef.TagIDRec := TTagIDRec(ATagID); + tagdef.Group := GetGroupOfTag(ATagID); + tagdef.TagType := AType; + tagdef.Count := ACount; + tagdef.Name := AName; + tagdef.Desc := ADesc; + tagdef.LkUpTbl := ALkUpTbl; + tagdef.FormatStr := AFormatStr; + tagdef.ReadOnly := AReadOnly; + if AClass = nil then + case AType of + ttUInt8, ttUInt16, ttUInt32, ttSInt8, ttSInt16, ttSInt32: + AClass := TIntegerTag; + ttURational, ttSRational: + AClass := TFloatTag; + ttString: + AClass := TStringTag; + ttBinary: + AClass := TBinaryTag; + ttIFD: + AClass := TSubIFDTag; + else + raise EFpExif.Create('[TTagDefList.AddTag] TagType not supported.'); + end; + tagdef.TagClass := AClass; + Add(tagdef); +end; + +procedure TTagDefList.AddUShortTag(ATagID: TTagID; AName: String; + ACount: Word = 1; ADesc: String = ''; ALkupTbl: String = ''; + AFormatStr: String = ''; AClass: TTagClass = nil; AReadOnly: Boolean = false); +begin + AddTag(ATagID, AName, ttUInt16, ACount, ADesc, ALkupTbl, AFormatStr, + AClass, AReadOnly); +end; + +procedure TTagDefList.AddULongTag(ATagID: TTagID; AName: String; + ACount: Word = 1; ADesc: String = ''; ALkupTbl: String = ''; + AFormatStr: String = ''; AClass: TTagClass = nil; AReadOnly: Boolean = false); +begin + AddTag(ATagID, AName, ttUInt32, ACount, ADesc, ALkupTbl, AFormatStr, + AClass, AReadOnly); +end; + +procedure TTagDefList.AddURationalTag( ATagID: TTagID; AName: String; + ACount: Word = 1; ADesc: String = ''; + ALkupTbl: String = ''; AFormatStr: String = ''; AClass: TTagClass = nil; + AReadOnly: Boolean = false); +begin + AddTag(ATagID, AName, ttURational, ACount, ADesc, ALkupTbl, AFormatStr, + AClass, AReadOnly); +end; + +function TTagDefList.FindByID(ATagID: TTagID): TTagDef; +var + i: Integer; +begin + for i:=0 to Count-1 do begin + Result := GetItem(i); + if TTagID(Result.TagIDRec) = ATagID then + exit; + end; + Result := nil; +end; + +{ Looks for the tag definition specified by the ID of the tag only, ignoring + the id of its parent. } +function TTagDefList.FindByIDWithoutParent(ATagID: word): TTagDef; +var + i: Integer; + tagdef: TTagDef; +begin + for i := 0 to Count-1 do begin + tagdef := GetItem(i); + if TTagIDRec(tagdef.TagID).Tag = ATagID then begin + Result := tagDef; + exit; + end; + end; + Result := nil; +end; + +function TTagDefList.FindByName(AFullTagName: String): TTagDef; +var + gname, tname: String; + p, i: Integer; +begin + p := pos('.', AFullTagName); + if p <> 0 then begin + gname := copy(AFullTagName, 1, p-1); + tname := copy(AFullTagName, p+1, MaxInt); + end else begin + gname := ''; + tname := AFullTagName; + end; + if gname = '' then + for i:=0 to Count-1 do begin + Result := GetItem(i); + if SameText(tname, Result.Name) then + exit; + end + else + for i:=0 to Count-1 do begin + Result := GetItem(i); + if SameText(tname, Result.Name) and + (SameText(gname, GroupNames[Result.Group]) or SameText(gname, NiceGroupNames[Result.Group])) + then + exit; + end; + Result := nil; +end; + +function TTagDefList.GetGroupOfTag(ATagID: TTagID): TTagGroup; +var + idx: Integer; + tagIDRec: TTagIDRec absolute ATagID; + tagDef: TTagDef; +begin + Result := tgUnknown; + case tagIDRec.Parent of + $0000 : ; + $0001 : Result := tgExifPrimary; + $0002 : Result := tgExifThumbnail; + TAG_GPS_OFFSET : Result := tgExifGPS; + TAG_INTEROP_OFFSET : Result := tgExifInterOp; + TAG_EXIF_OFFSET : Result := tgExifSub; + TAG_MAKERNOTE : Result := tgExifMakerNote + else + idx := IndexOfParentByID(ATagID); + if idx = -1 then + exit; + tagdef := GetItem(idx); + Result := GetGroupOfTag(TTagID(tagdef.TagID)); + end; +end; + +function TTagDefList.GetItem(AIndex: Integer): TTagDef; +begin + Result := TTagDef(inherited Items[AIndex]); +end; + +{ Finds the index of the tag which is the parent of the tag with the specified ID } +function TTagDefList.IndexOfParentByID(ATagID: TTagID): Integer; +var + tagDef: TTagDef; +begin + for Result := 0 to Count - 1 do begin + tagDef := GetItem(Result); + if TTagIDRec(tagDef.TagID).Tag = TTagIDRec(ATagID).Parent then + exit; + end; + Result := -1; +end; + +procedure TTagDefList.SetItem(AIndex: Integer; AValue: TTagDef); +begin + inherited Items[AIndex] := AValue; +end; + + +//============================================================================== +// TTag +//============================================================================== + +constructor TTag.Create(ATagDef: TTagDef; AIsBigEndian: Boolean); +var + optns: TTagOptions; +begin + optns := []; + if AIsBigEndian then + Include(optns, toBigEndian); + if ATagDef.ReadOnly then + Include(optns, toReadOnly); + Create(ATagDef, optns); +end; + +constructor TTag.Create(ATagDef: TTagDef; AOptions: TTagOptions); +begin + FTagID := ATagDef.TagID; + FGroup := ATagDef.Group; + FName := ATagDef.Name; + FDesc := ATagDef.Desc; + FType := ATagDef.TagType; + FCount := ATagDef.Count; + FFormatStr := ATagDef.FormatStr; + FLkupTbl := ATagDef.LkupTbl; + FOptions := AOptions; + FListSeparator := fpExifFmtSettings.ListSeparator; +end; + +function TTag.{%H-}GetAsInteger: Integer; +begin + raise EFpExif.CreateFmt('Tag "%s" does not return an integer', [FName]); +end; + +function TTag.{%H-}GetAsIntegerArray: TExifIntegerArray; +begin + raise EFpExif.CreateFmt('Tag "%s" does not return an integer array.', [FName]); +end; + +function TTag.{%H-}GetAsFloat: Double; +begin + raise EFpExif.CreateFmt('Tag "%s" does not return a float value', [FName]); +end; + +function TTag.{%H-}GetAsFloatArray: TExifDoubleArray; +begin + raise EFpExif.CreateFmt('Tag "%s" does not return a float array.', [FName]); +end; + +function TTag.{%H-}GetAsRational: TExifRational; +begin + raise EFpExif.CreateFmt('Tag "%s" does not return a rational value', [FName]); +end; + +function TTag.{%H-}GetAsRationalArray: TExifRationalArray; +begin + raise EFpExif.CreateFmt('Tag "%s" does not return a rational array.', [FName]); +end; + +function TTag.GetAsString: String; +begin + Result := ''; +end; + +function TTag.GetBigEndian: Boolean; +begin + Result := toBigEndian in FOptions; +end; + +function TTag.GetBinaryAsASCII: Boolean; +begin + Result := toBinaryAsAscii in FOptions; +end; + +function TTag.GetDecodeValue: Boolean; +begin + Result := toDecodeValue in FOptions; +end; + +function TTag.GetDescription: String; +begin + if FDesc = '' then begin + if FName = '' then + Result := 'Unknown' + else + Result := InsertSpaces(FName); + end + else + Result := FDesc; +end; + +function TTag.GetIsVolatile: Boolean; +begin + Result := toVolatile in FOptions; +end; + +function TTag.GetReadOnly: Boolean; +begin + Result := toReadOnly in FOptions; +end; + (* +{ Returns the ID and the group of the tag defining the group of the current tag. + Example: + The tag "FocalLength" belongs to group EXIF; this group is defined by tag + ATagIDOfGroup (--> ATagIDOfGroup) which itself resides in the primary group + (--> AGroupOfGroup = tgExifPrimary). } +procedure TTag.GetTagIDOfGroup(out ATagIDOfGroup: TTagID; + out AGroupOfGroup: TTagGroup); +begin + with TagsOfGroups[FGroup] do begin + ATagIDOfGroup := TagID; + AGroupOfGroup := Group; + end; +end; *) + +function TTag.GetTagIDRec: TTagIDRec; +begin + Result := TTagIDRec(FTagID); +end; + +{ Getter for property TruncateBinary. Returns whether the function AsString + should return at most MaxBinaryBytes bytes. } +function TTag.GetTruncBinary: Boolean; +begin + Result := toTruncateBinary in FOptions; +end; + +{ Checks if the tag has data. Tags without data can occur if a non-existing + tag has been accessed by its TExifData property. Such tags will not be written + to the stream. } +function TTag.HasData: Boolean; +begin + Result := Length(FRawData) > 0; +end; + +{ The lookup table to which ALookupTbl points is a comma-separated string + constisting of key:value pairs. Seeks for the provided key and returns the + corresponding value. The function SameKeyFunk is used to check that the + key is matched. } +function TTag.Lookup(const AKey, ALookupTbl: String; ASameKeyFunc: TLookupCompareFunc): String; +begin + Result := fpeUtils.LookupValue(AKey, ALookupTbl, ASameKeyFunc); +end; + +function TTag.LookupValue(const AValue, ALookupTbl: String): String; +begin + Result := fpeUtils.LookupKey(AValue, ALookupTbl, @SameStringFunc); +end; + +procedure TTag.SetAsFloat(const AValue: Double); +begin + Unused(AValue); + raise EFpExif.CreateFmt('Cannot assign a float value to tag "%s".', [FName]); +end; + +procedure TTag.SetAsFloatArray(const AValue: TExifDoubleArray); +begin + Unused(AValue); + raise EFpExif.CreateFmt('Cannot assign a float array to tag "%s".', [FName]); +end; + +procedure TTag.SetAsInteger(const AValue: Integer); +begin + Unused(AValue); + raise EFpExif.CreateFmt('Cannot assign an integer value to tag "%s".', [FName]); +end; + +procedure TTag.SetAsIntegerArray(const AValue: TExifIntegerArray); +begin + Unused(AValue); + raise EFpExif.CreateFmt('Cannot assign an integer array to tag "%s".', [FName]); +end; + +procedure TTag.SetAsRational(const AValue: TExifRational); +begin + Unused(AValue); + raise EFpExif.CreateFmt('Cannot assign an rational value to tag "%s".', [FName]); +end; + +procedure TTag.SetAsRationalArray(const AValue: TExifRationalArray); +begin + Unused(AValue); + raise EFpExif.CreateFmt('Cannot assign a rational array to tag "%s".', [FName]); +end; + +procedure TTag.SetAsString(const AValue: String); +begin + Unused(AValue); +end; + +procedure TTag.SetBinaryAsASCII(const AValue: Boolean); +begin + if AValue then + Include(FOptions, toBinaryAsAscii) + else + Exclude(FOptions, toBinaryAsAscii); +end; + +procedure TTag.SetDecodeValue(const AValue: Boolean); +begin + if AValue then + Include(FOptions, toDecodeValue) + else + Exclude(FOptions, toDecodeValue); +end; + +procedure TTag.SetRawData(const AValue: TBytes); +var + len: Integer; +begin + len := Length(AValue); + FCount := len div TagElementSize[ord(FType)]; + SetLength(FRawData, len); + Move(AValue[0], FRawData[0], len); +end; + +procedure TTag.SetTruncBinary(const AValue: Boolean); +begin + if AValue then + Include(FOptions, toTruncateBinary) + else + Exclude(FOptions, toTruncateBinary); +end; + + +//============================================================================== +// TNumericTag +//============================================================================== + +constructor TNumericTag.Create(ATagDef: TTagDef; AOptions: TTagOptions); +begin + inherited Create(ATagDef, AOptions); + FLkupTbl := ATagDef.LkupTbl; +end; + + +//============================================================================== +// TIntegerTag +//============================================================================== + +function TIntegerTag.GetAsFloat: Double; +var + intVal: Integer; +begin + if GetInteger(0, intVal) then + Result := intVal * 1.0 + else + Result := NaN; +end; + +function TIntegerTag.GetAsFloatArray: TExifDoubleArray; +var + intVal: TExifIntegerArray; + i: Integer; +begin + intval := GetAsIntegerArray; + SetLength(Result, Length(intVal)); + for i:=0 to High(intval) do + Result[i] := intval[i] * 1.0; +end; + +function TIntegerTag.GetAsInteger: Integer; +begin + if not GetInteger(0, Result) then + Result := -1; +end; + +function TIntegerTag.GetAsIntegerArray: TExifIntegerArray; +var + i: Integer; +begin + SetLength(Result, FCount); + for i:=0 to FCount-1 do + if not GetInteger(i, Result[i]) then begin + SetLength(Result, 0); + exit; + end; +end; + +function TIntegerTag.GetAsRational: TExifRational; +var + intval: Integer; +begin + if GetInteger(0, intval) then begin + Result.Numerator := intval; + Result.Denominator := 1; + end else begin + Result.Numerator := 1; + Result.Denominator := 0; + end; +end; + +function TIntegerTag.GetAsRationalArray: TExifRationalArray; +var + intval: TExifIntegerArray; + i: Integer; +begin + intval := GetAsIntegerArray; + SetLength(Result, Length(intval)); + for i:=0 to High(intval) do begin + Result[i].Numerator := intval[i]; + Result[i].Denominator := 1; + end; +end; + +function TIntegerTag.GetAsString: String; +var + intVal: Integer; + i: Integer; + s: String; +begin + Result := ''; + + for i:=0 to FCount-1 do begin + if not GetInteger(i, intVal) then begin + Result := ''; + exit; + end; + if FFormatStr <> '' then + s := Format(FFormatStr, [intVal]) + else + if (FLkupTbl <> '') and (toDecodeValue in FOptions) then + s := Lookup(IntToStr(intVal), FLkupTbl, @SameIntegerFunc) + else + s := IntToStr(intVal); + Result := IfThen(i = 0, s, Result + FListSeparator + s); + if (toTruncateBinary in FOptions) and (i >= MaxBinaryBytes) then begin + Result := Result + ' [...]'; + exit; + end; + end; +end; + +function TIntegerTag.GetInteger(AIndex: Integer; out AValue: Integer): Boolean; +var + byteIndex: Integer; +begin + Result := false; + byteIndex := AIndex * TagElementSize[ord(FType)]; + if byteIndex + TagElementSize[ord(FType)] > Length(FRawData) then + exit; + + case FType of + ttUInt8: + AValue := FRawData[byteIndex]; + ttUInt16: + if BigEndian then + AValue := BEtoN(Word(PWord(@FRawData[byteIndex])^)) + else + AValue := LEtoN(Word(PWord(@FRawData[byteIndex])^)); + ttUInt32: + if BigEndian then + AValue := BEtoN(DWord(PDWord(@FRawData[byteIndex])^)) + else + AValue := LEtoN(DWord(PDWord(@FRawData[byteIndex])^)); + ttSInt8: + AValue := ShortInt(FRawData[byteIndex]); + ttSInt16: + if BigEndian then + AValue := SmallInt(BEtoN(Word(PWord(@FRawData[byteIndex])^))) + else + AValue := SmallInt(LEtoN(Word(PWord(@FRawData[byteIndex])^))); + ttSInt32: + if BigEndian then + AValue := LongInt(BEtoN(DWord(PDWord(@FRawData[byteIndex])^))) + else + AValue := LongInt(BEtoN(DWord(PDWord(@FRawData[byteIndex])^))); + //else + // raise EFpExif.CreateFmt('TagType not allowed for TIntegerTag "%s"', [FName]); + end; + Result := true; +end; + +procedure TIntegerTag.SetAsInteger(const AValue: Integer); +begin + FCount := 1; + SetLength(FRawData, TagElementSize[ord(FType)]); + SetInteger(0, AValue); +end; + +procedure TIntegerTag.SetAsIntegerArray(const AValue: TExifIntegerArray); +var + i: Integer; +begin + FCount := Length(AValue); + SetLength(FRawData, FCount * TagElementSize[ord(FType)]); + for i := 0 to FCount-1 do + SetInteger(i, AValue[i]); +end; + +procedure TIntegerTag.SetAsString(const AValue: String); + + function SetString(AStr: String): Integer; + var + s: String; + begin + if TryStrToInt(AStr, Result) then + exit; + s := LookupValue(AStr, FLkupTbl); + if TryStrToInt(s, Result) then + exit; + raise EFpExif.CreateFmt('Unknown value in tag "%s"', [FName]); + end; + +var + i, j, n: Integer; + s: String; + intArr: TExifIntegerArray; +begin + if AValue = '' then begin + SetLength(FRawData, 0); + exit; + end; + + n := CountChar(FListSeparator, AValue); + SetLength(intArr, n+1); + + j := 0; + s := ''; + for i := 1 to Length(AValue) do begin + if (AValue[i] = FListSeparator) then begin + intArr[j] := SetString(s); + inc(j); + s := ''; + end else + s := s + AValue[i]; + end; + + if s <> '' then + intArr[j] := SetString(s); + + SetAsIntegerArray(intArr); +end; + + +// Assumes that Length(FValue) is already set up correctly. +procedure TIntegerTag.SetInteger(const AIndex, AValue: Integer; + WithRangeCheck: Boolean = true); +var + byteIndex: Integer; + w: Word; + dw: DWord; +begin + byteIndex := AIndex * TagElementSize[ord(FType)]; + case FType of + ttUInt8: + if not WithRangeCheck or ((AValue >= 0) and (AValue <= 255)) then + FRawData[AIndex] := PByte(@AValue)^ + else + raise EFpExif.CreateFmt('Value %d out of range for tag "%s"', [AValue, FName]); + ttUInt16: + if not WithRangeCheck or ((AValue >= 0) and (AValue <= 65535)) then begin + if BigEndian then + w := NtoBE(PWord(@AValue)^) + else + w := NtoLE(PWord(@AValue)^); + Move(w, FRawData[byteIndex], SizeOf(w)); + end else + raise EFpExif.CreateFmt('Value %d out of range for tag "%s"', [AValue, FName]); + ttUInt32, + ttIFD: + if not WithRangeCheck or (AValue >= 0) then begin + if BigEndian then + dw := NtoBE(PDWord(@AValue)^) + else + dw := NtoLE(PDWord(@AValue)^); + Move(dw, FRawData[byteIndex], SizeOf(dw)); + end else + raise EFpExif.CreateFmt('Value %d out of range for tag "%s"', [AValue, FName]); + ttSInt8: + if not WithRangeCheck or ((AValue >= -128) and (AValue <= 127)) then + FRawData[AIndex] := {%H-}PByte(AValue)^ + else + raise EFpExif.CreateFmt('Value %d out of range for tag "%s"', [AValue, FName]); + ttSInt16: + if not WithRangeCheck or ((AValue >= -32768) and (AValue <= 32767)) then begin + if BigEndian then + w := NtoBE(PWord(@AValue)^) + else + w := NtoLE(PWord(@AValue)^); + Move(w, FRawData[byteIndex], SizeOf(w)); + end else + raise EFpExif.CreateFmt('Value %d out of range for tag "%s"', [AValue, FName]); + ttSInt32: + { + if not WithRangeCheck or + ((AValue >= LongInt($80000000)) and (AValue <= LongInt($7FFFFFFF))) then + } + begin + if BigEndian then + dw := NtoBE(PDWord(@AValue)^) + else + dw := NtoLE(PDWord(@AValue)^); + Move(dw, FRawData[byteIndex], SizeOf(dw)); + end; + { + else + raise EFpExif.CreateFmt('Value %d out of range for tag "%s"', [AValue, FName]); + } + else + raise EFpExif.Create('TagType not allowed for TIntegerTag'); + end; +end; + + +//============================================================================== +// TFloatTag +//============================================================================== + { +constructor TFloatTag.Create(ATagDef: TTagDef; AOptions: TTagOptions); +begin + inherited Create(ATagDef, AOptions); + FValidDigits := 6; +end; + } +function TFloatTag.GetAsFloat: Double; +begin + if not GetFloat(0, Result) then + Result := NaN +end; + +function TFloatTag.GetAsFloatArray: TExifDoubleArray; +var + i, n: Integer; +begin + n := Length(FRawData) div TagElementSize[ord(FType)]; + SetLength(Result, n); + for i := 0 to n-1 do + if not GetFloat(i, Result[i]) then begin + SetLength(Result, 0); + exit; + end; +end; + +function TFloatTag.GetAsInteger: Integer; +var + f: Double; +begin + f := GetAsFloat; + if IsNaN(f) or (frac(f) <> 0.0) then + raise EFpExif.CreateFmt('Tag "%s" has a non-integer value.', [FName]) + else + Result := Round(f); +end; + +function TFloatTag.GetAsIntegerArray: TExifIntegerArray; +var + f: TExifDoubleArray; + i: Integer; +begin + f := GetAsFloatArray; + for i:=0 to High(f) do + if IsNaN(f[i]) or (frac(f[i]) <> 0) then + raise EFpExif.CreateFmt('Tag "%s" contains non-integer values.', [FName]); + SetLength(Result, Length(f)); + for i:=0 to High(f) do + Result[i] := Round(f[i]); +end; + +function TFloatTag.GetAsRational: TExifRational; +begin + if not GetRational(0, Result) then + Result.Denominator := 0; +end; + +function TFloatTag.GetAsRationalArray: TExifRationalArray; +var + i: Integer; + n: Integer; +begin + n := Length(FRawData) div TagElementSize[ord(FType)]; + SetLength(Result, n); + for i:=0 to n-1 do + if not GetRational(i, Result[i]) then begin + SetLength(Result, 0); + exit; + end; +end; + +function TFloatTag.GetAsString: String; +var + r: TExifRational; + i: Integer; + s: String; + fval: Double; +begin + for i:=0 to Count-1 do begin + if (not GetRational(i, r)) or (r.Denominator = 0) then begin + Result := 'undef'; + exit; + end; + + fVal := r.Numerator / r.Denominator; + if IsInt(fval) then + fVal := Round(fVal); + + if FFormatStr <> '' then + s := Format(FFormatStr, [r.Numerator, r.Denominator, fval], fpExifFmtSettings) + // NOTE: FFormatStr must contain an index to the parameter, + // e.g. '%0:d/%1:d = %2:f sec' --> '1/100 = 0.01 sec' + else + if (r.Numerator = 0) then + s := '0' + else + if abs(r.Denominator) = 1 then + s := IntToStr(r.Numerator * Sign(r.Denominator)) + else + s := FloatToStr(fval, fpExifFmtSettings); + + Result := IfThen(i = 0, s, Result + FListSeparator + s); + end +end; + +function TFloatTag.GetFloat(AIndex: Integer; out AValue: Double): Boolean; +var + r: TExifRational; +begin + Result := GetRational(AIndex, r); + if Result then begin + AValue := r.Numerator / r.Denominator; + if IsInt(AValue) then + AValue := Round(AValue); + end; +end; + +function TFloatTag.GetRational(AIndex: Integer; out AValue: TExifRational): Boolean; +var + byteIndex: Integer; + num, denom: DWord; +begin + Result := false; + byteIndex := AIndex * TagElementSize[ord(FType)]; + if byteIndex + TagElementSize[ord(FType)] > Length(FRawData) then + exit; + + case FType of + ttUInt32: + begin + if BigEndian then + AValue.Numerator := BEtoN(DWord(PDWord(@FRawData[byteIndex])^)) + else + AValue.Numerator := LEtoN(DWord(PDWord(@FRawData[byteIndex])^)); + AValue.Denominator := 1; + end; + ttURational, ttSRational: + begin + if BigEndian then begin + num := BEtoN(DWord(PDWord(@FRawData[byteIndex])^)); + denom := BEToN(DWord(PDWord(@FRawData[byteIndex + 4])^)); + end else + begin + num := LEtoN(DWord(PDWord(@FRawData[byteIndex])^)); + denom := LEtoN(DWord(PDWord(@FRawData[byteIndex + 4])^)); + end; + if FType = ttURational then begin + AValue.Numerator := LongInt(num); + AValue.Denominator := LongInt(denom); + end else begin + AValue.Numerator := LongInt(num); + AValue.Denominator := LongInt(denom); + end; + end; + else + raise EFpExif.Create('TagType not allowed for TFloatTag'); + end; + Result := true; +end; + +procedure TFloatTag.InternalSetRational(AIndex: Integer; AValue: TExifRational); +const + ndw = SizeOf(DWord); +var + byteIndex: Integer; + dw: DWord; +begin + byteindex := AIndex * TagElementSize[ord(FType)]; + case FType of + ttURational, ttSRational: + begin + if BigEndian then begin + dw := NtoBE(DWord(AValue.Numerator)); + Move(dw, FRawData[byteIndex], ndw); + dw := NtoBE(DWord(AValue.Denominator)); + Move(dw, FRawData[byteIndex + ndw], ndw); + end else + begin + dw := NtoLE(DWord(AValue.Numerator)); + Move(dw, FRawData[byteIndex], ndw); + dw := NtoLE(DWord(AValue.Denominator)); + Move(dw, FRawData[byteIndex + ndw], ndw); + end; + end; + else + raise EFpExif.CreateFmt('TagType not allowed for TFloatTag "%s"', [FName]); + end; +end; + +function TFloatTag.IsInt(AValue: Double): Boolean; +const + EPS = 1E-6; +begin + Result := abs(AValue - round(AValue)) < EPS; +end; + +procedure TFloatTag.SetAsFloat(const AValue: Double); +begin + FCount := 1; + SetLength(FRawData, SizeOf(TExifRational)); + SetFloat(0, AValue); +end; + +procedure TFloatTag.SetAsFloatArray(const AValue: TExifDoubleArray); +var + i: Integer; +begin + FCount := Length(AValue); + SetLength(FRawData, Length(AValue) * TagElementSize[ord(FType)]); + for i:=0 to FCount-1 do + SetFloat(i, AValue[i]); +end; + +procedure TFloatTag.SetAsInteger(const AValue: Integer); +var + r: TExifRational; +begin + FCount := 1; + SetLength(FRawData, SizeOf(TExifRational)); + r.Numerator := AValue; + r.Denominator := 1; + SetRational(0, r); +end; + +procedure TFloatTag.SetAsIntegerArray(const AValue: TExifIntegerArray); +var + i: Integer; + r: TExifRational; +begin + FCount := Length(AValue); + SetLength(FRawData, Length(AValue) * TagElementSize[ord(FType)]); + for i:=0 to FCount-1 do begin + r.Numerator := AValue[i]; + r.Denominator := 1; + SetRational(i, r); + end; +end; + +procedure TFloatTag.SetAsRational(const AValue: TExifRational); +begin + FCount := 1; + SetLength(FRawData, SizeOf(TExifRational)); + SetRational(0, AValue); +end; + +procedure TFloatTag.SetAsRationalArray(const AValue: TExifRationalArray); +var + i: Integer; +begin + FCount := Length(AValue); + SetLength(FRawData, Length(AValue) * TagElementSize[ord(FType)]); + for i:=0 to FCount-1 do + SetRational(i, AValue[i]); +end; + +procedure TFloatTag.SetAsString(const AValue: String); + + function SetString(AStr: String): Double; + var + p: Integer; + sNum, sDenom: String; + code: Integer; + begin + p := pos('/', AStr); + if p <> 0 then begin + sNum := Copy(AStr, 1, p-1); + sDenom := Copy(AStr, p+1, MaxInt); + Result := StrToInt(sNum) / StrToInt(sDenom); + end else + val(AStr, Result, code); + end; + +var + i, j, n: Integer; + s: String; + floatArr: TExifDoubleArray; +begin + if AValue = '' then begin + SetLength(FRawData, 0); + exit; + end; + + n := CountChar(FListSeparator, AValue); + SetLength(floatArr, n+1); + + s := ''; + j := 0; + for i:=1 to Length(AValue) do begin + if AValue[i] = FListSeparator then begin + floatArr[j] := SetString(s); + inc(j); + s := ''; + end else + if AValue[i] in ['0'..'9', '+', '-', '.', '/', 'e', 'E'] then + s := s + AValue[i] + else + if AValue[i] = ',' then + s := s + '.'; + end; + + if s <> '' then + floatArr[j] := SetString(s); + + SetAsFloatArray(floatArr); +end; + +procedure TFloatTag.SetFloat(AIndex: Integer; const AValue: Double); +var + r: TExifRational; +begin + if (AValue < 0) and (FType = ttURational) then + raise EFpExif.Create('No negative values for unsigned-rational tags.'); + + r := FloatToRational(AValue, 1E-9); + InternalSetRational(AIndex, r); +end; + +procedure TFloatTag.SetRational(AIndex: Integer; const AValue: TExifRational); +begin + InternalSetRational(AIndex, AValue); +end; + + +//============================================================================== +// TStringTag +//============================================================================== + +constructor TStringTag.Create(ATagDef: TTagDef; AOptions: TTagOptions); +begin + inherited Create(ATagDef, AOptions); + FLkupTbl := ATagDef.LkupTbl; +end; + +function TStringTag.GetAsString: String; +var + sa: ansistring; +begin + // FIXME: The next lines assume that FValue stores a string as ansistring + // which is true only for Exif, probably not for IPTC and XMP. + // Not sure what Delphi does when a unicodestring is put into FValue. + + Result := ''; + SetLength(sa, Length(FRawData)); + Move(FRawData[0], sa[1], Length(FRawData)); + while (sa <> '') and (sa[Length(sa)] = #0) do + Delete(sa, Length(sa), 1); + + Result := sa; + + if (FLkUpTbl <> '') and DecodeValue then + Result := Lookup(Result, FLkupTbl, @SameStringFunc); +end; + +procedure TStringTag.SetAsString(const AValue: String); +var + sa: Ansistring; +begin + if AValue = '' then + SetLength(FRawData, 0) + else + begin + sa := ansistring(AValue); + FCount := Length(sa); + SetLength(FRawData, FCount); + Move(sa[1], FRawData[0], FCount); + end; +end; + + +//============================================================================== +// TBinaryTag +//============================================================================== + +function TBinaryTag.GetAsString: String; +var + i: Integer; + mx: Integer; + isTruncated: Boolean; + s: String; + intVal: Integer; + + function MakeASCII(b: Byte): char; + begin + if (b >=32) and (b < 128) then + Result := Char(b) + else + Result := '.'; + end; + +begin + Result := ''; + if Length(FRawData) = 0 then + exit; + + mx := High(FRawData); + if (toTruncateBinary in FOptions) and (MaxBinaryBytes < Length(FRawData)) then + begin + mx := MaxBinaryBytes - 1; + isTruncated := true; + end else + isTruncated := false; + + if (toBinaryAsASCII in FOptions) then begin + for i:= 0 to mx do + Result := Result + MakeASCII(FRawData[i]); + end else + begin + for i := 0 to mx do begin + intVal := FRawData[i]; + if (FLkupTbl <> '') and (toDecodeValue in FOptions) then + s := Lookup(IntToStr(intVal), FLkupTbl, @SameIntegerFunc) + else + s := IntToStr(intVal); + Result := IfThen(i = 0, s, Result + FListSeparator + s); + end; + end; + + if isTruncated then + result := Result + FListSeparator + ' [...]'; +end; + +procedure TBinaryTag.SetAsString(const AValue: String); +var + L: TStringList; + i, n: Integer; +begin + if AValue = '' then begin + SetLength(FRawData, 0); + exit; + end; + + L := TStringList.Create; + try + L.Delimiter := FListSeparator; + L.DelimitedText := AValue; + FCount := L.Count; + SetLength(FRawData, FCount); + for i:=0 to L.Count-1 do + if TryStrToInt(L[i], n) and (n >= 0) and (n <= 255) then + FRawData[i] := byte(n) + else begin + SetLength(FRawData, 0); + FCount := 0; + end; + finally + L.Free; + end; +end; + + +//============================================================================== +// TSubIFTag +//============================================================================== +constructor TSubIFDTag.Create(ATagDef: TTagDef; AOptions: TTagOptions); +begin + inherited Create(ATagDef, AOptions + [toReadOnly]); + // The data value of the SubIFDTag is determined later during saving. + // The default constructor creates the tag without data (Length(FRawData) = 0). + // This would prevent the tag from being written to file. Therefore, we must + // set a dummy value. + AsInteger := 0; +end; + +//============================================================================== +// TTagList +//============================================================================== + +function TTagList.GetGroupOfTag(ATagID: TTagID): TTagGroup; +var + idx: Integer; + tagIDRec: TTagIDRec absolute ATagID; + tag: TTag; +begin + Result := tgUnknown; + case tagIDRec.Parent of + $0000 : ; + $0001 : Result := tgExifPrimary; + $0002 : Result := tgExifThumbnail; + TAG_GPS_OFFSET : Result := tgExifGPS; + TAG_INTEROP_OFFSET : Result := tgExifInterOp; + TAG_EXIF_OFFSET : Result := tgExifSub; + TAG_MAKERNOTE : Result := tgExifMakerNote + else + idx := IndexOfParentByID(ATagID); + if idx = -1 then + exit; + tag := GetItem(idx); + Result := GetGroupOfTag(tag.TagID); + end; +end; + +function TTagList.GetItem(AIndex: Integer): TTag; +begin + Result := TTag(inherited Items[AIndex]); +end; + +{ Finds the index of the tag which is the parent of the tag with the specified ID } +function TTagList.IndexOfParentByID(ATagID: TTagID): Integer; +var + tag: TTag; +begin + for Result := 0 to Count - 1 do begin + tag := GetItem(Result); + if TTagIDRec(tag.TagID).Tag = TTagIDRec(ATagID).Parent then + exit; + end; + Result := -1; +end; + +{ Finds the index of the tag which has the specified TagID } +function TTagList.IndexOfTagByID(ATagID: TTagID): Integer; +var + tag: TTag; +begin + for Result := 0 to Count - 1 do begin + tag := GetItem(Result); + if tag.TagID = ATagID then + exit; + end; + Result := -1; +end; + +procedure TTagList.SetItem(AIndex: Integer; const AValue: TTag); +begin + inherited Items[AIndex] := AValue; +end; + + +//============================================================================== +// Tag groups +//============================================================================== + +(* +{ Determines the tag group which is generated by the specified tag. + Example: ATagID = TAG_EXIF_OFFSET --> Result = tgExifSub } +function GetGroupFromGeneratingTagID(ATagID: TTagID): TTagGroup; +begin + for Result := Low(TTagGroup) to High(TTagGroup) do + if TagsOfGroups[Result].TagID = ATagID then + exit; + Result := tgUnknown; +end; +*) + (* +{ Returns true if the specified tag links to another image file directory (IFD). + Example: Tag $8769 (= TAG_EXIF_OFFSET) links to the EXIF-SubIFD. } +function IsGeneratingTag(ATagID: TTagID): Boolean; +begin + Result := GetGroupFromGeneratingTagID(ATagID) <> tgUnknown; +end; *) + + (* +//============================================================================== +// Tags which link to subdirectories (SubIFD) +//============================================================================== +var + SubIFDTags: Array of TTagID; + +function TagLinksToSubIFD(ATagID: TTagID): Boolean; +var + i: Integer; +begin + for i:=0 to High(SubIFDTags) do + if SubIFDTags[i] = ATagID then begin + Result := true; + exit; + end; + Result := false; +end; + +procedure RegisterSubIFDTag(ATagID: TTagID); +var + n: Integer; +begin + // Ignore if new tag is already registered; + if TagLinksToSubIFD(ATagID) then + exit; + + n := Length(SubIFDTags); + SetLength(SubIFDTags, n + 1); + SubIFDTags[n] := ATagID; +end; + + +initialization + SetLength(SubIFDTags, 3); + SubIFDTags[0] := TAG_EXIF_OFFSET; + SubIFDTags[1] := TAG_INTEROP_OFFSET; + SubIFDTags[2] := TAG_GPS_OFFSET; + +finalization + SubIFDTags := nil; +*) +end. + diff --git a/components/fpexif/fpeutils.pas b/components/fpexif/fpeutils.pas new file mode 100644 index 000000000..ff9e0308c --- /dev/null +++ b/components/fpexif/fpeutils.pas @@ -0,0 +1,1451 @@ +unit fpeUtils; + +{$IFDEF FPC} + {$mode ObjFPC}{$H+} +{$ENDIF} + +{$I fpExif.inc} + +interface + +uses + Classes, SysUtils, +{$IFDEF FPC} + fgl, +{$ELSE} + Windows, + {$IFNDEF dExifNoJpeg}Graphics, jpeg,{$ENDIF} +{$ENDIF} + fpeGlobal; + +type + {$IFDEF FPC} + TInt64List = specialize TFPGList; + {$ELSE} + TInt64List = class(TList) + private + function GetItem(AIndex: Integer): Int64; + procedure SetItem(AIndex: Integer; AValue: Int64); + public + destructor Destroy; override; + function Add(AValue: Int64): Integer; + procedure Clear; override; + property Items[AIndex: Integer]: Int64 read GetItem write SetItem; default; + end; + + TStringArray = array of string; + {$ENDIF} + + // Big endian/little endian utilities +function BEtoN(const AValue: WideString): WideString; overload; +function LEtoN(const AValue: WideString): WideString; overload; +function NtoBE(const AValue: WideString): WideString; overload; +function NtoLE(const AValue: WideString): WideString; overload; +{$IFNDEF FPC} +function NtoBE(const AValue: Word): Word; overload; +function NtoBE(const AValue: DWord): DWord; overload; + +function BEtoN(const AValue: Word): Word; overload; +function BEtoN(const AValue: DWord): DWord; overload; + +function NtoLE(const AValue: Word): Word; overload; +function NtoLE(const AValue: DWord): DWord; overload; + +function LEtoN(const AValue: Word): Word; overload; +function LEtoN(const AValue: DWord): DWord; overload; +{$ENDIF} + +// Delphi7 compatible stream access +function ReadByte(AStream: TStream): Byte; +function ReadWord(AStream: TStream): Word; +function ReadDWord(AStream: TStream): DWord; + +procedure WriteByte(AStream: TStream; AData: Byte); +procedure WriteWord(AStream: TStream; AData: Word); +procedure WriteDWord(AStream: TStream; AData: DWord); + +// GPS utils +{ +//function ExtractGPSPosition(const AValue: String; +// out ADeg, AMin, ASec: Double): Boolean; +} +procedure SplitGps(AValue: Double; out ADegs, AMins, ASecs: Double); overload; +procedure SplitGps(AValue: Double; out ADegs, AMins: Double); overload; +function TryStrToGps(const AValue: String; out ADeg: Double): Boolean; +{ +function GPSToStr(ACoord: Extended; ACoordType: TGpsCoordType; + AGpsFormat: TGpsFormat = gf_DMS_Short; ADecs: Integer = 0): String; +function StrToGPS(s: String): Extended; } + + +// String utils +function CountChar(AChar: Char; const AText: String): Integer; +function FirstWord(const AText: String): String; +function InsertSpaces(ACamelCaseText: String): String; +function LettersOnly(const AText: String): String; +function LookupValue(const AKey, ALookupTbl: String; ACompareFunc: TLookupCompareFunc): String; +function LookupKey(const AValue, ALookupTbl: String; ACompareFunc: TLookupCompareFunc): String; +function NumericOnly(const AText: String): String; +function Split(AText: String; ASeparator: String = #9): TStringArray; +{$IFNDEF FPC} +{$IFNDEF UNICODE} +function UTF8ToAnsi(const S: Ansistring): string; +{$ENDIF} +{$ENDIF} + +// Math utils +function FloatToRational(Value, Precision: Double): TExifRational; +function TryStrToRational(const AStr: String; out AValue: TExifRational): Boolean; +function StrToRational(const AStr: String): TExifRational; +//function GCD(a, b: integer): integer; + +// Image utils +function JPEGImageSize(AStream: TStream; out AWidth, AHeight: Integer): Boolean; +procedure JPEGScaleImage(ASrcStream, ADestStream: TStream; + ADestSize: Integer = DEFAULT_THUMBNAIL_SIZE); + +// Buffer utils +function PosInBytes(AText: ansistring; ABuffer: TBytes): Integer; + +// Date/time utils +function LocalTimeZoneStr: String; +function IPTCDateStrToDate(AValue: String): TDateTime; +function IPTCTimeStrToTime(AValue: String): TDateTime; + +{ For silencing the compiler... } +procedure Unused(const A1); +procedure Unused(const A1, A2); +procedure Unused(const A1, A2, A3); + + +implementation + +uses +{$IFDEF FPC} + fpreadjpeg, fpwritejpeg, fpimage, fpcanvas, fpimgcanv, +{$ELSE} +// EncdDecd, +{$ENDIF} + Math, DateUtils, + fpeStrConsts; + +{$IFNDEF FPC} +//------------------------------------------------------------------------------ +// Helper class: TInt64List - a list for 64-bit integers +//------------------------------------------------------------------------------ +type + TInt64 = record Value: Int64; end; + PInt64 = ^TInt64; + +destructor TInt64List.Destroy; +begin + Clear; + inherited; +end; + +procedure TInt64List.Clear; +var + i: Integer; + P: PInt64; +begin + for i:=0 to Count-1 do begin + P := inherited Items[i]; + Dispose(P); + end; + inherited Clear; +end; + +function TInt64List.Add(AValue: Int64): Integer; +var + P: PInt64; +begin + New(P); + P^.Value := AValue; + Result := inherited Add(P); +end; + +function TInt64List.GetItem(AIndex: Integer): Int64; +begin + Result := PInt64(inherited Items[AIndex])^.Value; +end; + +procedure TInt64List.SetItem(AIndex: Integer; AValue: Int64); +var + p: PInt64; +begin + p := inherited Items[AIndex]; + p^.Value := AValue; +end; + +{$IFNDEF UNICODE} +function UTF8ToWideString(const S: AnsiString): WideString; +var + BufSize: Integer; +begin + Result := ''; + if Length(S) = 0 then Exit; + BufSize := MultiByteToWideChar(CP_UTF8, 0, PAnsiChar(S), Length(S), nil, 0); + SetLength(result, BufSize); + MultiByteToWideChar(CP_UTF8, 0, PANsiChar(S), Length(S), PWideChar(Result), BufSize); +end; + +function UTF8ToAnsi(const S: Ansistring): string; +begin + Result := UTF8ToWideString(S); +end; +{$ENDIF} + +function SwapEndian(const AValue: Word): Word; overload; +begin + Result := Word((AValue shr 8) or (AValue shl 8)); +end; + +function SwapEndian(const AValue: DWord): DWord; overload; +begin + Result := ((AValue shl 8) and $FF00FF00) or ((AValue shr 8) and $00FF00FF); + Result := (Result shl 16) or (Result shr 16); +end; + +function BEtoN(const AValue: Word): Word; +begin + {$IFDEF ENDIAN_BIG} + Result := AValue; + {$ELSE} + Result := SwapEndian(AValue); + {$ENDIF} +end; + +function BEtoN(const AValue: DWord): DWord; +begin + {$IFDEF ENDIAN_BIG} + Result := AValue; + {$ELSE} + Result := SwapEndian(AValue); + {$ENDIF} +end; + +function NtoBE(const AValue: Word): Word; +begin + {$IFDEF ENDIAN_BIG} + Result := AValue; + {$ELSE} + Result := SwapEndian(AValue); + {$ENDIF} +end; + +function NtoBE(const AValue: DWord): DWord; +begin + {$IFDEF ENDIAN_BIG} + Result := AValue; + {$ELSE} + Result := SwapEndian(AValue); + {$ENDIF} +end; + + +function LEtoN(const AValue: Word): Word; +begin + {$IFDEF ENDIAN_BIG} + Result := SwapEndian(AValue); + {$ELSE} + Result := AValue; + {$ENDIF} +end; + +function LEtoN(const AValue: DWord): DWord; +begin + {$IFDEF ENDIAN_BIG} + Result := SwapEndian(AValue); + {$ELSE} + Result := AValue; + {$ENDIF} +end; + +function NtoLE(const AValue: Word): Word; +begin + {$IFDEF ENDIAN_BIG} + Result := SwapEndian(AValue); + {$ELSE} + Result := AValue; + {$ENDIF} +end; + +function NtoLE(const AValue: DWord): DWord; +begin + {$IFDEF ENDIAN_BIG} + Result := SwapEndian(AValue); + {$ELSE} + Result := AValue; + {$ENDIF} +end; + +{$ENDIF} + +function BEtoN(const AValue: WideString): WideString; +{$IFNDEF ENDIAN_BIG} +var + i: Integer; +{$ENDIF} +begin + {$IFDEF ENDIAN_BIG} + Result := AValue; + {$ELSE} + SetLength(Result, Length(AValue)); + for i:=1 to Length(AValue) do + Result[i] := WideChar(BEToN(PDWord(@AValue[i])^)); + {$ENDIF} +end; + +function LEtoN(const AValue: WideString): WideString; +{$IFDEF ENDIAN_BIG} +var + i: Integer; +{$ENDIF} +begin + {$IFDEF ENDIAN_BIG} + SetLength(Result, Length(AValue)); + for i:=1 to Length(AValue) do + Result[i] := WideChar(LEToN(PDWord(@AValue[i])^)); + {$ELSE} + Result := AValue; + {$ENDIF} +end; + +function NtoBE(const AValue: WideString): WideString; +var + i: Integer; +begin + {$IFDEF ENDIAN_BIG} + Result := AValue; + {$ELSE} + SetLength(Result, Length(AValue)); + for i:=1 to Length(AValue) do + Result[i] := WideChar(NtoBE(PDWord(@AValue[i])^)); + {$ENDIF} +end; + +function NtoLE(const AValue: WideString): WideString; +{$IFDEF ENDIAN_BIG} +var + i: Integer; +{$ENDIF} +begin + {$IFDEF ENDIAN_BIG} + SetLength(Result, Length(AValue)); + for i:=1 to Length(AValue) do + Result[i] := WideChar(NtoLE(PDWord(@AValue[i])^)); + {$ELSE} + Result := AValue; + {$ENDIF} +end; + +{ A simple Delphi-7 compatible way of reading a byte from a stream } +function ReadByte(AStream: TStream): Byte; +begin + AStream.Read(Result{%H-}, 1); +end; + +{ A simple Delphi-7 compatible way of reading two bytes from a stream } +function ReadWord(AStream: TStream): Word; +begin + AStream.Read(Result{%H-}, 2); +end; + +{ A simple Delphi-7 compatible way of reading four bytes from a stream } +function ReadDWord(AStream: TStream): DWord; +begin + AStream.Read(Result{%H-}, 4); +end; + +{ A simple Delphi-7 compatible way of writing a byte to a stream } +procedure WriteByte(AStream: TStream; AData: Byte); +begin + AStream.Write(AData, 1); +end; + +{ A simple Delphi-7 compatible way of writing two bytex to a stream } +procedure WriteWord(AStream: TStream; AData: Word); +begin + AStream.Write(AData, 2); +end; + +{ A simple Delphi-7 compatible way of writing four bytes to a stream } +procedure WriteDWord(AStream: TStream; AData: DWord); +begin + AStream.Write(AData, 4); +end; + +//============================================================================== +// GPS Utilities +//============================================================================== + (* +function ExtractGPSPosition(const AValue: String; + out ADeg, AMin, ASec: Double): Boolean; +const + NUMERIC_CHARS = ['0'..'9', '.', ',']; //, '-', '+']; +var + p, p0: PChar; + n: Integer; + s: String; + res: Integer; +begin + Result := false; + + ADeg := NaN; + AMin := NaN; + ASec := NaN; + + if AValue = '' then + exit; + + // skip leading non-numeric characters + p := @AValue[1]; + while (p <> nil) and not (p^ in NUMERIC_CHARS) do + inc(p); + + // extract first value: degrees + p0 := p; + n := 0; + while (p <> nil) and (p^ in NUMERIC_CHARS) do begin + if p^ = ',' then p^ := '.'; + inc(p); + inc(n); + end; + SetLength(s, n); + Move(p0^, s[1], n*SizeOf(Char)); + val(s, ADeg, res); + if res <> 0 then + exit; + + // skip non-numeric characters between degrees and minutes + while (p <> nil) and not (p^ in NUMERIC_CHARS) do + inc(p); + + // extract second value: minutes + p0 := p; + n := 0; + while (p <> nil) and (p^ in NUMERIC_CHARS) do begin + if p^ = ',' then p^ := '.'; + inc(p); + inc(n); + end; + SetLength(s, n); + Move(p0^, s[1], n*SizeOf(Char)); + val(s, AMin, res); + if res <> 0 then + exit; + + // skip non-numeric characters between minutes and seconds + while (p <> nil) and not (p^ in NUMERIC_CHARS) do + inc(p); + + // extract third value: seconds + p0 := p; + n := 0; + while (p <> nil) and (p^ in NUMERIC_CHARS) do begin + if p^ = ',' then p^ := '.'; + inc(p); + inc(n); + end; + SetLength(s, n); + Move(p0^, s[1], n*SizeOf(Char)); + val(s, ASec, res); + if res <> 0 then + exit; + + Result := (AMin >= 0) and (AMin < 60) and (ASec >= 0) and (ASec < 60); +end; *) + +procedure SplitGps(AValue: Double; out ADegs, AMins, ASecs: Double); +begin + SplitGps(AValue, ADegs, AMins); + ASecs := frac(AMins) * 60; + AMins := trunc(AMins); +end; + +procedure SplitGps(AValue: Double; out ADegs, AMins: Double); +begin + AValue := abs(AValue); + AMins := frac(AValue) * 60; + ADegs := trunc(AValue); +end; + +{ Combines up to three parts a GPS coordinate string (degrees, minutes, seconds) + to a floating-point degree value. The parts are separated by non-numeric + characters: + + three parts ---> d m s ---> d and m must be integer, s can be float + two parts ---> d m ---> d must be integer, s can be float + one part ---> d ---> d can be float + + Each part can exhibit a unit identifier, such as °, ', or ". BUT: they are + ignored. This means that an input string 50°30" results in the output value 50.5 + although the second part is marked as seconds, not minutes! } +function TryStrToGps(const AValue: String; out ADeg: Double): Boolean; +const + NUMERIC_CHARS = ['0'..'9', '.', ',', '-', '+']; +var + mins, secs: Double; + i, j, len: Integer; + n: Integer; + s: String; + res: Integer; +begin + Result := false; + + ADeg := NaN; + mins := 0; + secs := 0; + + if AValue = '' then + exit; + + // skip leading non-numeric characters + len := Length(AValue); + i := 1; + while (i <= len) and not (AValue[i] in NUMERIC_CHARS) do + inc(i); + + // extract first value: degrees + SetLength(s, len); + j := 1; + n := 0; + while (i <= len) and (AValue[i] in NUMERIC_CHARS) do begin + if AValue[i] = ',' then s[j] := '.' else s[j] := AValue[i]; + inc(i); + inc(j); + inc(n); + end; + if n > 0 then begin + SetLength(s, n); + val(s, ADeg, res); + if res <> 0 then + exit; + end; + + // skip non-numeric characters between degrees and minutes + while (i <= len) and not (AValue[i] in NUMERIC_CHARS) do + inc(i); + + // extract second value: minutes + SetLength(s, len); + j := 1; + n := 0; + while (i <= len) and (AValue[i] in NUMERIC_CHARS) do begin + if AValue[i] = ',' then s[j] := '.' else s[j] := AValue[i]; + inc(i); + inc(j); + inc(n); + end; + if n > 0 then begin + SetLength(s, n); + val(s, mins, res); + if (res <> 0) or (mins < 0) then + exit; + end; + + // skip non-numeric characters between minutes and seconds + while (i <= len) and not (AValue[i] in NUMERIC_CHARS) do + inc(i); + + // extract third value: seconds + SetLength(s, len); + j := 1; + n := 0; + while (i <= len) and (AValue[i] in NUMERIC_CHARS) do begin + if AValue[i] = ',' then s[j] := '.' else s[j] := AValue[i]; + inc(i); + inc(j); + inc(n); + end; + if n > 0 then begin + SetLength(s, n); + val(s, secs, res); + if (res <> 0) or (secs < 0) then + exit; + end; + + // If the string contains seconds then minutes and deegrees must be integers + if (secs <> 0) and ((frac(ADeg) > 0) or (frac(mins) > 0)) then + exit; + // If the string does not contain seconds then degrees must be integer. + if (secs = 0) and (mins <> 0) and (frac(ADeg) > 0) then + exit; + + // If the string contains minutes, but no seconds, then the degrees must be integer. + Result := (mins >= 0) and (mins < 60) and (secs >= 0) and (secs < 60); + + // A similar check should be made for the degrees range, but since this is + // different for latitude and longitude the check is skipped here. + if Result then + ADeg := abs(ADeg) + mins / 60 + secs / 3600; +end; + + (* +{ Converts a GPS coordinate (extended data type) to a string } +function GPSToStr(ACoord: Extended; ACoordType: TGpsCoordType; + AGpsFormat: TGpsFormat = gf_DMS_Short; ADecs: Integer = 0): String; +const + {$IFDEF FPC} + DEG_SYMBOL: string = '°'; + {$ELSE} + DEG_SYMBOL: ansistring = #176; + // Delphi 7 wants the degree symbol in ANSI, newer versions will convert + // it to a widechar automatically. + {$ENDIF} + RefStr: array[TGpsCoordType] of String[2] = ('NS', 'EW'); +var + idegs, imins: Integer; + floatval: Extended; + sgn: String; +begin + if IsNaN(ACoord) then begin + Result := ''; + exit; + end; + sgn := RefStr[ACoordType][1 + ord(ACoord < 0)]; + ACoord := abs(ACoord); + case AGpsFormat of + gf_DD, gf_DD_Short : + case AGpsFormat of + gf_DD: + Result := Format('%.*f degrees', [ADecs, ACoord], fpExifFmtSettings); + gf_DD_Short: + Result := Format('%.*f%s', [ADecs, ACoord, DEG_SYMBOL], fpExifFmtSettings); + end; + gf_DM, gf_DM_Short: + begin + idegs := trunc(ACoord); + floatVal := frac(ACoord) * 60; + case AGpsFormat of + gf_DM: + Result := Format('%d degrees %.*f minutes', + [idegs, ADecs, floatVal], fpExifFmtSettings); + gf_DM_Short: + Result := Format('%d%s %.*f''', + [idegs, DEG_SYMBOL, ADecs, floatVal], fpExifFmtSettings); + end; + end; + gf_DMS, gf_DMS_Short: + begin + idegs := trunc(ACoord); + imins := trunc(frac(ACoord)*60); + floatVal := frac(frac(ACoord)*60)*60; // seconds + case AGpsFormat of + gf_DMS: + Result := Format('%d degrees %d minutes %.*f seconds', + [idegs, imins, ADecs, floatVal], fpExifFmtSettings); + gf_DMS_Short: + Result := Format('%d%s %d'' %.*f"', + [idegs, DEG_SYMBOL, imins, ADecs, floatVal], fpExifFmtSettings); + end; + end; + end; + + Result := Result + ' ' + sgn; +end; + +{ Converts a string to a GPS extended number. The input string s must be + formatted as dd° mm' ss[.zzz]" E|W. Decimal places of seconds are optional. + Instead of seconds, the string can also contain a fractional part for minutes, + e.g. dd° m.mmmmmm', or for degress: d.ddddd° + E|W means: either E or W. } +function StrToGPS(s: String): Extended; +var + ds, ms, ss: String; + i: Integer; + tmp: String; + degs, mins, secs: Extended; + res: Integer; + scannedPart: Integer; // 0=degrees, 1=minutes, 2=seconds + isFloat: Array[-1..2] of Boolean; + sgn: Integer; +begin + if s = '' then begin + Result := NaN; + exit; + end; + i := 1; + tmp := ''; + scannedPart := 0; + isFloat[0] := false; + isFloat[1] := false; + isFloat[2] := false; + degs := 0; + mins := 0; + secs := 0; + sgn := +1; + while i <= Length(s) do begin + case s[i] of + '0'..'9': + tmp := tmp + s[i]; + '.', ',': + begin + tmp := tmp + '.'; + isFloat[scannedPart] := true; + end; + ' ': + if scannedPart = 0 then begin // in degrees par + val(tmp, degs, res); + if res > 0 then + raise EFpExif.Create('No numeric data in gps coordinate.'); + tmp := ''; + scannedPart := 1; + end; + '''': + if not isFloat[0] then begin // ignore minutes and seconds if degrees are floats + val(tmp, mins, res); + if res > 0 then + raise EFpExif.Create('No numeric data in gps coordinate.'); + tmp := ''; + scannedPart := 2; + end; + '"': + // ignore seconds of degrees or minutes are floating point values + if not (isFloat[0] or isFloat[1]) then begin + val(tmp, secs, res); + if res > 0 then + raise EFpExif.Create('No numerical data in gps coordinate.'); + tmp := ''; + scannedPart := -1; + end; + 'W', 'w', 'S', 's': + sgn := -1; + end; + inc(i); + end; + Result := (degs + mins/60 + secs/3600) * sgn; +end; + *) + + +//============================================================================== +// Image file utilities +//============================================================================== + +{ Extracts the width and height of a JPEG image from its data without loading + it into a TJpegImage. + Returns false if the stream does not contain a jpeg image. } +function JPEGImageSize(AStream: TStream; out AWidth, AHeight: Integer): Boolean; +type + TJPGHeader = array[0..1] of Byte; //FFD8 = StartOfImage (SOI) + TJPGRecord = packed record + Marker: Byte; + RecType: Byte; + RecSize: Word; + end; +var + n: integer; + hdr: TJPGHeader; + rec: TJPGRecord; + p: Int64; + savedPos: Int64; +begin + Result := false; + + AWidth := 0; + AHeight := 0; + + savedPos := AStream.Position; + try + // Check for SOI (start of image) record + n := AStream.Read(hdr{%H-}, SizeOf(hdr)); + if (n < SizeOf(hdr)) or (hdr[0] <> $FF) or (hdr[1] <> $D8) then + exit; + + rec.Marker := $FF; + while (AStream.Position < AStream.Size) and (rec.Marker = $FF) do begin + if AStream.Read(rec, SizeOf(rec)) < SizeOf(rec) then + exit; + rec.RecSize := BEToN(rec.RecSize); + p := AStream.Position - 2; + case rec.RecType of + $C0..$C3: + if (rec.RecSize >= 4) then // Start of frame markers + begin + AStream.Seek(1, soFromCurrent); // Skip "bits per sample" + AHeight := BEToN(ReadWord(AStream)); + AWidth := BEToN(ReadWord(AStream)); + Result := true; + exit; + end; + $D9: // end of image; + break; + end; + AStream.Position := p + rec.RecSize; + end; + finally + AStream.Position := savedPos; + end; +end; + +procedure JPEGScaleImage(ASrcStream, ADestStream: TStream; + ADestSize: Integer = DEFAULT_THUMBNAIL_SIZE); +{$IFDEF FPC} +var + srcImage, destImage: TFPCustomImage; + destCanvas: TFPImageCanvas; + reader: TFPCustomImageReader; + writer: TFPCustomImageWriter; + w, h: Integer; + f: Double; +begin + srcImage := TFPMemoryImage.Create(10, 10); + reader := TFPReaderJPEG.Create; + srcImage.LoadFromStream(ASrcStream, reader); + reader.Free; + + w := srcImage.Width; + h := srcImage.Height; + if w > h then f := ADestSize / w else f := ADestSize / h; + + destImage := TFPMemoryImage.Create(round(w*f), round(h*f)); + destCanvas := TFPImageCanvas.Create(destImage); + destCanvas.StretchDraw(0, 0, destImage.Width, destImage.Height, srcImage); + + writer := TFPWriterJPEG.Create; + destImage.SaveToStream(ADestStream, writer); + writer.Free; +end; +{$ELSE} +{$IFNDEF dExifNoJpeg} +var + jpeg: TJPegImage; + bmp: TBitmap; + w, h: Integer; + f: Double; +begin + jpeg := TJpegImage.Create; + try + jpeg.LoadfromStream(ASrcStream); + w := jpeg.Width; + h := jpeg.Height; + if w > h then f := ADestSize / w else f := ADestSize / h; + bmp := TBitmap.Create; + bmp.PixelFormat := pf24bit; + bmp.Width := round(w * f); + bmp.Height := round(h * f); + bmp.Canvas.StretchDraw(Rect(0, 0, bmp.Width, bmp.Height), jpeg); + jpeg.Free; + jpeg := TJpegImage.Create; + jpeg.Assign(bmp); + jpeg.SaveToStream(ADestStream); + finally + jpeg.Free; + bmp.Free; + end; +end; +{$ELSE} +begin + // CreateThumb will not work in delphi if dExifNoJpeg is defined. +end; +{$ENDIF} +{$ENDIF} + + +{ Formatting callbacks } + (* +Function GpsPosn(InStr: String): String; +const + {$IFDEF FPC} + DEGREES: string = '°'; + {$ELSE} + DEGREES: ansistring = #176; + {$ENDIF} +var + p, sl: integer; + s: string; + gDegree, gMin, gSec: double; +begin + sl := length(fpExifDataSep); + Result := instr; // if error return input string + p := Pos(fpExifDataSep, instr); + s := copy(InStr, 1, p-1); // get first irrational number + gDegree := CvtRational(s); // degrees + InStr := copy(InStr, p+sl, 64); + p := Pos(fpExifDataSep, instr); + s := copy(InStr, 1, p-1); // get second irrational number + gMin := CvtRational(s); // minutes + InStr := copy(InStr, p+sl, 64); + gSec := CvtRational(InStr); // seconds + if gSec = 0 then // camera encoded as decimal minutes + begin + gSec := ((gMin - trunc(gMin))*100); // seconds as a fraction of degrees + gSec := gSec * 0.6; // convert to seconds + gMin := trunc(gMin); // minutes is whole portion + end; + // Ok we'll send the result back as Degrees with + // Decimal Minutes. Alternatively send back as Degree + // Minutes, Seconds or Decimal Degrees. + case GpsFormat of + gf_DD: + Result := Format('%1.4f Decimal Degrees', [gDegree + (gMin + gSec/60)/60], fpExifFmtSettings); + gf_DD_Short: + Result := Format('%1.4f%s', [gDegree + (gmin + gSec/60)/60, DEGREES], fpExifFmtSettings); + gf_DM: + Result := Format('%0.0f Degrees %1.2f Minutes',[gDegree, gMin + gsec/60], fpExifFmtSettings); + gf_DM_Short: + Result := Format('%0.0f%s %1.2f''', [gDegree, DEGREES, gMin + gsec/60], fpExifFmtSettings); + gf_DMS: + Result := Format('%0.0f Degrees %0.0f Minutes %0.2f Seconds', [gDegree, gMin, gSec], fpExifFmtSettings); + gf_DMS_Short: + Result := Format('%0.0f%s %0.0f'' %0.2f"', [gDegree, DEGREES, gMin, gSec], fpExifFmtSettings); + end; +end; + +function GpsAltitude(InStr: string): String; +var + gAltitude: double; +begin + Result := InStr; // if error return input string + gAltitude := CvtRational(InStr); // meters/multiplier, e.g.. 110/10 + Result := Format('%1.2f m', [gAltitude]); +end; +*) + { +function GpsVersionID(AText: String): String; +var + i: Integer; + sep: Char; +begin + Result := ''; + sep := ','; + for i:=1 to Length(fpExifDataSep) do + if fpExifDataSep[i] <> ' ' then begin + sep := char(fpExifDataSep[i]); + break; + end; + + for i:=1 to Length(AText) do begin + if AText[i] = sep then + Result := Result + '.' + else if AText[i] <> ' ' then + Result := Result + AText[i]; + end; +end; + +function CompCfgCallback(AText: String): String; +var + i, ti: Integer; +begin + Result := ''; + for i := 1 to 4 do + if i <= Length(AText) then begin + ti := integer(AText[i]); + case ti of +// 0: Result := Result + '-'; + 1: Result := Result + 'Y'; + 2: Result := Result + 'Cb'; + 3: Result := Result + 'Cr'; + 4: Result := Result + 'R'; + 5: Result := Result + 'G'; + 6: Result := Result + 'B'; + end; + end; +end; + } + +//============================================================================== +// String utilities +//============================================================================== + +{ Counts how often the specified character is contained within a string } +function CountChar(AChar: Char; const AText: String): Integer; +var + i: Integer; +begin + Result := 0; + for i:=1 to Length(AText) do + if (AChar = AText[i]) then inc(Result); +end; + +function FirstWord(const AText: String): String; +var + i: Integer; +begin + Result := ''; + for i:=1 to Length(AText) do + if AText[i] in ['a'..'z', 'A'..'Z', '0'..'9'] then + Result := Result + AText[i] + else + exit; +end; + +{ Inserts spaces into a camel-case text, i.e. 'ShutterSpeed' --> 'Shutter Speed'} +function InsertSpaces(ACamelCaseText: String): String; + + function IsUpper(ch: char): boolean; + begin + Result := ((ch >= 'A') and (ch <= 'Z')) or (ch = #0) or (ch = '/'); + end; + +var + i: integer; + len: Integer; + ch, nextch, prevch: char; + s: String; +begin + len := Length(ACamelCaseText); + if len < 3 then begin + Result := ACamelCaseText; + exit; + end; + s := ACamelCaseText[1]; + prevch := ACamelCaseText[1]; + for i := 2 to len do + begin + ch := ACamelCaseText[i]; + if i < len then nextch := ACamelCaseText[i+1] else nextch := #0; + if IsUpper(ch) and + (not IsUpper(prevch) or not IsUpper(nextch)) and + (ch <> ' ') and (prevch <> ' ') and (nextch <> ' ') + then + s := s + ' ' + ch + else + s := s + ch; + prevch := ch; + end; + Result := s; +end; + +{ Removes all non-alpha characters ('a'..'z', 'A'..'Z') from a string } +function LettersOnly(const AText: String): string; +var + i: Integer; +begin + Result := ''; + for i:=1 to Length(AText) do + if AText[i] in ['a'..'z', 'A'..'Z'] then + Result := Result + AText[i]; +end; + + +//============================================================================== +// Lookup +//============================================================================== +type + TLookupMode = (lmKey, lmValue); + +function LookupHelper(const ASearchStr, ALookupTbl: String; + ACompareFunc: TLookupCompareFunc; AMode: TLookupMode; out AResultStr: String): Boolean; +var + i: Integer; + key, val: String; + inKey: Boolean; +begin + Result := false; + if ALookupTbl = '' then + exit; + + key := ''; + inKey := true; + + for i:=1 to Length(ALookupTbl) do begin + if ALookupTbl[i] = fpExifLookupKeySep then + begin + inKey := false; + val := ''; + end else + if (ALookupTbl[i] = fpExifLookupSep) then + begin + case AMode of + lmKey: + if ACompareFunc(key, ASearchStr) then begin + Result := true; + AResultStr := val; + exit; + end; + lmValue: + if ACompareFunc(val, ASearchStr) then begin + Result := true; + AResultStr := key; + exit; + end; + end; + inKey := true; + key := ''; + end else + if inKey then + key := key + ALookupTbl[i] + else + val := val + ALookupTbl[i]; + end; + + case AMode of + lmKey: + if ACompareFunc(key, ASearchStr) then begin + Result := true; + AResultStr := val; + end; + lmValue: + if ACompareFunc(val, ASearchStr) then begin + Result := true; + AResultStr := key; + end; + end; +end; + +function LookupValue(const AKey, ALookupTbl: String; + ACompareFunc: TLookupCompareFunc): String; +var + found: Boolean; +begin + found := LookupHelper(AKey, ALookupTbl, ACompareFunc, lmKey, Result); + if not found then + Result := AKey; +end; + +function LookupKey(const AValue, ALookupTbl: String; + ACompareFunc: TLookupCompareFunc): String; +var + found: Boolean; +begin + found := LookupHelper(AValue, ALookupTbl, ACompareFunc, lmValue, Result); + if not found then + Result := ''; +end; + +function NumericOnly(const AText: String): String; +var + i: Integer; +begin + Result := ''; + for i:=1 to Length(AText) do + if AText[i] in ['0'..'9'] then + Result := Result + AText[i]; +end; + +function Split(AText: String; ASeparator: String = #9): TStringArray; +const + BLOCK_SIZE = 20; +var + i, j, k, n, len: Integer; + s: String; + found: Boolean; +begin + Assert(ASeparator <> ''); + + if AText = '' then begin + SetLength(Result, 0); + exit; + end; + +// AText := AText + ASeparator; + len := Length(AText); + SetLength(Result, BLOCK_SIZE); + i := 1; + n := 0; + s := ''; + while (i <= len) do begin + if AText[i] = ASeparator[1] then begin + j := i; + k := 1; + found := true; + while (i <= len) and (k <= Length(ASeparator)) do begin + if ASeparator[k] <> AText[i] then begin + found := false; + break; + end; + inc(k); + inc(i); + end; + if found then begin + Result[n] := s; + inc(n); + if n mod BLOCK_SIZE = 0 then + SetLength(Result, Length(Result) + BLOCK_SIZE); + s := ''; + Continue; + end else + i := j; + end else + s := s + AText[i]; + inc(i); + end; +(* + if (AText[i] = ASeparator) or (i = len) then begin + Result[n] := Copy(AText, 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; + *) + + Result[n] := s; + inc(n); + + SetLength(Result, n); +end; + +//============================================================================== +// Float to fraction converstion +// +// These routines are adapted from unit Fractions by Bart Boersma +// https://sourceforge.net/p/lazarus-ccr/svn/HEAD/tree/components/fractions/ +//============================================================================== +const + MaxInt32 = High(Int32); + MinInt32 = Low(Int32); + +function InRange32(Value: Double): Boolean; {$IFDEF FPC}inline;{$ENDIF} +begin + Result := not ((Value > MaxInt32) or (Value < MinInt32)); +end; + +procedure CheckRange(Value: Double); +begin + if not InRange32(Value) then + raise ERangeError.Create(rsRangeCheckError); +end; + +procedure AdjustPrecision(var Precision: Double; Value: Double); +const + MaxPrec: Double = 1.0 / MaxInt32; +begin + Precision := Abs(Precision); + if ((Abs(Value) / Precision) > 1E15) then + Precision := Abs(Value) / 1E16; + if (Precision < MaxPrec) then + Precision := MaxPrec; +end; + +function IsBorderlineValue(Value: Double; out F: TExifRational): Boolean; +const + MaxPrec: Double = 1.0 / MaxInt32; + ZeroBoundary: Double = 0.5 / MaxInt32; +begin + if (Abs(Value) <= MaxPrec) then + begin + Result := True; + if (Abs(Value) < ZeroBoundary) then + begin + F.Numerator := 0; + F.Denominator := 1; + end + else + begin + if (Value < 0) then + F.Numerator := -1 + else + F.Numerator := 1; + F.Denominator := MaxInt32; + end; + end + else + Result := False; +end; + +// Uses method of continued fractions +function FloatToRational(Value, Precision: Double): TExifRational; +var + H1, H2, K1, K2, A, NewA, tmp: Int32; + B, diff, test: Double; + PendingOverFlow, Found: Boolean; +begin + if IsNaN(Value) then begin + Result.Numerator := 1; + Result.Denominator := 0; + exit; + end; + + CheckRange(Value); + AdjustPrecision(Precision, Value); + + //Borderline cases + if IsBorderlineValue(Value, Result) then + Exit; + + H1 := 1; + H2 := 0; + K1 := 0; + K2 := 1; + b := Value; + NewA := Round(Floor(b)); + repeat + A := NewA; + tmp := H1; + H1 := (a * H1) + H2; + H2 := tmp; + tmp := K1; + K1 := (a * K1) + K2; + K2 := tmp; + test := H1 / K1; + diff := Abs(test - Value); + Found := (diff < Precision); + if not Found then + begin + if (Abs(B-A) < 1E-30) then + B := 1E30 //happens when H1/K2 exactly matches Value + else + B := 1 / (B - A); + PendingOverFlow := (((Double(B) * H1) + H2) > MaxInt32) or + (((Double(B) * K1) + K2) > MaxInt32) or + (B > MaxInt32); + if not PendingOverFlow then + NewA := Round(Floor(B)); + end; + until Found or PendingOverFlow; + Result.Numerator := H1; + Result.Denominator := K1; +end; + +function TryStrToRational(const AStr: String; out AValue: TExifRational): Boolean; +var + p: Integer; + snum, sdenom: String; +begin + Result := false; + + if AStr = '' then + exit; + + p := pos('/', AStr); + if p = 0 then begin + snum := AStr; + sdenom := '1'; + end else begin + snum := trim(Copy(AStr, 1, p-1)); + sdenom := trim(Copy(AStr, p+1, MaxInt)); + end; + + if (snum = '') or (sdenom = '') then + exit; + + Result := TryStrToInt(snum, AValue.Numerator) and TryStrToInt(sdenom, AValue.Denominator); +end; + +function StrToRational(const AStr: String): TExifRational; +begin + if not TryStrToRational(AStr, Result) then begin + Result.Numerator := 1; + Result.Denominator := 0; + end; +end; + +function GCD(a, b: integer): integer; +begin + if (a = 0) then + Result := abs(b) + else + if (b = 0) then + Result := abs(a) + else + if (b mod a) = 0 then + Result := a + else + Result := GCD(b, a mod b); +end; + + +//============================================================================== +// Buffer utilities +//============================================================================== + +function PosInBytes(AText: AnsiString; ABuffer: TBytes): Integer; +var + i, j: Integer; + found: Boolean; +begin + if (AText = '') or (ABuffer = nil) then begin + Result := -1; + exit; + end; + + for i:= 0 to High(ABuffer) do + if ABuffer[i] = ord(AText[1]) then begin + found := true; + for j := 2 to Length(AText) do + if ABuffer[i+j-1] <> ord(AText[j]) then begin + found := false; + break; + end; + if found then begin + Result := i; + exit; + end; + end; + + Result := -1; +end; + + +//============================================================================== +// Date/time utilities +//============================================================================== + +{$IFNDEF FPC} +function GetLocalTimeOffset: LongInt; +var + TZoneInfo: TTimeZoneInformation; +begin + GetTimeZoneInformation(TZoneInfo); + Result := TZoneInfo.Bias; +end; +{$ENDIF} + +function LocalTimeZoneStr: string; +var + bias: Integer; + h, m: Integer; +begin + bias := GetLocalTimeOffset; + if bias >= 0 then + Result := '+' + else + Result := '-'; + bias := Abs(bias); + h := bias div 60; + m := bias mod 60; + Result := Result + Format('%.2d%.2d', [h, m]); +end; + +function IPTCDateStrToDate(AValue: String): TDateTime; +var + yr, mon, day: Integer; +begin + Result := 0; + if (Length(AValue) >= 8) and + TryStrToInt(Copy(AValue, 1, 4), yr) and + TryStrToInt(Copy(AValue, 5, 2), mon) and (mon >= 1) and (mon <= 12) and + TryStrToInt(Copy(AValue, 7, 2), day) and (day >= 1) and (day <= DaysInAMonth(yr, mon)) + then + Result := EncodeDate(yr, mon, day); +end; + +function IPTCTimeStrToTime(AValue: String): TDateTime; +var + hr, mn, sc: Integer; +begin + Result := 0; + if (Length(AValue) >= 6) and + TryStrToInt(Copy(AValue, 1, 2), hr) and (hr >= 0) and (hr < 24) and + TryStrToInt(Copy(AValue, 3, 2), mn) and (mn >= 0) and (mn < 60) and + TryStrToInt(Copy(AValue, 5, 2), sc) and (sc >= 0) and (sc < 60) + then + Result := EncodeTime(hr, mn, sc, 0) +end; + + +//============================================================================== +// Silence compiler warnings due to unused parameters +// (code adapted from TAChart) +//============================================================================== +{$PUSH}{$HINTS OFF} +procedure Unused(const A1); +begin +end; + +procedure Unused(const A1, A2); +begin +end; + +procedure Unused(const A1, A2, A3); +begin +end; +{$POP} + +end. + diff --git a/components/fpexif/fpexif.inc b/components/fpexif/fpexif.inc new file mode 100644 index 000000000..d1c74c51e --- /dev/null +++ b/components/fpexif/fpexif.inc @@ -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} + diff --git a/components/fpexif/fpexif_fpc.inc b/components/fpexif/fpexif_fpc.inc new file mode 100644 index 000000000..7434ebee2 --- /dev/null +++ b/components/fpexif/fpexif_fpc.inc @@ -0,0 +1,3 @@ +{$IF FPC_FullVersion < 30000} + {$UNDEF FPC3+} + {$ENDIF} \ No newline at end of file diff --git a/components/fpexif/fpexif_pkg.lpk b/components/fpexif/fpexif_pkg.lpk new file mode 100644 index 000000000..de621c76b --- /dev/null +++ b/components/fpexif/fpexif_pkg.lpk @@ -0,0 +1,84 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/fpexif/fpexif_pkg.pas b/components/fpexif/fpexif_pkg.pas new file mode 100644 index 000000000..191f397f8 --- /dev/null +++ b/components/fpexif/fpexif_pkg.pas @@ -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. diff --git a/components/fpexif/languages/fpestrconsts.de.po b/components/fpexif/languages/fpestrconsts.de.po new file mode 100644 index 000000000..1d5709109 --- /dev/null +++ b/components/fpexif/languages/fpestrconsts.de.po @@ -0,0 +1,1693 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: \n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: \n" +"Language-Team: \n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: de\n" +"X-Generator: Poedit 2.0.4\n" + +#: fpestrconsts.rsacceleration +msgid "Acceleration" +msgstr "Beschleunigung" + +#: fpestrconsts.rsactionadvised +msgid "Action advised" +msgstr "" + +#: fpestrconsts.rsaperturevalue +msgid "Aperture value" +msgstr "Blendenwert" + +#: fpestrconsts.rsartist +msgid "Artist" +msgstr "Künstler" + +#: fpestrconsts.rsautomanual +msgid "0:Auto,1:Manual" +msgstr "0:Auto,1:Manuell" + +#: fpestrconsts.rsbitspersample +msgid "Bits per sample" +msgstr "" + +#: fpestrconsts.rsbrightnessvalue +msgid "Brightness value" +msgstr "Helligkeitswert" + +#: fpestrconsts.rsbyline +msgid "ByLine" +msgstr "" + +#: fpestrconsts.rsbylinetitle +msgid "ByLine title" +msgstr "" + +#: fpestrconsts.rscameraelevationangle +msgid "Camera elevation angle" +msgstr "" + +#: fpestrconsts.rscannotsavetounknownfileformat +msgid "The metadata structure cannot be saved because the file format of the receiving file is not known or not supported." +msgstr "Die Metadaten-Struktur kann nicht gespeichert werden, weil das Format der Zieldatei nicht bekannt ist oder nicht unterstützt wird." + +#: fpestrconsts.rscanonaelkup +msgid "0:Normal AE,1:Exposure compensation,2:AE lock,3:AE lock + Exposure compensation,4:No AE" +msgstr "" + +#: fpestrconsts.rscanonaflkup +msgid "$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" +msgstr "" + +#: fpestrconsts.rscanonautorotlkup +msgid "0:None,1:Rotate 90 CW,2:Rotate 180,3:Rotate 270 CW" +msgstr "" + +#: fpestrconsts.rscanonbiaslkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanoncamtypelkup +msgid "248:EOS High-end,250:Compact,252:EOS Mid-range,255:DV Camera" +msgstr "" + +#: fpestrconsts.rscanoneasylkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanonexposelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanonflashactlkup +msgid "0:Did not fire,1:Fired" +msgstr "0:Hat nicht ausgelöst,1:Ausgelöst" + +#: fpestrconsts.rscanonflashlkup +msgid "0:Not fired,1:Auto,2:On,3:Red-eye,4:Slow sync,5:Auto+red-eye,6:On+red eye,16:External flash" +msgstr "" + +#: fpestrconsts.rscanonfocaltypelkup +msgid "1:Fixed,2:Zoom" +msgstr "" + +#: fpestrconsts.rscanonfoctypelkup +msgid "0:Manual,1:Auto,3:Close-up (macro),8:Locked (pan mode)" +msgstr "" + +#: fpestrconsts.rscanonfocuslkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanongenlkup +msgid "65535:Low,0:Normal,1:High" +msgstr "" + +#: fpestrconsts.rscanonimgstablkup +msgid "0:Off,1:On,2:Shoot only,3:Panning,4:Dynamic,256:Off,257:On,258:Shoot only,259:Panning,260:Dynamic" +msgstr "" + +#: fpestrconsts.rscanonisolkup +msgid "0:Not used,15:auto,16:50,17:100,18:200,19:400" +msgstr "" + +#: fpestrconsts.rscanonmacrolkup +msgid "1:Macro,2:Normal" +msgstr "1:Makro,2:Normal" + +#: fpestrconsts.rscanonmeterlkup +msgid "0:Default,1:Spot,2:Average,3:Evaluative,4:Partial,5:Center-weighted average" +msgstr "" + +#: fpestrconsts.rscanonpandirlkup +msgid "0:Left to right,1:Right to left,2:Bottom to top,3:Top to bottom,4:2x2 Matrix (clockwise)" +msgstr "" + +#: fpestrconsts.rscanonqualitylkup +msgid "65535:n/a,1:Economy,2:Normal,3:Fine,4:RAW,5:Superfine,130:Normal Movie,131:Movie (2)" +msgstr "" + +#: fpestrconsts.rscanonreclkup +msgid "1:JPEG,2:CRW+THM,3:AVI+THM,4:TIF,5:TIF+JPEG,6:CR2,7:CR2+JPEG,9:MOV,10:MP4" +msgstr "" + +#: fpestrconsts.rscanonsizelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanonsloshuttlkup +msgid "65535:n/a,0:Off,1:Night scene,2:On,3:None" +msgstr "" + +#: fpestrconsts.rscanonwhiteballkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanonzoomlkup +msgid "0:None,1:2x,2:4x,3:Other" +msgstr "0:Nichts,1:2x,2:4x,3:Anderer Wert" + +#: fpestrconsts.rscasioafmode2lkup +msgid "0:Off,1:Spot,2:Multi,3:Face detection,4:Tracking,5:Intelligent" +msgstr "" + +#: fpestrconsts.rscasioartmode2lkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscasioautoiso2lkup +msgid "1:On,2:Off,7:On (high sensitivity),8:On (anti-shake),10:High Speed" +msgstr "" + +#: fpestrconsts.rscasioccdsensitivitylkup +msgid "64:Normal,125:+1.0,250:+2.0,244:+3.0,80:Normal,100:High" +msgstr "" + +#: fpestrconsts.rscasiocolorfilter2lkup +msgid "0:Off,1:Blue,3:Green,4:Yellow,5:Red,6:Purple,7:Pink" +msgstr "" + +#: fpestrconsts.rscasiocolormode2lkup +msgid "0:Off,2:Black & White,3:Sepia" +msgstr "0:Aus,1:Schwarzweiß,2:Sepia" + +#: fpestrconsts.rscasiodigitalzoomlkup +msgid "$10000:Off,$10001:2x Digital zoom,$20000:2x digital zoom,$40000:4x digital zoom" +msgstr "" + +#: fpestrconsts.rscasiodrivemode2lkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscasioenhancement2lkup +msgid "0:Off,1:Scenery,3:Green,5:Underwater,9:Flesh tones" +msgstr "" + +#: fpestrconsts.rscasioflashintensitylkup +msgid "11:Weak,13:Normal,15:Strong" +msgstr "11:Schwach,13:Normal,15:Stark" + +#: fpestrconsts.rscasioflashmodelkup +msgid "1:Auto,2:On,3:Off,4:Red-eye reduction" +msgstr "1:Auto,2:Ein,3:Unterdrückung von roten Augen" + +#: fpestrconsts.rscasiofocusingmodelkup +msgid "2:Macro,3:Auto focus,4:Manual focus,5:Infinity" +msgstr "2:Makro,3:Auto-Fokus,4:Manuelle Entfernungseinstellung,5:Unendlich" + +#: fpestrconsts.rscasiofocusmode22lkup +msgid "0:Manual,1:Focus lock,2:Macro,3:Single-area auto focus,5:Infinity,6:Multi-area auto focus,8:Super macro" +msgstr "" + +#: fpestrconsts.rscasiofocusmode2lkup +msgid "0:Normal,1:Macro" +msgstr "0:Normal,1:Makro" + +#: fpestrconsts.rscasioimagesize2lkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscasioimagestabilization2lkup +msgid "0:Off,1:On,2:Best shot,3:Movie anti-shake" +msgstr "" + +#: fpestrconsts.rscasioisospeed2lkup +msgid "3 = 50,4:64,6:100,9:200" +msgstr "" + +#: fpestrconsts.rscasiolightingmode2lkup +msgid "0:Off,1:High dynamic range,5:Shadow enhance low,6:Shadow enhance high" +msgstr "" + +#: fpestrconsts.rscasioportraitrefiner2lkup +msgid "0:Off,1:+1,2:+2" +msgstr "" + +#: fpestrconsts.rscasiorecordingmodelkup +msgid "1:Single shutter,2:Panorama,3:Night scene,4:Portrait,5:Landscape" +msgstr "" + +#: fpestrconsts.rscasiorecordmode2lkup +msgid "2:Program AE,3:Shutter priority,4:Aperture priority,5:Manual,6:Best shot,17:Movie,19:Movie (19),20:YouTube Movie" +msgstr "" + +#: fpestrconsts.rscasioreleasemode2lkup +msgid "1:Normal,3:AE Bracketing,11:WB Bracketing,13 = Contrast Bracketing,19:High Speed Burst" +msgstr "" + +#: fpestrconsts.rscasiosharpness2lkup +msgid "0:Soft,1:Normal,2:Hard" +msgstr "0:Weich,1:Normal,2:Hart" + +#: fpestrconsts.rscasiospecialeffectsetting2lkup +msgid "0:Off,1:Makeup,2:Mist removal,3:Vivid landscape,16:Art shot" +msgstr "" + +#: fpestrconsts.rscasiovideoquality2lkup +msgid "1:Standard,3:HD (720p),4:Full HD (1080p),5:Low" +msgstr "" + +#: fpestrconsts.rscasiowhitebalance22lkup +msgid "0:Manual,1:Daylight,2:Cloudy,3:Shade,4:Flash?,6:Fluorescent,9:Tungsten?,10:Tungsten,12:Flash" +msgstr "" + +#: fpestrconsts.rscasiowhitebalance2lkup +msgid "0:Auto,1:Daylight,2:Shade,3:Tungsten,4:Fluorescent,5:Manual" +msgstr "" + +#: fpestrconsts.rscasiowhitebalancelkup +msgid "1:Auto,2:Tungsten,3:Daylight,4:Fluorescent,5:Shade,129:Manual" +msgstr "1:Auto,2:Wolframlampe,3:Tagelicht,4:Leuchstoffröhre,5:Schatten,129:Manuell" + +#: fpestrconsts.rscategory +msgid "Category" +msgstr "Kategorie" + +#: fpestrconsts.rscellheight +msgid "Cell height" +msgstr "Zellhöhe" + +#: fpestrconsts.rscellwidth +msgid "Cell width" +msgstr "Zellbreite" + +#: fpestrconsts.rscfapattern +msgid "CFA pattern" +msgstr "" + +#: fpestrconsts.rscity +msgid "City" +msgstr "Stadt" + +#: fpestrconsts.rscodedcharset +msgid "Coded character set" +msgstr "Kodierter Zeichensatz" + +#: fpestrconsts.rscolorspace +msgid "Color space" +msgstr "Farbraum" + +#: fpestrconsts.rscolorspacelkup +msgid "0:sBW,1:sRGB,2:Adobe RGB,65533:Wide Gamut RGB,65534:ICC Profile,65535:Uncalibrated" +msgstr "" + +#: fpestrconsts.rscomponentsconfig +msgid "Components configuration" +msgstr "Komponentenkonfiguration" + +#: fpestrconsts.rscompressedbitsperpixel +msgid "Compressed bits per pixel" +msgstr "" + +#: fpestrconsts.rscompression +msgid "Compression" +msgstr "Kompression" + +#: fpestrconsts.rscompressionlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscontact +msgid "Contact" +msgstr "Kontakt" + +#: fpestrconsts.rscontentloccode +msgid "Content location code" +msgstr "" + +#: fpestrconsts.rscontentlocname +msgid "Content location name" +msgstr "" + +#: fpestrconsts.rscontrast +msgid "Contrast" +msgstr "Kontrast" + +#: fpestrconsts.rscopyright +msgid "Copyright" +msgstr "Copyright" + +#: fpestrconsts.rscustomrendered +msgid "Custom rendered" +msgstr "" + +#: fpestrconsts.rscustomrenderedlkup +msgid "0:Normal,1:Custom" +msgstr "" + +#: fpestrconsts.rsdatecreated +msgid "Date created" +msgstr "Erzeugungsdatum" + +#: fpestrconsts.rsdatetime +msgid "Date/time" +msgstr "Datum/Uhrzeit" + +#: fpestrconsts.rsdatetimedigitized +msgid "Date/time digitized" +msgstr "Datum/Uhrzeit der digitalen Erfassung" + +#: fpestrconsts.rsdatetimeoriginal +msgid "Date/time original" +msgstr "Original-Datum/Uhrzeit" + +#: fpestrconsts.rsdevicesettingdescription +msgid "Device setting description" +msgstr "" + +#: fpestrconsts.rsdigitalzoom +msgid "Digital zoom" +msgstr "Digitalzoom" + +#: fpestrconsts.rsdigitalzoomratio +msgid "Digital zoom ratio" +msgstr "Digitalzoom-Verhältnis" + +#: fpestrconsts.rsdigitizedate +msgid "Digital creation date" +msgstr "" + +#: fpestrconsts.rsdigitizetime +msgid "Digital creation time" +msgstr "" + +#: fpestrconsts.rsdocumentname +msgid "Document name" +msgstr "Dokument-Name" + +#: fpestrconsts.rseconomynormalfine +msgctxt "fpestrconsts.rseconomynormalfine" +msgid "0:Economy,1:Normal,2:Fine" +msgstr "" + +#: fpestrconsts.rseconomynormalfine1 +msgctxt "fpestrconsts.rseconomynormalfine1" +msgid "1:Economy,2:Normal,3:Fine" +msgstr "" + +#: fpestrconsts.rseditorialupdate +msgid "Editorial update" +msgstr "" + +#: fpestrconsts.rseditstatus +msgid "Edit status" +msgstr "Bearbeitungsstatus" + +#: fpestrconsts.rsexifimageheight +msgid "EXIF image height" +msgstr "EXIF Bildhöhe" + +#: fpestrconsts.rsexifimagewidth +msgid "EXIF image width" +msgstr "EXIF Bildbreite" + +#: fpestrconsts.rsexifoffset +msgid "EXIF offset" +msgstr "EXIF-Offset" + +#: fpestrconsts.rsexifversion +msgid "EXIF version" +msgstr "EXIF-Version" + +#: fpestrconsts.rsexpiredate +msgid "Expiration date" +msgstr "Ablaufdatum" + +#: fpestrconsts.rsexpiretime +msgid "Expiration time" +msgstr "Ablaufzeit" + +#: fpestrconsts.rsexposurebiasvalue +msgid "Exposure bias value" +msgstr "Belichtungskorrektur" + +#: fpestrconsts.rsexposureindex +msgid "Exposure index" +msgstr "Belichtungsindex" + +#: fpestrconsts.rsexposuremode +msgid "Exposure mode" +msgstr "Belichtungsmodus" + +#: fpestrconsts.rsexposuremodelkup +msgid "0:Auto,1:Manual,2:Auto bracket" +msgstr "0:Auto,1:Manuell,2:Automatische Belichtugnsreihe" + +#: fpestrconsts.rsexposureprogram +msgid "Exposure program" +msgstr "Belichtungsprogramm" + +#: fpestrconsts.rsexposureprogramlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsexposuretime +msgid "Exposure time" +msgstr "Belichtungszeit" + +#: fpestrconsts.rsextensiblemetadataplatform +msgid "Extensible metadata platform" +msgstr "" + +#: fpestrconsts.rsfilenotfounderror +msgid "File \"%s\" not found." +msgstr "Datei \"%s\" nicht gefunden." + +#: fpestrconsts.rsfilesource +msgid "File source" +msgstr "Dateiquelle" + +#: fpestrconsts.rsfilesourcelkup +msgid "0:Unknown,1:Film scanner,2:Reflection print scanner,3:Digital camera" +msgstr "0:Unbekannt,1:Durchlichtscanner,2:Auflichtscanner,3:Digitalkamera" + +#: fpestrconsts.rsfillorder +msgid "Fill order" +msgstr "" + +#: fpestrconsts.rsfillorderlkup +msgid "1:Normal,2:Reversed" +msgstr "1:Normal,2:Umgekehrt" + +#: fpestrconsts.rsfixtureid +msgid "Fixture ID" +msgstr "" + +#: fpestrconsts.rsflash +msgid "Flash" +msgstr "Blitz" + +#: fpestrconsts.rsflashenergy +msgid "Flash energy" +msgstr "Blitz-Energie" + +#: fpestrconsts.rsflashlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsflashpixversion +msgid "FlashPix version" +msgstr "FlashPix-Version" + +#: fpestrconsts.rsfnumber +msgid "F number" +msgstr "Blendenzahl" + +#: fpestrconsts.rsfocallength +msgid "Focal length" +msgstr "Brennweite" + +#: fpestrconsts.rsfocallengthin35mm +msgid "Focal length in 35 mm film" +msgstr "Kleinbild-Brennweite" + +#: fpestrconsts.rsfocalplaneresunit +msgid "Focal plane resolution unit" +msgstr "" + +#: fpestrconsts.rsfocalplaneresunitlkup +msgid "1:None,2:inches,3:cm,4:mm,5:um" +msgstr "1:Nichts,2:Zoll,3:cm,4:mm,5:µm" + +#: fpestrconsts.rsfocalplanexres +msgid "Focal plane x resolution" +msgstr "" + +#: fpestrconsts.rsfocalplaneyres +msgid "Focal plane y resolution" +msgstr "" + +#: fpestrconsts.rsfujiadvancedfilterlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsfujiautobracketinglkup +msgid "0:Off,1:On,2:No flash & flash" +msgstr "" + +#: fpestrconsts.rsfujiblurwarninglkup +msgid "0:None,1:Blur Warning" +msgstr "0:Nichts,1:Unschärfewarnung" + +#: fpestrconsts.rsfujicolormodelkup +msgid "0:Standard,16:Chrome,48:B & W" +msgstr "" + +#: fpestrconsts.rsfujicontrastlkup +msgid "0:Normal,128:Medium High,256:High,384:Medium Low,512:Low,32768:Film Simulation" +msgstr "" + +#: fpestrconsts.rsfujicontrastlkup1 +msgid "0:Normal,256:High,768:Low" +msgstr "0:Normal,256:Hoch,768:Niedrig" + +#: fpestrconsts.rsfujidynamicrangelkup +msgid "1:Standard,3:Wide" +msgstr "1:Standard,3:Breit" + +#: fpestrconsts.rsfujiexposurewarninglkup +msgid "0:Good,1:Bad exposure" +msgstr "0:Gut,1:Schlecht belichtet" + +#: fpestrconsts.rsfujiexrmodelkup +msgid "128:HR (High Resolution),512:SN (Signal to Noise priority),768:DR (Dynamic Range priority)" +msgstr "" + +#: fpestrconsts.rsfujiflashmodelkup +msgid "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)" +msgstr "" + +#: fpestrconsts.rsfujifocuswarninglkup +msgid "0:Good,1:Out of focus" +msgstr "0:Gut,1:Unscharf" + +#: fpestrconsts.rsfujihighisonoisereductionlkup +msgid "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)" +msgstr "" + +#: fpestrconsts.rsfujinoisereductionlkup +msgid "64:Low,128:Normal,256:n/a" +msgstr "" + +#: fpestrconsts.rsfujipanoramadirlkup +msgid "1:Right,2:Up,3:Left,4:Down" +msgstr "1:Rechts,2:Oben,3:Links,4:Unten" + +#: fpestrconsts.rsfujipicturemodelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsfujisaturationlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsfujiscenerecognlkup +msgid "0:Unrecognized,256:Portrait Image,512:Landscape Image,768:Night Scene,1024:Macro" +msgstr "" + +#: fpestrconsts.rsfujishadowhighlightlkup +msgid "-64:+4 (hardest),-48:+3 (very hard),-32:+2 (hard),-16:+1 (medium hard)" +msgstr "" + +#: fpestrconsts.rsfujisharpnesslkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsfujishuttertypelkup +msgid "0:Mechanical,1:Electronic" +msgstr "0:Mechanisch,1:Elektronisch" + +#: fpestrconsts.rsfujiwhiteballkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsgaincontrol +msgid "Gain control" +msgstr "Verstärkungsregelung" + +#: fpestrconsts.rsgaincontrollkup +msgid "0:None,1:Low gain up,2:High gain up,3:Low gain down,4:High gain down" +msgstr "" + +#: fpestrconsts.rsgamma +msgid "Gamma" +msgstr "Gamma" + +#: fpestrconsts.rsgpsaltitude +msgid "GPS altitude" +msgstr "GPS-Höhe" + +#: fpestrconsts.rsgpsaltituderef +msgid "GPS altitude reference" +msgstr "GPS-Höhenbezug" + +#: fpestrconsts.rsgpsaltitudereflkup +msgid "0: Above sea level,1:Below sea level" +msgstr "0:Ãœber Meereshöhe,1:Unter Meereshöhe" + +#: fpestrconsts.rsgpsareainformation +msgid "Area information" +msgstr "Flächeninformation" + +#: fpestrconsts.rsgpsdatedifferential +msgid "GPS date differential" +msgstr "GPS-Datumsdifferenz" + +#: fpestrconsts.rsgpsdatedifferentiallkup +msgid "0:No correction,1:Differential corrected" +msgstr "" + +#: fpestrconsts.rsgpsdatestamp +msgid "GPS date stamp" +msgstr "GPS-Datum" + +#: fpestrconsts.rsgpsdestbearing +msgid "GPS destination bearing" +msgstr "" + +#: fpestrconsts.rsgpsdestbearingref +msgid "GPS destination bearing reference" +msgstr "" + +#: fpestrconsts.rsgpsdestdistance +msgid "GPS destination distance" +msgstr "" + +#: fpestrconsts.rsgpsdestdistanceref +msgid "GPS destination distance reference" +msgstr "" + +#: fpestrconsts.rsgpsdestlatitude +msgid "GPS destination latitude" +msgstr "" + +#: fpestrconsts.rsgpsdestlatituderef +msgid "GPS destination latitude reference" +msgstr "" + +#: fpestrconsts.rsgpsdestlongitude +msgid "GPS destination longitude" +msgstr "" + +#: fpestrconsts.rsgpsdestlongituderef +msgid "GPS destination longitude reference" +msgstr "" + +#: fpestrconsts.rsgpsdistancereflkup +msgid "K:Kilometers,M:Miles,N:Nautical miles" +msgstr "K:Kilometer,M:Meilen,N:nautische Meilen" + +#: fpestrconsts.rsgpsdop +msgid "GPS DOP" +msgstr "" + +#: fpestrconsts.rsgpshpositioningerror +msgid "GPS H positioning error" +msgstr "" + +#: fpestrconsts.rsgpsimagedirection +msgid "GPS image direction" +msgstr "" + +#: fpestrconsts.rsgpsimagedirectionref +msgid "GPS image direction reference" +msgstr "" + +#: fpestrconsts.rsgpsinfo +msgid "GPS info" +msgstr "GPS-Info" + +#: fpestrconsts.rsgpslatitude +msgid "GPS latitude" +msgstr "GPS-Breite" + +#: fpestrconsts.rsgpslatituderef +msgid "GPS latitude reference" +msgstr "GPS-Breitenreferenz" + +#: fpestrconsts.rsgpslatitudereflkup +msgid "N:North,S:South" +msgstr "N:Nord,S:Süd" + +#: fpestrconsts.rsgpslongitude +msgid "GPS longitude" +msgstr "GPS-Länge" + +#: fpestrconsts.rsgpslongituderef +msgid "GPS longitude reference" +msgstr "GPS-Längenreferenz" + +#: fpestrconsts.rsgpslongitudereflkup +msgid "E:East,W:West" +msgstr "E:Ost,2:West" + +#: fpestrconsts.rsgpsmapdatum +msgid "GPS map datum" +msgstr "" + +#: fpestrconsts.rsgpsmeasuremode +msgid "GPS measurement mode" +msgstr "GPS-Messmodus" + +#: fpestrconsts.rsgpsmeasuremodelkup +msgid "2:2-Dimensional Measurement,3:3-Dimensional Measurement" +msgstr "2:2-dimensionale Messung,3:3-dimensionale Messung" + +#: fpestrconsts.rsgpsprocessingmode +msgid "GPS processing mode" +msgstr "GPS-Bearbeitungsmodus" + +#: fpestrconsts.rsgpssatellites +msgid "GPS satellites" +msgstr "GPS-Satelliten" + +#: fpestrconsts.rsgpsspeed +msgid "GPS speed" +msgstr "GPS-Geschwindigkeit" + +#: fpestrconsts.rsgpsspeedref +msgid "GPS speed reference" +msgstr "" + +#: fpestrconsts.rsgpsspeedreflkup +msgid "K:km/h,M:mph,N:knots" +msgstr "K:cm/h,M:Meilen,N:Knoten" + +#: fpestrconsts.rsgpsstatus +msgid "GPS status" +msgstr "GPS-Stsatus" + +#: fpestrconsts.rsgpstimestamp +msgid "GPS time stamp" +msgstr "" + +#: fpestrconsts.rsgpstrack +msgid "GPS track" +msgstr "" + +#: fpestrconsts.rsgpstrackref +msgid "GPS track reference" +msgstr "" + +#: fpestrconsts.rsgpstrackreflkup +msgid "M:Magnetic north,T:True north" +msgstr "M:Magnetischer Nordpol,T:Wahrer Nordpol" + +#: fpestrconsts.rsgpsversionid +msgid "GPS version ID" +msgstr "" + +#: fpestrconsts.rshalftonehints +msgid "Half-tone hints" +msgstr "" + +#: fpestrconsts.rshostcomputer +msgid "Host computer" +msgstr "" + +#: fpestrconsts.rshumidity +msgid "Humidity" +msgstr "Feuchte" + +#: fpestrconsts.rsimagedatafilenotexisting +msgid "File \"%s\" providing the image data does not exist." +msgstr "Datei \"%s\", die die Bilddaten zur Verfügung stellen sollte, existiert nicht." + +#: fpestrconsts.rsimagedatafilenotspecified +msgid "The metadata structure is not linked to an image. Specify the name of the file providing the image data." +msgstr "Die Metadatenstruktur ist nicht mit einem Bild verbunden. Geben Sie den Namen der Datei an, die die Bilddaten zur Verfügung stellt." + +#: fpestrconsts.rsimagedescr +msgid "Image description" +msgstr "Bildbeschreibung" + +#: fpestrconsts.rsimageformatnotsupported +msgid "Image format not supported." +msgstr "Bildformat nicht unterstützt." + +#: fpestrconsts.rsimageheight +msgid "Image height" +msgstr "Bildhöhe" + +#: fpestrconsts.rsimagehistory +msgid "Image history" +msgstr "Bildhistorie" + +#: fpestrconsts.rsimagenumber +msgid "Image number" +msgstr "Bildnummer" + +#: fpestrconsts.rsimageresourcenametoolong +msgid "Image resource name \"%s\" too long." +msgstr "" + +#: fpestrconsts.rsimageuniqueid +msgid "Unique image ID" +msgstr "Eindeutige Bildkennung" + +#: fpestrconsts.rsimagewidth +msgid "Image width" +msgstr "Bildbreite" + +#: fpestrconsts.rsimgcaption +msgid "Image caption" +msgstr "Bildtitel" + +#: fpestrconsts.rsimgcaptionwriter +msgid "Image caption writer" +msgstr "Autor des Bildtitels" + +#: fpestrconsts.rsimgcredit +msgid "Image credit" +msgstr "" + +#: fpestrconsts.rsimgheadline +msgid "Image headline" +msgstr "" + +#: fpestrconsts.rsimgtype +msgid "Image type" +msgstr "Bildtyp" + +#: fpestrconsts.rsincompletejpegsegmentheader +msgid "Defective JPEG structure: Incomplete segment header" +msgstr "Defekte JPEG-Struktur: Unvollständiger Segment-Header" + +#: fpestrconsts.rsincorrectfilestructure +msgid "Incorrect file structure" +msgstr "Falsche Dateistruktur" + +#: fpestrconsts.rsincorrecttagtype +msgid "Incorrect tag type %d: Index=%d, TagID=$%.04x, File:\"%s\"" +msgstr "Falscher Tag-Typ %d: Index=%d, TagID=$%.94x, Datei: \"%s\"" + +#: fpestrconsts.rsinkset +msgid "Ink set" +msgstr "" + +#: fpestrconsts.rsinksetlkup +msgid "1:CMYK,2:Not CMYK" +msgstr "1:CMYK,2:Nicht CMYK" + +#: fpestrconsts.rsinteropindex +msgid "Interoperabiliy index" +msgstr "" + +#: fpestrconsts.rsinteropoffset +msgid "Interoperability offset" +msgstr "" + +#: fpestrconsts.rsinteropversion +msgid "Interoperability version" +msgstr "" + +#: fpestrconsts.rsiptcdataexpected +msgid "IPTC data expected, but not found." +msgstr "IPTC-Daten erwartet, aber nicht gefunden." + +#: fpestrconsts.rsiptcextendeddatasizenotsupported +msgid "Data size %d not supported for an IPTC extended dataset." +msgstr "Datengröße %d wird für einen erweiterten IPTC Datensatz nicht unterstützt." + +#: fpestrconsts.rsiptcnaa +msgid "IPTC/NAA" +msgstr "IPTC/NAA" + +#: fpestrconsts.rsiptcorientationlkup +msgid "P:Portrait,L:Landscape,S:Square" +msgstr "P:Hochformat,L:Querformat,S:Quadratisch" + +#: fpestrconsts.rsiso +msgid "ISO" +msgstr "ISO" + +#: fpestrconsts.rsisospeed +msgid "ISO speed" +msgstr "ISO-Wert" + +#: fpestrconsts.rsisospeedlatitudeyyy +msgid "ISO latitude yyy" +msgstr "" + +#: fpestrconsts.rsisospeedlatitudezzz +msgid "ISO speed latitude zzz" +msgstr "" + +#: fpestrconsts.rsjpegcompresseddatawriting +msgid "Writing error of compressed data." +msgstr "Fehler beim Schreiben der komprimierten Daten." + +#: fpestrconsts.rsjpegreadwriteerrorinsegment +msgid "Read/write error in segment $FF%.2x" +msgstr "Lese-/Schreibfehler in Segment $FF%.2x" + +#: fpestrconsts.rsjpegsegmentmarkerexpected +msgid "Defective JPEG structure: Segment marker ($FF) expected." +msgstr "Defekte JPEG-Struktur: Segment-Marker ($FF) erwartet." + +#: fpestrconsts.rskeywords +msgid "Keywords" +msgstr "Schlüsselwörter" + +#: fpestrconsts.rslangid +msgid "Language ID" +msgstr "Sprach-Kennnummer" + +#: fpestrconsts.rslensinfo +msgid "Lens info" +msgstr "Objektiv-Info" + +#: fpestrconsts.rslensmake +msgid "Lens make" +msgstr "Objektivhersteller" + +#: fpestrconsts.rslensmodel +msgid "Lens model" +msgstr "Objektivmodell" + +#: fpestrconsts.rslensserialnumber +msgid "Lens serial number" +msgstr "Objektiv-Seriennummer" + +#: fpestrconsts.rslightsource +msgid "Light source" +msgstr "Lichtquelle" + +#: fpestrconsts.rslightsourcelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rslocationcode +msgid "Country/primary location code" +msgstr "Land / primärer Ortscode" + +#: fpestrconsts.rslocationname +msgid "Country/primary location name" +msgstr "Land / primärer Ortsname" + +#: fpestrconsts.rslownormalhigh +msgid "0:Low,1:Normal,2:High" +msgstr "0:Niedrig,1:Normal,2:Hoch" + +#: fpestrconsts.rsmacro +msgid "Macro" +msgstr "Makro" + +#: fpestrconsts.rsmake +msgid "Make" +msgstr "Hersteller" + +#: fpestrconsts.rsmakernote +msgid "Maker note" +msgstr "Hersteller-Notiz" + +#: fpestrconsts.rsmaxaperturevalue +msgid "Max aperture value" +msgstr "Maximaler Blendenwert" + +#: fpestrconsts.rsmaxsamplevalue +msgid "Max sample value" +msgstr "Maximaler Abtastwert" + +#: fpestrconsts.rsmeteringmode +msgid "Metering mode" +msgstr "Belichtungsmess-Modus" + +#: fpestrconsts.rsmeteringmodelkup +msgid "0:Unknown,1:Average,2:Center-weighted average,3:Spot,4:Multi-spot,5:Multi-segment,6:Partial,255:Other" +msgstr "" + +#: fpestrconsts.rsminoltabracketsteplkup +msgid "0:1/3 EV,1:2/3 EV,2:1 EV" +msgstr "0:1/3 EV,1:2/3 EV,2:1 EV" + +#: fpestrconsts.rsminoltacolormodelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsminoltacolorprofilelkup +msgid "0:Not embedded,1:Embedded" +msgstr "" + +#: fpestrconsts.rsminoltadataimprintlkup +msgid "0;None,1:YYYY/MM/DD,2:MM/DD/HH:MM,3:Text,4:Text + ID#" +msgstr "" + +#: fpestrconsts.rsminoltadecpositionlkup +msgid "0:Exposure,1:Contrast,2:Saturation,3:Filter" +msgstr "0:Belichtung,1:Kontrast,2:Sättigung,3:Filter" + +#: fpestrconsts.rsminoltadigitalzoomlkup +msgid "0:Off,1:Electronic magnification,2:2x" +msgstr "" + +#: fpestrconsts.rsminoltadrivemodelkup +msgid "0:Single,1:Continuous,2:Self-timer,4:Bracketing,5:Interval,6:UHS continuous,7:HS continuous" +msgstr "0:Einzeln,1:Ständig,2:Selbstauslöser,4:Belichtungsreihe,4:Intervall,6:UHS ständig,7:HS ständig" + +#: fpestrconsts.rsminoltaexposuremodelkup +msgid "0:Program,1:Aperture priority,2:Shutter priority,3:Manual" +msgstr "" + +#: fpestrconsts.rsminoltaflashmeteringlkup +msgid "0:ADI (Advanced Distance Integration),1:Pre-flash TTL,2:Manual flash control" +msgstr "" + +#: fpestrconsts.rsminoltaflashmodelkup +msgid "0:Fill flash,1:Red-eye reduction,2:Rear flash sync,3:Wireless,4:Off?" +msgstr "" + +#: fpestrconsts.rsminoltafocusarealkup +msgid "0:Wide Focus (normal),1:Spot Focus" +msgstr "" + +#: fpestrconsts.rsminoltafocusmodelkup +msgid "0:AF,1:MF" +msgstr "0:AF,1:MF" + +#: fpestrconsts.rsminoltafoldernamelkup +msgid "0:Standard Form,1:Data Form" +msgstr "" + +#: fpestrconsts.rsminoltaimagesizelkup +msgid "1:1600x1200,2:1280x960,3:640x480,5:2560x1920,6:2272x1704,7:2048x1536" +msgstr "1:1600x1200,2:1280x960,3:640x480,5:2560x1920,6:2272x1704,7:2048x1536" + +#: fpestrconsts.rsminoltaimagesizelkup1 +msgid "0:Full,1:1600x1200,2:1280x960,3:640x480,6:2080x1560,7:2560x1920,8;3264x2176" +msgstr "0:Full,1:1600x1200,2:1280x960,3:640x480,6:2080x1560,7:2560x1920,8;3264x2176" + +#: fpestrconsts.rsminoltaimagestablkup +msgid "1:Off,5:On" +msgstr "1:Aus,2:Ein" + +#: fpestrconsts.rsminoltainternalflashlkup +msgid "0:No,1:Fired" +msgstr "0:Nein,1:Ausgelöst" + +#: fpestrconsts.rsminoltaintervalmodelkup +msgid "0:Still image,1:Time-lapse movie" +msgstr "" + +#: fpestrconsts.rsminoltaisosettinglkup +msgid "0:100,1:200,2:400,3:800,4:Auto,5:64" +msgstr "0:100,1:200,2:400,3:800,4:Auto,5:64" + +#: fpestrconsts.rsminoltameteringmodelkup +msgid "0:Multi-segment,1:Center-weighted average,2:Spot" +msgstr "" + +#: fpestrconsts.rsminoltamodelidlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsminoltaqualitylkup +msgid "0:Raw,1:Super Fine,2:Fine,3:Standard,4:Economy,5:Extra fine" +msgstr "" + +#: fpestrconsts.rsminoltascenemodelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsminoltasharpnesslkup +msgid "0:Hard,1:Normal,2:Soft" +msgstr "0:Hart,1:Normal,2:Weich" + +#: fpestrconsts.rsminoltasubjectprogramlkup +msgid "0:None,1:Portrait,2:Text,3:Night portrait,4:Sunset,5:Sports action" +msgstr "" + +#: fpestrconsts.rsminoltateleconverterlkup +msgid "$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" +msgstr "" + +#: fpestrconsts.rsminoltawhitebalancelkup +msgid "$00:Auto,$01:Color Temperature/Color Filter,$10:Daylight,$20:Cloudy,$30:Shade,$40:Tungsten,$50:Flash,$60:Fluorescent,$70:Custom" +msgstr "" + +#: fpestrconsts.rsminoltawidefocuszonelkup +msgid "0:No zone,1:Center zone (horizontal orientation),2:Center zone (vertical orientation),3:Left zone,4:Right zone" +msgstr "" + +#: fpestrconsts.rsminoltazonematchinglkup +msgid "0:ISO Setting Used,1:High Key,2:Low Key" +msgstr "" + +#: fpestrconsts.rsminsamplevalue +msgid "Min sample value" +msgstr "Minimaler Abtastwert" + +#: fpestrconsts.rsmodel +msgid "Model" +msgstr "Modell" + +#: fpestrconsts.rsmorethumbnailtagsthanexpected +msgid "More thumbnail tags than expected." +msgstr "Mehr Vorschaubild-Tags als erwartet." + +#: fpestrconsts.rsnikoncolormodelkup +msgid "1:Color,2:Monochrome" +msgstr "1:Farbe,2:Monochrom" + +#: fpestrconsts.rsnikonconverterlkup +msgid "0:Not used,1:Used" +msgstr "0:Nicht benutzt,1:Benutzt" + +#: fpestrconsts.rsnikonimgadjlkup +msgid "0:Normal,1:Bright+,2:Bright-,3:Contrast+,4:Contrast-" +msgstr "" + +#: fpestrconsts.rsnikonisolkup +msgid "0:ISO80,2:ISO160,4:ISO320,5:ISO100" +msgstr "" + +#: fpestrconsts.rsnikonqualitylkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsnikonwhitebalancelkup +msgid "0:Auto,1:Preset,2:Daylight,3:Incandescense,4:Fluorescence,5:Cloudy,6:SpeedLight" +msgstr "" + +#: fpestrconsts.rsnormallowhigh +msgctxt "fpestrconsts.rsnormallowhigh" +msgid "0:Normal,1:Low,2:High" +msgstr "0:Normal,1:Niedrig,2:Hoch" + +#: fpestrconsts.rsnormalsofthard +msgctxt "fpestrconsts.rsnormalsofthard" +msgid "0:Normal,1:Soft,2:Hard" +msgstr "" +"0:Normal,1:Weich,2:\n" +"Hart" + +#: fpestrconsts.rsnovalidiptcfile +msgid "No valid IPTC file" +msgstr "Ungültige IPTC-Datei" + +#: fpestrconsts.rsnovalidiptcsignature +msgid "No valid IPTC signature" +msgstr "Ungültige IPTC-Signatur" + +#: fpestrconsts.rsnoyes +msgctxt "fpestrconsts.rsnoyes" +msgid "0:No,1:Yes" +msgstr "0:Nein,1:Ja" + +#: fpestrconsts.rsobjectattr +msgid "Object attribute reference" +msgstr "" + +#: fpestrconsts.rsobjectcycle +msgid "Object cycle" +msgstr "Objekt-Zyklus" + +#: fpestrconsts.rsobjectcyclelkup +msgid "a:morning,p:evening,b:both" +msgstr "" + +#: fpestrconsts.rsobjectname +msgid "Object name" +msgstr "Objekt-Name" + +#: fpestrconsts.rsobjecttype +msgid "Object type reference" +msgstr "" + +#: fpestrconsts.rsoffon +msgctxt "fpestrconsts.rsoffon" +msgid "0:Off,1:On" +msgstr "0:Aus,1:Ein" + +#: fpestrconsts.rsoffsettime +msgid "Time zone for date/time" +msgstr "Zeitzone für Datum/Uhrzeit" + +#: fpestrconsts.rsoffsettimedigitized +msgid "Time zone for date/time digitized" +msgstr "Zeitzone für Datum/Uhrzeit der Digitalisierung" + +#: fpestrconsts.rsoffsettimeoriginal +msgid "Time zone for date/time original" +msgstr "Zeitzone für Original-Datum/Uhrzeit" + +#: fpestrconsts.rsolympusccdscanmodelkup +msgid "0:Interlaced,1:Progressive" +msgstr "" + +#: fpestrconsts.rsolympuscontrastlkup +msgid "0:High,1:Normal,2:Low" +msgstr "0:Hoch,1:Normal,2:Niedrig" + +#: fpestrconsts.rsolympusflashdevlkup +msgid "0:None,1:Internal,4:External,5:Internal + External" +msgstr "" + +#: fpestrconsts.rsolympusflashmodelkup +msgid "2:On,3;Off" +msgstr "2:Ein,3:Aus" + +#: fpestrconsts.rsolympusflashmodellkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsolympusflashtypelkup +msgid "0:None,2:Simple E-System,3:E-System" +msgstr "" + +#: fpestrconsts.rsolympusjpegquallkup +msgid "1:SQ,2:HQ,3:SHQ,4:Raw" +msgstr "" + +#: fpestrconsts.rsolympusmacrolkup +msgid "0:Off,1:On,2:Super Macro" +msgstr "0:Aus,1:Ein,2:Super-Makro" + +#: fpestrconsts.rsolympuspreviewimglength +msgid "Preview image length" +msgstr "Vorschaubildhöhe" + +#: fpestrconsts.rsolympuspreviewimgstart +msgid "Preview image start" +msgstr "Vorschaubild-Start" + +#: fpestrconsts.rsolympuspreviewimgvalid +msgid "Preview image valid" +msgstr "Vorschaubild ungültig" + +#: fpestrconsts.rsolympusscenemodelkup +msgid "0:Normal,1:Standard,2:Auto,3:Intelligent Auto,4:Portrait,5:Landscape+Portrait,6:Landscape,7:Night Scene,8:Night+Portrait9: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" +msgstr "" + +#: fpestrconsts.rsolympussharpnesslkup +msgid "0:Normal,1:Hard,2:Soft" +msgstr "0:Normal,1:Hart,2:Weich" + +#: fpestrconsts.rsorientation +msgid "Orientation" +msgstr "Ausrichtung" + +#: fpestrconsts.rsorientationlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsoriginatingprog +msgid "Originating program" +msgstr "Ursprungsprogramm" + +#: fpestrconsts.rsownername +msgid "Owner name" +msgstr "Name des Besitzers" + +#: fpestrconsts.rspagename +msgid "Page name" +msgstr "Seitenname" + +#: fpestrconsts.rspagenumber +msgid "Page number" +msgstr "Seitennummer" + +#: fpestrconsts.rsphotometricint +msgid "Photometric interpretation" +msgstr "" + +#: fpestrconsts.rsphotometricintlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsplanarconfiguration +msgid "Planar configuration" +msgstr "" + +#: fpestrconsts.rsplanarconfigurationlkup +msgid "1:Chunky,2:Planar" +msgstr "" + +#: fpestrconsts.rspredictor +msgid "Predictor" +msgstr "" + +#: fpestrconsts.rspredictorlkup +msgid "1:None,2:Horizontal differencing" +msgstr "" + +#: fpestrconsts.rspressure +msgid "Pressure" +msgstr "Druck" + +#: fpestrconsts.rsprimarychromaticities +msgid "Primary chromaticities" +msgstr "" + +#: fpestrconsts.rsprogversion +msgid "Program version" +msgstr "Programm-Version" + +#: fpestrconsts.rsquality +msgid "Quality" +msgstr "Qualität" + +#: fpestrconsts.rsrangecheckerror +msgid "Range check error." +msgstr "" + +#: fpestrconsts.rsreadincompleteifdrecord +msgid "Read incomplete IFD record at stream position %d." +msgstr "" + +#: fpestrconsts.rsrecexpindex +msgid "Recommended exposure index" +msgstr "Empfohlener Belichtungsindex" + +#: fpestrconsts.rsrecordversion +msgid "Record version" +msgstr "Datensatzversion" + +#: fpestrconsts.rsrefblackwhite +msgid "Reference black & white" +msgstr "" + +#: fpestrconsts.rsrefdate +msgid "Reference date" +msgstr "Referenzdatum" + +#: fpestrconsts.rsrefnumber +msgid "Reference number" +msgstr "Referenznummer" + +#: fpestrconsts.rsrefservice +msgid "Reference service" +msgstr "" + +#: fpestrconsts.rsrelatedimagefileformat +msgid "Related image file format" +msgstr "" + +#: fpestrconsts.rsrelatedimageheight +msgid "Related image height" +msgstr "" + +#: fpestrconsts.rsrelatedimagewidth +msgid "Related image width" +msgstr "" + +#: fpestrconsts.rsrelatedsoundfile +msgid "Related sound file" +msgstr "" + +#: fpestrconsts.rsreleasedate +msgid "Release date" +msgstr "Freigabe-Datum" + +#: fpestrconsts.rsreleasetime +msgid "Release time" +msgstr "Freigabe-Uhrzeit" + +#: fpestrconsts.rsresolutionunit +msgid "Resolution unit" +msgstr "Auflösungseinheit" + +#: fpestrconsts.rsresolutionunitlkup +msgid "1:None,2:inches,3:cm" +msgstr "1:Nichts,2:Zoll,3:cm" + +#: fpestrconsts.rsrowsperstrip +msgid "Rows per strip" +msgstr "" + +#: fpestrconsts.rssamplesperpixel +msgid "Samples per pixel" +msgstr "" + +#: fpestrconsts.rssanyomacrolkup +msgid "0:Normal,1:Macro,2:View,3:Manual" +msgstr "0:Normal,1.Makro,2:Ansicht,3:Manuell" + +#: fpestrconsts.rssanyoqualitylkup +msgid "0:Normal/Very Low,1:Normal/Low,2:Normal/Medium Low,3:Normal/Medium,4:Normal/Medium High,5:Normal/High,6:Normal/Very High7:Normal/Super High,256:Fine/Very Low,257:Fine/Low,258:Fine/Medium Low259:Fine/Medium,260:Fine/Medium High,261:Fine/High,262:Fine/Very High263: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" +msgstr "" + +#: fpestrconsts.rssanyospecialmode +msgid "Special mode" +msgstr "Spezialmodus" + +#: fpestrconsts.rssaturation +msgid "Saturation" +msgstr "Sättigung" + +#: fpestrconsts.rsscenecapturetype +msgid "Scene capture type" +msgstr "" + +#: fpestrconsts.rsscenecapturetypelkup +msgid "0:Standard,1:Landscape,2:Portrait,3:Night" +msgstr "0:Standard,1:Landschaft,2:Porträt,3:Nachaufnahme" + +#: fpestrconsts.rsscenetype +msgid "Scene type" +msgstr "Motiv-Typ" + +#: fpestrconsts.rsscenetypelkup +msgid "0:Unknown,1:Directly photographed" +msgstr "0:Unbekannt,1:Direkt fotografiert" + +#: fpestrconsts.rssecurityclassification +msgid "Security classification" +msgstr "Sicherheitsklassifizierung" + +#: fpestrconsts.rsselftimermode +msgid "Self-timer mode" +msgstr "Selbstauslöser-Modus" + +#: fpestrconsts.rsseminfo +msgid "SEM info" +msgstr "" + +#: fpestrconsts.rssensingmethod +msgid "Sensing method" +msgstr "" + +#: fpestrconsts.rssensingmethodlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rssensitivitytype +msgid "Sensitivity type" +msgstr "" + +#: fpestrconsts.rssensitivitytypelkup +msgid "0:Unknown,1:Standard Output Sensitivity2: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" +msgstr "" + +#: fpestrconsts.rsserialnumber +msgid "Serial number" +msgstr "Seriennummer" + +#: fpestrconsts.rssharpness +msgid "Sharpness" +msgstr "Schärfe" + +#: fpestrconsts.rsshutterspeedvalue +msgid "Shutter speed value" +msgstr "Verschlusszeit" + +#: fpestrconsts.rssinglecontinuous +msgctxt "fpestrconsts.rssinglecontinuous" +msgid "0:Single,1:Continuous" +msgstr "0:Einzeln,1:Ständig" + +#: fpestrconsts.rssoftware +msgid "Software" +msgstr "Software" + +#: fpestrconsts.rssource +msgid "Source" +msgstr "Quelle" + +#: fpestrconsts.rsspatialfrequresponse +msgid "Spatial frequency response" +msgstr "" + +#: fpestrconsts.rsspecialinstruct +msgid "Special instructions" +msgstr "Spezielle Anweisungen" + +#: fpestrconsts.rsspectralsensitivity +msgid "Spectral sensitivity" +msgstr "" + +#: fpestrconsts.rsstate +msgid "Province/State" +msgstr "Provinz/Staat" + +#: fpestrconsts.rsstdoutputsens +msgid "Standard output sensitivity" +msgstr "" + +#: fpestrconsts.rsstripbytecounts +msgid "Strip byte counts" +msgstr "" + +#: fpestrconsts.rsstripoffsets +msgid "Strip offsets" +msgstr "" + +#: fpestrconsts.rssubfile +msgid "Subfile" +msgstr "Unterdatei" + +#: fpestrconsts.rssubfiletypelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rssubjectarea +msgid "Subject area" +msgstr "Objektfläche" + +#: fpestrconsts.rssubjectdistance +msgid "Subject distance" +msgstr "Objektabstand" + +#: fpestrconsts.rssubjectdistancerange +msgid "Subject distance range" +msgstr "" + +#: fpestrconsts.rssubjectdistancerangelkup +msgid "0:Unknown,1:Macro,2:Close,3:Distant" +msgstr "0:Unbekannt,1:Makro,2:Nah,3:Fern" + +#: fpestrconsts.rssubjectlocation +msgid "Subject location" +msgstr "" + +#: fpestrconsts.rssubjectref +msgid "Subject reference" +msgstr "" + +#: fpestrconsts.rssublocation +msgid "Sublocation" +msgstr "" + +#: fpestrconsts.rssubsectime +msgid "Fractional seconds of date/time" +msgstr "" + +#: fpestrconsts.rssubsectimedigitized +msgid "Fractional seconds of date/time digitized" +msgstr "" + +#: fpestrconsts.rssubsectimeoriginal +msgid "Fractional seconds of date/time original" +msgstr "" + +#: fpestrconsts.rssuppcategory +msgid "Supplemental category" +msgstr "Zusatzkategorie" + +#: fpestrconsts.rstagtypenotsupported +msgid "Tag \"%s\" has an unsupported type." +msgstr "Der Typ von Tag \"%s\" wird nicht unterstützt." + +#: fpestrconsts.rstargetprinter +msgid "Target printer" +msgstr "" + +#: fpestrconsts.rstemperature +msgid "Temperature" +msgstr "Temperatur" + +#: fpestrconsts.rsthresholding +msgid "Thresholding" +msgstr "" + +#: fpestrconsts.rsthresholdinglkup +msgid "1:No dithering or halftoning,2:Ordered dither or halftone,3:Randomized dither" +msgstr "" + +#: fpestrconsts.rsthumbnailheight +msgid "Thumbnail height" +msgstr "Vorschaubild-Höhe" + +#: fpestrconsts.rsthumbnailoffset +msgid "Thumbnail offset" +msgstr "Vorschaubild-Offset" + +#: fpestrconsts.rsthumbnailsize +msgid "Thumbnail size" +msgstr "Vorschaubild-Größe" + +#: fpestrconsts.rsthumbnailwidth +msgid "Thumbnail width" +msgstr "Vorschaubild-Breite" + +#: fpestrconsts.rstilelength +msgid "Tile length" +msgstr "" + +#: fpestrconsts.rstilewidth +msgid "Tile width" +msgstr "" + +#: fpestrconsts.rstimecreated +msgid "Time created" +msgstr "" + +#: fpestrconsts.rstimezoneoffset +msgid "Time zone offset" +msgstr "Zeitzonenoffset" + +#: fpestrconsts.rstransferfunction +msgid "Transfer function" +msgstr "Ãœbertragungsfunktion" + +#: fpestrconsts.rstransmissionref +msgid "Original transmission reference" +msgstr "" + +#: fpestrconsts.rsunknownimageformat +msgid "Unknown image format." +msgstr "Unbekanntes Bildformat." + +#: fpestrconsts.rsurgency +msgid "Urgency" +msgstr "Dringlichkeit" + +#: fpestrconsts.rsurgencylkup +msgid "0:reserved,1:most urgent,5:normal,8:least urgent,9:reserved" +msgstr "" + +#: fpestrconsts.rsusercomment +msgid "User comment" +msgstr "Benutzerkommentar" + +#: fpestrconsts.rswaterdepth +msgid "Water depth" +msgstr "Wassertiefe" + +#: fpestrconsts.rswhitebalance +msgid "White balance" +msgstr "Weißabgleich" + +#: fpestrconsts.rswhitepoint +msgid "White point" +msgstr "Weißpunkt" + +#: fpestrconsts.rswritingnotimplemented +msgid "Writing of %s files not yet implemented." +msgstr "" + +#: fpestrconsts.rsxposition +msgid "X position" +msgstr "X-Position" + +#: fpestrconsts.rsxresolution +msgid "X resolution" +msgstr "X-Auflösung" + +#: fpestrconsts.rsycbcrcoefficients +msgid "YCbCr coefficients" +msgstr "" + +#: fpestrconsts.rsycbcrpositioning +msgid "YCbCr positioning" +msgstr "" + +#: fpestrconsts.rsycbcrposlkup +msgid "1:Centered,2:Co-sited" +msgstr "" + +#: fpestrconsts.rsycbcrsubsampling +msgid "YCbCr subsampling" +msgstr "" + +#: fpestrconsts.rsyposition +msgid "Y position" +msgstr "Y-Position" + +#: fpestrconsts.rsyresolution +msgid "Y resolution" +msgstr "Y-Auflösung" diff --git a/components/fpexif/languages/fpestrconsts.po b/components/fpexif/languages/fpestrconsts.po new file mode 100644 index 000000000..5344e26bb --- /dev/null +++ b/components/fpexif/languages/fpestrconsts.po @@ -0,0 +1,1682 @@ +msgid "" +msgstr "Content-Type: text/plain; charset=UTF-8" + +#: fpestrconsts.rsacceleration +msgid "Acceleration" +msgstr "" + +#: fpestrconsts.rsactionadvised +msgid "Action advised" +msgstr "" + +#: fpestrconsts.rsaperturevalue +msgid "Aperture value" +msgstr "" + +#: fpestrconsts.rsartist +msgid "Artist" +msgstr "" + +#: fpestrconsts.rsautomanual +msgid "0:Auto,1:Manual" +msgstr "" + +#: fpestrconsts.rsbitspersample +msgid "Bits per sample" +msgstr "" + +#: fpestrconsts.rsbrightnessvalue +msgid "Brightness value" +msgstr "" + +#: fpestrconsts.rsbyline +msgid "ByLine" +msgstr "" + +#: fpestrconsts.rsbylinetitle +msgid "ByLine title" +msgstr "" + +#: fpestrconsts.rscameraelevationangle +msgid "Camera elevation angle" +msgstr "" + +#: fpestrconsts.rscannotsavetounknownfileformat +msgid "The metadata structure cannot be saved because the file format of the receiving file is not known or not supported." +msgstr "" + +#: fpestrconsts.rscanonaelkup +msgid "0:Normal AE,1:Exposure compensation,2:AE lock,3:AE lock + Exposure compensation,4:No AE" +msgstr "" + +#: fpestrconsts.rscanonaflkup +msgid "$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" +msgstr "" + +#: fpestrconsts.rscanonautorotlkup +msgid "0:None,1:Rotate 90 CW,2:Rotate 180,3:Rotate 270 CW" +msgstr "" + +#: fpestrconsts.rscanonbiaslkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanoncamtypelkup +msgid "248:EOS High-end,250:Compact,252:EOS Mid-range,255:DV Camera" +msgstr "" + +#: fpestrconsts.rscanoneasylkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanonexposelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanonflashactlkup +msgid "0:Did not fire,1:Fired" +msgstr "" + +#: fpestrconsts.rscanonflashlkup +msgid "0:Not fired,1:Auto,2:On,3:Red-eye,4:Slow sync,5:Auto+red-eye,6:On+red eye,16:External flash" +msgstr "" + +#: fpestrconsts.rscanonfocaltypelkup +msgid "1:Fixed,2:Zoom" +msgstr "" + +#: fpestrconsts.rscanonfoctypelkup +msgid "0:Manual,1:Auto,3:Close-up (macro),8:Locked (pan mode)" +msgstr "" + +#: fpestrconsts.rscanonfocuslkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanongenlkup +msgid "65535:Low,0:Normal,1:High" +msgstr "" + +#: fpestrconsts.rscanonimgstablkup +msgid "0:Off,1:On,2:Shoot only,3:Panning,4:Dynamic,256:Off,257:On,258:Shoot only,259:Panning,260:Dynamic" +msgstr "" + +#: fpestrconsts.rscanonisolkup +msgid "0:Not used,15:auto,16:50,17:100,18:200,19:400" +msgstr "" + +#: fpestrconsts.rscanonmacrolkup +msgid "1:Macro,2:Normal" +msgstr "" + +#: fpestrconsts.rscanonmeterlkup +msgid "0:Default,1:Spot,2:Average,3:Evaluative,4:Partial,5:Center-weighted average" +msgstr "" + +#: fpestrconsts.rscanonpandirlkup +msgid "0:Left to right,1:Right to left,2:Bottom to top,3:Top to bottom,4:2x2 Matrix (clockwise)" +msgstr "" + +#: fpestrconsts.rscanonqualitylkup +msgid "65535:n/a,1:Economy,2:Normal,3:Fine,4:RAW,5:Superfine,130:Normal Movie,131:Movie (2)" +msgstr "" + +#: fpestrconsts.rscanonreclkup +msgid "1:JPEG,2:CRW+THM,3:AVI+THM,4:TIF,5:TIF+JPEG,6:CR2,7:CR2+JPEG,9:MOV,10:MP4" +msgstr "" + +#: fpestrconsts.rscanonsizelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanonsloshuttlkup +msgid "65535:n/a,0:Off,1:Night scene,2:On,3:None" +msgstr "" + +#: fpestrconsts.rscanonwhiteballkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscanonzoomlkup +msgid "0:None,1:2x,2:4x,3:Other" +msgstr "" + +#: fpestrconsts.rscasioafmode2lkup +msgid "0:Off,1:Spot,2:Multi,3:Face detection,4:Tracking,5:Intelligent" +msgstr "" + +#: fpestrconsts.rscasioartmode2lkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscasioautoiso2lkup +msgid "1:On,2:Off,7:On (high sensitivity),8:On (anti-shake),10:High Speed" +msgstr "" + +#: fpestrconsts.rscasioccdsensitivitylkup +msgid "64:Normal,125:+1.0,250:+2.0,244:+3.0,80:Normal,100:High" +msgstr "" + +#: fpestrconsts.rscasiocolorfilter2lkup +msgid "0:Off,1:Blue,3:Green,4:Yellow,5:Red,6:Purple,7:Pink" +msgstr "" + +#: fpestrconsts.rscasiocolormode2lkup +msgid "0:Off,2:Black & White,3:Sepia" +msgstr "" + +#: fpestrconsts.rscasiodigitalzoomlkup +msgid "$10000:Off,$10001:2x Digital zoom,$20000:2x digital zoom,$40000:4x digital zoom" +msgstr "" + +#: fpestrconsts.rscasiodrivemode2lkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscasioenhancement2lkup +msgid "0:Off,1:Scenery,3:Green,5:Underwater,9:Flesh tones" +msgstr "" + +#: fpestrconsts.rscasioflashintensitylkup +msgid "11:Weak,13:Normal,15:Strong" +msgstr "" + +#: fpestrconsts.rscasioflashmodelkup +msgid "1:Auto,2:On,3:Off,4:Red-eye reduction" +msgstr "" + +#: fpestrconsts.rscasiofocusingmodelkup +msgid "2:Macro,3:Auto focus,4:Manual focus,5:Infinity" +msgstr "" + +#: fpestrconsts.rscasiofocusmode22lkup +msgid "0:Manual,1:Focus lock,2:Macro,3:Single-area auto focus,5:Infinity,6:Multi-area auto focus,8:Super macro" +msgstr "" + +#: fpestrconsts.rscasiofocusmode2lkup +msgid "0:Normal,1:Macro" +msgstr "" + +#: fpestrconsts.rscasioimagesize2lkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscasioimagestabilization2lkup +msgid "0:Off,1:On,2:Best shot,3:Movie anti-shake" +msgstr "" + +#: fpestrconsts.rscasioisospeed2lkup +msgid "3 = 50,4:64,6:100,9:200" +msgstr "" + +#: fpestrconsts.rscasiolightingmode2lkup +msgid "0:Off,1:High dynamic range,5:Shadow enhance low,6:Shadow enhance high" +msgstr "" + +#: fpestrconsts.rscasioportraitrefiner2lkup +msgid "0:Off,1:+1,2:+2" +msgstr "" + +#: fpestrconsts.rscasiorecordingmodelkup +msgid "1:Single shutter,2:Panorama,3:Night scene,4:Portrait,5:Landscape" +msgstr "" + +#: fpestrconsts.rscasiorecordmode2lkup +msgid "2:Program AE,3:Shutter priority,4:Aperture priority,5:Manual,6:Best shot,17:Movie,19:Movie (19),20:YouTube Movie" +msgstr "" + +#: fpestrconsts.rscasioreleasemode2lkup +msgid "1:Normal,3:AE Bracketing,11:WB Bracketing,13 = Contrast Bracketing,19:High Speed Burst" +msgstr "" + +#: fpestrconsts.rscasiosharpness2lkup +msgid "0:Soft,1:Normal,2:Hard" +msgstr "" + +#: fpestrconsts.rscasiospecialeffectsetting2lkup +msgid "0:Off,1:Makeup,2:Mist removal,3:Vivid landscape,16:Art shot" +msgstr "" + +#: fpestrconsts.rscasiovideoquality2lkup +msgid "1:Standard,3:HD (720p),4:Full HD (1080p),5:Low" +msgstr "" + +#: fpestrconsts.rscasiowhitebalance22lkup +msgid "0:Manual,1:Daylight,2:Cloudy,3:Shade,4:Flash?,6:Fluorescent,9:Tungsten?,10:Tungsten,12:Flash" +msgstr "" + +#: fpestrconsts.rscasiowhitebalance2lkup +msgid "0:Auto,1:Daylight,2:Shade,3:Tungsten,4:Fluorescent,5:Manual" +msgstr "" + +#: fpestrconsts.rscasiowhitebalancelkup +msgid "1:Auto,2:Tungsten,3:Daylight,4:Fluorescent,5:Shade,129:Manual" +msgstr "" + +#: fpestrconsts.rscategory +msgid "Category" +msgstr "" + +#: fpestrconsts.rscellheight +msgid "Cell height" +msgstr "" + +#: fpestrconsts.rscellwidth +msgid "Cell width" +msgstr "" + +#: fpestrconsts.rscfapattern +msgid "CFA pattern" +msgstr "" + +#: fpestrconsts.rscity +msgid "City" +msgstr "" + +#: fpestrconsts.rscodedcharset +msgid "Coded character set" +msgstr "" + +#: fpestrconsts.rscolorspace +msgid "Color space" +msgstr "" + +#: fpestrconsts.rscolorspacelkup +msgid "0:sBW,1:sRGB,2:Adobe RGB,65533:Wide Gamut RGB,65534:ICC Profile,65535:Uncalibrated" +msgstr "" + +#: fpestrconsts.rscomponentsconfig +msgid "Components configuration" +msgstr "" + +#: fpestrconsts.rscompressedbitsperpixel +msgid "Compressed bits per pixel" +msgstr "" + +#: fpestrconsts.rscompression +msgid "Compression" +msgstr "" + +#: fpestrconsts.rscompressionlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rscontact +msgid "Contact" +msgstr "" + +#: fpestrconsts.rscontentloccode +msgid "Content location code" +msgstr "" + +#: fpestrconsts.rscontentlocname +msgid "Content location name" +msgstr "" + +#: fpestrconsts.rscontrast +msgid "Contrast" +msgstr "" + +#: fpestrconsts.rscopyright +msgid "Copyright" +msgstr "" + +#: fpestrconsts.rscustomrendered +msgid "Custom rendered" +msgstr "" + +#: fpestrconsts.rscustomrenderedlkup +msgid "0:Normal,1:Custom" +msgstr "" + +#: fpestrconsts.rsdatecreated +msgid "Date created" +msgstr "" + +#: fpestrconsts.rsdatetime +msgid "Date/time" +msgstr "" + +#: fpestrconsts.rsdatetimedigitized +msgid "Date/time digitized" +msgstr "" + +#: fpestrconsts.rsdatetimeoriginal +msgid "Date/time original" +msgstr "" + +#: fpestrconsts.rsdevicesettingdescription +msgid "Device setting description" +msgstr "" + +#: fpestrconsts.rsdigitalzoom +msgid "Digital zoom" +msgstr "" + +#: fpestrconsts.rsdigitalzoomratio +msgid "Digital zoom ratio" +msgstr "" + +#: fpestrconsts.rsdigitizedate +msgid "Digital creation date" +msgstr "" + +#: fpestrconsts.rsdigitizetime +msgid "Digital creation time" +msgstr "" + +#: fpestrconsts.rsdocumentname +msgid "Document name" +msgstr "" + +#: fpestrconsts.rseconomynormalfine +msgctxt "fpestrconsts.rseconomynormalfine" +msgid "0:Economy,1:Normal,2:Fine" +msgstr "" + +#: fpestrconsts.rseconomynormalfine1 +msgctxt "fpestrconsts.rseconomynormalfine1" +msgid "1:Economy,2:Normal,3:Fine" +msgstr "" + +#: fpestrconsts.rseditorialupdate +msgid "Editorial update" +msgstr "" + +#: fpestrconsts.rseditstatus +msgid "Edit status" +msgstr "" + +#: fpestrconsts.rsexifimageheight +msgid "EXIF image height" +msgstr "" + +#: fpestrconsts.rsexifimagewidth +msgid "EXIF image width" +msgstr "" + +#: fpestrconsts.rsexifoffset +msgid "EXIF offset" +msgstr "" + +#: fpestrconsts.rsexifversion +msgid "EXIF version" +msgstr "" + +#: fpestrconsts.rsexpiredate +msgid "Expiration date" +msgstr "" + +#: fpestrconsts.rsexpiretime +msgid "Expiration time" +msgstr "" + +#: fpestrconsts.rsexposurebiasvalue +msgid "Exposure bias value" +msgstr "" + +#: fpestrconsts.rsexposureindex +msgid "Exposure index" +msgstr "" + +#: fpestrconsts.rsexposuremode +msgid "Exposure mode" +msgstr "" + +#: fpestrconsts.rsexposuremodelkup +msgid "0:Auto,1:Manual,2:Auto bracket" +msgstr "" + +#: fpestrconsts.rsexposureprogram +msgid "Exposure program" +msgstr "" + +#: fpestrconsts.rsexposureprogramlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsexposuretime +msgid "Exposure time" +msgstr "" + +#: fpestrconsts.rsextensiblemetadataplatform +msgid "Extensible metadata platform" +msgstr "" + +#: fpestrconsts.rsfilenotfounderror +msgid "File \"%s\" not found." +msgstr "" + +#: fpestrconsts.rsfilesource +msgid "File source" +msgstr "" + +#: fpestrconsts.rsfilesourcelkup +msgid "0:Unknown,1:Film scanner,2:Reflection print scanner,3:Digital camera" +msgstr "" + +#: fpestrconsts.rsfillorder +msgid "Fill order" +msgstr "" + +#: fpestrconsts.rsfillorderlkup +msgid "1:Normal,2:Reversed" +msgstr "" + +#: fpestrconsts.rsfixtureid +msgid "Fixture ID" +msgstr "" + +#: fpestrconsts.rsflash +msgid "Flash" +msgstr "" + +#: fpestrconsts.rsflashenergy +msgid "Flash energy" +msgstr "" + +#: fpestrconsts.rsflashlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsflashpixversion +msgid "FlashPix version" +msgstr "" + +#: fpestrconsts.rsfnumber +msgid "F number" +msgstr "" + +#: fpestrconsts.rsfocallength +msgid "Focal length" +msgstr "" + +#: fpestrconsts.rsfocallengthin35mm +msgid "Focal length in 35 mm film" +msgstr "" + +#: fpestrconsts.rsfocalplaneresunit +msgid "Focal plane resolution unit" +msgstr "" + +#: fpestrconsts.rsfocalplaneresunitlkup +msgid "1:None,2:inches,3:cm,4:mm,5:um" +msgstr "" + +#: fpestrconsts.rsfocalplanexres +msgid "Focal plane x resolution" +msgstr "" + +#: fpestrconsts.rsfocalplaneyres +msgid "Focal plane y resolution" +msgstr "" + +#: fpestrconsts.rsfujiadvancedfilterlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsfujiautobracketinglkup +msgid "0:Off,1:On,2:No flash & flash" +msgstr "" + +#: fpestrconsts.rsfujiblurwarninglkup +msgid "0:None,1:Blur Warning" +msgstr "" + +#: fpestrconsts.rsfujicolormodelkup +msgid "0:Standard,16:Chrome,48:B & W" +msgstr "" + +#: fpestrconsts.rsfujicontrastlkup +msgid "0:Normal,128:Medium High,256:High,384:Medium Low,512:Low,32768:Film Simulation" +msgstr "" + +#: fpestrconsts.rsfujicontrastlkup1 +msgid "0:Normal,256:High,768:Low" +msgstr "" + +#: fpestrconsts.rsfujidynamicrangelkup +msgid "1:Standard,3:Wide" +msgstr "" + +#: fpestrconsts.rsfujiexposurewarninglkup +msgid "0:Good,1:Bad exposure" +msgstr "" + +#: fpestrconsts.rsfujiexrmodelkup +msgid "128:HR (High Resolution),512:SN (Signal to Noise priority),768:DR (Dynamic Range priority)" +msgstr "" + +#: fpestrconsts.rsfujiflashmodelkup +msgid "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)" +msgstr "" + +#: fpestrconsts.rsfujifocuswarninglkup +msgid "0:Good,1:Out of focus" +msgstr "" + +#: fpestrconsts.rsfujihighisonoisereductionlkup +msgid "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)" +msgstr "" + +#: fpestrconsts.rsfujinoisereductionlkup +msgid "64:Low,128:Normal,256:n/a" +msgstr "" + +#: fpestrconsts.rsfujipanoramadirlkup +msgid "1:Right,2:Up,3:Left,4:Down" +msgstr "" + +#: fpestrconsts.rsfujipicturemodelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsfujisaturationlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsfujiscenerecognlkup +msgid "0:Unrecognized,256:Portrait Image,512:Landscape Image,768:Night Scene,1024:Macro" +msgstr "" + +#: fpestrconsts.rsfujishadowhighlightlkup +msgid "-64:+4 (hardest),-48:+3 (very hard),-32:+2 (hard),-16:+1 (medium hard)" +msgstr "" + +#: fpestrconsts.rsfujisharpnesslkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsfujishuttertypelkup +msgid "0:Mechanical,1:Electronic" +msgstr "" + +#: fpestrconsts.rsfujiwhiteballkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsgaincontrol +msgid "Gain control" +msgstr "" + +#: fpestrconsts.rsgaincontrollkup +msgid "0:None,1:Low gain up,2:High gain up,3:Low gain down,4:High gain down" +msgstr "" + +#: fpestrconsts.rsgamma +msgid "Gamma" +msgstr "" + +#: fpestrconsts.rsgpsaltitude +msgid "GPS altitude" +msgstr "" + +#: fpestrconsts.rsgpsaltituderef +msgid "GPS altitude reference" +msgstr "" + +#: fpestrconsts.rsgpsaltitudereflkup +msgid "0: Above sea level,1:Below sea level" +msgstr "" + +#: fpestrconsts.rsgpsareainformation +msgid "Area information" +msgstr "" + +#: fpestrconsts.rsgpsdatedifferential +msgid "GPS date differential" +msgstr "" + +#: fpestrconsts.rsgpsdatedifferentiallkup +msgid "0:No correction,1:Differential corrected" +msgstr "" + +#: fpestrconsts.rsgpsdatestamp +msgid "GPS date stamp" +msgstr "" + +#: fpestrconsts.rsgpsdestbearing +msgid "GPS destination bearing" +msgstr "" + +#: fpestrconsts.rsgpsdestbearingref +msgid "GPS destination bearing reference" +msgstr "" + +#: fpestrconsts.rsgpsdestdistance +msgid "GPS destination distance" +msgstr "" + +#: fpestrconsts.rsgpsdestdistanceref +msgid "GPS destination distance reference" +msgstr "" + +#: fpestrconsts.rsgpsdestlatitude +msgid "GPS destination latitude" +msgstr "" + +#: fpestrconsts.rsgpsdestlatituderef +msgid "GPS destination latitude reference" +msgstr "" + +#: fpestrconsts.rsgpsdestlongitude +msgid "GPS destination longitude" +msgstr "" + +#: fpestrconsts.rsgpsdestlongituderef +msgid "GPS destination longitude reference" +msgstr "" + +#: fpestrconsts.rsgpsdistancereflkup +msgid "K:Kilometers,M:Miles,N:Nautical miles" +msgstr "" + +#: fpestrconsts.rsgpsdop +msgid "GPS DOP" +msgstr "" + +#: fpestrconsts.rsgpshpositioningerror +msgid "GPS H positioning error" +msgstr "" + +#: fpestrconsts.rsgpsimagedirection +msgid "GPS image direction" +msgstr "" + +#: fpestrconsts.rsgpsimagedirectionref +msgid "GPS image direction reference" +msgstr "" + +#: fpestrconsts.rsgpsinfo +msgid "GPS info" +msgstr "" + +#: fpestrconsts.rsgpslatitude +msgid "GPS latitude" +msgstr "" + +#: fpestrconsts.rsgpslatituderef +msgid "GPS latitude reference" +msgstr "" + +#: fpestrconsts.rsgpslatitudereflkup +msgid "N:North,S:South" +msgstr "" + +#: fpestrconsts.rsgpslongitude +msgid "GPS longitude" +msgstr "" + +#: fpestrconsts.rsgpslongituderef +msgid "GPS longitude reference" +msgstr "" + +#: fpestrconsts.rsgpslongitudereflkup +msgid "E:East,W:West" +msgstr "" + +#: fpestrconsts.rsgpsmapdatum +msgid "GPS map datum" +msgstr "" + +#: fpestrconsts.rsgpsmeasuremode +msgid "GPS measurement mode" +msgstr "" + +#: fpestrconsts.rsgpsmeasuremodelkup +msgid "2:2-Dimensional Measurement,3:3-Dimensional Measurement" +msgstr "" + +#: fpestrconsts.rsgpsprocessingmode +msgid "GPS processing mode" +msgstr "" + +#: fpestrconsts.rsgpssatellites +msgid "GPS satellites" +msgstr "" + +#: fpestrconsts.rsgpsspeed +msgid "GPS speed" +msgstr "" + +#: fpestrconsts.rsgpsspeedref +msgid "GPS speed reference" +msgstr "" + +#: fpestrconsts.rsgpsspeedreflkup +msgid "K:km/h,M:mph,N:knots" +msgstr "" + +#: fpestrconsts.rsgpsstatus +msgid "GPS status" +msgstr "" + +#: fpestrconsts.rsgpstimestamp +msgid "GPS time stamp" +msgstr "" + +#: fpestrconsts.rsgpstrack +msgid "GPS track" +msgstr "" + +#: fpestrconsts.rsgpstrackref +msgid "GPS track reference" +msgstr "" + +#: fpestrconsts.rsgpstrackreflkup +msgid "M:Magnetic north,T:True north" +msgstr "" + +#: fpestrconsts.rsgpsversionid +msgid "GPS version ID" +msgstr "" + +#: fpestrconsts.rshalftonehints +msgid "Half-tone hints" +msgstr "" + +#: fpestrconsts.rshostcomputer +msgid "Host computer" +msgstr "" + +#: fpestrconsts.rshumidity +msgid "Humidity" +msgstr "" + +#: fpestrconsts.rsimagedatafilenotexisting +msgid "File \"%s\" providing the image data does not exist." +msgstr "" + +#: fpestrconsts.rsimagedatafilenotspecified +msgid "The metadata structure is not linked to an image. Specify the name of the file providing the image data." +msgstr "" + +#: fpestrconsts.rsimagedescr +msgid "Image description" +msgstr "" + +#: fpestrconsts.rsimageformatnotsupported +msgid "Image format not supported." +msgstr "" + +#: fpestrconsts.rsimageheight +msgid "Image height" +msgstr "" + +#: fpestrconsts.rsimagehistory +msgid "Image history" +msgstr "" + +#: fpestrconsts.rsimagenumber +msgid "Image number" +msgstr "" + +#: fpestrconsts.rsimageresourcenametoolong +msgid "Image resource name \"%s\" too long." +msgstr "" + +#: fpestrconsts.rsimageuniqueid +msgid "Unique image ID" +msgstr "" + +#: fpestrconsts.rsimagewidth +msgid "Image width" +msgstr "" + +#: fpestrconsts.rsimgcaption +msgid "Image caption" +msgstr "" + +#: fpestrconsts.rsimgcaptionwriter +msgid "Image caption writer" +msgstr "" + +#: fpestrconsts.rsimgcredit +msgid "Image credit" +msgstr "" + +#: fpestrconsts.rsimgheadline +msgid "Image headline" +msgstr "" + +#: fpestrconsts.rsimgtype +msgid "Image type" +msgstr "" + +#: fpestrconsts.rsincompletejpegsegmentheader +msgid "Defective JPEG structure: Incomplete segment header" +msgstr "" + +#: fpestrconsts.rsincorrectfilestructure +msgid "Incorrect file structure" +msgstr "" + +#: fpestrconsts.rsincorrecttagtype +msgid "Incorrect tag type %d: Index=%d, TagID=$%.04x, File:\"%s\"" +msgstr "" + +#: fpestrconsts.rsinkset +msgid "Ink set" +msgstr "" + +#: fpestrconsts.rsinksetlkup +msgid "1:CMYK,2:Not CMYK" +msgstr "" + +#: fpestrconsts.rsinteropindex +msgid "Interoperabiliy index" +msgstr "" + +#: fpestrconsts.rsinteropoffset +msgid "Interoperability offset" +msgstr "" + +#: fpestrconsts.rsinteropversion +msgid "Interoperability version" +msgstr "" + +#: fpestrconsts.rsiptcdataexpected +msgid "IPTC data expected, but not found." +msgstr "" + +#: fpestrconsts.rsiptcextendeddatasizenotsupported +msgid "Data size %d not supported for an IPTC extended dataset." +msgstr "" + +#: fpestrconsts.rsiptcnaa +msgid "IPTC/NAA" +msgstr "" + +#: fpestrconsts.rsiptcorientationlkup +msgid "P:Portrait,L:Landscape,S:Square" +msgstr "" + +#: fpestrconsts.rsiso +msgid "ISO" +msgstr "" + +#: fpestrconsts.rsisospeed +msgid "ISO speed" +msgstr "" + +#: fpestrconsts.rsisospeedlatitudeyyy +msgid "ISO latitude yyy" +msgstr "" + +#: fpestrconsts.rsisospeedlatitudezzz +msgid "ISO speed latitude zzz" +msgstr "" + +#: fpestrconsts.rsjpegcompresseddatawriting +msgid "Writing error of compressed data." +msgstr "" + +#: fpestrconsts.rsjpegreadwriteerrorinsegment +msgid "Read/write error in segment $FF%.2x" +msgstr "" + +#: fpestrconsts.rsjpegsegmentmarkerexpected +msgid "Defective JPEG structure: Segment marker ($FF) expected." +msgstr "" + +#: fpestrconsts.rskeywords +msgid "Keywords" +msgstr "" + +#: fpestrconsts.rslangid +msgid "Language ID" +msgstr "" + +#: fpestrconsts.rslensinfo +msgid "Lens info" +msgstr "" + +#: fpestrconsts.rslensmake +msgid "Lens make" +msgstr "" + +#: fpestrconsts.rslensmodel +msgid "Lens model" +msgstr "" + +#: fpestrconsts.rslensserialnumber +msgid "Lens serial number" +msgstr "" + +#: fpestrconsts.rslightsource +msgid "Light source" +msgstr "" + +#: fpestrconsts.rslightsourcelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rslocationcode +msgid "Country/primary location code" +msgstr "" + +#: fpestrconsts.rslocationname +msgid "Country/primary location name" +msgstr "" + +#: fpestrconsts.rslownormalhigh +msgid "0:Low,1:Normal,2:High" +msgstr "" + +#: fpestrconsts.rsmacro +msgid "Macro" +msgstr "" + +#: fpestrconsts.rsmake +msgid "Make" +msgstr "" + +#: fpestrconsts.rsmakernote +msgid "Maker note" +msgstr "" + +#: fpestrconsts.rsmaxaperturevalue +msgid "Max aperture value" +msgstr "" + +#: fpestrconsts.rsmaxsamplevalue +msgid "Max sample value" +msgstr "" + +#: fpestrconsts.rsmeteringmode +msgid "Metering mode" +msgstr "" + +#: fpestrconsts.rsmeteringmodelkup +msgid "0:Unknown,1:Average,2:Center-weighted average,3:Spot,4:Multi-spot,5:Multi-segment,6:Partial,255:Other" +msgstr "" + +#: fpestrconsts.rsminoltabracketsteplkup +msgid "0:1/3 EV,1:2/3 EV,2:1 EV" +msgstr "" + +#: fpestrconsts.rsminoltacolormodelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsminoltacolorprofilelkup +msgid "0:Not embedded,1:Embedded" +msgstr "" + +#: fpestrconsts.rsminoltadataimprintlkup +msgid "0;None,1:YYYY/MM/DD,2:MM/DD/HH:MM,3:Text,4:Text + ID#" +msgstr "" + +#: fpestrconsts.rsminoltadecpositionlkup +msgid "0:Exposure,1:Contrast,2:Saturation,3:Filter" +msgstr "" + +#: fpestrconsts.rsminoltadigitalzoomlkup +msgid "0:Off,1:Electronic magnification,2:2x" +msgstr "" + +#: fpestrconsts.rsminoltadrivemodelkup +msgid "0:Single,1:Continuous,2:Self-timer,4:Bracketing,5:Interval,6:UHS continuous,7:HS continuous" +msgstr "" + +#: fpestrconsts.rsminoltaexposuremodelkup +msgid "0:Program,1:Aperture priority,2:Shutter priority,3:Manual" +msgstr "" + +#: fpestrconsts.rsminoltaflashmeteringlkup +msgid "0:ADI (Advanced Distance Integration),1:Pre-flash TTL,2:Manual flash control" +msgstr "" + +#: fpestrconsts.rsminoltaflashmodelkup +msgid "0:Fill flash,1:Red-eye reduction,2:Rear flash sync,3:Wireless,4:Off?" +msgstr "" + +#: fpestrconsts.rsminoltafocusarealkup +msgid "0:Wide Focus (normal),1:Spot Focus" +msgstr "" + +#: fpestrconsts.rsminoltafocusmodelkup +msgid "0:AF,1:MF" +msgstr "" + +#: fpestrconsts.rsminoltafoldernamelkup +msgid "0:Standard Form,1:Data Form" +msgstr "" + +#: fpestrconsts.rsminoltaimagesizelkup +msgid "1:1600x1200,2:1280x960,3:640x480,5:2560x1920,6:2272x1704,7:2048x1536" +msgstr "" + +#: fpestrconsts.rsminoltaimagesizelkup1 +msgid "0:Full,1:1600x1200,2:1280x960,3:640x480,6:2080x1560,7:2560x1920,8;3264x2176" +msgstr "" + +#: fpestrconsts.rsminoltaimagestablkup +msgid "1:Off,5:On" +msgstr "" + +#: fpestrconsts.rsminoltainternalflashlkup +msgid "0:No,1:Fired" +msgstr "" + +#: fpestrconsts.rsminoltaintervalmodelkup +msgid "0:Still image,1:Time-lapse movie" +msgstr "" + +#: fpestrconsts.rsminoltaisosettinglkup +msgid "0:100,1:200,2:400,3:800,4:Auto,5:64" +msgstr "" + +#: fpestrconsts.rsminoltameteringmodelkup +msgid "0:Multi-segment,1:Center-weighted average,2:Spot" +msgstr "" + +#: fpestrconsts.rsminoltamodelidlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsminoltaqualitylkup +msgid "0:Raw,1:Super Fine,2:Fine,3:Standard,4:Economy,5:Extra fine" +msgstr "" + +#: fpestrconsts.rsminoltascenemodelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsminoltasharpnesslkup +msgid "0:Hard,1:Normal,2:Soft" +msgstr "" + +#: fpestrconsts.rsminoltasubjectprogramlkup +msgid "0:None,1:Portrait,2:Text,3:Night portrait,4:Sunset,5:Sports action" +msgstr "" + +#: fpestrconsts.rsminoltateleconverterlkup +msgid "$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" +msgstr "" + +#: fpestrconsts.rsminoltawhitebalancelkup +msgid "$00:Auto,$01:Color Temperature/Color Filter,$10:Daylight,$20:Cloudy,$30:Shade,$40:Tungsten,$50:Flash,$60:Fluorescent,$70:Custom" +msgstr "" + +#: fpestrconsts.rsminoltawidefocuszonelkup +msgid "0:No zone,1:Center zone (horizontal orientation),2:Center zone (vertical orientation),3:Left zone,4:Right zone" +msgstr "" + +#: fpestrconsts.rsminoltazonematchinglkup +msgid "0:ISO Setting Used,1:High Key,2:Low Key" +msgstr "" + +#: fpestrconsts.rsminsamplevalue +msgid "Min sample value" +msgstr "" + +#: fpestrconsts.rsmodel +msgid "Model" +msgstr "" + +#: fpestrconsts.rsmorethumbnailtagsthanexpected +msgid "More thumbnail tags than expected." +msgstr "" + +#: fpestrconsts.rsnikoncolormodelkup +msgid "1:Color,2:Monochrome" +msgstr "" + +#: fpestrconsts.rsnikonconverterlkup +msgid "0:Not used,1:Used" +msgstr "" + +#: fpestrconsts.rsnikonimgadjlkup +msgid "0:Normal,1:Bright+,2:Bright-,3:Contrast+,4:Contrast-" +msgstr "" + +#: fpestrconsts.rsnikonisolkup +msgid "0:ISO80,2:ISO160,4:ISO320,5:ISO100" +msgstr "" + +#: fpestrconsts.rsnikonqualitylkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsnikonwhitebalancelkup +msgid "0:Auto,1:Preset,2:Daylight,3:Incandescense,4:Fluorescence,5:Cloudy,6:SpeedLight" +msgstr "" + +#: fpestrconsts.rsnormallowhigh +msgctxt "fpestrconsts.rsnormallowhigh" +msgid "0:Normal,1:Low,2:High" +msgstr "" + +#: fpestrconsts.rsnormalsofthard +msgctxt "fpestrconsts.rsnormalsofthard" +msgid "0:Normal,1:Soft,2:Hard" +msgstr "" + +#: fpestrconsts.rsnovalidiptcfile +msgid "No valid IPTC file" +msgstr "" + +#: fpestrconsts.rsnovalidiptcsignature +msgid "No valid IPTC signature" +msgstr "" + +#: fpestrconsts.rsnoyes +msgctxt "fpestrconsts.rsnoyes" +msgid "0:No,1:Yes" +msgstr "" + +#: fpestrconsts.rsobjectattr +msgid "Object attribute reference" +msgstr "" + +#: fpestrconsts.rsobjectcycle +msgid "Object cycle" +msgstr "" + +#: fpestrconsts.rsobjectcyclelkup +msgid "a:morning,p:evening,b:both" +msgstr "" + +#: fpestrconsts.rsobjectname +msgid "Object name" +msgstr "" + +#: fpestrconsts.rsobjecttype +msgid "Object type reference" +msgstr "" + +#: fpestrconsts.rsoffon +msgctxt "fpestrconsts.rsoffon" +msgid "0:Off,1:On" +msgstr "" + +#: fpestrconsts.rsoffsettime +msgid "Time zone for date/time" +msgstr "" + +#: fpestrconsts.rsoffsettimedigitized +msgid "Time zone for date/time digitized" +msgstr "" + +#: fpestrconsts.rsoffsettimeoriginal +msgid "Time zone for date/time original" +msgstr "" + +#: fpestrconsts.rsolympusccdscanmodelkup +msgid "0:Interlaced,1:Progressive" +msgstr "" + +#: fpestrconsts.rsolympuscontrastlkup +msgid "0:High,1:Normal,2:Low" +msgstr "" + +#: fpestrconsts.rsolympusflashdevlkup +msgid "0:None,1:Internal,4:External,5:Internal + External" +msgstr "" + +#: fpestrconsts.rsolympusflashmodelkup +msgid "2:On,3;Off" +msgstr "" + +#: fpestrconsts.rsolympusflashmodellkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsolympusflashtypelkup +msgid "0:None,2:Simple E-System,3:E-System" +msgstr "" + +#: fpestrconsts.rsolympusjpegquallkup +msgid "1:SQ,2:HQ,3:SHQ,4:Raw" +msgstr "" + +#: fpestrconsts.rsolympusmacrolkup +msgid "0:Off,1:On,2:Super Macro" +msgstr "" + +#: fpestrconsts.rsolympuspreviewimglength +msgid "Preview image length" +msgstr "" + +#: fpestrconsts.rsolympuspreviewimgstart +msgid "Preview image start" +msgstr "" + +#: fpestrconsts.rsolympuspreviewimgvalid +msgid "Preview image valid" +msgstr "" + +#: fpestrconsts.rsolympusscenemodelkup +msgid "0:Normal,1:Standard,2:Auto,3:Intelligent Auto,4:Portrait,5:Landscape+Portrait,6:Landscape,7:Night Scene,8:Night+Portrait9: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" +msgstr "" + +#: fpestrconsts.rsolympussharpnesslkup +msgid "0:Normal,1:Hard,2:Soft" +msgstr "" + +#: fpestrconsts.rsorientation +msgid "Orientation" +msgstr "" + +#: fpestrconsts.rsorientationlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsoriginatingprog +msgid "Originating program" +msgstr "" + +#: fpestrconsts.rsownername +msgid "Owner name" +msgstr "" + +#: fpestrconsts.rspagename +msgid "Page name" +msgstr "" + +#: fpestrconsts.rspagenumber +msgid "Page number" +msgstr "" + +#: fpestrconsts.rsphotometricint +msgid "Photometric interpretation" +msgstr "" + +#: fpestrconsts.rsphotometricintlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rsplanarconfiguration +msgid "Planar configuration" +msgstr "" + +#: fpestrconsts.rsplanarconfigurationlkup +msgid "1:Chunky,2:Planar" +msgstr "" + +#: fpestrconsts.rspredictor +msgid "Predictor" +msgstr "" + +#: fpestrconsts.rspredictorlkup +msgid "1:None,2:Horizontal differencing" +msgstr "" + +#: fpestrconsts.rspressure +msgid "Pressure" +msgstr "" + +#: fpestrconsts.rsprimarychromaticities +msgid "Primary chromaticities" +msgstr "" + +#: fpestrconsts.rsprogversion +msgid "Program version" +msgstr "" + +#: fpestrconsts.rsquality +msgid "Quality" +msgstr "" + +#: fpestrconsts.rsrangecheckerror +msgid "Range check error." +msgstr "" + +#: fpestrconsts.rsreadincompleteifdrecord +msgid "Read incomplete IFD record at stream position %d." +msgstr "" + +#: fpestrconsts.rsrecexpindex +msgid "Recommended exposure index" +msgstr "" + +#: fpestrconsts.rsrecordversion +msgid "Record version" +msgstr "" + +#: fpestrconsts.rsrefblackwhite +msgid "Reference black & white" +msgstr "" + +#: fpestrconsts.rsrefdate +msgid "Reference date" +msgstr "" + +#: fpestrconsts.rsrefnumber +msgid "Reference number" +msgstr "" + +#: fpestrconsts.rsrefservice +msgid "Reference service" +msgstr "" + +#: fpestrconsts.rsrelatedimagefileformat +msgid "Related image file format" +msgstr "" + +#: fpestrconsts.rsrelatedimageheight +msgid "Related image height" +msgstr "" + +#: fpestrconsts.rsrelatedimagewidth +msgid "Related image width" +msgstr "" + +#: fpestrconsts.rsrelatedsoundfile +msgid "Related sound file" +msgstr "" + +#: fpestrconsts.rsreleasedate +msgid "Release date" +msgstr "" + +#: fpestrconsts.rsreleasetime +msgid "Release time" +msgstr "" + +#: fpestrconsts.rsresolutionunit +msgid "Resolution unit" +msgstr "" + +#: fpestrconsts.rsresolutionunitlkup +msgid "1:None,2:inches,3:cm" +msgstr "" + +#: fpestrconsts.rsrowsperstrip +msgid "Rows per strip" +msgstr "" + +#: fpestrconsts.rssamplesperpixel +msgid "Samples per pixel" +msgstr "" + +#: fpestrconsts.rssanyomacrolkup +msgid "0:Normal,1:Macro,2:View,3:Manual" +msgstr "" + +#: fpestrconsts.rssanyoqualitylkup +msgid "0:Normal/Very Low,1:Normal/Low,2:Normal/Medium Low,3:Normal/Medium,4:Normal/Medium High,5:Normal/High,6:Normal/Very High7:Normal/Super High,256:Fine/Very Low,257:Fine/Low,258:Fine/Medium Low259:Fine/Medium,260:Fine/Medium High,261:Fine/High,262:Fine/Very High263: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" +msgstr "" + +#: fpestrconsts.rssanyospecialmode +msgid "Special mode" +msgstr "" + +#: fpestrconsts.rssaturation +msgid "Saturation" +msgstr "" + +#: fpestrconsts.rsscenecapturetype +msgid "Scene capture type" +msgstr "" + +#: fpestrconsts.rsscenecapturetypelkup +msgid "0:Standard,1:Landscape,2:Portrait,3:Night" +msgstr "" + +#: fpestrconsts.rsscenetype +msgid "Scene type" +msgstr "" + +#: fpestrconsts.rsscenetypelkup +msgid "0:Unknown,1:Directly photographed" +msgstr "" + +#: fpestrconsts.rssecurityclassification +msgid "Security classification" +msgstr "" + +#: fpestrconsts.rsselftimermode +msgid "Self-timer mode" +msgstr "" + +#: fpestrconsts.rsseminfo +msgid "SEM info" +msgstr "" + +#: fpestrconsts.rssensingmethod +msgid "Sensing method" +msgstr "" + +#: fpestrconsts.rssensingmethodlkup +msgid "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" +msgstr "" + +#: fpestrconsts.rssensitivitytype +msgid "Sensitivity type" +msgstr "" + +#: fpestrconsts.rssensitivitytypelkup +msgid "0:Unknown,1:Standard Output Sensitivity2: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" +msgstr "" + +#: fpestrconsts.rsserialnumber +msgid "Serial number" +msgstr "" + +#: fpestrconsts.rssharpness +msgid "Sharpness" +msgstr "" + +#: fpestrconsts.rsshutterspeedvalue +msgid "Shutter speed value" +msgstr "" + +#: fpestrconsts.rssinglecontinuous +msgctxt "fpestrconsts.rssinglecontinuous" +msgid "0:Single,1:Continuous" +msgstr "" + +#: fpestrconsts.rssoftware +msgid "Software" +msgstr "" + +#: fpestrconsts.rssource +msgid "Source" +msgstr "" + +#: fpestrconsts.rsspatialfrequresponse +msgid "Spatial frequency response" +msgstr "" + +#: fpestrconsts.rsspecialinstruct +msgid "Special instructions" +msgstr "" + +#: fpestrconsts.rsspectralsensitivity +msgid "Spectral sensitivity" +msgstr "" + +#: fpestrconsts.rsstate +msgid "Province/State" +msgstr "" + +#: fpestrconsts.rsstdoutputsens +msgid "Standard output sensitivity" +msgstr "" + +#: fpestrconsts.rsstripbytecounts +msgid "Strip byte counts" +msgstr "" + +#: fpestrconsts.rsstripoffsets +msgid "Strip offsets" +msgstr "" + +#: fpestrconsts.rssubfile +msgid "Subfile" +msgstr "" + +#: fpestrconsts.rssubfiletypelkup +msgid "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" +msgstr "" + +#: fpestrconsts.rssubjectarea +msgid "Subject area" +msgstr "" + +#: fpestrconsts.rssubjectdistance +msgid "Subject distance" +msgstr "" + +#: fpestrconsts.rssubjectdistancerange +msgid "Subject distance range" +msgstr "" + +#: fpestrconsts.rssubjectdistancerangelkup +msgid "0:Unknown,1:Macro,2:Close,3:Distant" +msgstr "" + +#: fpestrconsts.rssubjectlocation +msgid "Subject location" +msgstr "" + +#: fpestrconsts.rssubjectref +msgid "Subject reference" +msgstr "" + +#: fpestrconsts.rssublocation +msgid "Sublocation" +msgstr "" + +#: fpestrconsts.rssubsectime +msgid "Fractional seconds of date/time" +msgstr "" + +#: fpestrconsts.rssubsectimedigitized +msgid "Fractional seconds of date/time digitized" +msgstr "" + +#: fpestrconsts.rssubsectimeoriginal +msgid "Fractional seconds of date/time original" +msgstr "" + +#: fpestrconsts.rssuppcategory +msgid "Supplemental category" +msgstr "" + +#: fpestrconsts.rstagtypenotsupported +msgid "Tag \"%s\" has an unsupported type." +msgstr "" + +#: fpestrconsts.rstargetprinter +msgid "Target printer" +msgstr "" + +#: fpestrconsts.rstemperature +msgid "Temperature" +msgstr "" + +#: fpestrconsts.rsthresholding +msgid "Thresholding" +msgstr "" + +#: fpestrconsts.rsthresholdinglkup +msgid "1:No dithering or halftoning,2:Ordered dither or halftone,3:Randomized dither" +msgstr "" + +#: fpestrconsts.rsthumbnailheight +msgid "Thumbnail height" +msgstr "" + +#: fpestrconsts.rsthumbnailoffset +msgid "Thumbnail offset" +msgstr "" + +#: fpestrconsts.rsthumbnailsize +msgid "Thumbnail size" +msgstr "" + +#: fpestrconsts.rsthumbnailwidth +msgid "Thumbnail width" +msgstr "" + +#: fpestrconsts.rstilelength +msgid "Tile length" +msgstr "" + +#: fpestrconsts.rstilewidth +msgid "Tile width" +msgstr "" + +#: fpestrconsts.rstimecreated +msgid "Time created" +msgstr "" + +#: fpestrconsts.rstimezoneoffset +msgid "Time zone offset" +msgstr "" + +#: fpestrconsts.rstransferfunction +msgid "Transfer function" +msgstr "" + +#: fpestrconsts.rstransmissionref +msgid "Original transmission reference" +msgstr "" + +#: fpestrconsts.rsunknownimageformat +msgid "Unknown image format." +msgstr "" + +#: fpestrconsts.rsurgency +msgid "Urgency" +msgstr "" + +#: fpestrconsts.rsurgencylkup +msgid "0:reserved,1:most urgent,5:normal,8:least urgent,9:reserved" +msgstr "" + +#: fpestrconsts.rsusercomment +msgid "User comment" +msgstr "" + +#: fpestrconsts.rswaterdepth +msgid "Water depth" +msgstr "" + +#: fpestrconsts.rswhitebalance +msgid "White balance" +msgstr "" + +#: fpestrconsts.rswhitepoint +msgid "White point" +msgstr "" + +#: fpestrconsts.rswritingnotimplemented +msgid "Writing of %s files not yet implemented." +msgstr "" + +#: fpestrconsts.rsxposition +msgid "X position" +msgstr "" + +#: fpestrconsts.rsxresolution +msgid "X resolution" +msgstr "" + +#: fpestrconsts.rsycbcrcoefficients +msgid "YCbCr coefficients" +msgstr "" + +#: fpestrconsts.rsycbcrpositioning +msgid "YCbCr positioning" +msgstr "" + +#: fpestrconsts.rsycbcrposlkup +msgid "1:Centered,2:Co-sited" +msgstr "" + +#: fpestrconsts.rsycbcrsubsampling +msgid "YCbCr subsampling" +msgstr "" + +#: fpestrconsts.rsyposition +msgid "Y position" +msgstr "" + +#: fpestrconsts.rsyresolution +msgid "Y resolution" +msgstr "" + diff --git a/components/fpexif/tests/multiread/MultiRead_D7.cfg b/components/fpexif/tests/multiread/MultiRead_D7.cfg new file mode 100644 index 000000000..db998d59c --- /dev/null +++ b/components/fpexif/tests/multiread/MultiRead_D7.cfg @@ -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 diff --git a/components/fpexif/tests/multiread/MultiRead_D7.dof b/components/fpexif/tests/multiread/MultiRead_D7.dof new file mode 100644 index 000000000..6202c761f --- /dev/null +++ b/components/fpexif/tests/multiread/MultiRead_D7.dof @@ -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 diff --git a/components/fpexif/tests/multiread/MultiRead_D7.dpr b/components/fpexif/tests/multiread/MultiRead_D7.dpr new file mode 100644 index 000000000..5b7e9e57e --- /dev/null +++ b/components/fpexif/tests/multiread/MultiRead_D7.dpr @@ -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. + diff --git a/components/fpexif/tests/multiread/MultiRead_D7.res b/components/fpexif/tests/multiread/MultiRead_D7.res new file mode 100644 index 000000000..196f8148e Binary files /dev/null and b/components/fpexif/tests/multiread/MultiRead_D7.res differ diff --git a/components/fpexif/tests/multiread/MultiRead_Delphi.dpr b/components/fpexif/tests/multiread/MultiRead_Delphi.dpr new file mode 100644 index 000000000..260637ed4 --- /dev/null +++ b/components/fpexif/tests/multiread/MultiRead_Delphi.dpr @@ -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. + diff --git a/components/fpexif/tests/multiread/MultiRead_Delphi.dproj b/components/fpexif/tests/multiread/MultiRead_Delphi.dproj new file mode 100644 index 000000000..6b8955e81 --- /dev/null +++ b/components/fpexif/tests/multiread/MultiRead_Delphi.dproj @@ -0,0 +1,142 @@ + + + {935C648F-D321-4462-B3C2-5CD89F17CD4F} + MultiRead_Delphi.dpr + True + Debug + 1 + Application + VCL + 18.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + false + false + true + false + 42200000 + false + 1 + TeeChart 2014 Components + D:\Prog_Lazarus\wp-laz\fpexif\tests\multiread + D:\Prog_Lazarus\wp-laz\fpexif\tests\multiread\output\dcu\Delphi + Tee97;TeeUI97;TeeDB97;TeePro97;TeeGL97;TeeImage97;TeeLanguage97;TeeWorld97;$(DCC_UsePackage) + MultiRead_Delphi + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) + true + 9 + 11 + 1033 + CompanyName=Steema Software;FileDescription=;FileVersion=9.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=9.0.0.0 + + + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + MultiRead_D7_Icon.ico + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + true + true + + + DEBUG;$(DCC_Define) + false + true + + + true + true + 1 + 0 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + $(BDS)\bin\delphi_PROJECTICON.ico + + + + MainSource + + + + + + + + + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + MultiRead_Delphi.dpr + + + + True + + + 12 + + + + diff --git a/components/fpexif/tests/multiread/MultiRead_Delphi.res b/components/fpexif/tests/multiread/MultiRead_Delphi.res new file mode 100644 index 000000000..f60b4d824 Binary files /dev/null and b/components/fpexif/tests/multiread/MultiRead_Delphi.res differ diff --git a/components/fpexif/tests/multiread/MultiRead_Laz.ico b/components/fpexif/tests/multiread/MultiRead_Laz.ico new file mode 100644 index 000000000..0341321b5 Binary files /dev/null and b/components/fpexif/tests/multiread/MultiRead_Laz.ico differ diff --git a/components/fpexif/tests/multiread/MultiRead_Laz.lpi b/components/fpexif/tests/multiread/MultiRead_Laz.lpi new file mode 100644 index 000000000..7a41a02c1 --- /dev/null +++ b/components/fpexif/tests/multiread/MultiRead_Laz.lpi @@ -0,0 +1,122 @@ + + + + + + + + + + <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> diff --git a/components/fpexif/tests/multiread/MultiRead_Laz.lpr b/components/fpexif/tests/multiread/MultiRead_Laz.lpr new file mode 100644 index 000000000..17863dd7f --- /dev/null +++ b/components/fpexif/tests/multiread/MultiRead_Laz.lpr @@ -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. + diff --git a/components/fpexif/tests/multiread/MultiRead_Laz.res b/components/fpexif/tests/multiread/MultiRead_Laz.res new file mode 100644 index 000000000..f6e849956 Binary files /dev/null and b/components/fpexif/tests/multiread/MultiRead_Laz.res differ diff --git a/components/fpexif/tests/multiread/common/mrtmain.dfm b/components/fpexif/tests/multiread/common/mrtmain.dfm new file mode 100644 index 000000000..636c1e1c1 --- /dev/null +++ b/components/fpexif/tests/multiread/common/mrtmain.dfm @@ -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 diff --git a/components/fpexif/tests/multiread/common/mrtmain.lfm b/components/fpexif/tests/multiread/common/mrtmain.lfm new file mode 100644 index 000000000..cfdbcb7be --- /dev/null +++ b/components/fpexif/tests/multiread/common/mrtmain.lfm @@ -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 diff --git a/components/fpexif/tests/multiread/common/mrtmain.pas b/components/fpexif/tests/multiread/common/mrtmain.pas new file mode 100644 index 000000000..0ce0fbf3b --- /dev/null +++ b/components/fpexif/tests/multiread/common/mrtmain.pas @@ -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. + diff --git a/components/fpexif/tests/pictures/originals/ExThBE_Nokia.jpg b/components/fpexif/tests/pictures/originals/ExThBE_Nokia.jpg new file mode 100644 index 000000000..60dd6af86 Binary files /dev/null and b/components/fpexif/tests/pictures/originals/ExThBE_Nokia.jpg differ diff --git a/components/fpexif/tests/pictures/originals/no_metadata.jpg b/components/fpexif/tests/pictures/originals/no_metadata.jpg new file mode 100644 index 000000000..d1d99296a Binary files /dev/null and b/components/fpexif/tests/pictures/originals/no_metadata.jpg differ diff --git a/components/fpexif/tests/pictures/originals/with_exif.jpg b/components/fpexif/tests/pictures/originals/with_exif.jpg new file mode 100644 index 000000000..3acfde6c2 Binary files /dev/null and b/components/fpexif/tests/pictures/originals/with_exif.jpg differ diff --git a/components/fpexif/tests/pictures/originals/with_exif.tif b/components/fpexif/tests/pictures/originals/with_exif.tif new file mode 100644 index 000000000..82876f43c Binary files /dev/null and b/components/fpexif/tests/pictures/originals/with_exif.tif differ diff --git a/components/fpexif/tests/pictures/originals/with_iptc.jpg b/components/fpexif/tests/pictures/originals/with_iptc.jpg new file mode 100644 index 000000000..d505d4e34 Binary files /dev/null and b/components/fpexif/tests/pictures/originals/with_iptc.jpg differ diff --git a/components/fpexif/tests/pictures/originals/with_iptc.tif b/components/fpexif/tests/pictures/originals/with_iptc.tif new file mode 100644 index 000000000..63e82f57a Binary files /dev/null and b/components/fpexif/tests/pictures/originals/with_iptc.tif differ diff --git a/components/fpexif/tests/readwrite/ReadWriteTest_D7.cfg b/components/fpexif/tests/readwrite/ReadWriteTest_D7.cfg new file mode 100644 index 000000000..139fe116f --- /dev/null +++ b/components/fpexif/tests/readwrite/ReadWriteTest_D7.cfg @@ -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 diff --git a/components/fpexif/tests/readwrite/ReadWriteTest_D7.dof b/components/fpexif/tests/readwrite/ReadWriteTest_D7.dof new file mode 100644 index 000000000..c706fd444 --- /dev/null +++ b/components/fpexif/tests/readwrite/ReadWriteTest_D7.dof @@ -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 diff --git a/components/fpexif/tests/readwrite/ReadWriteTest_D7.dpr b/components/fpexif/tests/readwrite/ReadWriteTest_D7.dpr new file mode 100644 index 000000000..4acf926f6 --- /dev/null +++ b/components/fpexif/tests/readwrite/ReadWriteTest_D7.dpr @@ -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. + diff --git a/components/fpexif/tests/readwrite/ReadWriteTest_D7.res b/components/fpexif/tests/readwrite/ReadWriteTest_D7.res new file mode 100644 index 000000000..85b53583b Binary files /dev/null and b/components/fpexif/tests/readwrite/ReadWriteTest_D7.res differ diff --git a/components/fpexif/tests/readwrite/ReadWriteTest_Delphi.dpr b/components/fpexif/tests/readwrite/ReadWriteTest_Delphi.dpr new file mode 100644 index 000000000..8f5c473ea --- /dev/null +++ b/components/fpexif/tests/readwrite/ReadWriteTest_Delphi.dpr @@ -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. + diff --git a/components/fpexif/tests/readwrite/ReadWriteTest_Delphi.dproj b/components/fpexif/tests/readwrite/ReadWriteTest_Delphi.dproj new file mode 100644 index 000000000..4d94915d5 --- /dev/null +++ b/components/fpexif/tests/readwrite/ReadWriteTest_Delphi.dproj @@ -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> diff --git a/components/fpexif/tests/readwrite/ReadWriteTest_Delphi.res b/components/fpexif/tests/readwrite/ReadWriteTest_Delphi.res new file mode 100644 index 000000000..8ccaa1c05 Binary files /dev/null and b/components/fpexif/tests/readwrite/ReadWriteTest_Delphi.res differ diff --git a/components/fpexif/tests/readwrite/ReadWriteTest_Laz.lpi b/components/fpexif/tests/readwrite/ReadWriteTest_Laz.lpi new file mode 100644 index 000000000..e6454b702 --- /dev/null +++ b/components/fpexif/tests/readwrite/ReadWriteTest_Laz.lpi @@ -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> diff --git a/components/fpexif/tests/readwrite/ReadWriteTest_Laz.lpr b/components/fpexif/tests/readwrite/ReadWriteTest_Laz.lpr new file mode 100644 index 000000000..b93b0c256 --- /dev/null +++ b/components/fpexif/tests/readwrite/ReadWriteTest_Laz.lpr @@ -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. + diff --git a/components/fpexif/tests/readwrite/ReadWriteTest_Laz.res b/components/fpexif/tests/readwrite/ReadWriteTest_Laz.res new file mode 100644 index 000000000..0ad004b9d Binary files /dev/null and b/components/fpexif/tests/readwrite/ReadWriteTest_Laz.res differ diff --git a/components/fpexif/tests/readwrite/common/rwMain.dfm b/components/fpexif/tests/readwrite/common/rwMain.dfm new file mode 100644 index 000000000..fe1f5bf65 --- /dev/null +++ b/components/fpexif/tests/readwrite/common/rwMain.dfm @@ -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 diff --git a/components/fpexif/tests/readwrite/common/rwMain.pas b/components/fpexif/tests/readwrite/common/rwMain.pas new file mode 100644 index 000000000..d0b820250 --- /dev/null +++ b/components/fpexif/tests/readwrite/common/rwMain.pas @@ -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. + diff --git a/components/fpexif/tests/readwrite/common/rwmain.lfm b/components/fpexif/tests/readwrite/common/rwmain.lfm new file mode 100644 index 000000000..2e38c5f34 --- /dev/null +++ b/components/fpexif/tests/readwrite/common/rwmain.lfm @@ -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 diff --git a/components/fpexif/tests/readwrite/common/testcases1.txt b/components/fpexif/tests/readwrite/common/testcases1.txt new file mode 100644 index 000000000..e64846fbd --- /dev/null +++ b/components/fpexif/tests/readwrite/common/testcases1.txt @@ -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 diff --git a/components/fpexif/tests/readwrite/common/testcases2.txt b/components/fpexif/tests/readwrite/common/testcases2.txt new file mode 100644 index 000000000..c176bf2a8 --- /dev/null +++ b/components/fpexif/tests/readwrite/common/testcases2.txt @@ -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 diff --git a/components/fpexif/tests/unittest/common/fetexifbe.pas b/components/fpexif/tests/unittest/common/fetexifbe.pas new file mode 100644 index 000000000..bb1cbc6dc --- /dev/null +++ b/components/fpexif/tests/unittest/common/fetexifbe.pas @@ -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. + diff --git a/components/fpexif/tests/unittest/common/fetexifle.pas b/components/fpexif/tests/unittest/common/fetexifle.pas new file mode 100644 index 000000000..226fbdc61 --- /dev/null +++ b/components/fpexif/tests/unittest/common/fetexifle.pas @@ -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. + diff --git a/components/fpexif/tests/unittest/common/fetiptc.pas b/components/fpexif/tests/unittest/common/fetiptc.pas new file mode 100644 index 000000000..ac620f4b3 --- /dev/null +++ b/components/fpexif/tests/unittest/common/fetiptc.pas @@ -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. + diff --git a/components/fpexif/tests/unittest/common/fettestutils.pas b/components/fpexif/tests/unittest/common/fettestutils.pas new file mode 100644 index 000000000..0cb9f3b62 --- /dev/null +++ b/components/fpexif/tests/unittest/common/fettestutils.pas @@ -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. + diff --git a/components/fpexif/tests/unittest/common/fetutils.pas b/components/fpexif/tests/unittest/common/fetutils.pas new file mode 100644 index 000000000..200944648 --- /dev/null +++ b/components/fpexif/tests/unittest/common/fetutils.pas @@ -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. + diff --git a/components/fpexif/tests/unittest/dunit/readme.txt b/components/fpexif/tests/unittest/dunit/readme.txt new file mode 100644 index 000000000..8ad7f509e --- /dev/null +++ b/components/fpexif/tests/unittest/dunit/readme.txt @@ -0,0 +1,3 @@ +For Delphi 7: +Download dunit from http://dunit.sourceforge.net/ +and copy the files into this folder. \ No newline at end of file diff --git a/components/fpexif/tests/unittest/fpExifTests.ico b/components/fpexif/tests/unittest/fpExifTests.ico new file mode 100644 index 000000000..0341321b5 Binary files /dev/null and b/components/fpexif/tests/unittest/fpExifTests.ico differ diff --git a/components/fpexif/tests/unittest/fpExifTests.lpi b/components/fpexif/tests/unittest/fpExifTests.lpi new file mode 100644 index 000000000..ff606370b --- /dev/null +++ b/components/fpexif/tests/unittest/fpExifTests.lpi @@ -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> diff --git a/components/fpexif/tests/unittest/fpExifTests.lpr b/components/fpexif/tests/unittest/fpExifTests.lpr new file mode 100644 index 000000000..369d8bac0 --- /dev/null +++ b/components/fpexif/tests/unittest/fpExifTests.lpr @@ -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. + diff --git a/components/fpexif/tests/unittest/fpExifTests_Delphi.dpr b/components/fpexif/tests/unittest/fpExifTests_Delphi.dpr new file mode 100644 index 000000000..c1e453964 --- /dev/null +++ b/components/fpexif/tests/unittest/fpExifTests_Delphi.dpr @@ -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. + + diff --git a/components/fpexif/tests/unittest/fpExifTests_Delphi.dproj b/components/fpexif/tests/unittest/fpExifTests_Delphi.dproj new file mode 100644 index 000000000..9285c9e61 --- /dev/null +++ b/components/fpexif/tests/unittest/fpExifTests_Delphi.dproj @@ -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> diff --git a/components/fpexif/tests/unittest/fpExifTests_Delphi.res b/components/fpexif/tests/unittest/fpExifTests_Delphi.res new file mode 100644 index 000000000..60e829e59 Binary files /dev/null and b/components/fpexif/tests/unittest/fpExifTests_Delphi.res differ diff --git a/components/fpexif/tests/unittest/fpExifTests_Delphi7.cfg b/components/fpexif/tests/unittest/fpExifTests_Delphi7.cfg new file mode 100644 index 000000000..542cddcc2 --- /dev/null +++ b/components/fpexif/tests/unittest/fpExifTests_Delphi7.cfg @@ -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 diff --git a/components/fpexif/tests/unittest/fpExifTests_Delphi7.dof b/components/fpexif/tests/unittest/fpExifTests_Delphi7.dof new file mode 100644 index 000000000..8755155a2 --- /dev/null +++ b/components/fpexif/tests/unittest/fpExifTests_Delphi7.dof @@ -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 diff --git a/components/fpexif/tests/unittest/fpExifTests_Delphi7.dpr b/components/fpexif/tests/unittest/fpExifTests_Delphi7.dpr new file mode 100644 index 000000000..77ff2903d --- /dev/null +++ b/components/fpexif/tests/unittest/fpExifTests_Delphi7.dpr @@ -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. + + diff --git a/components/fpexif/tests/unittest/fpExifTests_Delphi7.dproj b/components/fpexif/tests/unittest/fpExifTests_Delphi7.dproj new file mode 100644 index 000000000..4c5147fdc --- /dev/null +++ b/components/fpexif/tests/unittest/fpExifTests_Delphi7.dproj @@ -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> diff --git a/components/fpexif/tests/unittest/fpExifTests_Delphi7.res b/components/fpexif/tests/unittest/fpExifTests_Delphi7.res new file mode 100644 index 000000000..1e4099ba3 Binary files /dev/null and b/components/fpexif/tests/unittest/fpExifTests_Delphi7.res differ diff --git a/components/fpexif/tools/readme.txt b/components/fpexif/tools/readme.txt new file mode 100644 index 000000000..c29dcfdd1 --- /dev/null +++ b/components/fpexif/tools/readme.txt @@ -0,0 +1,2 @@ +Place the program exiftool.exe into this directory, it is needed by the +test program "multiread". \ No newline at end of file