Drawing with psInsideframe on TFPImageCanvas is buggy

[Jonny]

Code: [Select]

Lazarus 4.99 (rev main_4_99-920-g0d73603378) FPC 3.3.1 x86_64-linux-gtk2

This has been bugging me for days and not able to work out the issue...

Please see attached image - drawing with pen style set to psInsideframe does not make a solid line.

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, FPImage, FPCanvas, FPImgCanv;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Image1: TImage;
16.     procedure FormCreate(Sender: TObject);
17.   private
18.   public
19.   end;
20.  
21. var
22.   Form1: TForm1;
23.   myImage: TFPMemoryImage;
24.   myCanvas: TFPImageCanvas;
25.  
26. implementation
27.  
28. {$R *.lfm}
29.  
30. { TForm1 }
31.  
32. procedure TForm1.FormCreate(Sender: TObject);
33. begin
34.   myImage := TFPMemoryImage.Create(500,200);
35.   myCanvas := TFPImageCanvas.Create(myImage);
36.   with myCanvas do
37.   try
38.     Pen.Width := 1;
39.     Pen.Style := psInsideframe;
40.     Pen.FPColor := colWhite;
41.     Rectangle(50,20,210,180);
42.     Pen.Style := psSolid;
43.     Rectangle(280,20,440,180);
44.   finally
45.     Free;
46.   end;
47.   Image1.Picture.Bitmap.Assign(myImage);
48.   myImage.SaveToFile('image.bmp');
49. (*
50.   with TPortableNetworkGraphic.Create do
51.   try
52.     Width := 200;
53.     Height := 200;
54.     Canvas.CopyRect(Rect(0,0,200,200),myCanvas.?????,Rect(20,0,220,200));
55.     SaveToFile('rect.bmp');
56.   finally
57.     Free;
58.   end;
59. *)
60. end;
61.  
62. end.
63.  

Also, a secondary question: as in my commented code above, how can I access the canvas to select just an area to save?

Error: Incompatible type for arg no. 2: Got "TFPImageCanvas", expected "TCanvas"

Sample project attached. Thanks in advance.

[wp]

I'm afraid the functionality of this pen style has not been implemented in fcl-image... Searching for "psInsideFrame" within the entire fcl-image source folder yields only one location, namely where the identifier is declared. Moreover, some shapes (ellipse, polygon) are only drawin with 1-pixel wide lines. And there are limitation with the fills in FPC 3.2.2 (there were commits to FPC/main fixing the brushes).

[Jonny]

I'm afraid the functionality of this pen style has not been implemented in fcl-image...

Ah, I see, thank you for investigating and reporting back.

Also, a secondary question: as in my commented code above, how can I access the canvas to select just an area to save?

Any ideas about the second part of the question? I was able to do it with TCustomBitmap but since switching to TFPMemoryImage/TFPImageCanvas, I am not finding much information.

[TRon]

Any ideas about the second part of the question?

The canvas-type of these components are not the same. Perhaps you could use the following (no idea if it works).

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   FPImage, FPImgCanv;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Image1: TImage;
17.     procedure FormCreate(Sender: TObject);
18.   private
19.   public
20.   end;
21.  
22. var
23.   Form1    : TForm1;
24.  
25.   myImage  : TFPMemoryImage;
26.   myCanvas : TFPImageCanvas;
27.   png      : TPortableNetworkGraphic;
28.  
29. implementation
30.  
31. {$R *.lfm}
32.  
33. { TForm1 }
34.  
35. procedure CopyImageRect(SrcImg: TFPCustomImage; SrcRect: TRect; DstImg: TPortableNetworkGraphic; DstRect: TRect);
36. var
37.   tmpbmp : TBitmap;
38. begin
39.   tmpbmp := Tbitmap.create;
40.   try
41.     tmpbmp.Assign(SrcImg);
42.     DstImg.canvas.CopyRect(DstRect, tmpbmp.canvas, SrcRect);
43.   finally
44.     tmpbmp.free;
45.   end;
46. end;
47.  
48.  
49. procedure TForm1.FormCreate(Sender: TObject);
50. begin
51.   myImage := TFPMemoryImage.Create(500,200);
52.   myCanvas := TFPImageCanvas.Create(myImage);
53.   with myCanvas do
54.   try
55.     Pen.Width := 1;
56.     Pen.Style := psInsideframe;
57.     Pen.FPColor := colWhite;
58.     Rectangle(50,20,210,180);
59.     Pen.Style := psSolid;
60.     Rectangle(280,20,440,180);
61.   finally
62.     Free;
63.   end;
64.   Image1.Picture.Bitmap.Assign(myImage);
65.   myImage.SaveToFile('image.bmp');
66.  
67.   png := TPortableNetworkGraphic.Create;
68.   try
69.     png.SetSize(200,200);
70.     CopyImageRect(myimage, Rect(20,0,220,200), png, Rect(0,0,200,200));
71.     png.SaveToFile('rect.png');
72.   finally
73.     png.free;
74.   end;
75. end;
76.  
77. end.
78.  

Why not use the build in png support of fcl-image to save ?

[wp]

