Browse Source

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

luk 22 years ago
parent
commit
ccb68006b8
2 changed files with 27 additions and 1 deletions
  1. 15 1
      fcl/image/fpreadpng.pp
  2. 12 0
      fcl/image/fpwritepng.pp

+ 15 - 1
fcl/image/fpreadpng.pp

@@ -51,7 +51,8 @@ Type
       UseTransparent, EndOfFile : boolean;
       TransparentDataValue : TColorData;
       UsingBitGroup : byte;
-      DataIndex,DataBytes : longword;
+      DataIndex : longword;
+      DataBytes : TColorData;
       function CurrentLine(x:longword) : byte;
       function PrevSample (x:longword): byte;
       function PreviousLine (x:longword) : byte;
@@ -366,10 +367,23 @@ end;
 
 function TFPReaderPNG.CalcColor: TColorData;
 var cd : longword;
+    r : word;
+    b : byte;
 begin
   if UsingBitGroup = 0 then
     begin
     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);
     inc (DataIndex,bytewidth);
     end;

+ 12 - 0
fcl/image/fpwritepng.pp

@@ -477,12 +477,24 @@ procedure TFPWriterPNG.FillScanLine (y : integer; ScanLine : pByteArray);
 var r, x : integer;
     cd : TColorData;
     index : longword;
+    b : byte;
 begin
   index := 0;
   for x := 0 to pred(TheImage.Width) do
     begin
     cd := FGetPixel (x,y);
     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);
     end;
 end;