Gradient with fcl-image

[Jonny]

Maybe I am missing something, but I cannot figure out why I cannot daw a gradient with FPImage.

Code: Pascal  [Select][+][-]

1.  
2. var
3.     theimage: TFPMemoryImage;
4.     thecanvas: TFPImageCanvas;
5. begin
6.     theimage := TFPMemoryImage.Create(0,0);
7.     thecanvas := TFPImageCanvas.Create(theimage);
8.     theimage.width := 400;
9.     theimage.height := 400;
10.     thecanvas.gradientfill(rect(0,0,400,200),colblack,colwhite,gdhorizontal);
11.     thecanvas.gradientfill(rect(0,200,400,400),colblack,coltransparent,gdhorizontal);
12.  

I am using fpimage for transparency yet gradientfill does not seem to be a valid procedure.

[wp]

AFAIK gradients are not supported in fcl-image. Horizontal and vertical gradient should be relatively easy to implement, but I don't have the time at the moment to write a patch.

[Jonny]

I see, no wonder that I am struggling!

If you can provide some direction then I can try creating a patch and share it here.

[jamie]

I don't know what you are doing actually but, look below.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Button1: TButton;
16.     Image1: TImage;
17.     procedure Button1Click(Sender: TObject);
18.   private
19.  
20.   public
21.  
22.   end;
23.  
24. var
25.   Form1: TForm1;
26.  
27. implementation
28.  
29. {$R *.lfm}
30.  
31. { TForm1 }
32.  
33. procedure TForm1.Button1Click(Sender: TObject);
34. begin
35.  With Image1 do
36.   Begin
37.    Canvas.gradientfill(rect(0,0,width,height shr 1),clblack,clwhite,gdhorizontal);
38.    Canvas.gradientfill(rect(0,Height shr 1,width,height),clblack,clblue,gdhorizontal);
39.   end;
40.  
41. end;
42.  
43. end.
44.  
45.  
46.  

Drop a Timage on the form and a TButton. copy the events here.

[Jonny]

I don't know what you are doing actually but, look below.

Drop a Timage on the form and a TButton. copy the events here.

Thanks @jamie, but this bit will be used in a non-gui utility to preprocess some images, so no visual components, and I need transparency.

[wp]

If you can provide some direction then I can try creating a patch and share it here.