Any ideas about the second part of the question? I was able to do it with TCustomBitmap but since switching to TFPMemoryImage/TFPImageCanvas, I am not finding much information.

Use the CopyRect method of the TFPCanvas:

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

1. uses
2.   FPImage, FPCanvas, FPImgCanv;
3. var
4.   img1, img2: TFPMemoryImage;
5.   canv1, canv2: TFPImageCanvas;
6. begin
7.   img1 := TFPMemoryImage.Create(500,200);
8.   canv1 := TFPImageCanvas.Create(img1);
9.   try
10.     with canv1 do
11.     begin
12.       Brush.FPColor := colBlue;
13.       FillRect(0, 0, img1.Width, img1.Height);
14.       Pen.Width := 1;
15.       Pen.Style := psDash;  //Insideframe;
16.       Pen.FPColor := colWhite;
17.       Rectangle(50,20,210,180);
18.       Pen.Style := psSolid;
19.       Rectangle(280,20,440,180);
20.       img1.SaveToFile('image1.png');
21.  
22.       img2 := TFPMemoryImage.Create(300, 120);
23.       canv2 := TFPImageCanvas.Create(img2);
24.       try
25.         with canv2 do
26.           CopyRect(0, 0, canv1, Rect(0, 0, img2.Width, img2.Height));
27.         img2.SaveToFile('image2.png');
28.       finally
29.         canv2.Free;
30.         img2.Free;
31.       end;
32.     end;
33.  
34.   finally
35.     canv1.Free;
36.     img1.Free;
37.   end;
38. end;

[Jonny]

Thank you both, very much appreciate your efforts, I shall look into them now.

But I have noticed one flaw with using FPImage and that is drawing text on the canvas.

With TImage it was very easy; use TextRect/TextOut to get cross platform results with no hassle.

But with FPImage it requires FTFont/TFreeTypeFont which with Windows requires FreeType libraries and VC redistributables that adds 30Mb to my tiny executable and thus cannot be run as a portable standalone without them - and probably other requirements on Linux and MacOS.

So before I rewrite all of my code without FPImage - and thus losing the advantages of transparency - is there a saner way to draw text?

