* made PNG read/Write a bit faster

* removed color conversion routines (except gray)
* memory image with size 0,0 trew an exception
* creation of a TMemoryImage of size 0,0 will have no color in palette

fcl/image/fpcolcnv.inc

@@ -14,7 +14,7 @@
 
  **********************************************************************}
 
-function FillOtherBits (initial:word;CorrectBits:byte):word;
+{function FillOtherBits (initial:word;CorrectBits:byte):word;
 var r,c : byte;
 begin
   c := 16 div CorrectBits;
@@ -27,7 +27,19 @@ function ShiftAndFill (initial:word; CorrectBits:byte):word;
 begin
   result := FillOtherBits (initial shl (16-correctbits), correctbits);
 end;
+}
+function CalculateGray (const from : TFPcolor) : word;
+var temp : longword;
+begin
+  with GrayConvMatrix do
+    temp := round(red*from.red + green*from.green + blue*from.blue);
+  if temp > $ffff then
+    result := $ffff
+  else
+    result := temp;
+end;
 
+(*
 type
   TColorBits = array [0..3] of TColorData;
      // 0:alpha, 1:red, 2:green, 3:blue
@@ -113,6 +125,7 @@ function ConvertColor (const From : TColorData; FromFmt:TColorFormat) : TFPColor
     result := SetGrayScale (value);
     result.alpha := alphaOpaque;
   end;
+var m : qword;
 begin
   case FromFmt of
     cfMono : result := SetGrayScaleA (ShiftAndFill(From,1));
@@ -160,12 +173,41 @@ begin
   result := ConvertColor (From.data, From.Fmt)
 end;
 
+const BitMasks : array[1..32] of longword =
+    ($8000000, $C000000, $E000000, $F000000,
+     $F800000, $FC00000, $FE00000, $FF00000,
+     $FF80000, $FFC0000, $FFE0000, $FFF0000,
+     $FFF8000, $FFFC000, $FFFE000, $FFFF000,
+     $FFFF800, $FFFFC00, $FFFFE00, $FFFFF00,
+     $FFFFF80, $FFFFFC0, $FFFFFE0, $FFFFFF0,
+     $FFFFFF8, $FFFFFFC, $FFFFFFE, $FFFFFFF,
+     $FFFFFFF, $FFFFFFF, $FFFFFFF, $FFFFFFF);
+
+procedure PrepareBitMasks;
+{ Putting the correct bits in the array (problem with constants in compiler 1.0)}
+var r : integer;
+begin
+  for r := 1 to 32 do
+    BitMasks[r] := BitMasks[r] shl 4;
+  inc (BitMasks[29], $8);
+  inc (BitMasks[30], $C);
+  inc (BitMasks[31], $E);
+  inc (BitMasks[32], $F);
+end;
+
 function CalculateGray (const c : TFPcolor; Bits:byte) : TColorData;
+var temp : longword;
 begin
-  // MG: ToDo
-  raise FPImageException.create ('Not yet implemented');
-  if (c.alpha=0) or (Bits=0) then ;
-  Result:=0;
+  with GrayConvMatrix do
+    temp := round(red*c.red + green*c.green + blue*c.blue);
+  result := temp;
+  //temp := temp + (result shl 16);
+  //result := temp and BitMasks[Bits];
+  {if not (c = colBlack) then
+    with c do
+      //writeln ('red:',red,' - green:',green,' - blue:',blue, ' : result=',result);
+      writeln (format('red:%4x - green:%4x - blue:%4x => result:%4x',[integer(red),
+               integer(green),integer(blue),integer(result)]));}
 end;
 
 function CalculateGrayA (const c : TFPcolor; Bits:byte) : TColorData;
@@ -217,6 +259,8 @@ begin
       result := MakeSample(From.blue, sb[3], cb[3]) or
                 MakeSample(From.red, sb[1], cb[1]) or
                 MakeSample(From.green, sb[2], cb[2]);
+      with From do
+        writeln (red,',',green,',',blue,',',result);
       end;
     cfRGBA8,cfRGBA16,cfRGBA32,cfRGBA64,
     cfABGR8,cfABGR16,cfABGR32,cfABGR64 :
@@ -249,6 +293,7 @@ begin
   result.Fmt := Fmt;
   result.data := ConvertColorToData (From, Fmt);
 end;
+*)
 
 function CompareColors(const Color1, Color2: TFPColor): integer;
 begin

