TBGRABitmap.TextSize returns incorrect value ?

[hedgehog]

Hi!

I have Windows 10 and Lazarus 2.2.6 and a 120 dpi monitor.
I'm trying to find out the width of the word "Text"

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

1. FontEx.Name:= 'Arial';
2. FontEx.Height:= 24;
3. CalculateTextSize('Text', FontEx, w, h); // BCTools unit

And I'm getting the wrong value!
The problem is in the first 2 chars: "Te"
The function returns 27 pixels, but it's actually 24 pixels because the 'T' is overhanging the 'e'

Am I doing something wrong?

[circular]

Hello hedgehog,

I don't see any mistake in your code.

However 27 is the height h of the text and not the width w.

Regards

[hedgehog]

Here is my code

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

1.   FontEx.Name:= 'Arial';
2.   FontEx.Height:= 24;
3.   myText:= 'Text';
4.   n:= UTF8Length(myText);
5.   for i:= 1 to n do
6.   begin
7.     s:= UTF8LeftStr(myText, i);
8.    // w:= FBGRA.TextSize(s).Width;
9.     CalculateTextSize(s, FontEx, w, h, false);
10.     debugln(s+': '+inttostr(w));
11.   end;

And this is the output to the console window

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

1. T: 14
2. Te: 27
3. Tex: 38
4. Text: 45

[circular]

Ah ok, in fact you're looking for a partial size of the text.

Indeed, the number are different. After some investigation, it comes from the fact that TBGRABitmap.TextSize doesn't take into account the kerning while TBGRABitmap.TextOut does.

The kerning here is that "T" and "e" and be put closer because they fit together. So the result of TextSize can be bigger than the actual text width.

I will look into it. In the meantime, if you're looking for precise letter by letter measurement, I suggest to measure and draw each letter individually. This way kerning won't be involved.

Regards

EDIT: added issue #246 on GitHub

[hedgehog]

Oh yes, that's exactly what I meant, thanks for the answer.
Now I know that this thing is called kerning 

I'm making a component for entering short text (TEdit), and my text cursor was moving to the right.
I think the best option now is to print the text using Canvas.TextRect and Canvas.TextExtent, and leave the background and decorations for the BGRA.

[circular]

Glad we're on the same page.

Yes, kerning is a good thing but it is not implemented consistently, maybe for backward compatibility. 

If you use Canvas, then I suggest you use Canvas.TextOut instead of Canvas.TextRect. This is because Canvas.TextOut doesn't handle kerning (as Canvas.TextExtent) while Canvas.TextRect does.

Indeed you can still have the decorations using BGRABitmap. 

[hedgehog]

Hello Circular.

I installed the latest version of BGRABitmap and now TextSize works well.

If you allow me to ask a question:
How to draw selected text?
Is there an easy way?
Or need to first draw a blue rectangle, and then draw text on it in white.

[circular]

Hi hedgehog,

Glad it works well for you now. We're finetuning the library. 

Indeed, to draw highlighted text, the simplest is to do as you suggested. The background color is clHighlight and the foreground is clHighlightText.

Regards

[KodeZwerg]

If needed, here is an old method of me that calculate the exact size measured in pixels.
It is slow ...

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

1. procedure ExactTextPixels(const AFont: TFont; const AText: string; out AWidth, AHeight: Integer);
2. var
3.   LBitmap: TBitmap;
4.   X, Y, FirstX, LastX: Integer;
5.   Found: Boolean;
6. begin
7.   LBitmap := TBitmap.Create;
8.   try
9.     LBitmap.SetSize(1000, 100);
10.     LBitmap.PixelFormat := pf32bit;
11.     LBitmap.Canvas.Brush.Color := clWhite;
12.     LBitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
13.     LBitmap.Canvas.Font := AFont;
14.     LBitmap.Canvas.TextOut(0, 0, AText);
15.     AWidth := 0;
16.     AHeight := 0;
17.     FirstX := -1;
18.     LastX := -1;
19.     for Y := 0 to LBitmap.Height - 1 do
20.       begin
21.         Found := False;
22.         for X := 0 to LBitmap.Width - 1 do
23.           begin
24.             if LBitmap.Canvas.Pixels[X, Y] <> clWhite then
25.               begin
26.                 Found := True;
27.                 if FirstX = -1 then
28.                   FirstX := X;
29.                 LastX := X;
30.               end;
31.           end;
32.         if Found then
33.           begin
34.             Inc(AHeight);
35.             if (FirstX <> -1) and (LastX <> -1) then
36.               AWidth := Max(AWidth, LastX - FirstX + 1);
37.           end;
38.       end;
39.   finally
40.     LBitmap.Free;
41.   end;
42. end;

