--- Merging r40995 into '.':

U    packages/fcl-image/src/fpreadgif.pas
--- Recording mergeinfo for merge of r40995 into '.':
 U   .
--- Merging r41341 into '.':
A    packages/fcl-image/examples/DejaVuLGCSans.ttf
A    packages/fcl-image/examples/edit-clear.png
A    packages/fcl-image/examples/fpcanvasalphadraw.pp
U    packages/fcl-image/src/ellipses.pp
U    packages/fcl-image/src/fpcanvas.inc
U    packages/fcl-image/src/fpcanvas.pp
U    packages/fcl-image/src/fpinterpolation.inc
U    packages/fcl-image/src/ftfont.pp
U    packages/fcl-image/src/pixtools.pp
--- Recording mergeinfo for merge of r41341 into '.':
 G   .
--- Merging r41409 into '.':
G    packages/fcl-image/src/fpreadgif.pas
--- Recording mergeinfo for merge of r41409 into '.':
 G   .
--- Merging r41410 into '.':
U    packages/fcl-image/examples/imgconv.pp
--- Recording mergeinfo for merge of r41410 into '.':
 G   .
--- Merging r41411 into '.':
G    packages/fcl-image/examples/imgconv.pp
--- Recording mergeinfo for merge of r41411 into '.':
 G   .
--- Merging r41546 into '.':
U    packages/fcl-image/src/clipping.pp
--- Recording mergeinfo for merge of r41546 into '.':
 G   .
--- Merging r41550 into '.':
G    packages/fcl-image/src/ellipses.pp
U    packages/fcl-image/src/fpcolcnv.inc
U    packages/fcl-image/src/fpimage.pp
U    packages/fcl-image/src/fpwritexpm.pp
G    packages/fcl-image/src/ftfont.pp
--- Recording mergeinfo for merge of r41550 into '.':
 G   .
--- Merging r41802 into '.':
G    packages/fcl-image/examples/imgconv.pp
--- Recording mergeinfo for merge of r41802 into '.':
 G   .

# revisions: 40995,41341,41409,41410,41411,41546,41550,41802
r40995 | marco | 2019-01-22 16:11:04 +0100 (Tue, 22 Jan 2019) | 3 lines
Changed paths:
   M /trunk/packages/fcl-image/src/fpreadgif.pas

 * don't hangt on corrupt gifs, exit loops at end of streams.
   Fixes mantis #34919
r41341 | michael | 2019-02-16 13:43:14 +0100 (Sat, 16 Feb 2019) | 1 line
Changed paths:
   A /trunk/packages/fcl-image/examples/DejaVuLGCSans.ttf
   A /trunk/packages/fcl-image/examples/edit-clear.png
   A /trunk/packages/fcl-image/examples/fpcanvasalphadraw.pp
   M /trunk/packages/fcl-image/src/ellipses.pp
   M /trunk/packages/fcl-image/src/fpcanvas.inc
   M /trunk/packages/fcl-image/src/fpcanvas.pp
   M /trunk/packages/fcl-image/src/fpinterpolation.inc
   M /trunk/packages/fcl-image/src/ftfont.pp
   M /trunk/packages/fcl-image/src/pixtools.pp

* Patch from Ondrej Pokorny, to demonstrate alpha blending mode
r41409 | michael | 2019-02-22 09:03:39 +0100 (Fri, 22 Feb 2019) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/src/fpreadgif.pas

* Patch from Anton Kavalenka to fix gif reading (bug ID 35134)
r41410 | michael | 2019-02-22 09:05:24 +0100 (Fri, 22 Feb 2019) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/examples/imgconv.pp

* Support reading gifs
r41411 | michael | 2019-02-22 09:07:21 +0100 (Fri, 22 Feb 2019) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/examples/imgconv.pp

* Add gif to help message
r41546 | michael | 2019-03-02 11:29:44 +0100 (Sat, 02 Mar 2019) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/src/clipping.pp

