wiki.freepascal code shows nothing.

[jipété]

Hello,

Starting with this page (https://wiki.freepascal.org/fcl-image#Drawing_text) and using

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

1. procedure TForm1.Button1Click(Sender: TObject);
2. var  // https://wiki.freepascal.org/fcl-image
3. //  Img: TFPMemoryImage; // original
4.   Img: TFPCustomImage;   // essay, same poorly result
5.   Writer: TFPWriterPNG;
6.   ms: TMemoryStream;
7.   ImgCanvas: TFPImageCanvas;
8.   fs: TFileStream;
9.   AFont: TFreeTypeFont;
10. begin
11.   Img:=nil;
12.   ImgCanvas:=nil;
13.   Writer:=nil;
14.   ms:=nil;
15.   fs:=nil;
16.   AFont:=nil;
17.   try
18.     // initialize free type font manager
19.     ftfont.InitEngine;
20.     FontMgr.SearchPath:='/usr/share/fonts/truetype/dejavu/';
21.     AFont:=TFreeTypeFont.Create;
22.  
23.     // create an image of width 200, height 100
24.     Img:=TFPMemoryImage.Create(200,100);
25.     Img.UsePalette:=false;
26.     // create the canvas with the drawing operations
27.     ImgCanvas:=TFPImageCanvas.create(Img);
28.  
29.     // paint white background
30.     ImgCanvas.Brush.FPColor:=colYellow; //colWhite; -- better like that
31.     ImgCanvas.Brush.Style:=bsSolid;
32.     ImgCanvas.Rectangle(0,0,Img.Width,Img.Height);
33.  
34.     // paint text
35.     ImgCanvas.Font:=AFont;
36.     ImgCanvas.Font.Name:='DejaVuSans';
37.     ImgCanvas.Font.Size:=20;
38.     ImgCanvas.TextOut(10,30,'Test');
39.  
40.     // write image as png to memory stream
41.     Writer:=TFPWriterPNG.create;
42.     ms:=TMemoryStream.Create;
43.     writer.ImageWrite(ms,Img);
44.     // write memory stream to file
45.     ms.Position:=0;
46.     fs:=TFileStream.Create('testfont.png',fmCreate); // img written in prog's folder
47.     fs.CopyFrom(ms,ms.Size);
48.   finally
49.     AFont.Free;
50.     ftfont.DoneEngine; // needed or not ?
51.     ms.Free;
52.     Writer.Free;
53.     ImgCanvas.Free;
54.     Img.Free;
55.     fs.Free;
56.   end;
57. end;

absolutly nothing is displayed on form, while the saved file is correct.

What's wrong in that code ?
Thanks,

Debian Bullseye 11.7 64bits Gtk2 and FPC 3.2.2 Laz 2.2.6

[rvk]

Maybe I'm overlooking something but where in that code do you paint to your form?

The example is also not for painting to a form but to a file (which seems to work correctly).

[jipété]

You're right !

I've misunderstood the simple line from the wiki :
Here is an example, how to create a 200x100 image, painting a white background and some text and saving it as .png:

When I read the word "painting", I think "painting where ? On the form ?"
There is nothing else to receive paint, so it must be on form so I expected to see the background and the text on the form, but maybe I'm wrong...

[rvk]

When I read the word "painting", I think "painting where ? On the form ?"
There is nothing else to receive paint, so it must be on form so I expected to see the background and the text on the form, but maybe I'm wrong...

It's "painting" on a (virtual) canvas (that's the virtual TFPImageCanvas).
After that it is saved to a file.

And if you are going to save something to a file, you might not even want it to show on a form at all.
(That's where a canvas comes in. A canvas can be visible but doesn't need to be.)

[wp]

The following code paints the image onto a TImage component (which you must drop on the form):

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

1. procedure TForm1.Button1Click(Sender: TObject);
2. var  // https://wiki.freepascal.org/fcl-image
3. //  Img: TFPMemoryImage; // original
4.   Img: TFPCustomImage;   // essay, same poorly result
5.   Writer: TFPWriterPNG;
6.   ImgCanvas: TFPImageCanvas;
7.   AFont: TFreeTypeFont;
8. begin
9.   Img:=nil;
10.   ImgCanvas:=nil;
11.   Writer:=nil;
12.   AFont:=nil;
13.   try
14.     // initialize free type font manager
15.     ftfont.InitEngine;
16.     // FontMgr.SearchPath not needed on Windows
17. //    FontMgr.SearchPath:='c:\windows\fonts\';
18. //    FontMgr.SearchPath:='/usr/share/fonts/truetype/dejavu/';
19.     AFont:=TFreeTypeFont.Create;
20.  
21.     // create an image of width 200, height 100
22.     Img:=TFPMemoryImage.Create(200,100);
23.     Img.UsePalette:=false;
24.     // create the canvas with the drawing operations
25.     ImgCanvas:=TFPImageCanvas.create(Img);
26.  
27.     // paint white background
28.     ImgCanvas.Brush.FPColor:=colYellow; //colWhite; -- better like that
29.     ImgCanvas.Brush.Style:=bsSolid;
30.     ImgCanvas.Rectangle(0,0,Img.Width-1,Img.Height-1);
31.  
32.     // paint text
33.     ImgCanvas.Font:=AFont;
34.     ImgCanvas.Font.Name:='DejaVuSerif';
35.     ImgCanvas.Font.Size:=20;
36.     ImgCanvas.TextOut(10,30,'Test');
37.  
38.     // load image into TImage component
39.     Image1.Picture.Bitmap.Assign(Img);
40.   finally
41.     AFont.Free;
42.     ftfont.DoneEngine; // needed or not ?
43.     Writer.Free;
44.     ImgCanvas.Free;
45.     Img.Free;
46.   end;
47. end;      