[circular]

Thanks for sharing KodeZwerg. Your method would indeed give the exact size, without any margin.

While we're at it, maybe it would make sense to return a bounding rectangle, because FirstX may not be zero. So the origin could be adjusted (maybe vertically as well).

[hedgehog]

Hi!

.... and also after installing a new version of BGRABitmap, the BGRA.TextRect() does not clip off text that is too long.
Could there be some problem on my computer? (Windows 10)
Can anyone check this?

[KodeZwerg]

Thanks for sharing KodeZwerg.

You are welcome!

Your method would indeed give the exact size, without any margin.

I forgot the "font-astic" word but it aint called margins

While we're at it, maybe it would make sense to return a bounding rectangle, because FirstX may not be zero. So the origin could be adjusted (maybe vertically as well).

Heres a different version that does do same but faster:
(classic with AWidth/AHeight output)

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

1. procedure ExactTextPixels(const AFont: TFont; const AText: string; out AWidth, AHeight: Integer); overload;
2. var
3.   Bitmap: TBitmap;
4.   PixelX, PixelY, // for the scanning
5.   LeftX, RightX, TopY, BottomY, // store each direction to accurate output AWidth and AHeight
6.   SizeX, SizeY: Integer; // initial bitmap size
7. begin
8.   // Initialize the output values
9.   AWidth := 0;
10.   AHeight := 0;
11.  
12.   // Create a bitmap and canvas
13.   Bitmap := TBitmap.Create;
14.   try
15.     // Set the font for the canvas
16.     Bitmap.Canvas.Font := AFont;
17.  
18.     // Calculate the needed dimension and add more space for non-normal fonts or font styles
19.     SizeX := Bitmap.Canvas.TextWidth(AText) * 3;
20.     SizeY := Bitmap.Canvas.TextHeight(AText) * 3;
21.     Bitmap.SetSize(SizeX, SizeY);
22.  
23.     // Clear the bitmap and draw the text onto the bitmap,
24.     // ensure that we got 2 different colors to check for one of them
25.     Bitmap.Canvas.Brush.Color := clWhite;
26.     Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
27.     Bitmap.Canvas.Font.Color := clBlack;
28.     Bitmap.Canvas.TextOut(0, 0, AText);
29.  
30.     // Initialize scan variables in opposite manner to use Min() and Max() correct
31.     LeftX := Bitmap.Width;
32.     RightX := 0;
33.     TopY := Bitmap.Height;
34.     BottomY := 0;
35.  
36.     // Scan the bitmap from left to right
37.     for PixelX := 0 to Pred(Bitmap.Width) do
38.       for PixelY := 0 to Pred(Bitmap.Height) do
39.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> clWhite then
40.           LeftX := Min(LeftX, PixelX);
41.  
42.     // Scan the bitmap from right to left
43.     for PixelX := Pred(Bitmap.Width) downto 0 do
44.       for PixelY := 0 to Pred(Bitmap.Height) do
45.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> clWhite then
46.           RightX := Max(RightX, PixelX);
47.  
48.     // Scan the bitmap from top to bottom
49.     for PixelY := 0 to Pred(Bitmap.Height) do
50.       for PixelX := 0 to Pred(Bitmap.Width) do
51.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> clWhite then
52.           TopY := Min(TopY, PixelY);
53.  
54.     // Scan the bitmap from bottom to top
55.     for PixelY := Pred(Bitmap.Height) downto 0 do
56.       for PixelX := 0 to Pred(Bitmap.Width) do
57.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> clWhite then
58.           BottomY := Max(BottomY, PixelY);
59.  
60.     // Calculate the width and height based on the scan results
61.     AWidth := Pred(RightX - LeftX);
62.     AHeight := Succ(BottomY - TopY);
63.  finally
64.     Bitmap.Free;
65.  end;
66. end;