fcl/image/fpimage.inc

@@ -304,7 +304,7 @@ begin
     then
       begin
         FPalette := TFPPalette.Create (0);
-        FPalette.Add (colTransparent);    
+        // FPalette.Add (colTransparent);
       end
     else
       begin
@@ -378,6 +378,7 @@ end;
 
 constructor TFPMemoryImage.Create (AWidth,AHeight:integer);
 begin
+  Fdata := nil;
   inherited create (AWidth,AHeight);
 {Default behavior is to use palette as suggested by Michael}
   SetUsePalette(True);
@@ -476,13 +477,16 @@ begin
     then
       begin
         FPalette:=TFPPalette.Create(0);
-        FPalette.Add(colTransparent);    
-        OldColors:=PFPColorArray(FData);
-        GetMem(FData,FWidth*FHeight*SizeOf(Integer));
-        for r:=0 to FHeight-1 do
-          for c:=0 to FWidth-1 do
-            Colors[c,r]:=OldColors^[r*FWidth+c];
-        FreeMem(OldColors);
+        //FPalette.Add(colTransparent);
+        if assigned(FData) then
+          begin
+          OldColors:=PFPColorArray(FData);
+          GetMem(FData,FWidth*FHeight*SizeOf(Integer));
+          for r:=0 to FHeight-1 do
+            for c:=0 to FWidth-1 do
+              Colors[c,r]:=OldColors^[r*FWidth+c];
+          FreeMem(OldColors);
+          end;
       end
     else
       begin

fcl/image/fpimage.pp

@@ -251,15 +251,20 @@ type
       property TypeNames [index:integer] : string read GetTypeName;
     end;
 
-function ShiftAndFill (initial:word; CorrectBits:byte):word;
+{function ShiftAndFill (initial:word; CorrectBits:byte):word;
 function FillOtherBits (initial:word;CorrectBits:byte):word;
+}
+function CalculateGray (const From : TFPColor) : word;
+(*
 function ConvertColor (const From : TDeviceColor) : TFPColor;
 function ConvertColor (const From : TColorData; FromFmt:TColorFormat) : TFPColor;
 function ConvertColorToData (const From : TFPColor; Fmt : TColorFormat) : TColorData;
 function ConvertColorToData (const From : TDeviceColor; Fmt : TColorFormat) : TColorData;
 function ConvertColor (const From : TFPColor; Fmt : TColorFormat) : TDeviceColor;
 function ConvertColor (const From : TDeviceColor; Fmt : TColorFormat) : TDeviceColor;
+*)
 function FPColor (r,g,b,a:word) : TFPColor;
+function FPColor (r,g,b:word) : TFPColor;
 {$ifdef debug}function MakeHex (n:TColordata;nr:byte): string;{$endif}
 
 operator = (const c,d:TFPColor) : boolean;
@@ -311,6 +316,20 @@ const
 
 {$i FPColors.inc}
 
+type
+  TGrayConvMatrix = record
+    red, green, blue : single;
+  end;
+
+var
+  GrayConvMatrix : TGrayConvMatrix;
+
+const
+  GCM_NTSC : TGrayConvMatrix = (red:0.299; green:0.587; blue:0.114);
+  GCM_JPEG : TGrayConvMatrix = (red:0.299; green:0.587; blue:0.114);
+  GCM_Mathematical : TGrayConvMatrix = (red:0.334; green:0.333; blue:0.333);
+  GCM_Photoshop : TGrayConvMatrix = (red:0.213; green:0.715; blue:0.072);
+
 implementation
 
 procedure FPImgError (Fmt:TErrorTextIndices; data : array of const);
@@ -328,6 +347,17 @@ end;
 {$i FPPalette.inc}
 {$i FPColCnv.inc}
 
