View Issue Details

IDProjectCategoryView StatusLast Update
0034266FPCFCLpublic2019-02-16 20:37
ReporterOndrej PokornyAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityhave not tried
Status closedResolutionfixed 
Product VersionProduct Build 
Target Version3.2.0Fixed in Version3.3.1 
Summary0034266: TFPCustomCanvas.Draw and .StretchDraw do not support alpha-blended images
DescriptionIf you draw an image with an alpha channel with .Draw or .StretchDraw, the original canvas pixels are overwritten even if the image is transparent there.
Steps To ReproduceSee the attached project. See the results in attached images:
edit-clear-draw - orig.png VS edit-clear-draw - patched.png
edit-clear-strechdraw - orig.png VS edit-clear-strechdraw - patched.png
Additional InformationPatch attached.
TagsNo tags attached.
Fixed in Revision41341
FPCOldBugId
FPCTarget
Attached Files
  • fpcanvas-draw-alphablend.patch (1,012 bytes)
    Index: packages/fcl-image/src/fpcanvas.inc
    ===================================================================
    --- packages/fcl-image/src/fpcanvas.inc	(revision 39741)
    +++ packages/fcl-image/src/fpcanvas.inc	(working copy)
    @@ -784,7 +784,7 @@
         begin
         xx := r - x;
         for t := yi to ym do
    -      colors [r,t] := image.colors[xx,t-y];
    +      colors [r,t] := AlphaBlend(colors [r,t], image.colors[xx,t-y]);
         end;
     end;
     
    Index: packages/fcl-image/src/fpinterpolation.inc
    ===================================================================
    --- packages/fcl-image/src/fpinterpolation.inc	(revision 39741)
    +++ packages/fcl-image/src/fpinterpolation.inc	(working copy)
    @@ -223,7 +223,7 @@
               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]:=NewCol;
    +        Canvas.Colors[x+dx,y+dy]:=AlphaBlend(Canvas.Colors[x+dx,y+dy], NewCol);
           end;
         end;
       finally
    
  • fpcanvas-drawmode-01.patch (11,169 bytes)
    Index: packages/fcl-image/src/ellipses.pp
    ===================================================================
    --- packages/fcl-image/src/ellipses.pp	(revision 41244)
    +++ packages/fcl-image/src/ellipses.pp	(working copy)
    @@ -337,7 +337,7 @@
     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 @@
           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 @@
           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 @@
           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 @@
             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 @@
             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
               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 @@
           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
             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 @@
               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
    Index: packages/fcl-image/src/fpcanvas.inc
    ===================================================================
    --- packages/fcl-image/src/fpcanvas.inc	(revision 41244)
    +++ packages/fcl-image/src/fpcanvas.inc	(working copy)
    @@ -571,6 +571,16 @@
         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
         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;
     
    Index: packages/fcl-image/src/fpcanvas.pp
    ===================================================================
    --- packages/fcl-image/src/fpcanvas.pp	(revision 41244)
    +++ packages/fcl-image/src/fpcanvas.pp	(working copy)
    @@ -233,6 +233,9 @@
         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 @@
         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 @@
         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 @@
         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)
    Index: packages/fcl-image/src/fpinterpolation.inc
    ===================================================================
    --- packages/fcl-image/src/fpinterpolation.inc	(revision 41244)
    +++ packages/fcl-image/src/fpinterpolation.inc	(working copy)
    @@ -17,7 +17,7 @@
     
       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 @@
               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
    Index: packages/fcl-image/src/ftfont.pp
    ===================================================================
    --- packages/fcl-image/src/ftfont.pp	(revision 41244)
    +++ packages/fcl-image/src/ftfont.pp	(working copy)
    @@ -353,8 +353,16 @@
       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
           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;
    Index: packages/fcl-image/src/pixtools.pp
    ===================================================================
    --- packages/fcl-image/src/pixtools.pp	(revision 41244)
    +++ packages/fcl-image/src/pixtools.pp	(working copy)
    @@ -75,7 +75,7 @@
         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 @@
     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 @@
       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 @@
       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 @@
     
     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 @@
     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 @@
     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 @@
       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 @@
       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 @@
       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 @@
       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 @@
     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 @@
         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;
     
    
  • alphablend.png (15,798 bytes)
    alphablend.png (15,798 bytes)
  • opaque.png (15,142 bytes)
    opaque.png (15,142 bytes)
  • FPCanvasAlphaDraw.zip (193,351 bytes)

