JPEG Picture Properties Read
Test environment Delphi XE
Main function code obtained from other authors
Unit file
Unit utjpeginfo;
Interface uses Windows, Messages, sysutils, variants, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls;
Type Tfrmjpeginfo = Class (Tform) Btnopenjpeg:tbutton;
Mmojpeginfo:tmemo;
Procedure Btnopenjpegclick (Sender:tobject);
Private {private declarations} Fsimage:tfilestream;
I64refpos:int64;
Read JPEG information procedure readjpeginfo (const jpegfilename:string);
Reads the byte value function getbyte:byte;
Read Word value function Getword:word;
Read DWord value function Getdword:dword;
Gets the string function GetString (Intbuffersize:integer) of the specified length: string;
Label name function Gettagname (wrdtag:word): string;
Read the JPEG label information procedure PREADIFD;
Public {public declarations} end;
var frmjpeginfo:tfrmjpeginfo;
Implementation {$R *.DFM} function TfrmJpegInfo.GetByte:byte;
Begin Fsimage.read (result, 1);
End
function TfrmJpegInfo.GetWord:word;
Begin Result: = GetByte or (getbyte SHL 8);End
function TfrmJpegInfo.GetDWord:DWord;
Begin Result: = Getword or (Getword SHL 16);
End
function tfrmjpeginfo.getstring (Intbuffersize:integer): string;
var strresult:string;
I:integer;
Begin Result: = ';
For I: = 1 to intbuffersize does: = result + Chr (getbyte);
End
function Tfrmjpeginfo.gettagname (Wrdtag:word): string;
Begin case Wrdtag of $001:result: = ' interoperabilityindex ';
$002:result: = ' interoperabilityversion ';
$0fe:result: = ' newsubfiletype ';
$0ff:result: = ' subfiletype ';
$100:result: = ' imagewidth ';
$101:result: = ' imagelength ';
$102:result: = ' bitspersample ';
$103:result: = ' Compression ';
$106:result: = ' photometricinterpretation ';
$10a:result: = ' fillorder ';
$10d:result: = ' documentname ';
$10e:result: = ' imagedescription ';
$10f:result: = ' make ';
$110:result: = ' Model ';
$111:result: = ' stripoffsets ';
$112:result: = ' orientation ';
$115:result: = ' samplesperpixel '; $116:result:= ' Rowsperstrip ';
$117:result: = ' stripbytecounts ';
$11a:result: = ' xresolution ';
$11b:result: = ' yresolution ';
$11c:result: = ' planarconfiguration ';
$128:result: = ' resolutionunit ';
$12d:result: = ' transferfunction ';
$131:result: = ' Software ';
$132:result: = ' DateTime ';
$13b:result: = ' Artist ';
$13d:result: = ' predictor ';
$13e:result: = ' whitepoint ';
$13f:result: = ' primarychromaticities ';
$142:result: = ' tilewidth ';
$143:result: = ' tilelength ';
$144:result: = ' tileoffsets ';
$145:result: = ' tilebytecounts ';
$14a:result: = ' Subifds ';
$15b:result: = ' jpegtables ';
$156:result: = ' transferrange ';
$200:result: = ' jpegproc ';
$201:result: = ' Jpeginterchangeformat ';
$202:result: = ' jpeginterchangeformatlength ';
$211:result: = ' ycbcrcoefficients ';
$212:result: = ' ycbcrsubsampling ';
$213:result: = ' ycbcrpositioning ';
$214:result: = ' referenceblackwhite ';
$1001:result: = ' Related Image Width '; $1002:result: = ' Related Image Height ';
$828d:result: = ' Cfarepeatpatterndim ';
$828e:result: = ' cfapattern ';
$828f:result: = ' batterylevel ';
$8298:result: = ' Copyright ';
$829a:result: = ' exposuretime ';
$829d:result: = ' fnumber ';
$83bb:result: = ' Iptc/naa ';
$8769:result: = ' exifoffset ';
$8773:result: = ' intercolorprofile ';
$8822:result: = ' Exposureprogram ';
$8824:result: = ' spectralsensitivity ';
$8825:result: = ' gpsinfo ';
$8827:result: = ' isospeedratings ';
$8828:result: = ' OECF ';
$8829:result: = ' interlace ';
$882a:result: = ' timezoneoffset ';
$882b:result: = ' selftimermode ';
$9000:result: = ' exifversion ';
$9003:result: = ' datetimeoriginal ';
$9004:result: = ' datetimedigitized ';
$9101:result: = ' componentsconfiguration ';
$9102:result: = ' compressedbitsperpixel ';
$9201:result: = ' shutterspeedvalue ';
$9202:result: = ' aperturevalue ';
$9203:result: = ' brightnessvalue ';
$9204:result: = ' exposurebiasvalue '; $9205:result: = ' maxapertureValue ';
$9206:result: = ' subjectdistance ';
$9207:result: = ' meteringmode ';
$9208:result: = ' LightSource ';
$9209:result: = ' Flash ';
$920a:result: = ' focallength ';
$920b:result: = ' flashenergy ';
$920c:result: = ' spatialfrequencyresponse ';
$920d:result: = ' noise ';
$9211:result: = ' imagenumber ';
$9212:result: = ' securityclassification ';
$9213:result: = ' imagehistory ';
$9214:result: = ' subjectlocation ';
$9215:result: = ' exposureindex ';
$9216:result: = ' tiff/epstandardid ';
$927c:result: = ' makernote ';
$9286:result: = ' usercomment ';
$9290:result: = ' subsectime ';
$9291:result: = ' subsectimeoriginal ';
$9292:result: = ' subsectimedigitized ';
$A 000:result: = ' flashpixversion ';
$A 001:result: = ' colorspace ';
$A 002:result: = ' exifimagewidth ';
$A 003:result: = ' exifimagelength ';
$A 005:result: = ' interoperabilityoffset ';
$A 20b:result: = ' flashenergy ';
$A 20c:result: = ' spatialfrequencyresponse '; $A 20e:result: = ' FocalplanexrEsolution ';
$A 20f:result: = ' focalplaneyresolution ';
$A 210:result: = ' focalplaneresolutionunit ';
$A 214:result: = ' subjectlocation ';
$A 215:result: = ' exposureindex ';
$A 217:result: = ' Sensingmethod ';
$A 300:result: = ' filesource ';
$A 301:result: = ' scenetype ';
else Result: = ' Unknown Tag Type ';
End
End
Procedure Tfrmjpeginfo.preadifd; var Wrdnumberofentries:word; Number of directory entries Wrdtag:word; Tag number Wrddatatype:word; Type or kind of data in entry Dwdcomponents:dword; Number of components in entry Dwddata:dword; Data or offset to data wrdnextifd:word; Offset to next IFD Intloop:integer; loop control Intdataloop:integer; loop control Inttotaldatalength:integer; Total length of directory entry value strdata:string; String directory entry Bytdata:byte; Byte directory entry Lngdata:longint Long directory entry I64holdpos:int64;
Hold position within file begin//read number of entries wrdnumberofentries: = Getword;
MMOJPEGINFO.LINES.ADD (' Number of Entries: ' + inttostr (wrdnumberofentries)); Read individual entries for intloop: = 1 to wrdnumberofentries do begin//read tag number and interpret WRD
Tag: = Getword;
Strdata: = ' Tag: ' + gettagname (wrdtag);
Read tag type (kind of data) and interpret wrddatatype: = Getword; Case Wrddatatype of 1:strdata: = strdata + ':(unsigned byte '; 1 byte 2:strdata: = strdata + ':(ASCII strings '; 1 byte 3:strdata: = strdata + ':(unsigned short) '; 2 bytes 4:strdata: = strdata + ':(unsigned long '; 4 bytes 5:strdata: = strdata + ':(unsigned rational '; 8 bytes 6:strdata: = strdata + ':(signed byte '; 1 byte 7:strdata: = strdata + ':(undefined) '; 1 byte 8:strdata: = Strdata + ':(signed short) '; 2 bytes 9:strdata: = strdata + ':(signed long '; 4 bytes 10:strdata: = strdata + ':(signed rational '; 8 bytes 11:strdata: = strdata + ':(single float '; 4 bytes 12:strdata: = strdata + ':(double float ';
8 bytes Else MmoJpegInfo.lines.Add (' Unknown Data Type '); End
{Case Wrddatatype of} mmoJpegInfo.lines.Add (Strdata);
Read number of components dwdcomponents: = Getdword;
LSTINFO.ITEMS.ADD (' Number of components: ' + inttostr (dwdcomponents)); Read data value or offset to data value {I check the total data length (bytes/component * # of Components G Ives the total data length-if > 4 bytes Then dwddata are the offset to the data, if < 4 bytes then dwddata are The value itself} case Wrddatatype of 1:inttotaldatalength: = dwdcomponents; 1 byte 2:inttotaldatalength: = Dwdcomponents; 1 byte 3:inttotaldatalength: = Dwdcomponents * 2; 2 bytes 4:inttotaldataLength: = dwdcomponents * 4; 4 bytes 5:inttotaldatalength: = dwdcomponents * 8; 8 bytes 6:inttotaldatalength: = dwdcomponents; 1 byte 7:inttotaldatalength: = Dwdcomponents; 1 byte 8:inttotaldatalength: = Dwdcomponents * 2; 2 bytes 9:inttotaldatalength: = dwdcomponents * 4; 4 bytes 10:inttotaldatalength: = dwdcomponents * 8; 8 bytes 11:inttotaldatalength: = dwdcomponents * 4; 4 bytes 12:inttotaldatalength: = dwdcomponents * 8;
8 bytes Else Inttotaldatalength: = 0;
End
Read the data value dwddata: = Getdword;
Set the hold position i64holdpos: = fsimage.position; Now set data or read offset if inttotaldatalength > 4 then BEGIN//read offset value//seek to offs
ET value Fsimage.seek (dwddata+i64refpos,sofrombeginning);
Read specific data type (unsigned byte) if Wrddatatype = 1 then//unsigned byte begin Bytdata: = GetByte;
MMOJPEGINFO.LINES.ADD (' value= ' + inttostr (bytdata)); End
{wrddatatype=1}//read specific data type (string) if Wrddatatype = 2 then//ascii string begin
Strdata: = ';
For intdataloop: = 1 to Dwdcomponents do strdata: = strdata + chr (getbyte);
MMOJPEGINFO.LINES.ADD (' value= ' + strdata); End
{wrddatatype=2}//read specific data type (unsigned short) if Wrddatatype = 3 THEN BEGIN
For intdataloop: = 1 to Dwdcomponents do strdata: = strdata + chr (getbyte);
MMOJPEGINFO.LINES.ADD (' value= ' + strdata); End
{wrddatatype=3}//read specific data type (unsigned long) if Wrddatatype = 4 THEN BEGIN
Lngdata: = Getdword;
MMOJPEGINFO.LINES.ADD (' value:= ' + inttostr (lngdata)); End {wrddatatype=4}//read specific data type (unsigned rational) If Wrddatatype = 5 THEN BEGIN strdata: = IntToStr (Getdword) + '/' + INTTOSTR
(Getdword);
MMOJPEGINFO.LINES.ADD (' value:= ' + strdata); End
{wrddatatype=5} end {Inttotaldatalength > 4} else begin//read value Inttotaldatalength < 4
MMOJPEGINFO.LINES.ADD (' value= ' + inttostr (dwddata)); End
Read Value Inttotaldatalength < 4//return to former data position fsimage.seek (i64holdpos,sofrombeginning); End
{for intloop}//finally, read the offset to the next IFD wrdnextifd: = Getword;
End
Procedure Tfrmjpeginfo.readjpeginfo (const jpegfilename:string); var Wrdimage:word; Word read from image file Dwdimage:dword; Double word read from image file Bytimage:byte; Byte read from image file strimage:string;
String read from image file begin {Open the file} fsimage: = Tfilestream.create (Jpegfilename,fmopenread); {Show file path on Caption} Caption: = Jpegfilename;
{Look for start-of-image marker FF D8 as two bytes} if GetByte = $FF THEN BEGIN if GetByte = $D 8 Then MmoJpegInfo.lines.Add (' start-of-image Marker found:valid image ') ELSE begin//exit If invalid image mmojpeg
Info.lines.Add (' Start-of-image Marker not found:invalid Image ');
Exit End
Check for Soi marker end; {Look for EXIF marker} while bytimage <> $D 9 do//$D 9=eof byte begin Fsimage.read (bytimage,1);
Read one byte//if exif marker found (starts by $FFE 1} if Bytimage = $FF Then If getbyte = $E 1 Then
Begin MMOJPEGINFO.LINES.ADD (' EXIF Marker Found ');
Now read image information {read EXIF data size} wrdimage: = Getword;
MmoJpegInfo.lines.Add (' Exif Data size= ' + inttostr (wrdimage));
{Read actual EXIF header} strimage: = GetString (4);
If Strimage <> ' Exif ' then exit else MmoJpegInfo.lines.Add (' Header: ' + strimage);
Read two null bytes after EXIF header Getword;
Set reference position for future offsets i64refpos: = fsimage.position;
The next 8 bytes are the TIFF header//2 bytes to determine byte order//2 bytes (002A or 2a00) 4 bytes Offset to-i-image file directory {Now read-byte order, ' II is Intel ' (little endian), MM is
Motorola (big Endian)} wrdimage: = Getword;
Case Wrdimage of $4949:mmojpeginfo.lines.add (' encoding:little endian ');
$4d4d:mmojpeginfo.lines.add (' encoding:big endian ');
else MmoJpegInfo.lines.Add (' Unknown Encoding ');
End
{Read the next two bytes-always $02AA or $2a00} wrdimage: = Getword;
{Read the end of the ' the TIFF header-4 bytes contain offset to ' the ' the ' of ' the '. Dwdimage: = Getdword; MMOJPEGINFO.LINES.ADD (' Offset to 1st IFD: ' + inttostr (dwdimage));
{Seek to-subtract 8 bytes for TIFF header} fsimage.seek (dwdimage-8,sofromcurrent);
{Read the ' the ' the ' preadifd; End If EXIF marker found end;
{Look for EXIF marker-while Bytsoi <> $D 9 Do}
{Close the file} Fsimage.free; End
{Read information from the JPEG file} procedure Tfrmjpeginfo.btnopenjpegclick (Sender:tobject);
Begin Mmojpeginfo.clear;
With Topendialog.create (self) do begin Options: = [Ofhidereadonly, offilemustexist];
Filter: = ' *.jpeg|*.jpg ';
If Execute then begin Readjpeginfo (FileName);
End
Free
End
End End.
Form file
Object Frmjpeginfo:tfrmjpeginfo Left
= 0 Top
= 0
Caption = ' Frmjpeginfo '
clientheight = 564
clientwidth = 366
Color = clbtnface
font.charset = default_charset Font.Color
=
Clwindowtext Font.height = -12
font.name = ' Tahoma '
font.style = []
oldcreateorder = False
pixelsperinch = 106
textheight = Btnopenjpeg:tbutton left = + Top
=
Width =
Height =
Capt Ion = #25171 #24320 ' Jpeg '
taborder = 0
OnClick = Btnopenjpegclick
End
Object Mmojpeginfo:tmemo Left
= 0
top =
Width = 366
Height = 517
Align = albottom
ScrollBars = ssvertical TabOrder
= 1
end< C32/>end