+function FPColor (r,g,b:word) : TFPColor;
+begin
+  with result do
+    begin
+    red := r;
+    green := g;
+    blue := b;
+    alpha := alphaOpaque;
+    end;
+end;
+
 function FPColor (r,g,b,a:word) : TFPColor;
 begin
   with result do
@@ -391,12 +421,15 @@ end;
 
 initialization
   ImageHandlers := TImageHandlersManager.Create;
-  ColorBits [cfRGB48,1] := ColorBits [cfRGB48,1] shl 16;
+  GrayConvMatrix := GCM_JPEG;
+  // Following lines are here because the compiler 1.0 can't work with int64 constants
+(*  ColorBits [cfRGB48,1] := ColorBits [cfRGB48,1] shl 16;
   ColorBits [cfRGBA64,1] := ColorBits [cfRGBA64,1] shl 32;
   ColorBits [cfRGBA64,2] := ColorBits [cfRGBA64,2] shl 16;
   ColorBits [cfABGR64,0] := ColorBits [cfABGR64,0] shl 32;
   ColorBits [cfABGR64,3] := ColorBits [cfABGR64,3] shl 16;
   ColorBits [cfBGR48,3] := ColorBits [cfBGR48,3] shl 16;
+  PrepareBitMasks;*)
 
 finalization
   ImageHandlers.Free;

fcl/image/fppalette.inc

@@ -23,7 +23,7 @@ begin
   else
     FData := nil;
   FCapacity := ACount;
-  SetCount (ACount);
+  SetCount (0);
 end;
 
 destructor TFPPalette.destroy;

fcl/image/fpreadpng.pp

@@ -24,6 +24,7 @@ uses
 Type
 
   TSetPixelProc = procedure (x,y:integer; CD : TColordata) of object;
+  TConvertColorProc = function (CD:TColorData) : TFPColor of object;
 
   TFPReaderPNG = class (TFPCustomImageReader)
     private
@@ -39,14 +40,26 @@ Type
       BitsUsed : EightLong; // bitmasks to use to split a byte into smaller parts
       BitShift : byte;  // shift right to do of the bits extracted with BitsUsed for 1 element
       CountBitsUsed : byte;  // number of bit groups (1 pixel) per byte (when bytewidth = 1)
-      CFmt : TColorFormat; // format of the colors to convert from
+      //CFmt : TColorFormat; // format of the colors to convert from
       StartX,StartY, DeltaX,DeltaY, StartPass,EndPass : integer;  // number and format of passes
       FSwitchLine, FCurrentLine, FPreviousLine : pByteArray;
       FPalette : TFPPalette;
       FSetPixel : TSetPixelProc;
+      FConvertColor : TConvertColorProc;
       procedure ReadChunk;
       procedure HandleData;
       procedure HandleUnknown;
+      function ColorGray1 (CD:TColorData) : TFPColor;
+      function ColorGray2 (CD:TColorData) : TFPColor;
+      function ColorGray4 (CD:TColorData) : TFPColor;
+      function ColorGray8 (CD:TColorData) : TFPColor;
+      function ColorGray16 (CD:TColorData) : TFPColor;
+      function ColorGrayAlpha8 (CD:TColorData) : TFPColor;
+      function ColorGrayAlpha16 (CD:TColorData) : TFPColor;
+      function ColorColor8 (CD:TColorData) : TFPColor;
+      function ColorColor16 (CD:TColorData) : TFPColor;
+      function ColorColorAlpha8 (CD:TColorData) : TFPColor;
+      function ColorColorAlpha16 (CD:TColorData) : TFPColor;
     protected
       UseTransparent, EndOfFile : boolean;
       TransparentDataValue : TColorData;
@@ -73,7 +86,8 @@ Type
       function DecideSetPixel : TSetPixelProc; virtual;
       procedure InternalRead  (Str:TStream; Img:TFPCustomImage); override;
       function  InternalCheck (Str:TStream) : boolean; override;
-      property ColorFormat : TColorformat read CFmt;
+      //property ColorFormat : TColorformat read CFmt;
+      property ConvertColor : TConvertColorProc read FConvertColor;
       property CurrentPass : byte read FCurrentPass;
       property Pltte : boolean read FPltte;
       property ThePalette : TFPPalette read FPalette;
