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.