paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 07:29:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed reading/writing wrong colors when using bitdepth of 16

Browse Source
This commit is contained in:
luk 2003-09-23 21:47:32 +00:00
parent 420c1cdfe1
commit ccb68006b8
2 changed files with 27 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
fcl/image/fpreadpng.pp
View File

@ -51,7 +51,8 @@ Type
UseTransparent, EndOfFile : boolean; UseTransparent, EndOfFile : boolean;
TransparentDataValue : TColorData; TransparentDataValue : TColorData;
UsingBitGroup : byte; UsingBitGroup : byte;
DataIndex,DataBytes : longword; DataIndex : longword;
DataBytes : TColorData;
function CurrentLine(x:longword) : byte; function CurrentLine(x:longword) : byte;
function PrevSample (x:longword): byte; function PrevSample (x:longword): byte;
function PreviousLine (x:longword) : byte; function PreviousLine (x:longword) : byte;
@ -366,10 +367,23 @@ end;
function TFPReaderPNG.CalcColor: TColorData; function TFPReaderPNG.CalcColor: TColorData;
var cd : longword; var cd : longword;
r : word;
b : byte;
begin begin
if UsingBitGroup = 0 then if UsingBitGroup = 0 then
begin begin
Databytes := 0; Databytes := 0;
if Header.BitDepth = 16 then
begin
r := 1;
while (r < ByteWidth) do
begin
b := FCurrentLine^[Dataindex+r];
FCurrentLine^[Dataindex+r] := FCurrentLine^[Dataindex+r-1];
FCurrentLine^[Dataindex+r-1] := b;
inc (r,2);
end;
end;
move (FCurrentLine^[DataIndex], Databytes, bytewidth); move (FCurrentLine^[DataIndex], Databytes, bytewidth);
inc (DataIndex,bytewidth); inc (DataIndex,bytewidth);
end; end;

12
fcl/image/fpwritepng.pp
View File

@ -477,12 +477,24 @@ procedure TFPWriterPNG.FillScanLine (y : integer; ScanLine : pByteArray);
var r, x : integer; var r, x : integer;
cd : TColorData; cd : TColorData;
index : longword; index : longword;
b : byte;
begin begin
index := 0; index := 0;
for x := 0 to pred(TheImage.Width) do for x := 0 to pred(TheImage.Width) do
begin begin
cd := FGetPixel (x,y); cd := FGetPixel (x,y);
move (cd, ScanLine^[index], FBytewidth); move (cd, ScanLine^[index], FBytewidth);
if WordSized then
begin
r := 1;
while (r < FByteWidth) do
begin
b := Scanline^[index+r];
Scanline^[index+r] := Scanline^[index+r-1];
Scanline^[index+r-1] := b;
inc (r,2);
end;
end;
inc (index, FByteWidth); inc (index, FByteWidth);
end; end;
end; end;