* Patch from Ondrej Pokorny, to demonstrate alpha blending mode

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@41341 3ad0048d-3df7-0310-abae-a5850022a9f2

9 files changed, 153 insertions, 30 deletions

diff --git a/packages/fcl-image/examples/DejaVuLGCSans.ttf b/packages/fcl-image/examples/DejaVuLGCSans.ttf
new file mode 100644
index 0000000000..ddac067e9b
--- /dev/null
+++ b/packages/fcl-image/examples/DejaVuLGCSans.ttf
diff --git a/packages/fcl-image/examples/edit-clear.png b/packages/fcl-image/examples/edit-clear.png
new file mode 100644
index 0000000000..e6c8e8b9f3
--- /dev/null
+++ b/packages/fcl-image/examples/edit-clear.png
diff --git a/packages/fcl-image/examples/fpcanvasalphadraw.pp b/packages/fcl-image/examples/fpcanvasalphadraw.pp
new file mode 100644
index 0000000000..1c337bd4d8
--- /dev/null
+++ b/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.
+
diff --git a/packages/fcl-image/src/ellipses.pp b/packages/fcl-image/src/ellipses.pp
index 2141340999..1f14ee18b7 100644
--- a/packages/fcl-image/src/ellipses.pp
+++ b/packages/fcl-image/src/ellipses.pp
@@ -337,7 +337,7 @@ end;
 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);
@@ -508,7 +508,7 @@ 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;
@@ -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
diff --git a/packages/fcl-image/src/fpcanvas.inc b/packages/fcl-image/src/fpcanvas.inc
index 51bc07d064..21a5151fe2 100644
--- a/packages/fcl-image/src/fpcanvas.inc
+++ b/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;
 
diff --git a/packages/fcl-image/src/fpcanvas.pp b/packages/fcl-image/src/fpcanvas.pp
index 86882094a2..57a59ca432 100644
--- a/packages/fcl-image/src/fpcanvas.pp
+++ b/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)
diff --git a/packages/fcl-image/src/fpinterpolation.inc b/packages/fcl-image/src/fpinterpolation.inc
index 6dc88680d1..682f593faf 100644
--- a/packages/fcl-image/src/fpinterpolation.inc
+++ b/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
diff --git a/packages/fcl-image/src/ftfont.pp b/packages/fcl-image/src/ftfont.pp
index 0c2071f359..83f1bd7264 100644
--- a/packages/fcl-image/src/ftfont.pp
+++ b/packages/fcl-image/src/ftfont.pp
@@ -353,8 +353,16 @@ procedure TFreeTypeFont.DrawChar (x,y:integer; data:PByteArray; pitch, width, he
   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;
diff --git a/packages/fcl-image/src/pixtools.pp b/packages/fcl-image/src/pixtools.pp
index 69dc8bd822..46b08b8581 100644
--- a/packages/fcl-image/src/pixtools.pp
+++ b/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;