How can I get dimensions of an image file in Delphi?

Question

I want to know the width and height of an image file before opening that file.

So, how can I do that?

This refers to JPEG, BMP, PNG and GIF types of image files.

Solution 1

If by 'image file' you mean those raster image files recognised by the VCL's graphics system, and by 'before opening' you mean 'before the user is likely to notice that the file is opened', then you can do this very easily:

var
  pict: TPicture;
begin
  with TOpenDialog.Create(nil) do
    try
      if Execute then
      begin
        pict := TPicture.Create;          
        try
          pict.LoadFromFile(FileName);
          Caption := Format('%d×%d', [pict.Width, pict.Height])
        finally
          pict.Free;
        end;
      end;
    finally
      Free;
    end;

Of course, the file is opened, and this requires a lot of memory if the image is big. However, if you need to obtain metatada (like dimensions) without loading the file, I believe you need a more 'complicated' solution.

Solution 2

You can try this page. I have not tested it, but it seems pretty reasonable that it will work.

Also, different file types have different ways of getting the width and height.

One of the page answers:

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.

And for BMP (also found at the page I mentioned):

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;

Solution 3

As a complement to Rafael's answer, I believe that this much shorter procedure can detect BMP dimensions:

function GetBitmapDimensions(const FileName: string; out Width,
  Height: integer): boolean;
const
  BMP_MAGIC_WORD = ord('M') shl 8 or ord('B');
var
  f: TFileStream;
  header: TBitmapFileHeader;
  info: TBitmapInfoHeader;
begin
  result := false;
  f := TFileStream.Create(FileName, fmOpenRead);
  try
    if f.Read(header, sizeof(header)) <> sizeof(header) then Exit;
    if header.bfType <> BMP_MAGIC_WORD then Exit;
    if f.Read(info, sizeof(info)) <> sizeof(info) then Exit;
    Width := info.biWidth;
    Height := abs(info.biHeight);
    result := true;
  finally
    f.Free;
  end;
end;

Solution 4

If anyone yet interested in retrieving TIFF image dimensions without loading the graphic, there is a proven method that works perfectly for me in all environments. I also found another solution for that, but it returned wrong values from Illustrator-generated TIFFs. But there is a fantastic graphic library, called GraphicEx by Mike Lischke (TVirtualStringTree's very talented developer). There are implementations of many popular image formats and all of them descend from the base class TGraphicExGraphic, that implements ReadImageProperties virtual method. It is stream-based and only reads the fileheader in all implementations. So it is lightning-fast... :-)

So, here is a sample code, that retrieves a TIFF's dimensions (the method is the same for all graphic implementation, PNG,PCD,TGA,GIF,PCX,etc):

Uses ..., GraphicEx,...,...;

Procedure ReadTifSize (FN:String; Var iWidth,iHeight:Integer);
Var FS:TFileStream;
    TIFF:TTIFFGraphic;
Begin
  iWidth:=0;iHeight:=0;
  TIFF:=TTIFFGraphic.Create;
  FS:=TFileStream.Create(FN,OF_READ);

  Try
    TIFF.ReadImageProperties(FS,0);
    iWidth:=TIFF.ImageProperties.Width;
    iHeight:=TIFF.ImageProperties.Height;
  Finally
    TIFF.Destroy;
    FS.Free;
  End;
End;

That's all... :-) And this is the same for all the graphic implementations in the unit.

Solution 5

I don't like Rafael's solution for JPEG files too much because his algorithm parses every single byte until it hits FFC0. It doesn't make use of the fact that almost all markers (except FFD8, FFD9 and FFFE) are followed by two length bytes, allowing to skip from marker to marker. So I suggest the following procedure (which I condensed even a little more by stuffing checking for a marker and retrieving a value into the same function):

procedure GetJPGSize(const Filename: string; var ImgWidth, ImgHeight: word);
const
  SigJPG : TBytes = [$FF, $D8];
  SigC01 : TBytes = [$FF, $C0];
  SigC02 : TBytes = [$FF, $C1];
var
  FStream: TFileStream;
  Buf: array[0..1] of Byte;
  Offset,CheckMarker : Word;
//--------------------------------------------------------------------------------------------------------------------------------------------------------------
  function  SameValue(Sig:TBytes):Boolean;
  begin
     Result := CompareMem(@Sig[0], @Buf[0], Length(Sig));
  end;
//--------------------------------------------------------------------------------------------------------------------------------------------------------------
  function  CheckMarkerOrVal(var Value:Word):Boolean;
  begin
    FStream.ReadData(Buf, Length(Buf));
    Value := Swap(PWord(@Buf[0])^);
    Result := (Buf[0] = $FF);
  end;
//--------------------------------------------------------------------------------------------------------------------------------------------------------------
begin
  FStream := TFileStream.Create(Filename, fmOpenRead);
  Try
    // First two bytes in a JPG file MUST be $FFD8, followed by the next marker
    If not (CheckMarkerOrVal(CheckMarker) and SameValue(SigJPG))
      then exit;
    Repeat
      If not CheckMarkerOrVal(CheckMarker)
        then exit;
      If SameValue(SigC01) or SameValue(SigC02) then begin
        FStream.Position := FStream.Position + 3;
        CheckMarkerOrVal(ImgHeight);
        CheckMarkerOrVal(ImgWidth);
        exit;
      end;
      CheckMarkerOrVal(Offset);
      FStream.Position := FStream.Position + Offset - 2;
    until FStream.Position > FStream.Size div 2;
  Finally
    FStream.Free;
  end;
end;

View more solutions

Comments

[Andreas Rejbrand]

+1 This is the 'more complicated' thing I was talking about! :)

[Andreas Rejbrand]

But you forgot BMP, which is the simplest one.

[Rafael Colucci]

@AndreasRejbrand No, i have not. There is a example in the page I mentioned.

[TLama]

Wouldn't be easier to use memory stream and just point with the PBitmapFileHeader to the Memory ?

[Srdjan Vukmirica]

This is really 'more complicated' thing. :) So, I accepted @AndreasRejbrand's answer, although in that way file is opened (but users can't see that!) and it's little bit 'complicated'. Thanks

[kobik]

I don't like the NoBMP usage. I don't know why I don't like it though... :-P IMHO, Better return Boolean ,or at-least use a local flag, and throw the exception at the end of the function if needed.

[David Heffernan]

@TLama Why TMemoryStream? How would you read sizeof(header) bytes into a TMemoryStream? Andreas has the right solution. And he's even picked the correct method to call Read instead of ReadBuffer since he doesn't want a shortage of bytes to lead to an exception.

[David Heffernan]

@kobik NoBMP was good. No need for local flag. That's pointless. Just raise as soon as you know it's a failure.

[kobik]

@DavidHeffernan, Personally I think it reads much better now. look related solution for JPEG.

[Sertac Akyuz]

This gets you the logical screen width and height (what?).

[AlexV]

@Sertac Akyuz You are right but most of the time the image use all of it. I would be interested to see a working solution in Rafael answer.