[jipété]

The following code paints the image onto a TImage component (which you must drop on the form):

Thanks a lot !
Anyway, using

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

1. ImgCanvas.TextOut(10,30,'Test');

I don't understand why the "T" start at 10,10 :
img rect-10x10

On previous picture, width of big black lines is 6, so, if I ask ImgCanvas.Rectangle(5,5,... it means
ImgCanvas.Rectangle(0to5=6px,0to5=6px ?

If I write

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

1. ImgCanvas.Rectangle(0,0,Img.Width,Img.Height);

I notice strong left and top borders ; to have clean, nice and free border, I need to write

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

1. ImgCanvas.Rectangle(-1,-1,Img.Width,Img.Height);

: like that, The Gimp tells that the rectangle is 200 x 100...

If I select the yellow rect with right+1 and bottom+1, one can see one-pixel skyblue lines on bottom and right yellow sides, meaning the width is really 200 and the height really 100, so, what's wrong with

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

1. ImgCanvas.Rectangle(0,0,Img.Width,Img.Height);

?
img 201x101

Thx again,

[wp]

Anyway, using

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

1. ImgCanvas.TextOut(10,30,'Test');

I don't understand why the "T" start at 10,10

Text output is done here by the FTFont unit which is based on FreeType where Text is drawn relative to the base line. In the LCL's TCanvas, on the other hand, text is drawn relative to the top. Just two worlds... You can bring them together by evaluating the FontMetric parameters. Unfortunately, they are not readily accessible in the FTFont unit, but you could use this procedure:

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

1. procedure GetFontMetric(AFont: TFreeTypeFont; var Ascender, Descender: Integer);
2. var
3.   fontID: Integer;
4.   face: PFT_Face;
5.   h: Double;
6. begin
7.   fontID := FontMgr.RequestFont(AFont.Name, AFont.FontIndex);
8.   face := FontMgr.GetFreeTypeFont(fontID);
9.   h := AFont.GetTextHeight('Tg');
10.   Ascender := round(face^.ascender / face^.height * h);
11.   Descender := round(face^.descender / face^.height * h);
12. end;

Ascender is the distance between baseline and top-most pixel of a font, and descender is the difference to the bottom-most pixel. (descender < 0). Subtracting the ascender from the baseline position yields the top position of the character cells.

On previous picture, width of big black lines is 6, so, if I ask ImgCanvas.Rectangle(5,5,... it means
ImgCanvas.Rectangle(0to5=6px,0to5=6px ?

Again two worlds... In one world (yours), each pixel is a box and if you want to draw a line between x=0 and x=5 you draw the pixels 0, 1, 2, 3, 4, 5 - and these are 6 pixels. In the other world, a pixel is a mathematical coordinate, an infintely small point, and now the distance between 0 and 5 is 5 (this is the same as saying that there are 5 years between jan 1 2000 and jan 1 2005). I know there was an article somewhere explaining it better but I cannot find it at the moment. And there are cases in which it is not clear to which world they belong... I gave up to try to memorize these differences, a simple test quickly shows the differences.

[jipété]

Hi !

It's the first time in my life that I see the way you compute font's data and of course, your results are not the same as what I can find here and there.

For example, have a look at the page https://www.developpez.net/forums/d2121853/autres-langages/pascal/lazarus/telechargez/font-inspector/, this program gives other values than yours.
fontinspector.png

So, where is the truth ?
Linux doesn't retrieve the same values as Windows does, see here (it's french, but no matter) : https://www.developpez.net/forums/d2155453/autres-langages/pascal/lazarus/laz-2-2-6-fpc-3-2-2-tmemo-incapable-rendre-correctement-fonte/#post11969332
And last but not least, some values of TTextMetrics are not available in Linux, OMG, I'm lost...

Alas, no help available for FontMgr, Ascender or Descender...

[wp]

Interesting that you show me a screenshot similar to my own program (https://github.com/wp-xyz/LazSamples/tree/master/graphics/font%20inspector)...

But the calculation is correct. The only problem is that the sample text to measure the text height did not contain the highest characters. Changing this the ascender/descender determined by my procedure and by the LCL yield the same values.

[rvk]

For example, have a look at the page https://www.developpez.net/forums/d2121853/autres-langages/pascal/lazarus/telechargez/font-inspector/, this program gives other values than yours.
fontinspector.png

Is that forum only accessible to subscribers?
I get an error message "Cette discussion n'existe plus".

[jipété]

Interesting that you show me a screenshot similar to my own program (https://github.com/wp-xyz/LazSamples/tree/master/graphics/font%20inspector)...

Before now, I didn't know your code.

But the calculation is correct.

Things are not so simple : there is a bigger glyph than Ä, it's Ê.
So the results are now different : 25 <> 26 !
different_values.png

To have a better view, I've changed

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

1. ImgCanvas.Line(0, 30-asc, 400, 30-asc);

to

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

1. ImgCanvas.Line(0, 28-asc, 400, 28-asc);

and zoomed the resulting image, see 2nd attachment :
big-letters_and_1px-red-line.png

And maybe there are some other letters more bigger...
This problem is a nightmare.


Your code looks like better than the one I knew, so

Is that forum only accessible to subscribers?
I get an error message "Cette discussion n'existe plus".

for rvk, forget mine and use the wp's code.

[wp]

there is a bigger glyph than Ä, it's Ê.

Probably this is the reason why the LCL/VCL's Canvas.TextHeight reports the height including some white space above and below the character cells (internal/external leading)?

To do it correctly you should iterate over all characters of the font file and determine the maximum of the ascender/descender values. Or maybe there are better ways? There are several freetype libraries in FPC and in Lazarus. Maybe there are ones which provider better support.

But sincerly: Why are you doing it in the hard way? Why don't you use the standard TCanvas when you only draw on a bitmap to display it in a TImage?

[jipété]

Hello,

One physical machine running Linux Debian 11 and VirtualBox, one virtual machine running Seven.

Starting Lazarus 2.2.6 in Debian,
Project / New Project / Application, 1 TButton, 1 TMemo, 5 lines of code :

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

1. procedure TForm1.Button1Click(Sender: TObject);
2. begin
3.   Memo1.Clear;
4.   Memo1.Font.Name:='Bonita';
5.   Memo1.Font.Size:=60; // 60 to nicely see the problem
6.   Memo1.Append('Bonita');
7.   Memo1.Append('Bonita');
8. end;

and F9, then opening the project (shared folder) in Seven and voilà :
Debian-Seven.png

Why the Seven window bigger than the Debian window ? If same size, the Seven TMemo looks like empty !

The caret is 77 px height in Debian and 100 px in Seven, heavy in Debian and light in Seven, and there are 22 px between the 2 "B" in Debian and 47 in Seven.

Cross-platform, Lazarus, really ? I expected the same results, so I loose my time trying to understand what is happening, but I haven't the skills.
I'm just a fonts' lover.

But sincerly: Why are you doing it in the hard way? Why don't you use the standard TCanvas when you only draw on a bitmap to display it in a TImage?

with something like that ?

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

1. procedure TForm1.Button2Click(Sender: TObject);
2. var
3.   Bitmap: TBitmap;
4.   Metric: TLCLTextMetric;
5. begin
6.   Bitmap := TBitmap.Create;
7.   Bitmap.Height := 50;
8.   Bitmap.Width := 500;
9.  
10.   Bitmap.Canvas.Font.Name:='Palatino Linotype';
11.   Bitmap.Canvas.Font.Height:=20;
12.   Bitmap.Canvas.GetTextMetrics(Metric);
13.   Bitmap.Canvas.TextOut(0, 1, 'Test JjgÄÉÊ ' + IntToStr(Metric.Height) + ' = ' + IntToStr(Metric.Ascender) + ' + ' + IntToStr(Metric.Descender));
14.  
15.   Image2.Picture.Assign(Bitmap);
16.   Bitmap.Free;
17. end;
18.  

I loose accents (Basic button) :
img_3tries

3 tries, 3 different values ! A nightmare I've said, yesterday...

Also discovered the following (read comments) :

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

1. procedure TForm1.FormPaint(Sender: TObject);
2. var
3.   tm: TLCLTextMetric;
4. begin
5. // regarding Font.name, both commented out so prog uses ide params and shows ÄÉÊ
6. // but the font is NOT the good one I need !
7. // if one is activated, prog looses accents and shows AEE...
8.   Label1.Font.Name:='Palatino Linotype'; // new, jpt
9. //  Label1.Font.Name:='Bonita'; // new, jpt
10.  
11.   Label1.Font.Size:=20; // new, jpt
12.   Label1.Canvas.GetTextMetrics(tm);
13.   Label2.Caption := Format('Font metrics from Canvas.GetTextMetrics: ' + LineEnding +
14.     'Ascender  = %d' + LineEnding +
15.     'Descender = %d' + LineEnding +
16.     'Height = %d', [tm.Ascender, tm.Descender, tm.Height]);
17. end;
18.  

(no image)

And look at the yellow result, below, made with the TFPCustomImage, TFPImageCanvas and TFreeTypeFont, and use the red lines to compare.
I don't understand why the accent on the E between the A and the other E is smaller on the left than on the right, it's a mystery.
But noticed one hour ago that the font is wrong, re-read previous text.
And below, in skyblue, a try with LO Writer, which is better than the yellow and lightgray tries.
3tries-with-lowriter

Regards, (not available from this afternoon to late tomorrow morning, see you later, alligator !)
--
jp