* Fix bug #35127 in CheckRectClipping, patch from Ondrej Pokorny
r41550 | michael | 2019-03-02 13:13:31 +0100 (Sat, 02 Mar 2019) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/src/ellipses.pp
   M /trunk/packages/fcl-image/src/fpcolcnv.inc
   M /trunk/packages/fcl-image/src/fpimage.pp
   M /trunk/packages/fcl-image/src/fpwritexpm.pp
   M /trunk/packages/fcl-image/src/ftfont.pp

* optimization by Ondrej Pokorny, add const in front of TFPColor arguments where possible (bug ID 35131)
r41802 | michael | 2019-03-26 23:24:49 +0100 (Tue, 26 Mar 2019) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/examples/imgconv.pp

* Enhance example to allow specify grayscale for tiff

git-svn-id: branches/fixes_3_2@41915 -

.gitattributes

@@ -2356,6 +2356,7 @@ packages/fcl-fpcunit/src/xmltestreport.pp svneol=native#text/plain
 packages/fcl-image/Makefile svneol=native#text/plain
 packages/fcl-image/Makefile.fpc svneol=native#text/plain
 packages/fcl-image/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/fcl-image/examples/DejaVuLGCSans.ttf -text
 packages/fcl-image/examples/Makefile svneol=native#text/plain
 packages/fcl-image/examples/Makefile.fpc svneol=native#text/plain
 packages/fcl-image/examples/createbarcode.lpi svneol=native#text/plain
@@ -2363,6 +2364,8 @@ packages/fcl-image/examples/createbarcode.lpr svneol=native#text/plain
 packages/fcl-image/examples/createqrcode.lpi svneol=native#text/plain
 packages/fcl-image/examples/createqrcode.pp svneol=native#text/plain
 packages/fcl-image/examples/drawing.pp svneol=native#text/plain
+packages/fcl-image/examples/edit-clear.png -text svneol=unset#image/png
+packages/fcl-image/examples/fpcanvasalphadraw.pp svneol=native#text/plain
 packages/fcl-image/examples/imgconv.pp svneol=native#text/plain
 packages/fcl-image/examples/interpoldemo.pp svneol=native#text/plain
 packages/fcl-image/examples/pattern.png -text svneol=unset#image/png

packages/fcl-image/examples/fpcanvasalphadraw.pp

