pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazEdit: Lazedit_PicsLib.pp: refactoring and making it Endian safe

Browse Source 
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
2012-11-29 18:32:01 +00:00
parent 9426e4f37c
commit c89df7e568
1 changed files with 315 additions and 270 deletions
Download Patch File Download Diff File Expand all files Collapse all files

391
applications/lazedit/lazedit_picslib.pp
View File

@ -1,23 +1,26 @@
unit LazEdit_PicsLib; unit LazEdit_PicsLib;
{ $DEFINE DEBUG}
{ $DEFINE DebugPicsLib}
interface 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 GetImageSize(const Fn: String; out Width, Height: dword): Boolean;
function GetImageSizeAndFormat(const Fn: String; out Width, Height: dword): TImageFormat;
implementation implementation
uses SysUtils, Classes;
type TBitmapFileHeader = Packed Record
type
TBitmapFileHeader = Packed Record
ID: word; ID: word;
FileSize: dword; FileSize: dword;
Reserved: dword; Reserved: dword;
@ -64,154 +67,119 @@ type TBitmapFileHeader = Packed Record
NrComponents: byte; NrComponents: byte;
end; end;
function ExtToImageFormat(const Ext: String): TImageFormat;
function MotorolaToIntelDW(DW: dword): dword;
var HiWd, LoWd: word;
begin begin
HiWd := HiWord(DW); if AnsiUpperCase(Ext) = '.BMP' then
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 begin
if AnsiUpperCase(ExtractFileExt(Fn)) = '.BMP' then Result := ifBmp;
begin
Result := GetBMPSize(Fn, Width, Height);
end end
else if AnsiUpperCase(ExtractFileExt(Fn)) = '.GIF' then else if AnsiUpperCase(Ext) = '.GIF' then
begin begin
Result := GetGIFSize(Fn, Width, Height); Result := ifGif;
end end
else if (AnsiUpperCase(ExtractFileExt(Fn)) = '.JPG') else if (AnsiUpperCase(Ext) = '.JPG')
or (AnsiUpperCase(ExtractFileExt(Fn)) = '.JPEG') then or (AnsiUpperCase(Ext) = '.JPEG') then
begin begin
Result := GetJPGSize(Fn, Width, Height); Result := ifJpg;
end end
else if AnsiUpperCase(ExtractFileExt(Fn)) = '.PNG' then else if AnsiUpperCase(Ext) = '.PNG' then
begin begin
Result := GetPNGSize(Fn, Width, Height); Result := ifPng;
end end
else else
begin begin
Width := 0; Result := ifUnknown;
Height := 0;
Result := False;
end; end;
end; end;
function GetBMPSize(const Fn: String; out Width, Height: dword): Boolean;
var BitmapFileHeader: TBitmapFileHeader; function MaybeBmp(St: TStream; ChunkSize: Integer; out Width, Height: DWord): TImageFormat;
BitmapInfo: TBitmapInfo; var
F: File; BFH: TBitmapFileHeader;
bRead: Integer; BInfo: TBitmapInfo;
IDStr: String; IDStr: String;
begin begin
Result := False; Result := ifUnknown;
Width := 0; if (ChunkSize < (SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfo))) then Exit;
Height := 0; St.Position := 0;
Try St.ReadBuffer(BFH, Sizeof(TBitmapFileHeader));
AssignFile(F,Fn); St.ReadBuffer(BInfo, SizeOf(TBitmapInfo));
FileMode := fmOpenRead or fmShareDenyWrite; BFH.ID := LeToN(BFH.ID);
Reset(F,1); IDStr := Char(Lo(BFH.ID)) + Char(Hi(BFH.ID));
BlockRead(F,BitmapFileHeader,SizeOf(TBitmapFileHeader),bRead); {$ifdef DebugPicsLib}
if bRead <> SizeOf(TBitmapFileHeader) then Raise EInOutError.Create(''); if IsConsole then writeln('IDStr = ',idstr);
BlockRead(F,BitmapInfo,SizeOf(TBitmapInfo),bRead); if IsConsole then writeln('BInfo.BitmapHeaderSize = $',IntToHex(BInfo.BitmapHeaderSize,2));
if bRead <> SizeOf(TBitmapInfo) then Raise EInOutError.Create(''); if IsConsole then writeln('BInfo.BitsPerPixel = ',BInfo.BitsPerPixel);
CloseFile(F); {$endif}
IDStr := Char(Lo(BitmapFileHeader.ID)) + Char(Hi(BitmapFileHeader.ID)); BInfo.BitmapHeaderSize := LeToN(BInfo.BitmapHeaderSize);
//Is it correct file format? BInfo.BitsPerPixel := LeToN(BInfo.BitsPerPixel);
if (not (IDStr = 'BM') or (IDStr = 'BA')) or if ((IDStr = 'BM') or (IDStr = 'BA')) and
(not (BitmapInfo.BitmapHeaderSize in [$28,$0c,$f0])) or (BInfo.BitmapHeaderSize in [$28,$0c,$f0]) and
(not (BitmapInfo.BitsPerPixel in [1,4,8,16,24,32])) then Exit; (BInfo.BitsPerPixel in [1,4,8,16,24,32])then
Width := BitmapInfo.Width;
Height := BitmapInfo.Height;
Result := True;
Except
on EInOutError do
begin begin
{$I-} Width := LeToN(BInfo.Width);
CloseFile(F); Height := LeToN(BInfo.Height);
InOutRes := 0; //Ignore IO Errors at this point Result := ifBmp;
Exit;
end; end;
end;//try...except {$ifdef DebugPicsLib}
if IsConsole then writeln('MaybeBmp: Result = ',Result);
{$endif}
end; end;
function GetGIFSize(const Fn: String; out Width, Height: dword): Boolean;
var GifHeader: TGIFHeader; function MaybePng(St: TStream; ChunkSize: Integer; out Width, Height: DWord): TImageFormat;
F: File; var
bRead: Integer; PngHeader: TPngHeader;
begin begin
Result := False; Result := ifUnknown;
Width := 0; if (ChunkSize < SizeOf(TPngHeader)) then Exit;
Height := 0; St.Position := 0;
Try St.ReadBuffer(PngHeader, SizeOf(TPngHeader));
AssignFile(F,Fn); {$ifdef DebugPicsLib}
FileMode := fmOpenRead or fmShareDenyWrite; if IsConsole then writeln('PNGHeader.ID= ',PNGHeader.ID);
Reset(F,1); if IsConsole then writeln('PNGHeader.ChunkType = ',PNGHeader.ChunkType);
BlockRead(F,GifHeader,SizeOf(TGIFHeader),bRead); {$endif}
if bRead <> SizeOf(TGIFHeader) then Raise EInOutError.Create(''); if (AnsiUpperCase(PNGHeader.ID) = #137'PNG'#13#10#26#10) or
CloseFile(F); (AnsiUpperCase(PNGHeader.ChunkType) = 'IHDR') then
//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 begin
{$I-} //Vaues are in BigEndian format
CloseFile(F); Width := BeToN(PNGHeader.Width);
InOutRes := 0; //Ignore IO Errors at this point Height := BeToN(PNGHeader.Height);
Exit; Result := ifPng;
end; end;
end;//try...except {$ifdef DebugPicsLib}
if IsConsole then writeln('MaybePng: Result = ',Result);
{$endif}
end; end;
function MaybeGif(St: TStream; ChunkSize: Integer; out Width, Height: DWord): TImageFormat;
function GetPNGSize(const Fn: String; out Width, Height: dword): Boolean; var
var PNGHeader: TPNGHeader; GifHeader: TGifHeader;
F: File;
bRead: Integer;
begin begin
Result := False; Result := ifUnknown;
Width := 0; if (ChunkSize < SizeOf(TGifHeader)) then Exit;
Height := 0; St.Position := 0;
Try St.ReadBuffer(GifHeader, SizeOf(TGifHeader));
AssignFile(F,Fn); {$ifdef DebugPicsLib}
FileMode := fmOpenRead or fmShareDenyWrite; if IsConsole then writeln('GifHeader.ID = ',GifHeader.ID);
Reset(F,1); {$endif}
BlockRead(F,PNGHeader,SizeOf(TPNGHeader),bRead); if ((AnsiUpperCase(GifHeader.ID) = 'GIF87A') or (AnsiUpperCase(GifHeader.ID) = 'GIF89A')) then
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 begin
{$I-} Width := LeToN(GifHeader.Width);
CloseFile(F); Height := LeToN(GifHeader.Height);
InOutRes := 0; //Ignore IO Errors at this point Result := ifGif;
Exit;
end; end;
end;//try...except {$ifdef DebugPicsLib}
if IsConsole then writeln('MaybeGif: Result = ',Result);
{$endif}
end; end;
function MaybeJpg(St: TStream; ChunkSize: Integer; out Width, Height: DWord): TImageFormat;
function GetJPGSize(const Fn: String; out Width, Height: dword): Boolean; const
var F: File; Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
bRead: Integer; var
JPGHeader: TJPGHeader; JPGHeader: TJPGHeader;
SOFHeader: TSOFHeader; SOFHeader: TSOFHeader;
B, SegType: byte; B, SegType: byte;
@ -219,39 +187,45 @@ var F: File;
SOF_Found: boolean; SOF_Found: boolean;
Dummy: array[0..65532] of byte; //Max segment length Dummy: array[0..65532] of byte; //Max segment length
begin begin
Result := False; Result := ifUnknown;
Width := 0; if (ChunkSize < SizeOf(TJpgHeader)) then Exit;
Height := 0; St.Position := 0;
Try
AssignFile(F,Fn); St.ReadBuffer(JPGHeader, SizeOf(TJPGHeader));
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 if (JPGHeader[0] <> $FF) or (JPGHeader[1] <> $D8) then
begin begin
CloseFile(F);
Exit; Exit;
end; end;
{$ifdef DebugPicsLib}
if IsConsole then writeln('StartOfImage Found');
{$endif}
SOF_Found := False; SOF_Found := False;
//Find JFIFF and StartOfFrame (SOF) segment //Find JFIFF and StartOfFrame (SOF) segment
BlockRead(F,B,1,bRead); St.ReadBuffer(B,1);
if bRead <> 1 then Raise EInoutError.Create(''); While (not SOF_Found) and (St.Position < St.Size) and (B = $FF) do //All segments start with $FF
While (not EOF(F)) and (B = $FF) and not (SOF_Found) do //Alle segments start with $FF
begin begin
BlockRead(F,SegType,1,bRead); St.ReadBuffer(SegType,1);
if bRead <> 1 then Raise EInoutError.Create(''); {$ifdef DebugPicsLib}
if IsConsole then write('Segment Type: '+IntToHex(SegType,2)+' ');
{$endif}
case SegType of case SegType of
$c0,$c1,$c2 {,$c3,$c5,$c6,$c7,$c9,$ca,$cb,$cd,$ce,$cf ???}: $c0,$c1,$c2 {,$c3,$c5,$c6,$c7,$c9,$ca,$cb,$cd,$ce,$cf ???}:
begin//StartOfFrame begin//StartOfFrame
BlockRead(F,SOFHeader,SizeOf(TSOFHeader),bRead); {$ifdef DebugPicsLib}
if bRead <> SizeOf(TSOFHeader) then Raise EInOutError.Create(''); if IsConsole then write(' Found SOF');
//Motorola -> Intel {$endif}
SOFHeader.Len := Swap(SOFHeader.Len); St.ReadBuffer(SOFHeader,SizeOf(TSOFHeader));
SOFHeader.Height := Swap(SOFHeader.Height); //Values are in BigEndian
SOFHeader.Width := Swap(SOFHeader.Width); SOFHeader.Len := BeToN(SOFHeader.Len);
BlockRead(F,Dummy,SOFHeader.NrComponents*3,bRead); {$ifdef DebugPicsLib}
if bRead <> (SOFHeader.NrComponents * 3) then Raise EInOutError.Create(''); 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; Width := SOFHeader.Width;
Height := SOFHeader.Height; Height := SOFHeader.Height;
SOF_Found := true; SOF_Found := true;
@ -259,51 +233,122 @@ begin
$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7: $01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7:
begin//Parameterless segment begin//Parameterless segment
// Just ignore {$ifdef DebugPicsLib}
if IsConsole then write(' Parameterloos');
{$endif}
// Ignore
end; end;
$d9: $d9:
begin//EndOfImage begin//EndOfImage
{$ifdef DebugPicsLib}
if IsConsole then write(' EndOfImage');
{$endif}
Break; Break;
end; end;
$da: $da:
begin//Start Of Scan: JPG Data begin//Start Of Scan: JPG Data
{$ifdef DebugPicsLib}
if IsConsole then write(' StartOfScan');
{$endif}
Break; Break;
end; end;
else else
begin//Read segment into dummy and skip begin//Read segment into Dummy and ignore
//Firts 2 bytes are lenggth of segment //The first 2 bytes represent the length of the segment
//including the 2 length-bytes //including the 2 length-bytes
//Lengthbytes are in Motorola format (Hi-Lo) //Length bytes are in BigEndian format
BlockRead(F,SegSize,SizeOf(SegSize),bRead); St.ReadBuffer(SegSize,SizeOf(SegSize));
if bRead <> SizeOf(SegSize) then Raise EInOutError.Create(''); //SegSize := Swap(SegSize);
SegSize := Swap(SegSize); SegSize := BeTon(SegSize);
{$ifdef DebugPicsLib}
if IsConsole then write(' Segment Length: '+IntToStr(SegSize));
{$endif}
if SegSize > 2 then if SegSize > 2 then
begin//Read to end of segment begin//Read until end of segemt
SegSize := SegSize - 2; SegSize := SegSize - 2;
BlockRead(F,Dummy,SegSize,bRead); St.ReadBuffer(Dummy,SegSize);
if bRead <> SegSize then Raise EInOutError.Create('');
end; end;
end; end;
end;//case end;//case
//Read next segment, B shold be $FF right now ... //Lees volgense segmentbegin, B moet nu $FF zijn ...
BlockRead(F,B,1,bRead); St.ReadBuffer(B,1);
if bRead <> 1 then Raise EInoutError.Create(''); {$ifdef DebugPicsLib}
if IsConsole then writeln;
{$endif}
end;//While end;//While
//Did we find all info, and file format is correct? //Found all info.
if {JFIF_Found and} SOF_Found then Result := True; if SOF_Found then Result := ifJpg;
CloseFile(F); {$ifdef DebugPicsLib}
Except if IsConsole then begin writeln; writeln(' End of Search for markers'); writeln; end;
on EInOutError do if IsConsole then writeln('MaybeJpg: Result = ',Result);
begin {$endif}
{$I-}
CloseFile(F);
InOutRes := 0; //Ignore IO Errors at this point
Exit;
end;
end;//try...except
end; 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
Width := 0;
Height := 0;
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;
except
on EStreamError do Result := ifUnknown;
end;
end;
function GetImageSize(const Fn: String; out Width, Height: dword): Boolean;
begin
Result := (GetImageSizeAndFormat(Fn, Width, Height) <> ifUnknown);
end;
end. end.