paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 13:39:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Patch to read RGB files correctly from Colin Western

Browse Source 
git-svn-id: trunk@378 -
This commit is contained in:
michael 2005-06-11 13:08:50 +00:00
parent 31d3e72e56
commit 000e67d182
1 changed files with 30 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
fcl/image/fpreadpnm.pp
View File

@ -35,7 +35,7 @@ type
FWidth : Integer;
FHeight : Integer;
protected
FMaxVal : Integer;
FMaxVal : Cardinal;
FBitPP : Byte;
FScanLineSize : Integer;
FScanLine : PByte;
@ -131,9 +131,7 @@ end;
procedure TFPReaderPNM.InternalRead(Stream:TStream;Img:TFPCustomImage);
var
Row,Coulumn,nBpLine,ReadSize:Integer;
aColor:TFPcolor;
aLine:PByte;
Row:Integer;
begin
ReadHeader(Stream);
@ -199,7 +197,23 @@ procedure TFPReaderPNM.WriteScanLine(Row : Integer; Img : TFPCustomImage);
Var
C : TFPColor;
L : Cardinal;
FHalfMaxVal : Word;
Scale: Cardinal;
function ScaleByte(B: Byte):Word;
begin
if FMaxVal = 255 then
Result := (B shl 8) or B { As used for reading .BMP files }
else { Mimic the above with multiplications }
Result := (B*(FMaxVal+1) + B) * 65535 div Scale;
end;
function ScaleWord(W: Word):Word;
begin
if FMaxVal = 65535 then
Result := W
else { Mimic the above with multiplications }
Result := Int64(W*(FMaxVal+1) + W) * 65535 div Scale;
end;
Procedure ByteBnWScanLine;
@ -238,7 +252,7 @@ Var
P:=PWord(FScanLine);
For I:=0 to FWidth-1 do
begin
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF;
L:=ScaleWord(P^);
C.Red:=L;
C.Green:=L;
C.Blue:=L;
@ -257,14 +271,11 @@ Var
P:=PWord(FScanLine);
For I:=0 to FWidth-1 do
begin
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF;
C.Red:=L;
C.Red:=ScaleWord(P^);
Inc(P);
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF;
C.Green:=L;
C.Green:=ScaleWord(P^);
Inc(P);
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF;
C.Blue:=L;
C.Blue:=ScaleWord(P^);
Img.Colors[I,Row]:=C;
Inc(P);
end;
@ -280,7 +291,7 @@ Var
P:=PByte(FScanLine);
For I:=0 to FWidth-1 do
begin
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF;
L:=ScaleByte(P^);
C.Red:=L;
C.Green:=L;
C.Blue:=L;
@ -299,14 +310,11 @@ Var
P:=PByte(FScanLine);
For I:=0 to FWidth-1 do
begin
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF;
C.Red:=L;
C.Red:=ScaleByte(P^);
Inc(P);
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF;
C.Green:=L;
C.Green:=ScaleByte(P^);
Inc(P);
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF;
C.Blue:=L;
C.Blue:=ScaleByte(P^);
Img.Colors[I,Row]:=C;
Inc(P);
end;
@ -314,17 +322,17 @@ Var
begin
C.Alpha:=AlphaOpaque;
FHalfMaxVal:=(FMaxVal div 2);
Scale := FMaxVal*(FMaxVal+1) + FMaxVal;
Case FBitmapType of
1 : ;
2 : WordGrayScanline;
3 : WordRGBScanline;
4 : ByteBnWScanLine;
5 : If FBitPP=1 then
5 : If FBitPP=8 then
ByteGrayScanLine
else
WordGrayScanLine;
6 : If FBitPP=3 then
6 : If FBitPP=24 then
ByteRGBScanLine
else
WordRGBScanLine;