From 3bb2efc1074c1adf8795634705c2f928b66da8ae Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 15 Jan 2018 14:35:01 +0000 Subject: [PATCH] fpexif: Fix thumbnail not being detected in some cases. Remove unit "fpEXIF" (no longer needed). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6137 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpexif/fpEXIF.pas | 3597 ------------------------ components/fpexif/fpeexifreadwrite.pas | 4 +- 2 files changed, 2 insertions(+), 3599 deletions(-) delete mode 100644 components/fpexif/fpEXIF.pas diff --git a/components/fpexif/fpEXIF.pas b/components/fpexif/fpEXIF.pas deleted file mode 100644 index 7b931b3d9..000000000 --- a/components/fpexif/fpEXIF.pas +++ /dev/null @@ -1,3597 +0,0 @@ -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/fpeexifreadwrite.pas b/components/fpexif/fpeexifreadwrite.pas index 64d33bf80..a476fc03a 100644 --- a/components/fpexif/fpeexifreadwrite.pas +++ b/components/fpexif/fpeexifreadwrite.pas @@ -520,8 +520,8 @@ begin // 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 + (FThumbPosition > -1) and (FThumbSize > 0) //and + then //(FThumbPosition < FThumbSize) then begin // Move stream to beginning of thumbnail... AStream.Position := FThumbPosition;