Geek asks and answers

How to get image file size in Delphi?

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

So how to do this?

EDIT: This applies to jpg, bmp, png and gif image files.

+5
source share
5 answers

If by “image file” you mean those raster image files that are recognized by the VCL graphics system, and “before opening” you mean “before the user can notice that the file is open”, 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;

, , , . , metatada (, ) , , "" .

+11

. , , .

, . .

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.

BMP ( , ):

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 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;
+12

Rafael answer, , BMP:

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;
+6

- TIFF , , . , TIFF, Illustrator. , GraphicEx (TVirtualStringTree ). , TGraphicExGraphic, ReadImageProperties. . ...: -)

So, here is an example of code that retrieves TIFF sizes (the method is the same for all graphic implementations, 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 graphical implementations in the block.

0
source

Take a look at exiftool.exe. It's free. This is the standard for this kind of thing, but you have to give all your best.

0
source

More articles:


All Articles