How to get image size in pixels ?

Hi to all !
Since I'm new to this forum, please excuse me if this question's been answered over and over again...

I want to calculate the size of a GIF or JPEG image (height and width) without having to put it on a form. So I got myself the routine included bellow.

2 problems : it's not very elegant, and it doesn't work on some pics. Can't figure out why : gives me either 0*0 or some unrealistic figures. One thing I'm sure of : the pics that come out of a Sony Mavicam (digital camera) are 0*0...

Any suggestion ? Thanks in advance...

Damien

function TMainform.GetImageSize(nomimage: string): TImageSize;
var
iFileHandle: Integer;
Buffer: array[1..200] of Char;
begin
iFileHandle := FileOpen(nomimage, fmOpenRead);
FileSeek(iFileHandle,0,0);
FileRead(iFileHandle, Buffer, Sizeof(Buffer));
FileClose(iFileHandle);
if lowercase(ExtractFileExt(NomImage))='.gif' then
begin
GetImageSize.width:=ord(buffer[8])*256+ord(buffer[7]);
GetImageSize.height:=ord(buffer[10])*256+ord(buffer[9]);
end;
if (lowercase(ExtractFileExt(NomImage))='.jpg') or (lowercase(ExtractFileExt(NomImage))='.jpeg') then
begin
GetImageSize.width:=ord(buffer[166])*256+ord(buffer[167]);
GetImageSize.height:=ord(buffer[164])*256+ord(buffer[165]);
end;
end;

I found this code on the internet, but have not tried it out. It should calculate the width and height in pixels of JPG, GIF, and PNG images.

-------------------------------------------

This set of functions shows how to extract the dimensions (width and height) of a JPG, GIF and PNG file.


unit ImgSize;

interface

uses Classes;

procedure GetJPGSize(const sFile: string; var wWidth, wHeight: Word);
procedure GetPNGSize(const sFile: string; var wWidth, wHeight: Word);
procedure GetGIFSize(const sGIFFile: string; var wWidth, wHeight: Word);

implementation

uses SysUtils;

function ReadMWord(F: TFileStream): Word;
type
TMotorolaWord = record
case byte of
0: (Value: Word);
1: (Byte1, Byte2: Byte);
end;

var
MW: TMotorolaWord;

begin
{ It would probably be better to just read these two bytes in normally }
{ and then do a small ASM routine to swap them. But we aren't talking }
{ about reading an entire file, so I doubt the performance gain would be }
{ worth the trouble. }
f.Read(MW.Byte2, SizeOf(Byte));
f.Read(MW.Byte1, SizeOf(Byte));

Result := MW.Value;
end;

procedure GetJPGSize(const sFile: string; var wWidth, wHeight: Word);
const
ValidSig: array[0..1] of Byte = ($FF, $D8);
Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];

var
Sig: array[0..1] of Byte;
F: TFileStream;
x: Integer;
Seg: Byte;
Dummy: array[0..15] of Byte;
Len: Word;
ReadLen: LongInt;

begin
FillChar(Sig, SizeOf(Sig), #0);
f := TFileStream.Create(sFile, fmOpenRead);

try
ReadLen := F.Read(Sig[0], SizeOf(Sig));

for x := Low(Sig) to High(Sig) do
if Sig[x] <> ValidSig[x] then ReadLen := 0;

if ReadLn > 0 then
begin
ReadLen := f.Read(Seg, 1);
if Seg <> $FF then
begin
if (Seg = $C0) or (Seg = $C1) then
begin
ReadLen := f.Read(Dummy[0], 3); { don't need these bytes }
wHeight := ReadMWord(F);
wWidth := ReadMWord(F);
end else
begin
if not (Seg in Parameterless) then
begin
Len := ReadMWord(F);
F.Seek(Len - 2, 1);
F.Read(Seg, 1);
end else
Seg := $FF; { Fake it to keep looping }
end;
end;
end;
end;
finally
F.Free;
end;
end;

procedure GetPNGSize(const sFile: string; var wWidth, wHeight: Word);
type
TPNGSig = array[0..7] of Byte;

const
ValidSig: TPNGSig = (137,80,78,71,13,10,26,10);

var
SIG: TPNGSig;
F: TFileStream;
X: Integer;

begin
FillChar(Sig, SizeOf(Sig), #0);
F := TFileStream.Create(sFile, fmOpenRead);

try
f.Read(Sig[0], SizeOf(Sig));

for x := Low(Sig) to High(Sig) do
if Sig[x] <> ValidSig[x] then exit;
f.Seek(18,0);
wWidth := ReadMWord(F);
f.Seek(22, 0);
wHeight := ReadMWord(F);
finally
F.Free;
end;
end;

procedure GetGIFSize(const sGIFFile: string; var wWidth, wHeight: Word);
type
TGIFHeader = record
Sig: array[0..5] of Char;
ScreenWidth, ScreenHeight: Word;
Flags, Background, Aspect: Byte;
end;

TGIFImageBlock = record
Left, Top, Width, Height: Word;
Flags: Byte;
end;

var
F: file;
Header: TGIFHeader;
ImageBlock: TGIFImageBlock;
nResult: Integer;
x: Integer;
c: Char;
DimensionsFound: Boolean;

begin
wWidth := 0;
wHeight := 0;

if sGIFFile = '' then Exit;

{$I-}
FileMode := 0; { read-only }
AssignFile(F, sGIFFile);
Reset(F, 1);
if IOResult <> 0 then
{ Could not open file }
exit;

{ Read header and ensure valid file }
BlockRead(F, Header, SizeOf(TGIFHeader), nResult);
if (nResult <> SizeOf(TGIFHeader)) or (IOResult <> 0) or (StrLComp('GIF', Header.Sig, 3) <> 0) then
begin
{ Image file invalid }
Close(F);
exit;
end;

{ Skip color map, if there is one }
if (Header.Flags and $80) > 0 then
begin
x := 3 * (1 shl ((Header.Flags and 7) + 1));
Seek(F, x);
if IOResult <> 0 then
begin
{ Color map thrashed }
close(f);
exit;
end;
end;

DimensionsFound := False;
FillChar(ImageBlock, SizeOf(TGIFImageBlock), #0);

{ Step through block. }
BlockRead(F, C, 1, nResult);
while (not EOF(F)) and (not DimensionsFound) do
begin
case c of
',': { Found Image }
begin
BlockRead(f, ImageBlock, SizeOf(TGIFImageBlock), nResult);
if nResult <> SizeOf(TGIFImageBlock) then
begin
{ Invalid image block encountered }
Close(f);
Exit;
end;

wWidth := ImageBlock.Width;
wHeight := ImageBlock.Height;
DimensionsFound := True;
end;
'y': { Skip }
begin
{ NOP }
end;
{ Nothing else. just ignore }
end;
BlockRead(f, c, 1, nResult);
end;

Close(F);
{$I+}
end;

end.





------------------
Larry J. Rutledge

Programmer / Analyst
Prestwood Software & Consulting
7525 Auburn Blvd., #8
Citrus Heights, CA 95610


Old UBB Archived Link: [URL=http://www.prestwood.com]www.prestwood.com[/URL]


Serving your IT needs since 1984!

David,
Thanks a lot for your fast reply. I'll look into it this weekend, altough a quick glance through the code told me that it's quite beyond my skills at the moment...

I'll give it a try, though, and keep you informed of my progress. Thanks again.

Damien

Errrm... a triffle early in the morning... Thanks LARRY !

Damien, sleepy-head since 1977