@@ -218,6 +232,7 @@ end;
 procedure TFPReaderPNG.HandlePalette;
 var r : longword;
     c : TFPColor;
+    t : word;
 begin
   if header.colortype = 3 then
     with chunk do
@@ -225,7 +240,7 @@ begin
       if TheImage.UsePalette then
         FPalette := TheImage.Palette
       else
-        FPalette := TFPPalette.Create(1);
+        FPalette := TFPPalette.Create(0);
       c.Alpha := AlphaOpaque;
       if (aLength mod 3) > 0 then
         raise PNGImageException.Create ('Impossible length for PLTE-chunk');
@@ -233,11 +248,14 @@ begin
       ThePalette.count := 0;
       while r < alength do
         begin
-        c.red := ShiftAndFill(data^[r], 8);
+        t := data^[r];
+        c.red := t + (t shl 8);
         inc (r);
-        c.green := ShiftAndFill(data^[r], 8);
+        t := data^[r];
+        c.green := t + (t shl 8);
         inc (r);
-        c.blue := ShiftAndFill(data^[r], 8);
+        t := data^[r];
+        c.blue := t + (t shl 8);
         inc (r);
         ThePalette.Add (c);
         end;
@@ -246,7 +264,7 @@ end;
 
 procedure TFPReaderPNG.SetPalettePixel (x,y:integer; CD : TColordata);
 begin  // both PNG and palette have palette
-  TheImage.Pixels[x,y] := CD
+  TheImage.Pixels[x,y] := CD;
 end;
 
 procedure TFPReaderPNG.SetPalColPixel (x,y:integer; CD : TColordata);
@@ -257,14 +275,16 @@ end;
 procedure TFPReaderPNG.SetColorPixel (x,y:integer; CD : TColordata);
 var c : TFPColor;
 begin  // both PNG and Img work without palette, and no transparency colordata
-  c := ConvertColor (CD,CFmt);
+  // c := ConvertColor (CD,CFmt);
+  c := ConvertColor (CD);
   TheImage.Colors[x,y] := c;
 end;
 
 procedure TFPReaderPNG.SetColorTrPixel (x,y:integer; CD : TColordata);
 var c : TFPColor;
 begin  // both PNG and Img work without palette, and there is a transparency colordata
-  c := ConvertColor (CD,CFmt);
+  //c := ConvertColor (CD,CFmt);
+  c := ConvertColor (CD);
   if TransparentDataValue = CD then
     c.alpha := alphaTransparent;
   TheImage.Colors[x,y] := c;
@@ -397,10 +417,6 @@ begin
     if UsingBitGroup >= CountBitsUsed then
       UsingBitGroup := 0;
     end
-{    else if bytewidth = 2 then
-    result := DataBytes shr 16
-  else if bytewidth = 3 then
-    result := Databytes shr 8}
   else
     result := Databytes;
 end;
@@ -419,6 +435,160 @@ begin
     end
 end;
 
