* Gradient implementation, by Werner Pamler. Fixes issue #41257

packages/fcl-image/examples/demogradient.pp

@@ -0,0 +1,24 @@
+program demogradient;
+
+uses
+  Types, FPImage, FPCanvas, FPImgCanv, FPWriteBMP;
+  
+var
+  img: TFPMemoryImage;
+  canv: TFPCustomCanvas;
+  
+begin
+  img := TFPMemoryImage.Create(256, 128);
+  try
+    canv := TFPImageCanvas.Create(img);
+    try
+      canv.GradientFill(Rect(0, 0, 128, img.Height), colRed, colYellow, gdVertical);
+      canv.GradientFill(Rect(128, 0, 256, img.Height), colRed, colYellow, gdHorizontal);
+      img.SaveToFile('test.bmp');
+    finally
+      canv.Free;
+    end;
+  finally
+    img.Free;
+  end;
+end.

packages/fcl-image/src/fpcanvas.inc

@@ -598,6 +598,63 @@ begin
       Colors[x,y]:=colTransparent;
 end;
 
+function InterpolateColor(AStartColor, AEndColor: TFPColor; x, Total: Integer): TFPColor;
+var
+  f1, f2: Double;
+begin
+  f2 := x / Total;
+  f1 := 1.0 - f2;
+  Result.Red := round(AStartColor.Red * f1 + AEndColor.Red * f2);
+  Result.Green := round(AStartColor.Green * f1 + AEndColor.Green * f2);
+  Result.Blue := round(AStartColor.Blue * f1 + AEndColor.Blue * f2);
+  Result.Alpha := round(AStartColor.Alpha * f1 + AEndColor.Alpha * f2);
+end;
+
+procedure TFPCustomCanvas.GradientFill(const ARect: TRect;
+  AStartColor, AEndColor: TFPColor; ADirection: TFPGradientDirection);
+var
+  x, y, i, n: Integer;
+  oldPenStyle: TFPPenStyle;
+  oldPenWidth: Integer;
+  oldPenColor: TFPColor;
+begin
+  oldPenStyle := Pen.Style;
+  oldPenWidth := Pen.Width;
+  oldPenColor := Pen.FPColor;
+  Pen.Style := psSolid;
+  Pen.Width := 1;
+
+  if ADirection = gdVertical then
+  begin
+    n := ARect.Bottom - ARect.Top;
+    if n = 0 then
+      exit;
+    i := 0;
+    for y := ARect.Top to ARect.Bottom - 1 do
+    begin
+      Pen.FPColor := InterpolateColor(AStartColor, AEndColor, i, n);
+      Line(ARect.Left, y, ARect.Right - 1, y);
+      inc(i);
+    end;
+  end else
+  begin
+    n := ARect.Right - ARect.Left;
+    if n = 0 then
+      exit;
+    i := 0;
+    for x := ARect.Left to ARect.Right - 1 do
+    begin
+      Pen.FPColor := InterpolateColor(AStartColor, AEndColor, i, n);
+      Line(x, ARect.Top, x, ARect.Bottom - 1);
+      inc(i);
+    end;
+  end;
+
+  Pen.Style := oldPenStyle;
+  Pen.Width := oldPenWidth;
+  Pen.FPColor := oldPenColor;
+end;
+
 procedure TFPCustomCanvas.DoRectangleAndFill (const Bounds:TRect);
 begin
   DoRectangleFill (Bounds);

packages/fcl-image/src/fpcanvas.pp

@@ -241,6 +241,7 @@ type
 
   TFPDrawingMode = (dmOpaque, dmAlphaBlend, dmCustom);
   TFPCanvasCombineColors = function(const color1, color2: TFPColor): TFPColor of object;
+  TFPGradientDirection = (gdVertical, gdHorizontal);
 
   { TFPCustomCanvas }
 
@@ -383,6 +384,7 @@ type
     procedure StretchDraw (x,y,w,h:integer; source:TFPCustomImage); virtual;
     procedure Erase;virtual;
     procedure DrawPixel(const x, y: integer; const newcolor: TFPColor);
+    procedure GradientFill(const ARect: TRect; AStartColor, AEndColor: TFPColor; ADirection: TFPGradientDirection); virtual;
     // properties
     property LockCount: Integer read FLocks;
     property Font : TFPCustomFont read GetFont write SetFont;