new with ARect output:

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

1. procedure ExactTextPixels(const AFont: TFont; const AText: string; out ARect: TRect); overload;
2. var
3.   Bitmap: TBitmap;
4.   PixelX, PixelY, // for the scanning
5.   LeftX, RightX, TopY, BottomY, // store each direction to accurate output AWidth and AHeight
6.   SizeX, SizeY: Integer; // initial bitmap size
7. begin
8.   // Initialize the output values
9.   ARect.Width := 0;
10.   ARect.Height := 0;
11.   ARect.Top := 0;
12.   ARect.Left := 0;
13.   ARect.Right := 0;
14.   ARect.Bottom := 0;
15.  
16.   // Create a bitmap and canvas
17.   Bitmap := TBitmap.Create;
18.   try
19.     // Set the font for the canvas
20.     Bitmap.Canvas.Font := AFont;
21.  
22.     // Calculate the needed dimension and add more space for non-normal fonts or font styles
23.     SizeX := Bitmap.Canvas.TextWidth(AText) * 3;
24.     SizeY := Bitmap.Canvas.TextHeight(AText) * 3;
25.     Bitmap.SetSize(SizeX, SizeY);
26.  
27.     // Clear the bitmap and draw the text onto the bitmap,
28.     // ensure that we got 2 different colors to check for one of them
29.     Bitmap.Canvas.Brush.Color := clWhite;
30.     Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
31.     Bitmap.Canvas.Font.Color := clBlack;
32.     Bitmap.Canvas.TextOut(0, 0, AText);
33.  
34.     // Initialize scan variables in opposite manner to use Min() and Max() correct
35.     LeftX := Bitmap.Width;
36.     RightX := 0;
37.     TopY := Bitmap.Height;
38.     BottomY := 0;
39.  
40.     // Scan the bitmap from left to right
41.     for PixelX := 0 to Pred(Bitmap.Width) do
42.       for PixelY := 0 to Pred(Bitmap.Height) do
43.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> clWhite then
44.           LeftX := Min(LeftX, PixelX);
45.  
46.     // Scan the bitmap from right to left
47.     for PixelX := Pred(Bitmap.Width) downto 0 do
48.       for PixelY := 0 to Pred(Bitmap.Height) do
49.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> clWhite then
50.           RightX := Max(RightX, PixelX);
51.  
52.     // Scan the bitmap from top to bottom
53.     for PixelY := 0 to Pred(Bitmap.Height) do
54.       for PixelX := 0 to Pred(Bitmap.Width) do
55.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> clWhite then
56.           TopY := Min(TopY, PixelY);
57.  
58.     // Scan the bitmap from bottom to top
59.     for PixelY := Pred(Bitmap.Height) downto 0 do
60.       for PixelX := 0 to Pred(Bitmap.Width) do
61.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> clWhite then
62.           BottomY := Max(BottomY, PixelY);
63.  
64.     // Calculate the width and height based on the scan results
65.     ARect.Top := TopY;
66.     ARect.Left := Succ(LeftX);
67.     ARect.Bottom := Succ(BottomY);
68.     ARect.Right := RightX;
69.  finally
70.    Bitmap.Free;
71.  end;
72. end;

Now I've googled me the missing words
Ascent, Descent and Line Gap for the vertical size
and the horizontal size has a bit more
Bounding Box that can be modified by Horizontal Advance, Kerning, Tracking or Ligatures.

All those above the Font-renderer needs to handle at once and can lead to different results compared to common TextWidth TextHeight styled methods that most often just grab the bounding box to give back fastest result for the "guessed" max.
Especially when a font is created dirty, that mean that the actual font glyph will also be displayed outside the bounding box, the common methods fail to give any useful result.

Since my last method returns a TRect structure, you could also easy change that to return an Image thats cropped around Text, just add a background color as input argument and modify that i change the font color 

So here is the last overload, it results in a bitmap where the font touches the corner.

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

