paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 07:18:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL/graphics: Workaround for FPReaderBMP not implementing the InternalSize class function before 3.3.1 (issue 40685)

Browse Source
This commit is contained in:
wp_xyz 2024-11-08 18:18:53 +01:00
parent 15be94c0ad
commit a153126d5a
1 changed files with 33 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
lcl/intfgraphics.pas
View File

@ -522,7 +522,8 @@ type
property MaskMode: TLazReaderMaskMode read FMaskMode write FMaskMode;
property UpdateDescription: Boolean read GetUpdateDescription write SetUpdateDescription;
end;
{ TLazReaderBMP }
TLazReaderBMP = class(TLazReaderDIB)
@ -531,6 +532,9 @@ type
protected
function InternalCheck(Stream: TStream) : boolean; override;
procedure InternalReadHead; override;
{$IF FPC_FullVersion < 30301}
class function InternalSize(Stream: TStream): TPoint; override;
{$IFEND}
end;
{ TLazWriterBMP }
@ -5086,6 +5090,34 @@ begin
then TheStream.Position := FDataOffset;
end;
{$IF FPC_FullVersion < 30301}
class function TLazReaderBMP.InternalSize (Stream: TStream): TPoint;
var
fileHdr: TBitmapFileHeader;
infoHdr: TBitmapInfoHeader;
n: Int64;
StartPos: Int64;
begin
Result := Point(0, 0);
StartPos := Stream.Position;
try
n := Stream.Read(fileHdr, SizeOf(fileHdr));
if n <> SizeOf(fileHdr) then exit;
if {$IFDEF ENDIAN_BIG}swap(fileHdr.bfType){$ELSE}fileHdr.bfType{$ENDIF} <> BMmagic then exit;
n := Stream.Read(infoHdr, SizeOf(infoHdr));
if n <> SizeOf(infoHdr) then exit;
{$IFDEF ENDIAN_BIG}
Result := Point(swap(infoHdr.biWidth), swap(infoHdr.biHeight));
{$ELSE}
Result := Point(infoHdr.biWidth, infoHdr.biHeight);
{$ENDIF}
finally
Stream.Position := StartPos;
end;
end;
{$IFEND}
{ TLazWriterBMP }
procedure TLazWriterBMP.Finalize;