@@ -0,0 +1,97 @@
+{
+  Sample program by Ondrey Pokorny to demonstrate drawing modes of the TFPCustomCanvas:
+    - opaque 
+    - alphablend 
+    - custom blending, using a callback (not-used in this case)
+}
+program FPCanvasAlphaDraw;
+
+uses FPImage, FPImgCanv, FPCanvas, FPReadPNG, FPWritePNG, Classes, SysUtils, freetype, ftFont;
+
+const
+  cImageName: array[TFPDrawingMode] of string = ('opaque', 'alphablend', 'not-used');
+
+var
+  xNew, xImage: TFPMemoryImage;
+  xCanvas: TFPImageCanvas;
+  xDrawingMode: TFPDrawingMode;
+  xRect: TRect;
+begin
+  ftFont.InitEngine;
+  xNew := nil;
+  xCanvas := nil;
+  xImage := nil;
+  try
+    xImage := TFPMemoryImage.Create(0, 0);
+    xImage.LoadFromFile('edit-clear.png');
+
+    for xDrawingMode := dmOpaque to dmAlphaBlend do
+    begin
+      xNew := TFPMemoryImage.Create(200, 200);
+      xCanvas := TFPImageCanvas.Create(xNew);
+
+      xCanvas.DrawingMode := xDrawingMode;
+
+      xCanvas.Pen.Style := psClear;
+      xCanvas.Brush.FPColor := colRed;
+
+      xCanvas.FillRect(0, 0, xNew.Width, xNew.Height);
+      // draw semi-transparent objects
+      xCanvas.Brush.FPColor := FPColor($FFFF, $FFFF, $FFFF, $8000);
+      xRect := Rect(0, 0, 50, 50);
+      xCanvas.Ellipse(xRect);
+      xRect.Offset(50, 0);
+      xCanvas.Rectangle(xRect);
+
+      xRect := Rect(0, 50, 50, 100);
+
+      xCanvas.Pen.Style := psSolid;
+      xCanvas.Pen.FPColor := FPColor($FFFF, $FFFF, $FFFF, $8000);
+      xCanvas.Pen.Width := 4;
+      xCanvas.Brush.Style := bsClear;
+
+      xCanvas.Ellipse(xRect);
+      xRect.Offset(50, 0);
+      xCanvas.Rectangle(xRect);
+      xRect.Offset(50, 0);
+      xCanvas.Polyline([
+        Point(xRect.CenterPoint.X, xRect.Top),
+        Point(xRect.Right, xRect.CenterPoint.Y),
+        Point(xRect.CenterPoint.X, xRect.Bottom),
+        Point(xRect.Left, xRect.CenterPoint.Y),
+        Point(xRect.CenterPoint.X, xRect.Top)]);
+      xRect.Offset(50, 0);
+      xCanvas.MoveTo(xRect.TopLeft);
+      xCanvas.LineTo(xRect.Right, xRect.Top);
+
+      xRect := Rect(0, 100, 50, 150);
+      xCanvas.Draw(xRect.Left, xRect.Top, xImage);
+      xRect.Offset(50, 0);
+      xCanvas.StretchDraw(xRect.Left, xRect.Top, xRect.Width, xRect.Height, xImage);
+
+      xRect := Rect(0, 150, 50, 200);
+      xCanvas.Font:=TFreeTypeFont.Create;
+      xCanvas.Font.FPColor := FPColor($FFFF, $FFFF, $FFFF, $8000);
+      xCanvas.Font.Name := 'DejaVuLGCSans.ttf';
+      xCanvas.Font.Size := 15;
+      (xCanvas.Font as TFreeTypeFont).AntiAliased := True;
+      xCanvas.TextOut(xRect.Left, xRect.CenterPoint.Y, 'Hello');
+
+      xRect.Offset(100, 0);
+      (xCanvas.Font as TFreeTypeFont).AntiAliased := False;
+      xCanvas.TextOut(xRect.Left, xRect.CenterPoint.Y, 'Hello');
+
+      xNew.SaveToFile(cImageName[xDrawingMode]+'.png');
+
+      xCanvas.Font.Free;
+      xCanvas.Font := nil;
+      FreeAndNil(xNew);
+      FreeAndNil(xCanvas);
+    end;
+  finally
+    xCanvas.Free;
+    xNew.Free;
+    xImage.Free;
+  end;
+end.
+

packages/fcl-image/examples/imgconv.pp

@@ -17,7 +17,7 @@ program ImgConv;
 
 {_$define UseFile}
 
-uses FPWriteXPM, FPWritePNG, FPWriteBMP,
+uses FPWriteXPM, FPWritePNG, FPWriteBMP,fpreadgif,fptiffcmn,
      FPReadXPM, FPReadPNG, FPReadBMP, fpreadjpeg,fpwritejpeg,
      fpreadtga,fpwritetga,fpreadpnm,fpwritepnm, fpreadtiff, fpwritetiff,
      {$ifndef UseFile}classes,{$endif}
@@ -40,6 +40,8 @@ begin
       Reader := TFPReaderBMP.Create
     else if T = 'J' then
       Reader := TFPReaderJPEG.Create
+    else if T = 'G' then
+      Reader := TFPReaderGif.Create
     else if T = 'P' then
       Reader := TFPReaderPNG.Create
     else if T = 'T' then
@@ -130,6 +132,19 @@ begin
       writeln ('Grayscale ',Grayscale, ' - Indexed ',Indexed,
                ' - WordSized ',WordSized,' - UseAlpha ',UseAlpha);
       end