Please note that I cannot use TBGRABitmap or similar because the other developers here have stipulated no third-party addons :(

[wp]

If you're not after an ultra-fast application, you can use an auxiliary bitmap to draw the text - see attached demo. You first measure the size of the text, set the size of the aux bitmap accordingly, then copy the source image into the bitmap, draw the text and finally copy the aux bitmap back into the source image. In the demo I am using a TLazIntfImage for the source image because it is easier to convert to/from TBitmap than with TFPMemoryImage.

[Jonny]

see attached demo.

That's a neat solution - thank you for your ongoing support.

[Jonny]

If you're not after an ultra-fast application, you can use an auxiliary bitmap to draw the text - see attached demo. You first measure the size of the text, set the size of the aux bitmap accordingly, then copy the source image into the bitmap, draw the text and finally copy the aux bitmap back into the source image. In the demo I am using a TLazIntfImage for the source image because it is easier to convert to/from TBitmap than with TFPMemoryImage.

Hello again @wp - one last question to finish this off: can the text itself be semi-transparent?

Your code draws the text to a TBitmap and I cannot see a way to add an alpha channel to the TColor there.

All these different formats..., but I am getting there - I modified the code to give an example of what I mean:

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

1. procedure TForm1.FormCreate(Sender: TObject);
2. const
3.   MARGIN = 20;
4. var
5.   img: TLazIntfImage;
6.   canv: TFPCustomCanvas;
7.   ext: TSize;
8.   col: TFPColor;
9. begin
10.   FImage := TBitmap.Create;
11.   FImage.SetSize(800, 400);
12.   FImage.Canvas.GradientFill(Rect(0,0,Width,Height),clAqua,clFuchsia,gdHorizontal);
13.   img := FImage.CreateIntfImage;
14.   try
15.     canv := TLazCanvas.Create(img);
16.     canv.DrawingMode := dmAlphaBlend;
17.     col := colYellow;
18.     col.Alpha := alphaOpaque div 4;
19.     canv.Brush.FPColor := col;
20.     canv.Pen.Style := psClear;
21.     canv.Ellipse(10,10,210,210);
22.     canv.Ellipse(150,190,350,390);
23.     canv.Ellipse(290,10,490,210);
24.     canv.Ellipse(430,190,630,390);
25.     canv.Ellipse(570,10,770,210);
26.     FImage.Canvas.Font.Size := 160;
27.     FImage.Canvas.Font.Bold := True;
28.     ext := TextExtent('HELLO!', FImage.Canvas.Font);
29.     // Text shadow - can this be semi-transparent?
30.     FImage.Canvas.Font.Color := clDkGray;
31.     DrawText(img, 20, 40, 'HELLO!', FImage.Canvas.Font);
32.     // The actual text - opaque - non-transparent
33.     FImage.Canvas.Font.Color := clWhite;
34.     DrawText(img, 12, 32, 'HELLO!', FImage.Canvas.Font);
35.     FImage.LoadFromIntfImage(img);
36.   finally
37.     canv.Free;
38.     img.Free;
39.   end;
40. end;
41.  

[wp]

Here is a text rendering procedure which supports alpha transparency and does not need any third-party libraries. The basic idea is again that the text is drawn onto an auxiliary bitmap and this bitmap is blended with the image. The difficulty with text is that it is drawn with pixel interpolation at the character edges so that the characters look nice, in order words: black characters on white background have gray transitional pixels at the character edges. If we would run over this image and replace the white background pixels by fully alpha transparent pixels and would draw this on any image, there would still be these intermediate pixel where the original white background is present - and this looks really ugly when the receiving image is dark at these areas.

To avoid this issue I created an "alpha mask". This is a bitmap which copies the brightness of the pixels to the alpha channel. This is particularly easy when the background color is black and the text color is white because now the brightness directly can be mapped to the alpha value: black background pixels have brighness 0 and get an alpha of 0, and thus are fully transparent. Text pixels are white with max brightness, get the max alpha value and are opaque. And the  transitional pixels have an intermediate brightness and thus are semi-transparent. For a semitransparent text, the alpha values must be multiplied by a "transparency" factor F, or, to be more precise, by 1-F (where F=0 for opaqueness, and F=1 for full transparency).

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

1. // ATransparency <= 0 ---> fully opaque
2. // ATransparency >= 1 --> fully transparent
3. procedure DrawText(AImage: TFPCustomImage; X, Y: Integer; AText: String;
4.   AFont: TFont; ATransparency: Single);
5.  
6.   // Calculate the alpha value from the "brightness" of the given pixel
7.   // (average of RGB). Multiply by the transparency factor to get a semitransparent
8.   // mask.
9.   function CalcAlpha(AColor: TFPColor): Word;
10.   begin
11.     Result := trunc((1.0*AColor.Red + AColor.Green + AColor.Blue) / 3 * (1.0 - ATransparency));
12.   end;
13.  
14. var
15.   bmp: TBitmap;
16.   mask: TLazIntfImage;
17.   ext: TSize;
18.   ix, iy: Integer;
19.   fntColor: TFPColor;
20.   maskColor: TFPColor;
21.   imgColor: TFPColor;
22. begin
23.   // Create aux bitmap for white text on black background as alpha mask
24.   bmp := TBitmap.Create;
25.   try
26.     bmp.Pixelformat := pf32Bit;
27.  
28.     // Measure the size of the text and set the size of the aux bitmap accordingly
29.     bmp.Canvas.Font.Assign(AFont);
30.     ext := bmp.Canvas.TextExtent(AText);
31.     bmp.SetSize(ext.CX, ext.CY);
32.  
33.     // We need a black background of the aux bitmap
34.     bmp.Canvas.Brush.Color := clBlack;
35.     bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
36.  
37.     // Draw white text on black background of aux bitmap
38.     bmp.Canvas.Font.Color := clWhite;
39.     bmp.Canvas.Brush.Style := bsClear;
40.     bmp.Canvas.TextOut(0, 0, AText);
41.  
42.     // Use LazIntfImage to convert the gray scales of the aux bitmap to alpha
43.     // value. The non-zero pixels in the mask are replaced by the original font
44.     // color. Finally the mask pixels are alpha-blended with the image pixels.
45.     fntColor := TColorToFPColor(AFont.Color);
46.     mask := bmp.CreateIntfImage;
47.     try
48.       for iy := 0 to mask.Height-1 do
49.       begin
50.         for ix := 0 to mask.Width-1 do
51.         begin
52.           maskColor := mask.Colors[ix, iy];
53.           if (maskColor = colBlack) then   // The mask is fully transparent here
54.             maskColor.Alpha := alphaTransparent
55.           else begin
56.             // Non fully-transparent pixels get the calculated alpha value...
57.             maskColor.Alpha := CalcAlpha(maskColor);
58.             // ... and the color of the font.
59.             maskColor.Red := fntColor.Red;
60.             maskColor.Green := fntColor.Green;
61.             maskColor.Blue := fntColor.Blue;
62.           end;
63.           // Alpha-blend the mask pixel with the image pixel
64.           imgColor := AImage.Colors[X + ix, Y + iy];
65.           AImage.Colors[X + ix, Y + iy] := AlphaBlend(imgColor, maskColor);
66.         end;
67.       end;
68.     finally
69.       mask.Free;
70.     end;
71.   finally
72.     bmp.Free;
73.   end;
74. end;

[Jonny]

Here is a text rendering procedure which supports alpha transparency and does not need any third-party libraries.

Another big thank you @wp - yet another piece of the TFPimage puzzle added. Will your routines be added to the official LCL sources? I assume that you are a maintainer, with your in-depth knowledge of the internals.

The basic idea is again that the text is drawn onto an auxiliary bitmap and this bitmap is blended with the image.

Haha, this seems to be a regular occurrence. Are there any plans to avoid this overhead?

I shall test your code now - hopefully the requirements of TFPCustomImage, TBitmap, TLazIntfImage are not too great, especially since some of my programs will be executed on a low-resource embedded device. I appreciate your time answering my many questions.