Recent

Author Topic: TBGRABitmap.TextSize returns incorrect value ?  (Read 2858 times)

hedgehog

  • New Member
  • *
  • Posts: 47
TBGRABitmap.TextSize returns incorrect value ?
« on: March 17, 2024, 05:31:05 pm »
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

  • Hero Member
  • *****
  • Posts: 4274
    • Personal webpage
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #1 on: March 17, 2024, 06:47:05 pm »
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
Conscience is the debugger of the mind

hedgehog

  • New Member
  • *
  • Posts: 47
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #2 on: March 17, 2024, 08:25:29 pm »
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
« Last Edit: March 17, 2024, 08:27:36 pm by hedgehog »

circular

  • Hero Member
  • *****
  • Posts: 4274
    • Personal webpage
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #3 on: March 18, 2024, 11:36:14 am »
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
« Last Edit: March 18, 2024, 11:42:58 am by circular »
Conscience is the debugger of the mind

hedgehog

  • New Member
  • *
  • Posts: 47
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #4 on: March 18, 2024, 02:02:21 pm »
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

  • Hero Member
  • *****
  • Posts: 4274
    • Personal webpage
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #5 on: March 18, 2024, 04:40:11 pm »
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.  :)
Conscience is the debugger of the mind

hedgehog

  • New Member
  • *
  • Posts: 47
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #6 on: April 10, 2024, 03:34:13 pm »
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

  • Hero Member
  • *****
  • Posts: 4274
    • Personal webpage
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #7 on: April 10, 2024, 09:45:47 pm »
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
Conscience is the debugger of the mind

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #8 on: April 11, 2024, 12:02:07 am »
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;
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

circular

  • Hero Member
  • *****
  • Posts: 4274
    • Personal webpage
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #9 on: April 15, 2024, 09:22:03 am »
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).
Conscience is the debugger of the mind

hedgehog

  • New Member
  • *
  • Posts: 47
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #10 on: April 16, 2024, 06:29:29 am »
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

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #11 on: April 16, 2024, 10:26:36 am »
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 :D
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 :P
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  :D

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.
« Last Edit: April 16, 2024, 12:23:23 pm by KodeZwerg »
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

circular

  • Hero Member
  • *****
  • Posts: 4274
    • Personal webpage
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #12 on: April 16, 2024, 10:52:20 pm »
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
Conscience is the debugger of the mind

hedgehog

  • New Member
  • *
  • Posts: 47
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #13 on: April 17, 2024, 06:07:46 am »
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

  • Hero Member
  • *****
  • Posts: 4274
    • Personal webpage
Re: TBGRABitmap.TextSize returns incorrect value ?
« Reply #14 on: April 17, 2024, 05:24:04 pm »
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.  :)
Conscience is the debugger of the mind

 

TinyPortal © 2005-2018