Как узнать размер картинки для JPG, GIF и PNG файлов?

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; 
      'y': { Skip } 
        begin 
          { NOP } 
        end; 
      { nothing else.  just ignore } 
    end; 
    BlockRead(f, c, 1, nResult); 
  end; 
  Close(f); 
  {$I+} 
end; 
 
end. 

Взято с сайта https://www.swissdelphicenter.ch/en/tipsindex.php

type
  TImageSize = record
    Width: Integer;
    Height: Integer;
  end;
 
function ReadGIFSize(Stream: TStream): TImageSize;
type
  TGifHeader = record
    Signature: array [0..5] of Char;
    Width, Height: Word;
  end;
var
  Header: TGifHeader;
begin
  FillChar(Header, SizeOf(TGifHeader), #0);
  Result.Width := -1;
  Result.Height := -1;
  with Stream do
  begin
    Seek(0, soFromBeginning);
    ReadBuffer(Header, SizeOf(TGifHeader));
  end;
  if (AnsiUpperCase(Header.Signature) = 'GIF89A') or
    (AnsiUpperCase(Header.Signature) = 'GIF87A') then
  begin
    Result.Width  := Header.Width;
    Result.Height := Header.Height;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
  FileName = 'D:\test.gif';
var
  fs: TFileStream;
  gifsize: TImageSize;
begin
  fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    gifsize := ReadGIFSize(fs);
    ShowMessage(Format('Breite %d Hohe %d', [gifsize.Width, gifsize.Height]));
  finally
    fs.Free;
  end;
end;

Взято с сайта https://www.swissdelphicenter.ch/en/tipsindex.php