![]() | | | ![img]() |
|
 | DRKB online - Как узнать размер картинки для JPG, GIF и PNG файлов? |
|
|
| |
|
Как узнать размер картинки для JPG, GIF и PNG файлов?
| delphi | 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. |
@Drkb::04301
Взято с сайта http://www.swissdelph...ndex.php
Размер Gif файла:
| delphi | 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; |
@Drkb::04302
Взято с сайта http://www.swissdelph...ndex.php |
|
| | Количество статей: 4366 |
|
|
| |
|
| Статистика |
| | Сегодня | Всего |
| Посетителей | 431 | 10022323 |
| Запросов | 2585 | 449162201 |
| Online |
| Пользователей | 0 |
| Гостей | 6 |
|
|
|
Пуск