+  else if (t[1] = 'F') then
+    with (Writer as TFPWriterTiff) do
+      begin
+      if pos ('G', t) > 0 then
+         begin
+         Img.Extra[TiffPhotoMetric]:='0';
+         if Pos('8',T)>0 then
+           Img.Extra[TiffGrayBits]:='8'
+         else if Pos('16',T)>0 then
+           Img.Extra[TiffGrayBits]:='16';
+         Writeln(TiffPhotoMetric,': 0 ',TiffGrayBits,': ',Img.Extra[TiffGrayBits]);
+         end;
+      end
   else if (t[1] = 'X') then
     begin
     if length(t) > 1 then
@@ -154,12 +169,14 @@ begin
     begin
     writeln ('Give filename to read and to write, preceded by filetype:');
     writeln ('X for XPM, P for PNG, B for BMP, J for JPEG, T for TGA,');
-    writeln ('N for PNM (read only), F for TIFF');
+    writeln ('N for PNM (read only), F for TIFF, G for gif (read only)');
     writeln ('example: imgconv X hello.xpm P hello.png');
     writeln ('example: imgconv hello.xpm P hello.png');
     writeln ('Options for');
     writeln ('  PNG :  G : grayscale, A : use alpha, ');
     writeln ('         I : Indexed in palette, W : Word sized.');
+    writeln ('  TIFF :  G16 write grayscale 16 bits/pixel');
+    writeln ('          G8 write grayscale 16 bits/pixel');
     writeln ('  XPM :  Number of chars to use for 1 pixel');
     writeln ('  The color size of an XPM can be set after the X as 1,2,3 or 4');
     writeln ('example: imgconv hello.xpm PIA hello.png');

packages/fcl-image/src/clipping.pp

@@ -87,7 +87,7 @@ begin
       y1 := top;
     if ( y2 > bottom ) then // bottom side needs to be clipped
       y2 := bottom;
-    if (x1 > x2) or (y1 < y2) then
+    if (x1 > x2) or (y1 > y2) then
       ClearRect;
     end;
 end;

packages/fcl-image/src/ellipses.pp