+function TFPReaderPNG.ColorGray1 (CD:TColorDAta) : TFPColor;
+begin
+  if CD = 0 then
+    result := colBlack
+  else
+    result := colWhite;
+end;
+
+function TFPReaderPNG.ColorGray2 (CD:TColorDAta) : TFPColor;
+var c : word;
+begin
+  c := CD and 3;
+  c := c + (c shl 2);
+  c := c + (c shl 4);
+  c := c + (c shl 8);
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    alpha := alphaOpaque;
+    end;
+end;
+
+function TFPReaderPNG.ColorGray4 (CD:TColorDAta) : TFPColor;
+var c : word;
+begin
+  c := CD and $F;
+  c := c + (c shl 4);
+  c := c + (c shl 8);
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    alpha := alphaOpaque;
+    end;
+end;
+
+function TFPReaderPNG.ColorGray8 (CD:TColorDAta) : TFPColor;
+var c : word;
+begin
+  c := CD and $FF;
+  c := c + (c shl 8);
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    alpha := alphaOpaque;
+    end;
+end;
+
+function TFPReaderPNG.ColorGray16 (CD:TColorDAta) : TFPColor;
+var c : word;
+begin
+  c := CD and $FFFF;
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    alpha := alphaOpaque;
+    end;
+end;
+
+function TFPReaderPNG.ColorGrayAlpha8 (CD:TColorData) : TFPColor;
+var c : word;
+begin
+  c := CD and $FF00;
+  c := c + (c shr 8);
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    c := CD and $FF;
+    alpha := c + (c shl 8);
+    end;
+end;
+
+function TFPReaderPNG.ColorGrayAlpha16 (CD:TColorData) : TFPColor;
+var c : word;
+begin
+  c := (CD and qword($FFFF0000)) shr 16;
+  with result do
+    begin
+    red := c;
+    green := c;
+    blue := c;
+    alpha := CD and $FFFF;
+    end;
+end;
+
+function TFPReaderPNG.ColorColor8 (CD:TColorData) : TFPColor;
+var c : word;
+begin
+  with result do
+    begin
+    c := CD and $FF;
+    red := c + (c shl 8);
+    c := CD and $FF00;
+    green := c + (c shr 8);
+    c := (CD and $FF0000) shr 8;
+    blue := c + (c shr 8);
+    alpha := alphaOpaque;
+    end;
+end;
+
+function TFPReaderPNG.ColorColor16 (CD:TColorData) : TFPColor;
+var c : qword;
+begin
+  with result do
+    begin
+    red := CD and $FFFF;
+    c := qword($FFFF0000);
+    green := (CD and c) shr 16;
+    c := c shl 16;
+    blue := (CD and c) shr 32;
+    alpha := alphaOpaque;
+    end;
+end;
+
+function TFPReaderPNG.ColorColorAlpha8 (CD:TColorData) : TFPColor;
+var c : qword;
+begin
+  with result do
+    begin
+    c := CD and $FF;
+    red := c + (c shl 8);
+    c := CD and $FF00;
+    green := c + (c shr 8);
+    c := (CD and $FF0000) shr 8;
+    blue := c + (c shr 8);
+    c := (CD and qword($FF000000)) shr 16;
+    alpha := c + (c shr 8);
+    end;
+end;
+
+function TFPReaderPNG.ColorColorAlpha16 (CD:TColorData) : TFPColor;
+var c : qword;
+begin
+  with result do
+    begin
+    red := CD and $FFFF;
+    c := qword($FFFF0000);
+    green := (CD and c) shr 16;
+    c := c shl 16;
+    blue := (CD and c) shr 32;
+    c := c shl 16;
+    alpha := (CD and c) shr 48;
+    end;
+end;
+
 procedure TFPReaderPNG.DoDecompress;
 
   procedure initVars;
@@ -452,33 +622,70 @@ procedure TFPReaderPNG.DoDecompress;
       Fpltte := (ColorType = 3);
       case colortype of
         0 : case Bitdepth of
-              1  : CFmt := cfMono;
-              2  : CFmt := cfGray2;
-              4  : CFmt := cfGray4;
-              8  : CFmt := cfGray8;
-              16 : CFmt := cfGray16;
+              1  : begin
+                   FConvertColor := @ColorGray1; //CFmt := cfMono;
+                   ByteWidth := 1;
+                   end;
+              2  : begin
+                   FConvertColor := @ColorGray2; //CFmt := cfGray2;
+                   ByteWidth := 1;
+                   end;
+              4  : begin
+                   FConvertColor := @ColorGray4; //CFmt := cfGray4;
+                   ByteWidth := 1;
+                   end;
+              8  : begin
+                   FConvertColor := @ColorGray8; //CFmt := cfGray8;
+                   ByteWidth := 1;
+                   end;
+              16 : begin
+                   FConvertColor := @ColorGray16; //CFmt := cfGray16;
+                   ByteWidth := 2;
+                   end;
             end;
         2 : if BitDepth = 8 then
-              CFmt := cfBGR24
+              begin
+              FConvertColor := @ColorColor8; //CFmt := cfBGR24
+              ByteWidth := 3;
+              end
+            else
+              begin
+              FConvertColor := @ColorColor16; //CFmt := cfBGR48;
+              ByteWidth := 6;
+              end;
+        3 : if BitDepth = 16 then
+              ByteWidth := 2
             else
