Как узнать размер картинки для 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.
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04301
----
Размер Gif файла:
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;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04302
Category:Форматы файлов
Category:Графика