paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 05:59:27 +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; FWidth : Integer;
FHeight : Integer; FHeight : Integer;
protected protected
FMaxVal : Integer; FMaxVal : Cardinal;
FBitPP : Byte; FBitPP : Byte;
FScanLineSize : Integer; FScanLineSize : Integer;
FScanLine : PByte; FScanLine : PByte;
@ -131,9 +131,7 @@ end;
procedure TFPReaderPNM.InternalRead(Stream:TStream;Img:TFPCustomImage); procedure TFPReaderPNM.InternalRead(Stream:TStream;Img:TFPCustomImage);
var var
Row,Coulumn,nBpLine,ReadSize:Integer; Row:Integer;
aColor:TFPcolor;
aLine:PByte;
begin begin
ReadHeader(Stream); ReadHeader(Stream);
@ -199,7 +197,23 @@ procedure TFPReaderPNM.WriteScanLine(Row : Integer; Img : TFPCustomImage);
Var Var
C : TFPColor; C : TFPColor;
L : Cardinal; 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; Procedure ByteBnWScanLine;
@ -238,7 +252,7 @@ Var
P:=PWord(FScanLine); P:=PWord(FScanLine);
For I:=0 to FWidth-1 do For I:=0 to FWidth-1 do
begin begin
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF; L:=ScaleWord(P^);
C.Red:=L; C.Red:=L;
C.Green:=L; C.Green:=L;
C.Blue:=L; C.Blue:=L;
@ -257,14 +271,11 @@ Var
P:=PWord(FScanLine); P:=PWord(FScanLine);
For I:=0 to FWidth-1 do For I:=0 to FWidth-1 do
begin begin
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF; C.Red:=ScaleWord(P^);
C.Red:=L;
Inc(P); Inc(P);
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF; C.Green:=ScaleWord(P^);
C.Green:=L;
Inc(P); Inc(P);
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF; C.Blue:=ScaleWord(P^);
C.Blue:=L;
Img.Colors[I,Row]:=C; Img.Colors[I,Row]:=C;
Inc(P); Inc(P);
end; end;
@ -280,7 +291,7 @@ Var
P:=PByte(FScanLine); P:=PByte(FScanLine);
For I:=0 to FWidth-1 do For I:=0 to FWidth-1 do
begin begin
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF; L:=ScaleByte(P^);
C.Red:=L; C.Red:=L;
C.Green:=L; C.Green:=L;
C.Blue:=L; C.Blue:=L;
@ -299,14 +310,11 @@ Var
P:=PByte(FScanLine); P:=PByte(FScanLine);
For I:=0 to FWidth-1 do For I:=0 to FWidth-1 do
begin begin
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF; C.Red:=ScaleByte(P^);
C.Red:=L;
Inc(P); Inc(P);
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF; C.Green:=ScaleByte(P^);
C.Green:=L;
Inc(P); Inc(P);
L:=(((P^ shl 16)+FHalfMaxVal) div FMaxVal) and $FFFF; C.Blue:=ScaleByte(P^);
C.Blue:=L;
Img.Colors[I,Row]:=C; Img.Colors[I,Row]:=C;
Inc(P); Inc(P);
end; end;
@ -314,17 +322,17 @@ Var
begin begin
C.Alpha:=AlphaOpaque; C.Alpha:=AlphaOpaque;
FHalfMaxVal:=(FMaxVal div 2); Scale := FMaxVal*(FMaxVal+1) + FMaxVal;
Case FBitmapType of Case FBitmapType of
1 : ; 1 : ;
2 : WordGrayScanline; 2 : WordGrayScanline;
3 : WordRGBScanline; 3 : WordRGBScanline;
4 : ByteBnWScanLine; 4 : ByteBnWScanLine;
5 : If FBitPP=1 then 5 : If FBitPP=8 then
ByteGrayScanLine ByteGrayScanLine
else else
WordGrayScanLine; WordGrayScanLine;
6 : If FBitPP=3 then 6 : If FBitPP=24 then
ByteRGBScanLine ByteRGBScanLine
else else
WordRGBScanLine; WordRGBScanLine;