mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 17:06:14 +02:00
+ Patch to read RGB files correctly from Colin Western
git-svn-id: trunk@378 -
This commit is contained in:
parent
31d3e72e56
commit
000e67d182
@ -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;
|
||||||
|
Loading…
Reference in New Issue
Block a user