Relationships

related to 0034479 resolvedMichael Van Canneyt Artifacts in TImageList when importing image with transparent background 

Activities

Ondrej Pokorny

2018-09-12 11:31

reporter  

fpcanvas-draw-alphablend.patch (1,012 bytes)
Index: packages/fcl-image/src/fpcanvas.inc
===================================================================
--- packages/fcl-image/src/fpcanvas.inc	(revision 39741)
+++ packages/fcl-image/src/fpcanvas.inc	(working copy)
@@ -784,7 +784,7 @@
     begin
     xx := r - x;
     for t := yi to ym do
-      colors [r,t] := image.colors[xx,t-y];
+      colors [r,t] := AlphaBlend(colors [r,t], image.colors[xx,t-y]);
     end;
 end;
 
Index: packages/fcl-image/src/fpinterpolation.inc
===================================================================
--- packages/fcl-image/src/fpinterpolation.inc	(revision 39741)
+++ packages/fcl-image/src/fpinterpolation.inc	(working copy)
@@ -223,7 +223,7 @@
           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]:=NewCol;
+        Canvas.Colors[x+dx,y+dy]:=AlphaBlend(Canvas.Colors[x+dx,y+dy], NewCol);
       end;
     end;
   finally

Ondrej Pokorny

2018-09-12 11:31

reporter  

Ondrej Pokorny

2018-09-12 11:31

reporter  

Ondrej Pokorny

2018-09-12 11:31

reporter  

Ondrej Pokorny

2018-09-12 11:32

reporter  

Michael Van Canneyt

2018-09-12 17:22

administrator   ~0110696

Checked and applied, thank you very much !

Ondrej Pokorny

2018-09-12 17:26

reporter   ~0110698

Thank you!

Ondrej Pokorny

2019-02-01 11:36

reporter   ~0113769

My patch caused regressions in old code that needs the background to be copied even if it is transparent. See the related issue 0034479.

The solution is to implement a drawing mode (opaque/transparent). For backwards compatibility the default drawing mode should be opaque (=background will be rewritten). The new transparent drawing should be available only if drawing mode is transparent.

Graphics32 uses this approach as well: https://graphics32.github.io/Docs/Units/GR32/Classes/TCustomBitmap32/Properties/DrawMode.htm

I'll prepare a new patch.

Ondrej Pokorny

2019-02-07 08:22

reporter  

fpcanvas-drawmode-01.patch (11,169 bytes)
Index: packages/fcl-image/src/ellipses.pp
===================================================================
--- packages/fcl-image/src/ellipses.pp	(revision 41244)
+++ packages/fcl-image/src/ellipses.pp	(working copy)
@@ -337,7 +337,7 @@
 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 @@
       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 @@
       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 @@
       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 @@
         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 @@
         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
           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 @@
       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
         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 @@
           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
Index: packages/fcl-image/src/fpcanvas.inc
===================================================================
--- packages/fcl-image/src/fpcanvas.inc	(revision 41244)
+++ packages/fcl-image/src/fpcanvas.inc	(working copy)
@@ -571,6 +571,16 @@
     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
     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;
 
Index: packages/fcl-image/src/fpcanvas.pp
===================================================================
--- packages/fcl-image/src/fpcanvas.pp	(revision 41244)
+++ packages/fcl-image/src/fpcanvas.pp	(working copy)
@@ -233,6 +233,9 @@
     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 @@
     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 @@
     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 @@
     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)
Index: packages/fcl-image/src/fpinterpolation.inc
===================================================================
--- packages/fcl-image/src/fpinterpolation.inc	(revision 41244)
+++ packages/fcl-image/src/fpinterpolation.inc	(working copy)
@@ -17,7 +17,7 @@
 
   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 @@
           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
Index: packages/fcl-image/src/ftfont.pp
===================================================================
--- packages/fcl-image/src/ftfont.pp	(revision 41244)
+++ packages/fcl-image/src/ftfont.pp	(working copy)
@@ -353,8 +353,16 @@
   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
       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;
