...Get the image size of a JPG, GIF and PNG image file?

Author: Brad Stowers

Category: Files

unit ImgSize;

interface

uses 
Classes;


procedure GetJPGSize(const sFile: stringvar wWidth, wHeight: Word);
procedure GetPNGSize(const sFile: stringvar wWidth, wHeight: Word);
procedure GetGIFSize(const sGIFFile: stringvar 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 entire files, 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: stringvar 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 ReadLen > 0 then
    begin
      
ReadLen := f.read(Seg, 1);
      while (Seg = $FF) and (ReadLen > 0) do
      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: stringvar 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: stringvar 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 blocks. }
  
BlockRead(f, c, 1, nResult);
  while (not EOF(f)) and (not DimensionsFound) do
  begin
    case 
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;
      'ÿ': { Skip }
        
begin
          
{ NOP }
        
end;
      { nothing else.  just ignore }
    
end;
    BlockRead(f, c, 1, nResult);
  end;
  Close(f);
  {$I+}
end;

end.

 

printed from
www.swissdelphicenter.ch
developers knowledge base