Как получить размеры файла изображения в Delphi?

Question

Прежде чем открывать этот файл, я хочу знать ширину и высоту файла изображения.

Итак, как это сделать?

EDIT: Это относится к файлам изображений jpg, bmp, png и gif.

Answer 1

Если по «файлу изображения» вы имеете в виду те файлы растрового изображения, которые распознаются графической системой 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 (например, размеры) без загрузки файла, я считаю, что вам нужно более «сложное» решение.

Answer 2

Вы можете попробовать This. Я не тестировал его, но кажется довольно разумным, что он будет работать.

Кроме того, разные типы файлов имеют разные способы получения ширины и высоты. Постарайся уточнить свой вопрос.

Один страницы 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'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 3

В качестве дополнения к Rafael's 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; 

Answer 4

Если кто-либо еще интересуется извлечением изображения в формате TIFF без загрузки графики, существует проверенный метод, который отлично работает для меня во всех средах. Я также нашел для этого another solution, но он вернул неправильные значения из созданных Illustrator TIFF. Но есть фантастическая графическая библиотека под названием GraphicEx by Mike Lischke (очень талантливый разработчик TVirtualStringTree). Существуют реализации многих популярных форматов изображений, и все они происходят из базового класса TGraphicExGraphic, который реализует виртуальный метод ReadImageProperties. Он основан на потоках и только считывает файл-файл во всех реализациях. Итак, это молниеносно ... :-)

Итак, вот пример кода, который извлекает размеры TIFF (метод одинаковый для всех графических реализаций, PNG, PCD, TGA, GIF, PCX, и т.д.):

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; 

Вот и все ... :-) И это то же самое для всех графических реализаций в блоке.

Answer 5

Загляните в exiftool.exe. Это бесплатно. Это стандарт для такого рода вещей, но вам нужно будет выложить.