How to get dimensions of image file in Delphi?

Question

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

So, how to do that?

EDIT: This refers to jpg, bmp, png and gif types of image fil

Answer 1

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;

Answer 2

Since GetGIFSize in Rafael answer is broken and utterly complicated here is my personal version of it:

function GetGifSize(var Stream: TMemoryStream; var Width: Word; var Height: Word): Boolean;
var
    HeaderStr: AnsiString;

begin
    Result := False;
    Width := 0;
    Height := 0;

    //GIF header is 13 bytes in length
    if Stream.Size > 13 then
    begin
        SetString(HeaderStr, PAnsiChar(Stream.Memory), 6);
        if (HeaderStr = 'GIF89a') or (HeaderStr = 'GIF87a') then
        begin
            Stream.Seek(6, soFromBeginning);
            Stream.Read(Width, 2);  //Width is located at bytes 7-8
            Stream.Read(Height, 2); //Height is located at bytes 9-10

            Result := True;
        end;
    end;
end;

Found it by reading the RFC.

Answer 3

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.

Answer 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.

Answer 5

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. Try to be more specific on your question.

One of the page anwser:

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;

Answer 6

I don't like Rafael's solution for JPGs 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;