unit LazEdit_PicsLib; { $DEFINE DebugPicsLib} interface uses SysUtils, Classes, Math, LazUtf8Classes; type TImageFormat = (ifUnknown, ifBmp, ifPng, ifGif, ifJpg); function GetImageSize(const Fn: String; out Width, Height: dword): Boolean; function GetImageSizeAndFormat(const Fn: String; out Width, Height: dword): TImageFormat; implementation 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 if AnsiUpperCase(Ext) = '.BMP' then begin Result := ifBmp; end else if AnsiUpperCase(Ext) = '.GIF' then begin Result := ifGif; end else if (AnsiUpperCase(Ext) = '.JPG') or (AnsiUpperCase(Ext) = '.JPEG') then begin Result := ifJpg; end else if AnsiUpperCase(Ext) = '.PNG' then begin Result := ifPng; end else begin Result := ifUnknown; end; end; 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: TFileStreamUtf8; ImgFormat: TImageFormat; begin Width := 0; Height := 0; try ImgStream := TFileStreamUtf8.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.