@@ -19,11 +19,11 @@ interface
 
 uses classes, FPImage, FPCanvas;
 
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; c:TFPColor);
-procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; c:TFPColor);
-procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
-procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; const c:TFPColor);
+procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; const c:TFPColor);
+procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
+procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; const c:TFPColor);
 procedure FillEllipseHashHorizontal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
 procedure FillEllipseHashVertical (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
 procedure FillEllipseHashDiagonal (Canv:TFPCustomCanvas; const Bounds:TRect; width:integer; const c:TFPColor);
@@ -317,7 +317,7 @@ end;
 { The drawing routines }
 
 type
-  TPutPixelProc = procedure (Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+  TPutPixelProc = procedure (Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
   TLinePoints = array[0..PatternBitCount-1] of boolean;
   PLinePoints = ^TLinePoints;
 
@@ -334,31 +334,31 @@ begin
   LinePoints^[0] := (APattern and i) <> 0;
 end;
 
-procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
-    Colors[x,y] := color;
+    DrawPixel(x,y,color);
 end;
 
-procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
     Colors[x,y] := Colors[x,y] xor color;
 end;
 
-procedure PutPixelOr(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelOr(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
     Colors[x,y] := Colors[x,y] or color;
 end;
 
-procedure PutPixelAnd(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
+procedure PutPixelAnd(Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
 begin
   with Canv do
     Colors[x,y] := Colors[x,y] and color;
 end;
 
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
 var info : TEllipseInfo;
     r, y : integer;
     MyPutPix : TPutPixelProc;
@@ -387,7 +387,7 @@ begin
     end;
 end;
 
-procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; c:TFPColor);
+procedure DrawSolidEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Width:integer; const c:TFPColor);
 var infoOut, infoIn : TEllipseInfo;
     r, y : integer;
     id : PEllipseInfoData;
@@ -430,7 +430,7 @@ begin
     end;
 end;
 
-procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; c:TFPColor);
+procedure DrawPatternEllipse (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TPenPattern; const c:TFPColor);
 var info : TEllipseInfo;
     xx, y : integer;
     LinePoints : TLinePoints;
@@ -496,7 +496,7 @@ begin
     end;
 end;
 
-procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; c:TFPColor);
+procedure FillEllipseColor (Canv:TFPCustomCanvas; const Bounds:TRect; const c:TFPColor);
 var info : TEllipseInfo;
     r, y : integer;
     id : PEllipseInfoData;
@@ -508,13 +508,13 @@ begin
       for r := 0 to info.infolist.count-1 do
         with PEllipseInfoData (info.infolist[r])^ do
           for y := ytopmin to ybotmax do
-            colors[x,y] := c;
+            DrawPixel(x,y,c);
   finally
     info.Free;
   end;
 end;
 
-procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; c:TFPColor);
+procedure FillEllipsePattern (Canv:TFPCustomCanvas; const Bounds:TRect; Pattern:TBrushPattern; const c:TFPColor);
 begin
 end;
 
@@ -530,7 +530,7 @@ begin
       with PEllipseInfoData (info.infolist[r])^ do
         for y := ytopmin to ybotmax do
           if (y mod width) = 0 then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
   finally
     info.Free;
   end;
@@ -548,7 +548,7 @@ begin
       with PEllipseInfoData (info.infolist[r])^ do
         if (x mod width) = 0 then
           for y := ytopmin to ybotmax do
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
   finally
     info.Free;
   end;
@@ -569,7 +569,7 @@ begin
         w := width - 1 - (x mod width);
         for y := ytopmin to ybotmax do
           if (y mod width) = w then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
         end;
   finally
     info.Free;
@@ -591,7 +591,7 @@ begin
         w := (x mod width);
         for y := ytopmin to ybotmax do
           if (y mod width) = w then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
         end;
   finally
     info.Free;
@@ -616,7 +616,7 @@ begin
           begin
           wy := y mod width;
           if (wy = w1) or (wy = w2) then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
           end;
         end;
   finally
@@ -636,11 +636,11 @@ begin
       with PEllipseInfoData (info.infolist[r])^ do
         if (x mod width) = 0 then
           for y := ytopmin to ybotmax do
-            canv.colors[x,y] := c
+            canv.DrawPixel(x,y,c)
         else
           for y := ytopmin to ybotmax do
             if (y mod width) = 0 then
-              canv.colors[x,y] := c;
+              canv.DrawPixel(x,y,c);
   finally
     info.Free;
   end;
@@ -660,7 +660,7 @@ begin
         begin
         w := (x mod image.width);
         for y := ytopmin to ybotmax do
-          canv.colors[x,y] := Image.colors[w, (y mod image.height)];
+          canv.DrawPixel(x,y,Image.colors[w, (y mod image.height)]);
         end;
   finally
     info.Free;
@@ -692,7 +692,7 @@ begin
           yi := (y - yo) mod image.height;
           if yi < 0 then
             inc (yi, image.height);
-          canv.colors[x,y] := Image.colors[xi, yi];
+          canv.DrawPixel(x,y,Image.colors[xi, yi]);
           end;
         end;
   finally

packages/fcl-image/src/fpcanvas.inc

@@ -571,6 +571,16 @@ begin
     end;
 end;
 
+procedure TFPCustomCanvas.DrawPixel(const x, y: integer;
+  const newcolor: TFPColor);
+begin
+  case FDrawingMode of
+    dmOpaque: Colors[x,y] := newcolor;
+    dmAlphaBlend: Colors[x,y] := AlphaBlend(Colors[x,y], newcolor);
+    dmCustom: Colors[x,y] := FOnCombineColors(Colors[x,y], newcolor);
+  end;
+end;
+
 procedure TFPCustomCanvas.Erase;
 var
   x,y:Integer;
@@ -784,7 +794,7 @@ begin
     begin
     xx := r - x;
     for t := yi to ym do
-      colors [r,t] := AlphaBlend(colors [r,t], image.colors[xx,t-y]);
+      DrawPixel(r,t, image.colors[xx,t-y]);
     end;
 end;
 

packages/fcl-image/src/fpcanvas.pp

@@ -233,6 +233,9 @@ type
     function IsPointInRegion(AX, AY: Integer): Boolean; override;
   end;
 
+  TFPDrawingMode = (dmOpaque, dmAlphaBlend, dmCustom);
+  TFPCanvasCombineColors = function(const color1, color2: TFPColor): TFPColor of object;
+
   { TFPCustomCanvas }
 
   TFPCustomCanvas = class(TPersistent)
@@ -243,6 +246,8 @@ type
     FHelpers : TList;
     FLocks : integer;
     FInterpolation : TFPCustomInterpolation;
+    FDrawingMode : TFPDrawingMode;
+    FOnCombineColors : TFPCanvasCombineColors;
     function AllowFont (AFont : TFPCustomFont) : boolean;
     function AllowBrush (ABrush : TFPCustomBrush) : boolean;
     function AllowPen (APen : TFPCustomPen) : boolean;
@@ -370,6 +375,7 @@ type
     procedure Draw (x,y:integer; image:TFPCustomImage);
     procedure StretchDraw (x,y,w,h:integer; source:TFPCustomImage);
     procedure Erase;virtual;
+    procedure DrawPixel(const x, y: integer; const newcolor: TFPColor);
     // properties
     property LockCount: Integer read FLocks;
     property Font : TFPCustomFont read GetFont write SetFont;
@@ -384,6 +390,8 @@ type
     property Height : integer read GetHeight write SetHeight;
     property Width : integer read GetWidth write SetWidth;
     property ManageResources: boolean read FManageResources write FManageResources;
+    property DrawingMode : TFPDrawingMode read FDrawingMode write FDrawingMode;
+    property OnCombineColors : TFPCanvasCombineColors read FOnCombineColors write FOnCombineColors;
   end;
 
   TFPCustomDrawFont = class (TFPCustomFont)

packages/fcl-image/src/fpcolcnv.inc

@@ -296,7 +296,7 @@ begin
 end;
 *)
 
-function AlphaBlend(color1, color2: TFPColor): TFPColor;
+function AlphaBlend(const color1, color2: TFPColor): TFPColor;
 var
   factor1, factor2: single;
 begin

packages/fcl-image/src/fpimage.pp

@@ -286,7 +286,7 @@ function ConvertColor (const From : TFPColor; Fmt : TColorFormat) : TDeviceColor
 function ConvertColor (const From : TDeviceColor; Fmt : TColorFormat) : TDeviceColor;
 *)
 
