You've already forked lazarus-ccr
LazEdit: Lazedit_PicsLib.pp: refactoring and making it Endian safe
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2595 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
lazarus-bart
@ -1,309 +1,354 @@
|
||||
unit LazEdit_PicsLib;
|
||||
{ $DEFINE DEBUG}
|
||||
|
||||
{ $DEFINE DebugPicsLib}
|
||||
|
||||
interface
|
||||
|
||||
uses LCLIntf, LCLType;
|
||||
uses SysUtils, Classes, Math;
|
||||
|
||||
type
|
||||
TImageFormat = (ifUnknown, ifBmp, ifPng, ifGif, ifJpg);
|
||||
|
||||
function GetBMPSize(const Fn: String; out Width, Height: dword): Boolean;
|
||||
function GetGIFSize(const Fn: String; out Width, Height: dword): Boolean;
|
||||
function GetJPGSize(const Fn: String; out Width, Height: dword): Boolean;
|
||||
function GetPNGSize(const Fn: String; out Width, Height: dword): Boolean;
|
||||
function GetImageSize(const Fn: String; out Width, Height: dword): Boolean;
|
||||
|
||||
function GetImageSizeAndFormat(const Fn: String; out Width, Height: dword): TImageFormat;
|
||||
|
||||
|
||||
|
||||
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)
|
||||
|
||||
TSOFHeader = Packed record
|
||||
Len: word;
|
||||
DataPrecision: byte;
|
||||
Height, Width: word;
|
||||
NrComponents: byte;
|
||||
end;
|
||||
|
||||
|
||||
function MotorolaToIntelDW(DW: dword): dword;
|
||||
var HiWd, LoWd: word;
|
||||
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)
|
||||
|
||||
TSOFHeader = Packed record
|
||||
Len: word;
|
||||
DataPrecision: byte;
|
||||
Height, Width: word;
|
||||
NrComponents: byte;
|
||||
end;
|
||||
|
||||
function ExtToImageFormat(const Ext: String): TImageFormat;
|
||||
begin
|
||||
HiWd := HiWord(DW);
|
||||
LoWd := LoWord(DW);
|
||||
HiWd := Swap(HiWd);
|
||||
LoWd := Swap(LoWd);
|
||||
Result := HiWd + (LoWd shl 16);
|
||||
end;
|
||||
|
||||
|
||||
function GetImageSize(const Fn: String; out Width, Height: dword): Boolean;
|
||||
begin
|
||||
if AnsiUpperCase(ExtractFileExt(Fn)) = '.BMP' then
|
||||
if AnsiUpperCase(Ext) = '.BMP' then
|
||||
begin
|
||||
Result := GetBMPSize(Fn, Width, Height);
|
||||
Result := ifBmp;
|
||||
end
|
||||
else if AnsiUpperCase(ExtractFileExt(Fn)) = '.GIF' then
|
||||
else if AnsiUpperCase(Ext) = '.GIF' then
|
||||
begin
|
||||
Result := GetGIFSize(Fn, Width, Height);
|
||||
Result := ifGif;
|
||||
end
|
||||
else if (AnsiUpperCase(ExtractFileExt(Fn)) = '.JPG')
|
||||
or (AnsiUpperCase(ExtractFileExt(Fn)) = '.JPEG') then
|
||||
else if (AnsiUpperCase(Ext) = '.JPG')
|
||||
or (AnsiUpperCase(Ext) = '.JPEG') then
|
||||
begin
|
||||
Result := GetJPGSize(Fn, Width, Height);
|
||||
Result := ifJpg;
|
||||
end
|
||||
else if AnsiUpperCase(ExtractFileExt(Fn)) = '.PNG' then
|
||||
else if AnsiUpperCase(Ext) = '.PNG' then
|
||||
begin
|
||||
Result := GetPNGSize(Fn, Width, Height);
|
||||
Result := ifPng;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Width := 0;
|
||||
Height := 0;
|
||||
Result := False;
|
||||
end;
|
||||
Result := ifUnknown;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function GetBMPSize(const Fn: String; out Width, Height: dword): Boolean;
|
||||
var BitmapFileHeader: TBitmapFileHeader;
|
||||
BitmapInfo: TBitmapInfo;
|
||||
F: File;
|
||||
bRead: Integer;
|
||||
IDStr: String;
|
||||
|
||||
function MaybeBmp(St: TStream; ChunkSize: Integer; out Width, Height: DWord): TImageFormat;
|
||||
var
|
||||
BFH: TBitmapFileHeader;
|
||||
BInfo: TBitmapInfo;
|
||||
IDStr: String;
|
||||
begin
|
||||
Result := ifUnknown;
|
||||
if (ChunkSize < (SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfo))) then Exit;
|
||||
St.Position := 0;
|
||||
St.ReadBuffer(BFH, Sizeof(TBitmapFileHeader));
|
||||
St.ReadBuffer(BInfo, SizeOf(TBitmapInfo));
|
||||
BFH.ID := LeToN(BFH.ID);
|
||||
IDStr := Char(Lo(BFH.ID)) + Char(Hi(BFH.ID));
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then writeln('IDStr = ',idstr);
|
||||
if IsConsole then writeln('BInfo.BitmapHeaderSize = $',IntToHex(BInfo.BitmapHeaderSize,2));
|
||||
if IsConsole then writeln('BInfo.BitsPerPixel = ',BInfo.BitsPerPixel);
|
||||
{$endif}
|
||||
BInfo.BitmapHeaderSize := LeToN(BInfo.BitmapHeaderSize);
|
||||
BInfo.BitsPerPixel := LeToN(BInfo.BitsPerPixel);
|
||||
if ((IDStr = 'BM') or (IDStr = 'BA')) and
|
||||
(BInfo.BitmapHeaderSize in [$28,$0c,$f0]) and
|
||||
(BInfo.BitsPerPixel in [1,4,8,16,24,32])then
|
||||
begin
|
||||
Width := LeToN(BInfo.Width);
|
||||
Height := LeToN(BInfo.Height);
|
||||
Result := ifBmp;
|
||||
end;
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then writeln('MaybeBmp: Result = ',Result);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
function MaybePng(St: TStream; ChunkSize: Integer; out Width, Height: DWord): TImageFormat;
|
||||
var
|
||||
PngHeader: TPngHeader;
|
||||
begin
|
||||
Result := ifUnknown;
|
||||
if (ChunkSize < SizeOf(TPngHeader)) then Exit;
|
||||
St.Position := 0;
|
||||
St.ReadBuffer(PngHeader, SizeOf(TPngHeader));
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then writeln('PNGHeader.ID= ',PNGHeader.ID);
|
||||
if IsConsole then writeln('PNGHeader.ChunkType = ',PNGHeader.ChunkType);
|
||||
{$endif}
|
||||
if (AnsiUpperCase(PNGHeader.ID) = #137'PNG'#13#10#26#10) or
|
||||
(AnsiUpperCase(PNGHeader.ChunkType) = 'IHDR') then
|
||||
begin
|
||||
//Vaues are in BigEndian format
|
||||
Width := BeToN(PNGHeader.Width);
|
||||
Height := BeToN(PNGHeader.Height);
|
||||
Result := ifPng;
|
||||
end;
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then writeln('MaybePng: Result = ',Result);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function MaybeGif(St: TStream; ChunkSize: Integer; out Width, Height: DWord): TImageFormat;
|
||||
var
|
||||
GifHeader: TGifHeader;
|
||||
begin
|
||||
Result := ifUnknown;
|
||||
if (ChunkSize < SizeOf(TGifHeader)) then Exit;
|
||||
St.Position := 0;
|
||||
St.ReadBuffer(GifHeader, SizeOf(TGifHeader));
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then writeln('GifHeader.ID = ',GifHeader.ID);
|
||||
{$endif}
|
||||
if ((AnsiUpperCase(GifHeader.ID) = 'GIF87A') or (AnsiUpperCase(GifHeader.ID) = 'GIF89A')) then
|
||||
begin
|
||||
Width := LeToN(GifHeader.Width);
|
||||
Height := LeToN(GifHeader.Height);
|
||||
Result := ifGif;
|
||||
end;
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then writeln('MaybeGif: Result = ',Result);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function MaybeJpg(St: TStream; ChunkSize: Integer; out Width, Height: DWord): TImageFormat;
|
||||
const
|
||||
Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
|
||||
var
|
||||
JPGHeader: TJPGHeader;
|
||||
SOFHeader: TSOFHeader;
|
||||
B, SegType: byte;
|
||||
SegSize: Word; //Thumbnail Size
|
||||
SOF_Found: boolean;
|
||||
Dummy: array[0..65532] of byte; //Max segment length
|
||||
begin
|
||||
Result := ifUnknown;
|
||||
if (ChunkSize < SizeOf(TJpgHeader)) then Exit;
|
||||
St.Position := 0;
|
||||
|
||||
St.ReadBuffer(JPGHeader, SizeOf(TJPGHeader));
|
||||
if (JPGHeader[0] <> $FF) or (JPGHeader[1] <> $D8) then
|
||||
begin
|
||||
Exit;
|
||||
end;
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then writeln('StartOfImage Found');
|
||||
{$endif}
|
||||
SOF_Found := False;
|
||||
|
||||
//Find JFIFF and StartOfFrame (SOF) segment
|
||||
St.ReadBuffer(B,1);
|
||||
While (not SOF_Found) and (St.Position < St.Size) and (B = $FF) do //All segments start with $FF
|
||||
begin
|
||||
St.ReadBuffer(SegType,1);
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then write('Segment Type: '+IntToHex(SegType,2)+' ');
|
||||
{$endif}
|
||||
case SegType of
|
||||
$c0,$c1,$c2 {,$c3,$c5,$c6,$c7,$c9,$ca,$cb,$cd,$ce,$cf ???}:
|
||||
begin//StartOfFrame
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then write(' Found SOF');
|
||||
{$endif}
|
||||
St.ReadBuffer(SOFHeader,SizeOf(TSOFHeader));
|
||||
//Values are in BigEndian
|
||||
SOFHeader.Len := BeToN(SOFHeader.Len);
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then write(' Segment Length: '+IntToStr(SOFHeader.Len),' (StartOfFrame)');
|
||||
{$endif}
|
||||
//Values are in BigEndian
|
||||
SOFHeader.Height := BeToN(SOFHeader.Height);
|
||||
SOFHeader.Width := BeTon(SOFHeader.Width);
|
||||
|
||||
St.ReadBuffer(Dummy,SOFHeader.NrComponents*3);
|
||||
Width := SOFHeader.Width;
|
||||
Height := SOFHeader.Height;
|
||||
SOF_Found := true;
|
||||
end;
|
||||
|
||||
$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7:
|
||||
begin//Parameterless segment
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then write(' Parameterloos');
|
||||
{$endif}
|
||||
// Ignore
|
||||
end;
|
||||
$d9:
|
||||
begin//EndOfImage
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then write(' EndOfImage');
|
||||
{$endif}
|
||||
Break;
|
||||
end;
|
||||
$da:
|
||||
begin//Start Of Scan: JPG Data
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then write(' StartOfScan');
|
||||
{$endif}
|
||||
Break;
|
||||
end;
|
||||
else
|
||||
begin//Read segment into Dummy and ignore
|
||||
//The first 2 bytes represent the length of the segment
|
||||
//including the 2 length-bytes
|
||||
//Length bytes are in BigEndian format
|
||||
St.ReadBuffer(SegSize,SizeOf(SegSize));
|
||||
//SegSize := Swap(SegSize);
|
||||
SegSize := BeTon(SegSize);
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then write(' Segment Length: '+IntToStr(SegSize));
|
||||
{$endif}
|
||||
if SegSize > 2 then
|
||||
begin//Read until end of segemt
|
||||
SegSize := SegSize - 2;
|
||||
St.ReadBuffer(Dummy,SegSize);
|
||||
end;
|
||||
end;
|
||||
end;//case
|
||||
//Lees volgense segmentbegin, B moet nu $FF zijn ...
|
||||
St.ReadBuffer(B,1);
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then writeln;
|
||||
{$endif}
|
||||
end;//While
|
||||
//Found all info.
|
||||
if SOF_Found then Result := ifJpg;
|
||||
{$ifdef DebugPicsLib}
|
||||
if IsConsole then begin writeln; writeln(' End of Search for markers'); writeln; end;
|
||||
if IsConsole then writeln('MaybeJpg: Result = ',Result);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
type
|
||||
TMaybeFormatFunc = function(St: TStream; ChunkSize: Integer; out Width, Height: DWord): TImageFormat;
|
||||
TMaybeFormatFuncs = array[TImageFormat] of TMaybeFormatFunc;
|
||||
|
||||
const
|
||||
MaybeFormatFuncs: TMaybeFormatFuncs = (nil, @MaybeBmp, @MaybePng, @MaybeGif, @MaybeJpg);
|
||||
|
||||
function GetImageFormatAndDimensions(const St: TStream; const TryFirst: TImageFormat; out Width, Height: DWord): TImageFormat;
|
||||
var
|
||||
ChunkSize: Integer;
|
||||
Buf: PByte;
|
||||
ImgFormat: TImageFormat;
|
||||
begin
|
||||
ChunkSize := Max(SizeOf(TBitMapFileHeader) + SizeOf(TBitmapInfo),
|
||||
Max(SizeOf(TPngHeader),
|
||||
Max(SizeOf(TGifHeader), SizeOf(TJpgHeader))));
|
||||
{$ifdef DebugPicsLib}
|
||||
//if IsConsole then writeln('bmp: ', SizeOf(TBitMapFileHeader));
|
||||
//if IsConsole then writeln('gif: ', SizeOf(TGifHeader));
|
||||
//if IsConsole then writeln('png: ', SizeOf(TPngHeader));
|
||||
//if IsConsole then writeln('jpg: ', SizeOf(TJpgHeader));
|
||||
if IsConsole then writeln('chunksize ',chunksize);
|
||||
if IsConsole then writeln('TryFirst = ',TryFirst);
|
||||
{$endif}
|
||||
|
||||
ChunkSize := Max(ChunkSize, St.Size);
|
||||
Result := ifUnknown;
|
||||
if (TryFirst <> ifUnknown) then Result := MaybeFormatFuncs[TryFirst](St, ChunkSize, Width, Height);
|
||||
if (Result = ifUnknown) then
|
||||
begin
|
||||
for ImgFormat := Succ(Low(TImageFormat)) to High(TImageFormat) do
|
||||
begin
|
||||
if (ImgFormat <> TryFirst) then Result := MaybeFormatFuncs[ImgFormat](St, ChunkSize, Width, Height);
|
||||
if (Result <> ifUnknown) then Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetImageSizeAndFormat(const Fn: String; out Width, Height: dword): TImageFormat;
|
||||
var
|
||||
ImgStream: TFileStream;
|
||||
ImgFormat: TImageFormat;
|
||||
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));
|
||||
//Is it correct file format?
|
||||
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; //Ignore IO Errors at this point
|
||||
Exit;
|
||||
try
|
||||
ImgStream := TFileStream.Create(Fn,fmOpenRead or fmShareDenyNone);
|
||||
try
|
||||
ImgStream.Position := 0;
|
||||
ImgFormat := GetImageFormatAndDimensions(ImgStream, ExtToImageFormat(ExtractFileExt(Fn)), Width, Height);
|
||||
Result := ImgFormat;
|
||||
finally
|
||||
ImgStream.Free;
|
||||
end;
|
||||
end;//try...except
|
||||
except
|
||||
on EStreamError do Result := ifUnknown;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetGIFSize(const Fn: String; out Width, Height: dword): Boolean;
|
||||
var GifHeader: TGIFHeader;
|
||||
F: File;
|
||||
bRead: Integer;
|
||||
function GetImageSize(const Fn: String; out Width, Height: dword): Boolean;
|
||||
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);
|
||||
//Is correct file format?
|
||||
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; //Ignore IO Errors at this point
|
||||
Exit;
|
||||
end;
|
||||
end;//try...except
|
||||
Result := (GetImageSizeAndFormat(Fn, Width, Height) <> ifUnknown);
|
||||
end;
|
||||
|
||||
|
||||
function GetPNGSize(const Fn: String; out 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);
|
||||
//Is correct file format?
|
||||
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; //Ignore IO Errors at this point
|
||||
Exit;
|
||||
end;
|
||||
end;//try...except
|
||||
end;
|
||||
|
||||
|
||||
function GetJPGSize(const Fn: String; out Width, Height: dword): Boolean;
|
||||
var F: File;
|
||||
bRead: Integer;
|
||||
JPGHeader: TJPGHeader;
|
||||
SOFHeader: TSOFHeader;
|
||||
B, SegType: byte;
|
||||
SegSize: Word; //Thumbnail Size
|
||||
SOF_Found: boolean;
|
||||
Dummy: array[0..65532] of byte; //Max segment length
|
||||
begin
|
||||
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;
|
||||
SOF_Found := False;
|
||||
//Find JFIFF and 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) do //Alle segments start with $FF
|
||||
begin
|
||||
BlockRead(F,SegType,1,bRead);
|
||||
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);
|
||||
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;
|
||||
|
||||
$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7:
|
||||
begin//Parameterless segment
|
||||
// Just ignore
|
||||
end;
|
||||
$d9:
|
||||
begin//EndOfImage
|
||||
Break;
|
||||
end;
|
||||
$da:
|
||||
begin//Start Of Scan: JPG Data
|
||||
Break;
|
||||
end;
|
||||
else
|
||||
begin//Read segment into dummy and skip
|
||||
//Firts 2 bytes are lenggth of segment
|
||||
//including the 2 length-bytes
|
||||
//Lengthbytes are in Motorola format (Hi-Lo)
|
||||
BlockRead(F,SegSize,SizeOf(SegSize),bRead);
|
||||
if bRead <> SizeOf(SegSize) then Raise EInOutError.Create('');
|
||||
SegSize := Swap(SegSize);
|
||||
if SegSize > 2 then
|
||||
begin//Read to end of segment
|
||||
SegSize := SegSize - 2;
|
||||
BlockRead(F,Dummy,SegSize,bRead);
|
||||
if bRead <> SegSize then Raise EInOutError.Create('');
|
||||
end;
|
||||
end;
|
||||
end;//case
|
||||
//Read next segment, B shold be $FF right now ...
|
||||
BlockRead(F,B,1,bRead);
|
||||
if bRead <> 1 then Raise EInoutError.Create('');
|
||||
end;//While
|
||||
//Did we find all info, and file format is correct?
|
||||
if {JFIF_Found and} SOF_Found then Result := True;
|
||||
CloseFile(F);
|
||||
Except
|
||||
on EInOutError do
|
||||
begin
|
||||
{$I-}
|
||||
CloseFile(F);
|
||||
InOutRes := 0; //Ignore IO Errors at this point
|
||||
Exit;
|
||||
end;
|
||||
end;//try...except
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user