diff --git a/.gitattributes b/.gitattributes
index 1e55869f31..cc2740de08 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -2430,6 +2430,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
@@ -2437,6 +2438,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
diff --git a/packages/fcl-image/examples/DejaVuLGCSans.ttf b/packages/fcl-image/examples/DejaVuLGCSans.ttf
new file mode 100644
index 0000000000..ddac067e9b
Binary files /dev/null and b/packages/fcl-image/examples/DejaVuLGCSans.ttf differ
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
Binary files /dev/null and b/packages/fcl-image/examples/edit-clear.png differ
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;