-function AlphaBlend(color1, color2: TFPColor): TFPColor;
+function AlphaBlend(const color1, color2: TFPColor): TFPColor;
 
 function FPColor (r,g,b,a:word) : TFPColor;
 function FPColor (r,g,b:word) : TFPColor;
@@ -561,7 +561,7 @@ FuzzyDepth: word = 4): TFPCustomImage;
 { HTML Color support. RRGGBB or color name. Only W3 color names s are supported}
 
 function TryHtmlToFPColor(const S: String; out FPColor: TFPColor): Boolean;
-function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; Def: TFPColor): TFPColor;
+function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; const Def: TFPColor): TFPColor;
 function HtmlToFPColor(const S: String): TFPColor;
 
 
@@ -613,12 +613,12 @@ begin
             (c.Alpha = d.Alpha);
 end;
 
-function GetFullColorData (color:TFPColor) : TColorData;
+function GetFullColorData (const color:TFPColor) : TColorData;
 begin
   result := PColorData(@color)^;
 end;
 
-function SetFullColorData (color:TColorData) : TFPColor;
+function SetFullColorData (const color:TColorData) : TFPColor;
 begin
   result := PFPColor (@color)^;
 end;
@@ -760,7 +760,7 @@ begin
   end;
 end;
 
-function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; Def: TFPColor): TFPColor;
+function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; const Def: TFPColor): TFPColor;
 begin
   if not TryHtmlToFPColor(S, Result) then
     Result := Def;

packages/fcl-image/src/fpinterpolation.inc

@@ -17,7 +17,7 @@ begin
 
   for dx := 0 to w-1 do
     for dy := 0 to h-1 do
