Image 如何在Delphi中获取图像文件的尺寸？

在打开图像文件之前，我想知道该文件的宽度和高度

那么，如何做到这一点呢

编辑：

---

这指的是jpg、bmp、png和gif类型的图像文件。

如果“图像文件”指的是VCL图形系统识别的光栅图像文件，而“打开前”指的是“用户可能注意到文件已打开前”，则可以非常轻松地执行此操作：

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（如维度），我相信您需要一个更“复杂”的解决方案。

您可以尝试第页。我还没有测试过它，但它似乎可以正常工作

此外，不同的文件类型有不同的方式来获取宽度和高度。在你的问题上尽量说得更具体些

其中一个页面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.

unitimgsize；
接口
使用类；
过程GetJPGSize（const-sFile:string；var-wWidth，wHeight:word）；
过程GetPNGSize（const-sFile:string；var-wWidth，wHeight:word）；
过程GetGIFSize（const sGIFFile:string；var wWidth，wHeight:word）；
实施
使用SysUtils；
函数ReadMWord（f:TFileStream）：word；
类型
TMotorolaWord=记录
大小写字节
0：（值：word）；
1：（字节1，字节2：字节）；
结束；
变量
MW:TMotorolaWord；
开始
//最好是在正常情况下和正常情况下读取这两个字节
//然后执行一个小的ASM例程来交换它们。但我们不是在谈论
//读取整个文件，因此我怀疑性能提升是否值得费心。
f、 读取（MW.Byte2，SizeOf（Byte））；
f、 读取（MW.Byte1，SizeOf（Byte））；
结果：=分子量值；
结束；
过程GetJPGSize（const-sFile:string；var-wWidth，wHeight:word）；
常数
ValidSig:字节=（$FF，$D8）的数组[0..1]；
无参数=[$01、$D0、$D1、$D2、$D3、$D4、$D5、$D6、$D7]；
变量
Sig：字节的数组[0..1]；
f:TFileStream；
x：整数；
Seg：字节；
虚拟：字节的数组[0..15]；
蓝：字；
雷德伦：朗吉特；
开始
FillChar（Sig，SizeOf（Sig），#0）；
f:=TFileStream.Create（sFile，fmOpenRead）；
尝试
ReadLen:=f.Read（Sig[0]，SizeOf（Sig））；
对于x:=低（Sig）至高（Sig）do
如果Sig[x]有效，则
ReadLen:=0；
如果ReadLen>0，则
开始
ReadLen:=f.Read（Seg，1）；
而（Seg=$FF）和（ReadLen>0）则
开始
ReadLen:=f.Read（Seg，1）；
如果Seg$FF，则
开始
如果（Seg=$C0）或（Seg=$C1），则
开始
ReadLen:=f.Read（伪[0]，3）；//不需要这些字节
wHeight:=ReadMWord（f）；
wWidth:=ReadMWord（f）；
结束
其他的
开始
如果不是（Seg in Parameterless），则
开始
Len:=ReadMWord（f）；
f、 搜索（Len-2，1）；
f、 读取（Seg，1）；
结束
其他的
Seg:=$FF；//假装它继续循环。
结束；
结束；
结束；
结束；
最后
f、 免费的；
结束；
结束；
过程GetPNGSize（const-sFile:string；var-wWidth，wHeight:word）；
类型
TPNGSig=字节数组[0..7]；
常数
ValidSig:TPNGSig=（137,80,78,71,13,10,26,10）；
变量
Sig:TPNGSig；
f:tFileStream；
x：整数；
开始
FillChar（Sig，SizeOf（Sig），#0）；
f:=TFileStream.Create（sFile，fmOpenRead）；
尝试
f、 读取（Sig[0]，SizeOf（Sig））；
对于x:=低（Sig）至高（Sig）do
如果Sig[x]有效，则
出口
f、 寻求（18,0）；
wWidth:=ReadMWord（f）；
f、 寻求（22,0）；
wHeight:=ReadMWord（f）；
最后
f、 免费的；
结束；
结束；
过程GetGIFSize（const sGIFFile:string；var wWidth，wHeight:word）；
类型
TGIFHeader=记录
Sig:char的数组[0..5]；
屏幕宽度、屏幕高度：字；
标志、背景、方面：字节；
结束；
TGIFImageBlock=记录
左、上、宽、高：字；
标志：字节；
结束；
变量
f：文件；
标题：TGifHeader；
ImageBlock:TGifImageBlock；
结果：整数；
x：整数；
c：半焦；
维度查找：布尔值；
开始
wWidth:=0；
当：=0；
如果sGifFile=''，则
出口
{$I-}
文件模式：=0；//只读
赋值文件（f，sGifFile）；
复位（f，1）；
如果结果为0，则
//无法打开文件
出口
//读取头并确保文件有效
区块读取（f，标头，SizeOf（TGifHeader），nResult）；
如果（nResult SizeOf（TGifHeader））或（IOResult 0）
或者（StrLComp（'GIF'，Header.Sig，3）0）然后
开始
//图像文件无效
关闭（f）；
出口
结束；
//跳过颜色贴图（如果有）
如果（Header.Flags和$80）>0，则
开始
x:=3*（1个SHL（（Header.Flags和7）+1））；
寻找（f，x）；
如果结果为0，则
开始
//彩色地图
关闭（f）；
出口
结束；
结束；
维度发现：=假；
FillChar（ImageBlock，SizeOf（TGIFImageBlock），#0）；
//跨过街区
区块读取（f，c，1，nResult）；
而（非EOF（f））和（非尺寸基金）则
开始
案例c
“，”：//找到图像
开始
BlockRead（f，ImageBlock，SizeOf（TGIFImageBlock），nResult）；
如果nResult SizeOf（TGIFImageBlock），则
开始
//遇到无效的图像块
关闭（f）；
出口
结束；
wWidth:=ImageBlock.Width；
wHeight:=图像块高度；
维度发现：=真；
结束；
“，”：//跳过
开始
//不
结束；
//没有别的，只是忽略
结束；
区块读取（f，c，1，nResult）；
结束；
关闭（f）；
{$I+}
结束；
结束。

对于BMP（也可以在我提到的页面上找到）：

函数FetchBitmapHeader（PictFileName:String；Var-wd，ht:Word）：布尔值；
//类似的例程在“位图区域”例程中
标识出口；
常数
ValidSig:字节=（$FF，$D8）的数组[0..1]；
无参数=[$01、$D0、$D1、$D2、$D3、$D4、$D5、$D6、$D7]；
BmpSig=4d42美元；
变量
//错误：布尔；
fh:HFile；
//tof:TOFSTRUCT；
bf:TBITMAPFIL
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;

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;

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;

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;

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;