1. procedure ExactTextPixels(const AFont: TFont; const AText: string; const ABackground: TColor; out ABitmap: TBitmap); overload;
2. var
3.   Bitmap: TBitmap;
4.   PixelX, PixelY, // for the scanning
5.   LeftX, RightX, TopY, BottomY, // store each direction to accurate output AWidth and AHeight
6.   SizeX, SizeY: Integer; // initial bitmap size
7.   LRect: TRect;
8. begin
9.   // Initialize the output values
10.   LRect.Width := 0;
11.   LRect.Height := 0;
12.   LRect.Top := 0;
13.   LRect.Left := 0;
14.   LRect.Right := 0;
15.   LRect.Bottom := 0;
16.  
17.   // Create a bitmap and canvas
18.   Bitmap := TBitmap.Create;
19.   try
20.     // Set the font for the canvas
21.     Bitmap.Canvas.Font := AFont;
22.  
23.     // Calculate the needed dimension and add more space for non-normal fonts or font styles
24.     SizeX := Bitmap.Canvas.TextWidth(AText) * 3;
25.     SizeY := Bitmap.Canvas.TextHeight(AText) * 3;
26.     Bitmap.SetSize(SizeX, SizeY);
27.  
28.     // Clear the bitmap and draw the text onto the bitmap,
29.     // ensure that we got 2 different colors to check for one of them
30.     Bitmap.Canvas.Brush.Color := ABackground;
31.     Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
32. //    Bitmap.Canvas.Font.Color := clBlack;
33.     Bitmap.Canvas.TextOut(0, 0, AText);
34.  
35.     // Initialize scan variables in opposite manner to use Min() and Max() correct
36.     LeftX := Bitmap.Width;
37.     RightX := 0;
38.     TopY := Bitmap.Height;
39.     BottomY := 0;
40.  
41.     // Scan the bitmap from left to right
42.     for PixelX := 0 to Pred(Bitmap.Width) do
43.       for PixelY := 0 to Pred(Bitmap.Height) do
44.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> ABackground then
45.           LeftX := Min(LeftX, PixelX);
46.  
47.     // Scan the bitmap from right to left
48.     for PixelX := Pred(Bitmap.Width) downto 0 do
49.       for PixelY := 0 to Pred(Bitmap.Height) do
50.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> ABackground then
51.           RightX := Max(RightX, PixelX);
52.  
53.     // Scan the bitmap from top to bottom
54.     for PixelY := 0 to Pred(Bitmap.Height) do
55.       for PixelX := 0 to Pred(Bitmap.Width) do
56.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> ABackground then
57.           TopY := Min(TopY, PixelY);
58.  
59.     // Scan the bitmap from bottom to top
60.     for PixelY := Pred(Bitmap.Height) downto 0 do
61.       for PixelX := 0 to Pred(Bitmap.Width) do
62.         if Bitmap.Canvas.Pixels[PixelX, PixelY] <> ABackground then
63.           BottomY := Max(BottomY, PixelY);
64.  
65.     // Calculate the width and height based on the scan results
66.     LRect.Top := TopY;
67.     LRect.Left := Succ(LeftX);
68.     LRect.Bottom := Succ(BottomY);
69.     LRect.Right := RightX;
70.     ABitmap.SetSize(LRect.Width, LRect.Height);
71.     ABitmap.Canvas.CopyMode := cmSrcCopy;
72.     ABitmap.Canvas.CopyRect(ABitmap.Canvas.ClipRect, Bitmap.Canvas, LRect);
73.  finally
74.    Bitmap.Free;
75.  end;
76. end;

in combination with those overloads you can now easy get a perfect image with whatever text where the text fits from corner to corner.

[circular]

Hi!

.... and also after installing a new version of BGRABitmap, the BGRA.TextRect() does not clip off text that is too long.
Could there be some problem on my computer? (Windows 10)
Can anyone check this?

Hi Hedgehog,

That can be the case if in a previous version the text was always clipped. Can you provide the code you use? In the text style, there is a Clipping boolean that enables clipping or not.

Regards

[hedgehog]

Hi.

I added

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

1. aTextStyle.Clipping:= true;

And now everything works correctly!

Is it possible that in older versions this flag was not processed?

[circular]

Hi Hedgehog,

It is indeed the case that in older versions clipping was always enabled. I don't remember the version though when this changed.

This is a case of non backward compatibility. I try to keep this at the minimum but in this case, there wasn't a simple way to do that.

Glad to know the fix was easy.