2012-02-29 11:51:13 +00:00
|
|
|
unit LazEdit_PicsLib;
|
2012-11-29 18:32:01 +00:00
|
|
|
|
|
|
|
{ $DEFINE DebugPicsLib}
|
|
|
|
|
2012-02-29 11:51:13 +00:00
|
|
|
interface
|
|
|
|
|
2013-06-27 16:49:36 +00:00
|
|
|
uses SysUtils, Classes, Math, LazUtf8Classes;
|
2012-02-29 11:51:13 +00:00
|
|
|
|
2012-11-29 18:32:01 +00:00
|
|
|
type
|
|
|
|
TImageFormat = (ifUnknown, ifBmp, ifPng, ifGif, ifJpg);
|
2012-02-29 11:51:13 +00:00
|
|
|
|
2012-11-29 18:32:01 +00:00
|
|
|
function GetImageSize(const Fn: String; out Width, Height: dword): Boolean;
|
|
|
|
function GetImageSizeAndFormat(const Fn: String; out Width, Height: dword): TImageFormat;
|
2012-02-29 11:51:13 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
implementation
|
|
|
|
|
|
|
|
|
|
|
|
|
2012-11-29 18:32:01 +00:00
|
|
|
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;
|
2012-02-29 11:51:13 +00:00
|
|
|
begin
|
2012-11-29 18:32:01 +00:00
|
|
|
if AnsiUpperCase(Ext) = '.BMP' then
|
2012-02-29 11:51:13 +00:00
|
|
|
begin
|
2012-11-29 18:32:01 +00:00
|
|
|
Result := ifBmp;
|
2012-02-29 11:51:13 +00:00
|
|
|
end
|
2012-11-29 18:32:01 +00:00
|
|
|
else if AnsiUpperCase(Ext) = '.GIF' then
|
2012-02-29 11:51:13 +00:00
|
|
|
begin
|
2012-11-29 18:32:01 +00:00
|
|
|
Result := ifGif;
|
2012-02-29 11:51:13 +00:00
|
|
|
end
|
2012-11-29 18:32:01 +00:00
|
|
|
else if (AnsiUpperCase(Ext) = '.JPG')
|
|
|
|
or (AnsiUpperCase(Ext) = '.JPEG') then
|
2012-02-29 11:51:13 +00:00
|
|
|
begin
|
2012-11-29 18:32:01 +00:00
|
|
|
Result := ifJpg;
|
2012-02-29 11:51:13 +00:00
|
|
|
end
|
2012-11-29 18:32:01 +00:00
|
|
|
else if AnsiUpperCase(Ext) = '.PNG' then
|
2012-02-29 11:51:13 +00:00
|
|
|
begin
|
2012-11-29 18:32:01 +00:00
|
|
|
Result := ifPng;
|
2012-02-29 11:51:13 +00:00
|
|
|
end
|
|
|
|
else
|
|
|
|
begin
|
2012-11-29 18:32:01 +00:00
|
|
|
Result := ifUnknown;
|
|
|
|
end;
|
2012-02-29 11:51:13 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
|
2012-11-29 18:32:01 +00:00
|
|
|
|
|
|
|
function MaybeBmp(St: TStream; ChunkSize: Integer; out Width, Height: DWord): TImageFormat;
|
|
|
|
var
|
|
|
|
BFH: TBitmapFileHeader;
|
|
|
|
BInfo: TBitmapInfo;
|
|
|
|
IDStr: String;
|
2012-02-29 11:51:13 +00:00
|
|
|
begin
|
2012-11-29 18:32:01 +00:00
|
|
|
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}
|
2012-02-29 11:51:13 +00:00
|
|
|
end;
|
|
|
|
|
2012-11-29 18:32:01 +00:00
|
|
|
|
|
|
|
function MaybePng(St: TStream; ChunkSize: Integer; out Width, Height: DWord): TImageFormat;
|
|
|
|
var
|
|
|
|
PngHeader: TPngHeader;
|
2012-02-29 11:51:13 +00:00
|
|
|
begin
|
2012-11-29 18:32:01 +00:00
|
|
|
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}
|
2012-02-29 11:51:13 +00:00
|
|
|
end;
|
|
|
|
|
2012-11-29 18:32:01 +00:00
|
|
|
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;
|
2012-02-29 11:51:13 +00:00
|
|
|
|
2012-11-29 18:32:01 +00:00
|
|
|
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
|
2012-02-29 11:51:13 +00:00
|
|
|
begin
|
2012-11-29 18:32:01 +00:00
|
|
|
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}
|
2012-02-29 11:51:13 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
|
2012-11-29 18:32:01 +00:00
|
|
|
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;
|
2012-02-29 11:51:13 +00:00
|
|
|
begin
|
2012-11-29 18:32:01 +00:00
|
|
|
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
|
2012-02-29 11:51:13 +00:00
|
|
|
begin
|
2012-11-29 18:32:01 +00:00
|
|
|
if (ImgFormat <> TryFirst) then Result := MaybeFormatFuncs[ImgFormat](St, ChunkSize, Width, Height);
|
|
|
|
if (Result <> ifUnknown) then Break;
|
2012-02-29 11:51:13 +00:00
|
|
|
end;
|
2012-11-29 18:32:01 +00:00
|
|
|
end;
|
|
|
|
end;
|
2012-02-29 11:51:13 +00:00
|
|
|
|
2012-11-29 18:32:01 +00:00
|
|
|
function GetImageSizeAndFormat(const Fn: String; out Width, Height: dword): TImageFormat;
|
|
|
|
var
|
2013-06-27 16:49:36 +00:00
|
|
|
ImgStream: TFileStreamUtf8;
|
2012-11-29 18:32:01 +00:00
|
|
|
ImgFormat: TImageFormat;
|
|
|
|
begin
|
|
|
|
Width := 0;
|
|
|
|
Height := 0;
|
|
|
|
try
|
2013-06-27 16:49:36 +00:00
|
|
|
ImgStream := TFileStreamUtf8.Create(Fn,fmOpenRead or fmShareDenyNone);
|
2012-11-29 18:32:01 +00:00
|
|
|
try
|
|
|
|
ImgStream.Position := 0;
|
|
|
|
ImgFormat := GetImageFormatAndDimensions(ImgStream, ExtToImageFormat(ExtractFileExt(Fn)), Width, Height);
|
|
|
|
Result := ImgFormat;
|
|
|
|
finally
|
|
|
|
ImgStream.Free;
|
2012-02-29 11:51:13 +00:00
|
|
|
end;
|
2012-11-29 18:32:01 +00:00
|
|
|
except
|
|
|
|
on EStreamError do Result := ifUnknown;
|
|
|
|
end;
|
2012-02-29 11:51:13 +00:00
|
|
|
end;
|
|
|
|
|
2012-11-29 18:32:01 +00:00
|
|
|
function GetImageSize(const Fn: String; out Width, Height: dword): Boolean;
|
|
|
|
begin
|
|
|
|
Result := (GetImageSizeAndFormat(Fn, Width, Height) <> ifUnknown);
|
|
|
|
end;
|
2012-02-29 11:51:13 +00:00
|
|
|
|
|
|
|
end.
|
|
|
|
|
|
|
|
|