On 5/30/11, Ben <ben.smith.li...@gmail.com> wrote:
>
> The reason I'm reading in the jpg files is so I can get their Width and
> Height values. Avg. jpeg file sizes are between 35-45KB, and largest
> file size is 65KB.
> Ben.
A bit off-topic (as to the inner workings of FPImage), but I attached
some old code of mine to determine width/height of jpg, gif, bmp, png.
It's probably a little faster...
Bart
unit PicsLib;
{ $DEFINE DEBUG}
interface
uses Windows;
function GetBMPSize(const Fn: String; var Width, Height: dword): Boolean;
function GetGIFSize(const Fn: String; var Width, Height: dword): Boolean;
function GetJPGSize(const Fn: String; var Width, Height: dword): Boolean;
function GetPNGSize(const Fn: String; var Width, Height: dword): Boolean;
function GetImageSize(const Fn: String; var Width, Height: dword): Boolean;
implementation
uses SysUtils, Classes;
type TBitmapFileHeader = Packed Record
ID: word;
FileSize: dword;
Reserved: dword;
BitmapDataOffset: dword;
end;
TBitmapInfo = Packed Record
BitmapHeaderSize: dword;
Width: dword;
Height: dword;
Planes: word;
BitsPerPixel: word;
Compression: dword;
BitmapDataSize: dword;
XpelsPerMeter: dword;
YPelsPerMeter: dword;
ColorsUsed: dword;
ColorsImportant: dword;
end;
TGIFHeader = Packed Record
ID: array[0..5] of char;
Width, Height: Word;
end;
TPNGHeader = Packed Record
ID: array[0..7] of Char;
ChunkLength: dword;
ChunkType: array[0..3] of Char;
Width: dword;
Height: dword;
BitsPerPixel: byte;
ColorType: byte;
Compression: byte;
FilterMethod: byte;
CRC: dword;
end;
TJPGHeader = array[0..1] of Byte; //FFD8 = StartOfImage (SOI)
(*
TJFIFHeader = Packed record //APP0 Header
Len: Word;
ID: array[0..4] of Char; //JFIF#0
// Maj, Min: Byte;
// XYUnits: byte;
// XDens, YDens: word;
// ThWidth, ThHeight: byte; //Thumbnail info
end;
*)
TSOFHeader = Packed record
Len: word;
DataPrecision: byte;
Height, Width: word;
NrComponents: byte;
end;
function MotorolaToIntelDW(DW: dword): dword;
var HiWd, LoWd: word;
begin
HiWd := HiWord(DW);
LoWd := LoWord(DW);
HiWd := Swap(HiWd);
LoWd := Swap(LoWd);
Result := HiWd + (LoWd shl 16);
end;
function GetImageSize(const Fn: String; var Width, Height: dword): Boolean;
begin
if AnsiUpperCase(ExtractFileExt(Fn)) = '.BMP' then
begin
Result := GetBMPSize(Fn, Width, Height);
end
else if AnsiUpperCase(ExtractFileExt(Fn)) = '.GIF' then
begin
Result := GetGIFSize(Fn, Width, Height);
end
else if (AnsiUpperCase(ExtractFileExt(Fn)) = '.JPG')
or (AnsiUpperCase(ExtractFileExt(Fn)) = '.JPEG') then
begin
Result := GetJPGSize(Fn, Width, Height);
end
else if AnsiUpperCase(ExtractFileExt(Fn)) = '.PNG' then
begin
Result := GetPNGSize(Fn, Width, Height);
end
else
begin
Width := 0;
Height := 0;
Result := False;
end;
end;
function GetBMPSize(const Fn: String; var Width, Height: dword): Boolean;
var BitmapFileHeader: TBitmapFileHeader;
BitmapInfo: TBitmapInfo;
F: File;
bRead: Integer;
IDStr: String;
begin
Result := False;
Width := 0;
Height := 0;
Try
AssignFile(F,Fn);
FileMode := fmOpenRead or fmShareDenyWrite;
Reset(F,1);
BlockRead(F,BitmapFileHeader,SizeOf(TBitmapFileHeader),bRead);
if bRead <> SizeOf(TBitmapFileHeader) then Raise EInOutError.Create('');
BlockRead(F,BitmapInfo,SizeOf(TBitmapInfo),bRead);
if bRead <> SizeOf(TBitmapInfo) then Raise EInOutError.Create('');
CloseFile(F);
IDStr := Char(Lo(BitmapFileHeader.ID)) + Char(Hi(BitmapFileHeader.ID));
//Klopt bestandsopmaak ?
if (not (IDStr = 'BM') or (IDStr = 'BA')) or
(not (BitmapInfo.BitmapHeaderSize in [$28,$0c,$f0])) or
(not (BitmapInfo.BitsPerPixel in [1,4,8,16,24,32])) then Exit;
Width := BitmapInfo.Width;
Height := BitmapInfo.Height;
Result := True;
Except
on EInOutError do
begin
{$I-}
CloseFile(F);
InOutRes := 0; //Negeer IO errors hier (mogelijk is bestand al geclosed)
Exit;
end;
end;//try...except
end;
function GetGIFSize(const Fn: String; var Width, Height: dword): Boolean;
var GifHeader: TGIFHeader;
F: File;
bRead: Integer;
begin
Result := False;
Width := 0;
Height := 0;
Try
AssignFile(F,Fn);
FileMode := fmOpenRead or fmShareDenyWrite;
Reset(F,1);
BlockRead(F,GifHeader,SizeOf(TGIFHeader),bRead);
if bRead <> SizeOf(TGIFHeader) then Raise EInOutError.Create('');
CloseFile(F);
//Klopt bestandsopmaak ?
if not ((AnsiUpperCase(GifHeader.ID) = 'GIF87A') or (AnsiUpperCase(GifHeader.ID) = 'GIF89A')) then Exit;
Width := GifHeader.Width;
Height := GifHeader.Height;
Result := True;
Except
on EInOutError do
begin
{$I-}
CloseFile(F);
InOutRes := 0; //Negeer IO errors hier (mogelijk is bestand al geclosed)
Exit;
end;
end;//try...except
end;
function GetPNGSize(const Fn: String; var Width, Height: dword): Boolean;
var PNGHeader: TPNGHeader;
F: File;
bRead: Integer;
begin
Result := False;
Width := 0;
Height := 0;
Try
AssignFile(F,Fn);
FileMode := fmOpenRead or fmShareDenyWrite;
Reset(F,1);
BlockRead(F,PNGHeader,SizeOf(TPNGHeader),bRead);
if bRead <> SizeOf(TPNGHeader) then Raise EInOutError.Create('');
CloseFile(F);
//Klopt bestandsopmaak ?
if (AnsiUpperCase(PNGHeader.ID) <> #137'PNG'#13#10#26#10) or
(AnsiUpperCase(PNGHeader.ChunkType) <> 'IHDR') then exit;
Width := MotorolaToIntelDW(PNGHeader.Width);
Height := MotorolaToIntelDW(PNGHeader.Height);
Result := true;
Except
on EInOutError do
begin
{$I-}
CloseFile(F);
InOutRes := 0; //Negeer IO errors hier (mogelijk is bestand al geclosed)
Exit;
end;
end;//try...except
end;
function GetJPGSize(const Fn: String; var Width, Height: dword): Boolean;
const Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
var F: File;
bRead: Integer;
JPGHeader: TJPGHeader;
// JFIFHeader: TJFIFHeader;
SOFHeader: TSOFHeader;
B, SegType: byte;
SegSize: Word; //Thumbnail Size
SOF_Found: boolean;
Dummy: array[0..65532] of byte; //Max segment length
{$IFDEF DEBUG}
var tf: text;
{$ENDIF}
begin
{$IFDEF DEBUG}
assignfile(tf,'\debug.txt');
if fileexists('\debug.txt') then append(tf) else rewrite(tf);
writeln(tf,Fn);
{$ENDIF}
Result := False;
Width := 0;
Height := 0;
Try
AssignFile(F,Fn);
FileMode := fmOpenRead or fmShareDenyWrite;
Reset(F,1);
BlockRead(F,JPGHeader, SizeOf(TJPGHeader),bRead);
if bRead <> SizeOf(TJPGHeader) then Raise EInOutError.Create('');
if (JPGHeader[0] <> $FF) or (JPGHeader[1] <> $D8) then
begin
CloseFile(F);
Exit;
end;
{$IFDEF DEBUG}
writeln(tf,'StartOfImage Found');
{$ENDIF}
SOF_Found := False;
// JFIF_Found := False;
//Op zoek naar JFIFF en StartOfFrame (SOF) segment
BlockRead(F,B,1,bRead);
if bRead <> 1 then Raise EInoutError.Create('');
While (not EOF(F)) and (B = $FF) and not (SOF_Found {and JFIF_Found}) do //Alle segmenten beginnen met $FF
begin
BlockRead(F,SegType,1,bRead);
{$IFDEF DEBUG}
write(tf,'Segment Type: '+IntToHex(SegType,2)+' ');
{$ENDIF}
if bRead <> 1 then Raise EInoutError.Create('');
case SegType of
$c0,$c1,$c2 {,$c3,$c5,$c6,$c7,$c9,$ca,$cb,$cd,$ce,$cf ???}:
begin//StartOfFrame
BlockRead(F,SOFHeader,SizeOf(TSOFHeader),bRead);
if bRead <> SizeOf(TSOFHeader) then Raise EInOutError.Create('');
//Motorola -> Intel
SOFHeader.Len := Swap(SOFHeader.Len);
{$IFDEF DEBUG}
write(tf,' Segment Length: '+IntToStr(SOFHeader.Len),' (StartOfFrame)');
{$ENDIF}
SOFHeader.Height := Swap(SOFHeader.Height);
SOFHeader.Width := Swap(SOFHeader.Width);
BlockRead(F,Dummy,SOFHeader.NrComponents*3,bRead);
if bRead <> (SOFHeader.NrComponents * 3) then Raise EInOutError.Create('');
Width := SOFHeader.Width;
Height := SOFHeader.Height;
SOF_Found := true;
end;
(*
//Kennelijk bevat niet ieder JPG een JFIF segmet ...
$e0:
begin//App0 = JFIF segment
BlockRead(F,JFIFHeader,SizeOf(TJFIFHeader),bRead);
if bRead <> SizeOf(TJFIFHeader) then Raise EInOutError.Create('');
BytesLeft := Swap(JFIFHeader.Len) - SizeOf(TJFIFHeader);
if BytesLeft > 0 then
begin
BlockRead(F,Dummy,BytesLeft,bRead);
if bRead <> BytesLeft then Raise EInOutError.Create('');
end;
//Kennelijk bestaan er 2 verschillende APP0 segmenten,
//één heeft JFIFF als kenmerk en is 16 bytes + thumbnail groot,
//de andere heeft JFXX als kenmerk en is beduidend groter ...
if AnsiStrLComp(JFIFHeader.ID,PChar('JF'),2) <> 0 then Break;
JFIF_Found := True;
end;
*)
$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7:
begin//Parameterloos segment
{$IFDEF DEBUG}
write(tf,' Parameterloos');
{$ENDIF}
// Negeer
end;
$d9:
begin//EndOfImage
{$IFDEF DEBUG}
write(tf,' EndOfImage');
{$ENDIF}
Break;
end;
$da:
begin//Start Of Scan: JPG Data
{$IFDEF DEBUG}
write(tf,' StartOfScan');
{$ENDIF}
Break;
end;
else
begin//Lees segment in dummy en sla over
//De eerste 2 bytes zijn lengte v.h. segment
//inclusief de 2 lengte-bytes
//Lengtebytes zijn in Motorola formaat (Hi-Lo)
BlockRead(F,SegSize,SizeOf(SegSize),bRead);
if bRead <> SizeOf(SegSize) then Raise EInOutError.Create('');
SegSize := Swap(SegSize);
{$IFDEF DEBUG}
write(tf,' Segment Length: '+IntToStr(SegSize));
{$ENDIF}
if SegSize > 2 then
begin//RLees tot eind van segment
SegSize := SegSize - 2;
BlockRead(F,Dummy,SegSize,bRead);
if bRead <> SegSize then Raise EInOutError.Create('');
end;
end;
end;//case
//Lees volgense segmentbegin, B moet nu $FF zijn ...
BlockRead(F,B,1,bRead);
if bRead <> 1 then Raise EInoutError.Create('');
{$IFDEF DEBUG}
writeln(tf);
{$ENDIF}
end;//While
//Alle info gevonden en opmaak klopt ?
if {JFIF_Found and} SOF_Found then Result := True;
{$IFDEF DEBUG}
writeln(tf);writeln(tf);writeln(tf,' End of Search for markers');
writeln(tf);
closefile(tf);
{$ENDIF}
CloseFile(F);
(*
if not Result then
begin
_GetJPGSize(Fn,Width,Height);
if (Width <> 0) and (Height <> 0) then Result := true;
end;
*)
Except
on EInOutError do
begin
{$I-}
CloseFile(F);
InOutRes := 0; //Negeer IO errors hier (mogelijk is bestand al geclosed)
Exit;
end;
end;//try...except
end;
(*
procedure _GetJPGSize(const sFile: string; var wWidth, wHeight: dWord);
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;
function ReadMWord(f: TFileStream): Word;
type TMW = record
case Byte of
0: (Value: word);
1: (Byte1,Byte2: Byte);
end;
var mw: TMW;
begin
f.read(mw.byte2,1);
f.read(mw.byte1,1);
result := mw.value;
end;
begin
wHeight := 0;
wWidth := 0;
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;
*)
end.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