-      Canvas.Colors[x+dx,y+dy] := Image.Colors[dx*iw div w, dy*ih div h];
+      Canvas.DrawPixel(x+dx,y+dy, Image.Colors[dx*iw div w, dy*ih div h]);
 end;
 
 { TFPBaseInterpolation }
@@ -223,7 +223,7 @@ begin
           NewCol.blue:=Min(NewCol.blue+round(Col.blue*f),$ffff);
           NewCol.alpha:=Min(NewCol.alpha+round(Col.alpha*f),$ffff);
         end;
-        Canvas.Colors[x+dx,y+dy]:=AlphaBlend(Canvas.Colors[x+dx,y+dy], NewCol);
+        Canvas.DrawPixel(x+dx,y+dy, NewCol);
       end;
     end;
   finally

packages/fcl-image/src/fpreadgif.pas

@@ -211,7 +211,10 @@ begin
     // skip extensions
     Repeat
       Introducer:=SkipBlock(Stream);
-    until (Introducer = $2C) or (Introducer = $3B);
+    until (Introducer = $2C) or (Introducer = $3B) or (Stream.Position>=Stream.Size);
+    
+    if Stream.Position>=Stream.Size then 
+      Exit;
 
     // descriptor
     Stream.Read(FDescriptor, SizeOf(FDescriptor));
@@ -298,7 +301,10 @@ begin
         Stream.Seek(B, soFromCurrent);
         CodeMask := (1 shl CodeSize) - 1;
       end;
-    until B = 0;
+    until (B = 0)  or (Stream.Position>=Stream.Size);
+    
+   { if Stream.Position>=Stream.Size then 
+      Exit(False); }
 
     Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),
              False, Rect(0,0,0,0), '', ContProgress);
@@ -315,7 +321,11 @@ begin
          Stream.ReadBuffer(SourcePtr^, B);
          Inc(SourcePtr,B);
       end;
-    until B = 0;
+    until (B = 0) or (Stream.Position>=Stream.Size);
+    
+   { if Stream.Position>=Stream.Size then
+       Exit(False); }
+              
 
     Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),
              False, Rect(0,0,0,0), '', ContProgress);

packages/fcl-image/src/fpwritexpm.pp

@@ -28,7 +28,7 @@ type
       FColorShift : word;
       FColorSize : byte;
       procedure SetColorSize (AValue : byte);
-      function ColorToHex (c:TFPColor) : string;
+      function ColorToHex (const c:TFPColor) : string;
     protected
       procedure InternalWrite (Str:TStream; Img:TFPCustomImage); override;
     public
@@ -61,7 +61,7 @@ begin
     FColorSize := AValue;
 end;
 
-function TFPWriterXPM.ColorToHex (c:TFPColor) : string;
+function TFPWriterXPM.ColorToHex (const c:TFPColor) : string;
 var r,g,b : word;
 begin
   with c do

packages/fcl-image/src/ftfont.pp

@@ -349,12 +349,20 @@ const
 
 procedure TFreeTypeFont.DrawChar (x,y:integer; data:PByteArray; pitch, width, height:integer);
 
-  procedure Combine (canv:TFPCustomCanvas; x,y:integer; c : TFPColor; t:longword);
+  procedure Combine (canv:TFPCustomCanvas; x,y:integer; const c : TFPColor; t:longword);
   var
     pixelcolor: TFPColor;
   begin
-    pixelcolor := AlphaBlend(canv.colors[x,y], FPImage.FPColor(c.red, c.green,c.blue, (t+1) shl 8 - 1));
-    canv.colors[x,y] := pixelcolor;
+    case canv.DrawingMode of
+      dmOpaque:
+      begin
+        pixelcolor := FPImage.FPColor(c.red, c.green,c.blue, (t+1) shl 8 - 1); // opaque: ignore c.Alpha
+        canv.colors[x,y] := AlphaBlend(canv.colors[x,y], pixelcolor);
+      end;
+    else
+      pixelcolor := FPImage.FPColor(c.red, c.green,c.blue, ((t+1) shl 8 - 1) * c.Alpha div $ffff); // apply c.Alpha
+      canv.DrawPixel(x,y,pixelcolor);
+    end;
   end;
 
 var b,rx,ry : integer;
