How to get the image size of a JPG, GIF and PNG image file

Problem/Question/Abstract:

How to get the image size of a JPG, GIF and PNG image file

Answer:

Solve 1:

This set of functions shows how to extract the dimensions (width and height) of a JPG, GIF and PNG file. This code was done quite a while back and while it works fine for my purposes, it may be not handle some of the newer stuff like progressive JPEGs and such. Experimentation is highly recommened.

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 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: 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 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: 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 blocks }
  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;
      ',': { Skip }
        begin
          { NOP }
        end;
      { nothing else, just ignore }
    end;
    BlockRead(f, c, 1, nResult);
  end;
  close(f);

{$I+}

end;

end.


Solve 2:

Getting the size of a *.jpg and *.gif image:


{resourcestring
  SInvalidImage = 'Image is not valid';}

type
  TImageType = (itUnknown, itJPG, itGIF);

function GetImageType(Image: PByte): TImageType;
var
  pImage: PChar;
begin
  pImage := PChar(Image);
  Result := itUnknown;
  if StrLComp(pImage, 'GIF', 3) = 0 then
  begin
    Result := itGIF;
  end
  else if (pImage[0] = #$FF) and (pImage[1] = #$D8) then
  begin
    Result := itJPG;
  end;
end;

procedure GetImageBounds(Image: PByte; Size: Integer; var Width: Cardinal; var Height: Cardinal);
const
  SizeSegments = [#$C0, #$C1, #$C2];
var
  pImage: PChar;
  ImageType: TImageType;
  cSegmentType: Char;
  nSegmentSize: Word;
  nPos: Integer;
  bFound: Boolean;
begin
  ImageType := GetImageType(Image);
  pImage := PChar(Image);
  case ImageType of
    itJPG:
      begin
        nPos := 2;
        bFound := False;
        while not bFound and (nPos < Size) do
        begin
          if pImage[nPos] <> #$FF then
          begin
            EInvalidGraphic.Create(SInvalidImage);
          end;
          Inc(nPos);
          if nPos >= Size then
          begin
            raise EInvalidGraphic.Create(SInvalidImage);
          end;
          cSegmentType := pImage[nPos];
          bFound := cSegmentType in SizeSegments;
          if not bFound then
          begin
            Inc(nPos);
            if not (cSegmentType in [#$01, #$D0..#$D7]) then
            begin
              if nPos >= Size - 1 then
              begin
                raise EInvalidGraphic.Create(SInvalidImage);
              end;
              nSegmentSize := MakeWord(Byte(pImage[nPos + 1]), Byte(pImage[nPos]));
              Inc(nPos, nSegmentSize);
            end;
          end;
        end;
        if not bFound then
        begin
          raise EInvalidGraphic.Create(SInvalidImage);
        end;
        Inc(nPos, 4);
        if nPos >= Size - 1 then
        begin
          raise EInvalidGraphic.Create(SInvalidImage);
        end;
        Height := MakeWord(Byte(pImage[nPos + 1]), Byte(pImage[nPos]));
        Inc(nPos, 2);
        if nPos >= Size - 1 then
        begin
          raise EInvalidGraphic.Create(SInvalidImage);
        end;
        Width := MakeWord(Byte(pImage[nPos + 1]), Byte(pImage[nPos]));
      end;
    itGIF:
      begin
        nPos := 6;
        if nPos >= Size - 1 then
        begin
          raise EInvalidGraphic.Create(SInvalidImage);
        end;
        Width := MakeWord(Byte(pImage[nPos]), Byte(pImage[nPos + 1]));
        nPos := 8;
        if nPos >= Size - 1 then
        begin
          raise EInvalidGraphic.Create(SInvalidImage);
        end;
        Height := MakeWord(Byte(pImage[nPos]), Byte(pImage[nPos + 1]));
      end
  else
    begin
      raise EInvalidGraphic.Create(SInvalidImage);
    end;
  end;
end;


Solve 3:

This is a customization of Solve 1:


function GoodFileRead(fhdl: THandle; buffer: Pointer; readsize: DWord): Boolean;
var
  numread: DWord;
  retval: Boolean;
begin
  retval := ReadFile(fhdl, buffer^, readsize, numread, nil);
  result := retval and (readsize = numread);
end;

function ReadMWord(fh: HFile; var value: Word): Boolean;
type
  TMotorolaWord = record
    case byte of
      0: (Value: word);
      1: (Byte1, Byte2: byte);
  end;
var
  MW: TMotorolaWord;
  numread: DWord;
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.}
  Result := False;
  if ReadFile(fh, MW.Byte2, SizeOf(Byte), numread, nil) then
    if ReadFile(fh, MW.Byte1, SizeOf(Byte), numread, nil) then
      Result := True;
  Value := MW.Value;
end;

function ImageType(Fname: string): Smallint;
var
  ImgExt: string;
  Itype: Smallint;
begin
  ImgExt := UpperCase(ExtractFileExt(Fname));
  if ImgExt = '.BMP' then
    Itype := 1
  else if (ImgExt = '.JPEG') or (ImgExt = '.JPG') then
    Itype := 2
  else
    Itype := 0;
  Result := Itype;
end;

function FetchBitmapHeader(PictFileName: string; var wd, ht: Word): Boolean;
{similar routine is in "BitmapRegion" routine}
label
  ErrExit;
const
  ValidSig: array[0..1] of byte = ($FF, $D8);
  Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
  BmpSig = $4D42;
var
  {Err : Boolean;}
  fh: HFile;
  {tof : TOFSTRUCT;}
  bf: TBITMAPFILEHEADER;
  bh: TBITMAPINFOHEADER;
  {JpgImg  : TJPEGImage;}
  Itype: Smallint;
  Sig: array[0..1] of byte;
  x: integer;
  Seg: byte;
  Dummy: array[0..15] of byte;
  skipLen: word;
  OkBmp, Readgood: Boolean;
begin
  {Open the file and get a handle to it's BITMAPINFO}
  OkBmp := False;
  Itype := ImageType(PictFileName);
  fh := CreateFile(PChar(PictFileName), GENERIC_READ, FILE_SHARE_READ, nil,
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if (fh = INVALID_HANDLE_VALUE) then
    goto ErrExit;
  if Itype = 1 then
  begin
    {read the BITMAPFILEHEADER}
    if not GoodFileRead(fh, @bf, sizeof(bf)) then
      goto ErrExit;
    if (bf.bfType <> BmpSig) then {'BM'}
      goto ErrExit;
    if not GoodFileRead(fh, @bh, sizeof(bh)) then
      goto ErrExit;
    {for now, don't even deal with CORE headers}
    if (bh.biSize = sizeof(TBITMAPCOREHEADER)) then
      goto ErrExit;
    wd := bh.biWidth;
    ht := bh.biheight;
    OkBmp := True;
  end
  else if (Itype = 2) then
  begin
    FillChar(Sig, SizeOf(Sig), #0);
    if not GoodFileRead(fh, @Sig[0], sizeof(Sig)) then
      goto ErrExit;
    for x := Low(Sig) to High(Sig) do
      if Sig[x] <> ValidSig[x] then
        goto ErrExit;
    Readgood := GoodFileRead(fh, @Seg, sizeof(Seg));
    while (Seg = $FF) and Readgood do
    begin
      Readgood := GoodFileRead(fh, @Seg, sizeof(Seg));
      if Seg <> $FF then
      begin
        if (Seg = $C0) or (Seg = $C1) or (Seg = $C2) then
        begin
          Readgood := GoodFileRead(fh, @Dummy[0], 3); {don't need these bytes}
          if ReadMWord(fh, ht) and ReadMWord(fh, wd) then
            OkBmp := True;
        end
        else
        begin
          if not (Seg in Parameterless) then
          begin
            ReadMWord(fh, skipLen);
            SetFilePointer(fh, skipLen - 2, nil, FILE_CURRENT);
            GoodFileRead(fh, @Seg, sizeof(Seg));
          end
          else
            Seg := $FF; {Fake it to keep looping}
        end;
      end;
    end;
  end;
  ErrExit: CloseHandle(fh);
  Result := OkBmp;
end;