Index: packages/fcl-image/src/pixtools.pp
===================================================================
--- packages/fcl-image/src/pixtools.pp	(revision 41244)
+++ packages/fcl-image/src/pixtools.pp	(working copy)
@@ -75,7 +75,7 @@
     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 @@
 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 @@
   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 @@
   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 @@
 
 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 @@
 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 @@
 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 @@
   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 @@
   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 @@
   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 @@
   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 @@
 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 @@
     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;
 

Ondrej Pokorny

2019-02-07 08:23

reporter  

alphablend.png (15,798 bytes)
alphablend.png (15,798 bytes)

Ondrej Pokorny

2019-02-07 08:23

reporter  

opaque.png (15,142 bytes)
opaque.png (15,142 bytes)

Ondrej Pokorny

2019-02-07 08:24

reporter  

FPCanvasAlphaDraw.zip (193,351 bytes)

Ondrej Pokorny

2019-02-07 08:28

reporter   ~0113920

I created a new patch - see fpcanvas-drawmode-01.patch.

It adds support to DrawMode (opaque / alpha blend / custom) and uses this DrawMode for all available objects (at least objects that I found).

See the test project in FPCanvasAlphaDraw.zip that generates the two sample images.

The default drawing mode is dmOpaque, that means the issue 0034479 should be fixed with this. (Of course new code that takes advantage of r39748 must be fixed to use DrawMode:=dmAlphaBlend.)

Michael Van Canneyt

2019-02-16 13:44

administrator   ~0114178

Nice job. Applied, tested, added demo program.

Many thanks !

Ondrej Pokorny

2019-02-16 20:37

reporter   ~0114196

Thank you for looking at this and applying!

Issue History

Date Modified Username Field Change
2018-09-12 11:31 Ondrej Pokorny New Issue
2018-09-12 11:31 Ondrej Pokorny File Added: fpcanvas-draw-alphablend.patch
2018-09-12 11:31 Ondrej Pokorny File Added: edit-clear-draw - orig.png
2018-09-12 11:31 Ondrej Pokorny File Added: edit-clear-draw - patched.png
2018-09-12 11:31 Ondrej Pokorny File Added: edit-clear-strechdraw - orig.png
2018-09-12 11:32 Ondrej Pokorny File Added: edit-clear-strechdraw - patched.png
2018-09-12 13:28 Michael Van Canneyt Assigned To => Michael Van Canneyt
2018-09-12 13:28 Michael Van Canneyt Status new => assigned
2018-09-12 17:22 Michael Van Canneyt Fixed in Revision => 39748
2018-09-12 17:22 Michael Van Canneyt Note Added: 0110696
2018-09-12 17:22 Michael Van Canneyt Status assigned => resolved
2018-09-12 17:22 Michael Van Canneyt Fixed in Version => 3.3.1
2018-09-12 17:22 Michael Van Canneyt Resolution open => fixed
2018-09-12 17:22 Michael Van Canneyt Target Version => 3.2.0
2018-09-12 17:26 Ondrej Pokorny Note Added: 0110698
2018-09-12 17:26 Ondrej Pokorny Status resolved => closed
2018-10-31 09:44 Michael Van Canneyt Relationship added related to 0034479
2019-02-01 11:36 Ondrej Pokorny Note Added: 0113769
2019-02-01 11:36 Ondrej Pokorny Status closed => feedback
2019-02-01 11:36 Ondrej Pokorny Resolution fixed => reopened
2019-02-07 08:22 Ondrej Pokorny File Added: fpcanvas-drawmode-01.patch
2019-02-07 08:23 Ondrej Pokorny File Added: alphablend.png
2019-02-07 08:23 Ondrej Pokorny File Added: opaque.png
2019-02-07 08:24 Ondrej Pokorny File Added: FPCanvasAlphaDraw.zip
2019-02-07 08:28 Ondrej Pokorny Note Added: 0113920
2019-02-07 08:28 Ondrej Pokorny Status feedback => assigned
2019-02-16 13:44 Michael Van Canneyt Fixed in Revision 39748 => 41341
2019-02-16 13:44 Michael Van Canneyt Note Added: 0114178
2019-02-16 13:44 Michael Van Canneyt Status assigned => resolved
2019-02-16 13:44 Michael Van Canneyt Resolution reopened => fixed
2019-02-16 20:37 Ondrej Pokorny Note Added: 0114196
2019-02-16 20:37 Ondrej Pokorny Status resolved => closed