-              CFmt := cfBGR48;
+              ByteWidth := 1;
         4 : if BitDepth = 8 then
-              CFmt := cfGrayA16
+              begin
+              FConvertColor := @ColorGrayAlpha8; //CFmt := cfGrayA16
+              ByteWidth := 2;
+              end
             else
-              CFmt := cfGrayA32;
+              begin
+              FConvertColor := @ColorGrayAlpha16; //CFmt := cfGrayA32;
+              ByteWidth := 4;
+              end;
         6 : if BitDepth = 8 then
-              CFmt := cfABGR32
+              begin
+              FConvertColor := @ColorColorAlpha8; //CFmt := cfABGR32
+              ByteWidth := 4;
+              end
             else
-              CFmt := cfABGR64;
+              begin
+              FConvertColor := @ColorColorAlpha16; //CFmt := cfABGR64;
+              ByteWidth := 8;
+              end;
       end;
-      ByteWidth := BytesNeeded[CFmt];
+      //ByteWidth := BytesNeeded[CFmt];
       case BitDepth of
-        1 :begin
+        1 : begin
             CountBitsUsed := 8;
             BitShift := 1;
             BitsUsed := BitsUsed1Depth;
             end;
-        2 :begin
+        2 : begin
             CountBitsUsed := 4;
             BitShift := 2;
             BitsUsed := BitsUsed2Depth;

fcl/image/fpwritepng.pp

@@ -24,6 +24,8 @@ type
 
   TGetPixelFunc = function (x,y : LongWord) : TColorData of object;
 
+  TColorFormatFunction = function (color:TFPColor) : TColorData of object;
+
   TFPWriterPNG = class (TFPCustomImageWriter)
     private
       FUsetRNS, FCompressedText, FWordSized, FIndexed,
@@ -31,6 +33,7 @@ type
       FByteWidth : byte;
       FChunk : TChunk;
       CFmt : TColorFormat; // format of the colors to convert from
+      FFmtColor : TColorFormatFunction;
       FTransparentColor : TFPColor;
       FSwitchLine, FCurrentLine, FPreviousLine : pByteArray;
       FPalette : TFPPalette;
@@ -68,11 +71,20 @@ type
       procedure DetermineHeader (var AHeader : THeaderChunk); virtual;
       function DetermineFilter (Current, Previous:PByteArray; linelength:longword):byte; virtual;
       procedure FillScanLine (y : integer; ScanLine : pByteArray); virtual;
+      function ColorDataGrayB(color:TFPColor) : TColorData;
+      function ColorDataColorB(color:TFPColor) : TColorData;
+      function ColorDataGrayW(color:TFPColor) : TColorData;
+      function ColorDataColorW(color:TFPColor) : TColorData;
+      function ColorDataGrayAB(color:TFPColor) : TColorData;
+      function ColorDataColorAB(color:TFPColor) : TColorData;
+      function ColorDataGrayAW(color:TFPColor) : TColorData;
+      function ColorDataColorAW(color:TFPColor) : TColorData;
       property ChunkDataBuffer : pByteArray read FChunk.data;
       property UsetRNS : boolean read FUsetRNS;
       property SingleTransparentColor : TFPColor read FTransparentColor;
       property ThePalette : TFPPalette read FPalette;
       property ColorFormat : TColorformat read CFmt;
+      property ColorFormatFunc : TColorFormatFunction read FFmtColor;
       property byteWidth : byte read FByteWidth;
       property DatalineLength : longword read FDatalineLength;
     public
@@ -318,21 +330,53 @@ var c : integer;
     with AHeader do
       case colortype of
         0 : if FWordSized then
-              CFmt := cfGray16
+              begin
+              FFmtColor := @ColorDataGrayW;
+              FByteWidth := 2;
+              //CFmt := cfGray16
+              end
             else
-              CFmt := cfGray8;
+              begin
+              FFmtColor := @ColorDataGrayB;
+              FByteWidth := 1;
+              //CFmt := cfGray8;
+              end;
         2 : if FWordSized then
