paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-27 19:10:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* own solution that resolves #40127 :

Browse Source 
- attempt to read scanlines through the buffer till it is drained for types 4,5,6
This commit is contained in:
marcoonthegit 2023-04-28 22:17:50 +02:00
parent f0f42ca2a2
commit ec7f2e6871
1 changed files with 27 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
packages/fcl-image/src/fpreadpnm.pp
View File

@ -46,6 +46,7 @@ type
function DropWhiteSpaces(Stream: TStream): Char;
function ReadChar(Stream: TStream): Char;
function ReadInteger(Stream: TStream): Integer;
procedure ReadScanlineBuffer(Stream: TStream;p:Pbyte;Len:Integer);
protected
FMaxVal : Cardinal;
FBitPP : Byte;
@ -123,7 +124,28 @@ begin
Result:=StrToInt(s);
end;
Function TFPReaderPNM.ReadChar(Stream : TStream) : Char;
procedure TFPReaderPNM.ReadScanlineBuffer(Stream: TStream;p:Pbyte;Len:Integer);
// after the header read, there are still bytes in the buffer.
// drain the buffer before going for direct stream reads.
var BytesLeft : integer;
begin
BytesLeft:=FBufLen-FBufPos;
if BytesLeft>0 then
begin
if BytesLeft>Len then
BytesLeft:=Len;
Move (FBuffer[FBufPos],p^,BytesLeft);
Dec(Len,BytesLeft);
Inc(FBufPos,BytesLeft);
Inc(p,BytesLeft);
if Len>0 then
Stream.ReadBuffer(p^,len);
end
else
Stream.ReadBuffer(p^,len);
end;
function TFPReaderPNM.ReadChar(Stream: TStream): Char;
begin
If (FBufPos>=FBufLen) then
@ -245,8 +267,10 @@ begin
Inc(P)
end;
end;
4,5,6 :
Stream.ReadBuffer(FScanLine^,FScanLineSize);
4,5,6 : if FBufPos>=FBufLen then // still bytes in buffer?
Stream.ReadBuffer(FScanLine^,FScanLineSize)
else
ReadScanLineBuffer(Stream,FScanLine,FScanLineSize);
end;
end;