@@ -380,7 +388,7 @@ begin
       begin
       rb := rx mod 8;
       if (data^[b+l] and bits[rb]) <> 0 then
-        canvas.colors[x+rx,y+ry] := FPColor;
+        canvas.DrawPixel(x+rx,y+ry, FPColor);
       if rb = 7 then
         inc (l);
       end;

packages/fcl-image/src/pixtools.pp

@@ -75,7 +75,7 @@ begin
     begin
     for x := x1 to x2 do
       for y := y1 to y2 do
-        colors[x,y] := color;
+        DrawPixel(x,y,color);
     end;
 end;
 
@@ -104,7 +104,7 @@ type
 procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
 begin
   with Canv do
-    Colors[x,y] := color;
+    DrawPixel(x,y,color);
 end;
 
 procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
@@ -557,7 +557,7 @@ begin
   with image do
     for x := x1 to x2 do
       for y := y1 to y2 do
-        Canv.colors[x,y] := colors[x mod width, y mod height];
+        Canv.DrawPixel(x,y, colors[x mod width, y mod height]);
 end;
 
 procedure FillRectangleImageRel (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer; const Image:TFPCustomImage);
@@ -566,7 +566,7 @@ begin
   with image do
     for x := x1 to x2 do
       for y := y1 to y2 do
-        Canv.colors[x,y] := colors[(x-x1) mod width, (y-y1) mod height];
+        Canv.DrawPixel(x,y, colors[(x-x1) mod width, (y-y1) mod height]);
 end;
 
 type
@@ -890,7 +890,7 @@ end;
 
 procedure SetFloodColor (Canv:TFPCustomCanvas; x,y:integer; data:pointer);
 begin
-  Canv.colors[x,y] := PFPColor(data)^;
+  Canv.DrawPixel(x,y, PFPColor(data)^);
 end;
 
 procedure FillFloodColor (Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
@@ -967,7 +967,7 @@ var r : PFloodHashRec;
 begin
   r := PFloodHashRec(data);
   if (y mod r^.width) = 0 then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashVer(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -975,7 +975,7 @@ var r : PFloodHashRec;
 begin
   r := PFloodHashRec(data);
   if (x mod r^.width) = 0 then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashDiag(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -985,7 +985,7 @@ begin
   r := PFloodHashRec(data);
   w := r^.width;
   if ((x mod w) + (y mod w)) = (w - 1) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashBDiag(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -995,7 +995,7 @@ begin
   r := PFloodHashRec(data);
   w := r^.width;
   if (x mod w) = (y mod w) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashCross(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -1005,7 +1005,7 @@ begin
   r := PFloodHashRec(data);
   w := r^.width;
   if ((x mod w) = 0) or ((y mod w) = 0) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashDiagCross(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -1016,7 +1016,7 @@ begin
   w := r^.width;
   if ( (x mod w) = (y mod w) ) or
      ( ((x mod w) + (y mod w)) = (w - 1) ) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure FillFloodHash (Canv:TFPCustomCanvas; x,y:integer; width:integer; SetHashColor:TFuncSetColor; const c:TFPColor);
@@ -1109,7 +1109,7 @@ var r : PFloodImageRec;
 begin
   r := PFloodImageRec(data);
   with r^.image do
-    Canv.colors[x,y] := colors[x mod width, y mod height];
+    Canv.DrawPixel(x,y,colors[x mod width, y mod height]);
 end;
 
 procedure FillFloodImage (Canv:TFPCustomCanvas; x,y :integer; const Image:TFPCustomImage);
@@ -1142,7 +1142,7 @@ begin
     yi := (y - yo) mod height;
     if yi < 0 then
       yi := height - yi;
-    Canv.colors[x,y] := colors[xi,yi];
+    Canv.DrawPixel(x,y,colors[xi,yi]);
     end;
 end;