-              CFmt := cfBGR48
+              begin
+              FFmtColor := @ColorDataColorW;
+              FByteWidth := 6;
+              //CFmt := cfBGR48
+              end
             else
-              CFmt := cfBGR24;
+              begin
+              FFmtColor := @ColorDataColorB;
+              FByteWidth := 3;
+              //CFmt := cfBGR24;
+              end;
         4 : if FWordSized then
-              CFmt := cfGrayA32
+              begin
+              FFmtColor := @ColorDataGrayAW;
+              FByteWidth := 4;
+              //CFmt := cfGrayA32
+              end
             else
-              CFmt := cfGrayA16;
+              begin
+              FFmtColor := @ColorDataGrayAB;
+              FByteWidth := 2;
+              //CFmt := cfGrayA16;
+              end;
         6 : if FWordSized then
-              CFmt := cfABGR64
+              begin
+              FFmtColor := @ColorDataColorAW;
+              FByteWidth := 8;
+              //CFmt := cfABGR64
+              end
             else
-              CFmt := cfABGR32;
+              begin
+              FFmtColor := @ColorDataColorAB;
+              FByteWidth := 4;
+              //CFmt := cfABGR32;
+              end;
       end;
   end;
 begin
@@ -374,7 +418,6 @@ begin
       else
         BitDepth := 8;
       DetermineColorFormat;
-      FByteWidth := BytesNeeded[CFmt];
       end;
     Compression := 0;
     Filter := 0;
@@ -395,9 +438,62 @@ begin
   WriteChunk;
 end;
 
+{ Color convertions }
+
+function TFPWriterPNG.ColorDataGrayB(color:TFPColor) : TColorData;
+var t : word;
+begin
+  t := CalculateGray (color);
+  result := hi(t);
+end;
+
+function TFPWriterPNG.ColorDataGrayW(color:TFPColor) : TColorData;
+begin
+  result := CalculateGray (color);
+end;
+
+function TFPWriterPNG.ColorDataGrayAB(color:TFPColor) : TColorData;
+begin
+  result := ColorDataGrayB (color);
+  result := (result shl 8) and hi(color.Alpha);
+end;
+
+function TFPWriterPNG.ColorDataGrayAW(color:TFPColor) : TColorData;
+begin
+  result := ColorDataGrayW (color);
+  result := (result shl 16) and color.Alpha;
+end;
+
+function TFPWriterPNG.ColorDataColorB(color:TFPColor) : TColorData;
+begin
+  with color do
+    result := hi(red) + (green and $FF00) + (hi(blue) shl 16);
+end;
+
+function TFPWriterPNG.ColorDataColorW(color:TFPColor) : TColorData;
+begin
+  with color do
+    result := red + (green shl 16) + (blue shl 32);
+end;
+
+function TFPWriterPNG.ColorDataColorAB(color:TFPColor) : TColorData;
+begin
+  with color do
+    result := hi(red) + (green and $FF00) + (hi(blue) shl 16) + (hi(alpha) shl 24);
+end;
+
+function TFPWriterPNG.ColorDataColorAW(color:TFPColor) : TColorData;
+begin
+  with color do
+    result := red + (green shl 16) + (blue shl 32) + (alpha shl 48);
+end;
+
+{ Data making routines }
+
 function TFPWriterPNG.GetColorPixel (x,y:longword) : TColorData;
 begin
-  result := ConvertColorToData(TheImage.Colors[x,y],CFmt);
+  result := FFmtColor (TheImage[x,y]);
+  //result := ConvertColorToData(TheImage.Colors[x,y],CFmt);
 end;
 
 function TFPWriterPNG.GetPalettePixel (x,y:longword) : TColorData;
@@ -565,9 +661,9 @@ procedure TFPWriterPNG.WritetRNS;
   begin
     SetChunkLength(2);
     if WordSized then
-      g := ConvertColorToData (SingleTransparentColor, cfGray16)
+      g := CalculateGray (SingleTransparentColor)
     else
-      g := ConvertColorToData (SingleTransparentColor, cfGray8);
+      g := hi (CalculateGray(SingleTransparentColor));
     g := swap (g);
     move (g,ChunkDataBuffer^[0],2);
     WriteChunk;