I suppose you are after the analogon of TCanvas.GradientFill which is the only gradient supported by the LCL and which fills only rectangles. For this case, you could adapt the fill-rectangle procedure of fcl image which calls the following FillRectangleColor procedure in unit PixTools (I added the procedure to the wiki: https://wiki.freepascal.org/fcl-image#Drawing_a_Gradient):

Code: Pascal  [Select][+][-]

1. procedure FillRectangleColor (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer; const color:TFPColor);
2. var x,y : integer;
3. begin
4.   SortRect (x1,y1, x2,y2);
5.   with Canv do
6.     begin
7.       for y := y1 to y2 do
8.         for x := x1 to x2 do
9.           DrawPixel(x,y,color);
10.     end;
11. end;

For drawing a vertical gradient (color changes vertically) you must draw horizontal lines like in this procedure; the only difference is that the color changes from row to row (y value). You determine the row color by interpolation of the RGB values between the gradient start and end color, depending on the relative y value. Likewise you can draw a horizontal gradient - just exchange the x and y loops so that you draw vertical lines.

The following mini project demonstrates this:

Code: Pascal  [Select][+][-]

1. {-------------------------------------------------------------------------------
2.   Demonstrates drawing a vertical and horizontal gradient in a rectangle.
3. -------------------------------------------------------------------------------}
4.  
5. {$mode objfpc}{$h+}
6.  
7. program project1;
8.  
9. uses
10.   Classes, Types,
11.   FPImage, FPCanvas, FPImgCanv, FPWritePNG;
12.  
13. type
14.   TGradientDir = (gdHorizontal, gdVertical);
15.  
16. procedure GradientFill(Canvas: TFPCustomCanvas; ARect: TRect;
17.   AStartColor, AEndColor: TFPColor; ADirection: TGradientDir);
18.  
19.   function InterpolateColor(x, xmax: Integer): TFPColor;
20.   var
21.     factor1, factor2: Single;
22.   begin
23.     factor2 := x / xmax;
24.     factor1 := 1.0 - factor2;
25.     Result.Red := trunc(AStartColor.Red * factor1 + AEndColor.Red * factor2);
26.     Result.Green := trunc(AStartColor.Green * factor1 + AEndColor.Green * factor2);
27.     Result.Blue := trunc(AStartColor.Blue * factor1 + AEndColor.Blue * factor2);
28.     Result.Alpha := trunc(AStartColor.Alpha * factor1 + AEndColor.Alpha * factor2);
29.   end;
30.  
31. var
32.   x, y, xmax, ymax: Integer;
33.   color: TFPColor;
34. begin
35.   if ADirection = gdHorizontal then
36.   begin
37.     xmax := ARect.Right - ARect.Left;
38.     for x := ARect.Left to ARect.Right do
39.     begin
40.       color := InterpolateColor(x - ARect.Left, xmax);
41.       for y := ARect.Top to ARect.Bottom do
42.         Canvas.DrawPixel(x, y, color);
43.     end;
44.   end else
45.   begin
46.     ymax := ARect.Bottom - ARect.Top + 1;
47.     for y := ARect.Top to ARect.Bottom do
48.     begin
49.       color := InterpolateColor(y - ARect.Top, ymax);
50.       for x := ARect.Left to ARect.Right do
51.         Canvas.DrawPixel(x, y, color);
52.     end;
53.   end;
54. end;
55.  
56. var
57.   image: TFPCustomImage;
58.   canvas: TFPImageCanvas;
59.   R: TRect;
60.  
61. begin
62.   image := TFPMemoryImage.Create(400, 200);
63.   try
64.     canvas := TFPImageCanvas.Create(image);
65.     try
66.       // Horizontal gradient
67.       R := Rect(10, 10, 195, 190);
68.       canvas.Brush.Style := bsClear;
69.       canvas.Pen.FPColor := colWhite;
70.       canvas.Rectangle(R);
71.       InflateRect(R, -1, -1);
72.       GradientFill(canvas, R, colRed, colYellow, gdHorizontal);
73.  
74.       // Vertical gradient
75.       R := Rect(205, 10, 390, 190);
76.       canvas.Pen.FPColor := colWhite;
77.       canvas.Rectangle(R);
78.       InflateRect(R, -1, -1);
79.       GradientFill(canvas, R, colBlue, colSilver, gdVertical);
80.  
81.       // Save to file
82.       image.SaveToFile('Gradient_Test.png');
83.  
84.     finally
85.       canvas.Free;
86.     end;
87.  
88.   finally
89.     image.Free;
90.   end;
91. end.

For incorportation in fcl-image, I guess, this gradient drawing procedure should become a method of TFPPixelCanvas which implements all the other drawing routines. And - what's more work - I would think that should be generalized to other shapes (ellipses, polygons). The basic fill routines for them are available in unit PixTools; they must be adapted to a changing color like here for the rectangle.

[Jonny]

Wow, thank you @wp, I really was not expecting you to do that! Your amazing support here continues to be top notch.

I did do a deep dive into the LCL sources, and even though it blew my mind (ouch!!), my conclusion was: what a mess the different image formats are.

The fcl-image implementation - which is what I am mainly using due to transparency - seems very incomplete to my novice eyes. Routines such as drawing gradients (thanks again), working with text, clipboard handling, and other features that are available with tbitmap are lacking or very basic. Copying to TBitmap and back again is happening a lot in my code and makes them very sluggish.

Coming from fpGUI which had just TfpgImage that could handle everything, the LCL seems over-complicated. There is probably a logical reason, but for example, I have been spending hours trying to export a TFPMemoryImage to the clipboard to find that I need to go from TFPMemoryImage to TLazIntfImage to TBitmap to Clipboard.Assign(TBitmap) - unless I am very much mistaken - and I am spending more time looking through documentation and sources rather than coding, which becomes very tiring.

Sorry if I seem like I am complaining, I am not, it is more thinking out loud because I genuinely think that I am missing something very important which would help me understand the apparent complexity.

Again, I really value your ongoing patience and assistance.