[SOLVED] How to determine the width (in pixels) of a string?

[CM630]

I am searching for a decent way to determine the width of a string, measured in pixels, considering the font properties (name, size, decorations, etc)?
I am aware only of the bad way: assign the text to a visible label, set it to autosize and check its width,

[howardpc]

You could copy (or adapt) the protected CalculateSize() method of TCustomLabel.

[RAW]

Interesting question, I'm also interested in other ways of getting those information, but I like to use a labTEMP TLabel that is not visible or use an existing TLabel and use the Canvas functions:

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

1. .Canvas.TextWidth();
2. .Canvas.TextHeight();
3.  

[Mr.Madguy]

Dunno about portable solution, but on Windows you can use such API, as GetTextExtent. If you need "true" width, i.e. width of "black" part - you will have to use GetCharABCWidths. But please note, that this method isn't Unicode aware! It works for languages, where one character -> one glyph. In most cases TextExtent = summ of A + B + C for all chars. So the easiest way to obtain "black" width - calculate FullWidth = TextExtent - FirstCharacterA - LastCharacterC. But be aware, that there are rare cases, when this formula gives incorrect result. Such case - when B of last character + C of penultimate character - is negative number. If you need 100% accurate result - you need to cache ABC structures for all characters and calculate text width manually, while ensuring, that adding some character doesn't result in decrease of actual width of string.

If you need more advanced features, such as Unicode-aware formatting - you should use Uniscribe.

[wp]

Create a temporary bitmap and use its canvas to calculate the text width - this is portable:

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

1. function GetTextWidth(AText: String; AFont: TFont): Integer;
2. var
3.   bmp: TBitmap;
4. begin
5.   Result := 0;
6.   bmp := TBitmap.Create;
7.   try
8.     bmp.Canvas.Font.Assign(AFont);
9.     Result := bmp.Canvas.TextWidth(AText);
10.   finally
11.     bmp.Free;
12.   end;
13. end;  

[Mr.Madguy]

Yeah, TextWidth actually uses GetTextExtentPoint API, so I guess it's right portable way of obtaining text extent (not the same, as true width of black part of text).

[CM630]

Thanks for the help.
I tried @WP's proposal.
I still have some issues, but thay are probably caused by the component, that uses the widths.

[SA.Blackmon]

Create a temporary bitmap and use its canvas to calculate the text width - this is portable:

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

1. function GetTextWidth(AText: String; AFont: TFont): Integer;
2. var
3.   bmp: TBitmap;
4. begin
5.   Result := 0;
6.   bmp := TBitmap.Create;
7.   try
8.     bmp.Canvas.Font.Assign(AFont);
9.     Result := bmp.Canvas.TextWidth(AText);
10.   finally
11.     bmp.Free;
12.   end;
13. end;  

I apologize in advance for my ineptitude with this forum; i.e., I don't know how to use it.

So, I attempted WP's solution above and found that TBitmap (no longer?) has a constructor. I bumbled around and discovered that TCustomBitmap did, so I substituted that for TBitmap.

 (I also saw that TCustomBitmap is the grandparent of TBitmap but the FPC 3.2.0 (Windows 10, Lazarus ide 2.0.10 SVN revision 63526) said that TBitmap: "globalinclude.pp(202,18) Error: identifier idents no member "Create"")

This is my rendition of WP's code:

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

1. function GetTextWidth(AText: String; AFont: TFont): Integer;
2. var
3.   bmp: TCustomBitmap;
4. begin
5.   Result := 0;
6.   bmp := TCustomBitmap.Create;
7.   try
8.     bmp.Canvas.Font.Assign(AFont);
9.     Result := bmp.Canvas.TextWidth(AText);
10.   finally
11.     bmp.Free;
12.   end;
13. end;
14.  
15.  

Continuing, when I ran my application, it failed in

canvas.inc
-----------
function TCanvas.TextWidth(const Text: string): Integer;
begin
  Result := TextExtent(Text).cX;
end; 

Which I considered was used literally thousands of times before it got to my point of failure, at least the TextExtent part.

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

1. unit LogReader;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   ActnList,
9.   Classes,
10.   ComCtrls,
11.   Controls,
12.   Dialogs,
13.   ExtCtrls,
14.   Forms,
15.   Graphics,
16.   Menus,
17.   StdCtrls,
18.   SynEdit,
19.   SysUtils;
20.  
21. type
22.  
23.   { TfrmLogReader }
24.  
25.   TfrmLogReader = class(TForm)
26.     ActClose: TAction;
27.     ActGotoLineNumber: TAction;
28.     ActReadOrder: TAction;
29.     ActToggleReadOrder: TAction;
30.     ActRefreshLog: TAction;
31.     ActReadLogFile: TAction;
32.     ActOpenLog: TAction;
33.     Actions: TActionList;
34.     ckBoxReadOrder: TCheckBox;
35.     capFileName: TLabel;
36.     Label1 : TLabel ;
37.     lblBtnReadMore: TLabel;
38.     logEdit: TSynEdit;
39.     MainMenu1: TMainMenu;
40.     mnuGotoLine: TMenuItem;
41.     mnuToggleReadOrder: TMenuItem;
42.     mnuClose: TMenuItem;
43.     N1: TMenuItem;
44.     mnuOpenLog: TMenuItem;
45.     mnuEditFacility: TMenuItem;
46.     mnuFileFacility: TMenuItem;
47.     pnlAnnunciator: TPanel;
48.     statBar : TStatusBar ;
49.     procedure ActCloseExecute(Sender: TObject);
50.     procedure ActOpenLogExecute(Sender: TObject);
51.     procedure ActReadLogFileExecute(Sender: TObject);
52.     procedure ActRefreshLogExecute(Sender: TObject);
53.     procedure ActToggleReadOrderExecute(Sender: TObject);
54.     procedure ckBoxReadOrderClick(Sender: TObject);
55.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
56.     procedure FormCreate(Sender: TObject);
57.     procedure lblBtnReadMoreClick(Sender: TObject);
58.   private
59.     FFileList, FAddedList, FWorkList: TStringList;
60.     FFilename: string;
61.     FFilePos, FListPos, FFileSize: Int64;
62.   public
63.     property FileName: string read FFilename write FFilename;
64.   end;
65.  
66. var
67.   frmLogReader: TfrmLogReader;
68.  
69. implementation
70.  
71. {$R *.lfm}
72.  
73. uses GlobalInclude;
74.  
75. const
76.   statPanelBytesRead = 1;
77.   statPanelFileName = 4;
78.  
79. { TfrmLogReader }
80.  
81. procedure TfrmLogReader.ActOpenLogExecute(Sender: TObject);
82. var
83.   opnDlg: TOpenDialog;
84. begin
85.   opnDlg := TOpenDialog.Create(Self);
86.   try
87.     if opnDlg.Execute then
88.     begin
89.       FFilePos := 0;
90.       FListPos := 0;
91.       FFilename := opnDlg.FileName;
92.       statBar.Panels[statPanelFileName].Text := FFilename;
93.       statBar.Panels[statPanelFileName].Width := GetTextWidth(FFilename, statBar.Font);
94.       ActReadLogFile.Execute;
95.     end;
96.   finally
97.     opnDlg.Free;
98.   end;
99. end;
100.  
101.  

Please let me know what I screwed up. It all looked so straight forward.
Thank you.

[Alexandr R]

{вычисляет ширину отображаемой строки в пикселях}
function  TCustomDegEdit.CalcWidthInPixels: Integer;
var
 aBitMap: TBitMap;
 RealLenStrInPixel : Integer;
 Suffix, DefInp, DefOut, strResult : String;
begin
 Suffix:= Concat(StringOfChar('4', FAngularVal.FAccuracy), ' ');
 Case FAngularVal.FFmtInpDeg of
  degDms : DefInp:= Concat('±444_44_44_', Suffix);
  DegDm  : DefInp:= Concat('±444_4444', Suffix);
 end;
 Case FAngularVal.FFmtOutDeg of
  degDms : DefOut:= Concat('±444_44_44_', Suffix);
  DegDm  : DefOut:= Concat('±444_4444', Suffix);
 end;
 if UTF8Length(DefInp) >= UTF8Length(DefOut) then
  strResult:= DefInp
 else
  strResult:= DefOut;

 aBitmap:= TBitMap.Create;
  try
   aBitMap.Canvas.Font.Assign(self.Font);
   if aBitMap.Canvas.TryLock then
    begin
     RealLenStrInPixel:= aBitMap.Canvas.TextWidth(Self.Text);
     Result:= aBitmap.Canvas.TextWidth(strResult);
     aBitMap.Canvas.Unlock;
     Result:= Math.Max(Result, RealLenStrInPixel);
    end;
   finally
    FreeAndNil(aBitmap);
   end;
end;           

Добрый вечер
Чтобы особо не заморачиваться (перенапрегаться) Вы должны определить самый широкий символ в используемом шрифте и составить из него строку по длине (по количеству символов) равную исходной (наверное так быстрее). Моя функция расчитана на цифры. Самая широкая цифра по-моему 4 (четыре). Функция работает на Win-7(32), На остальных OS проверить нет возможности

Good evening
In order not to bother too much (overstrained), you must determine the widest character in the font used and compose a string from it in length (by the number of characters) equal to the original (probably faster this way). My function is for numbers. The widest figure in my opinion is 4 (four). The function works on Win-7 (32), On other OS there is no way to check
 
     

[ASerge]

(I also saw that TCustomBitmap is the grandparent of TBitmap but the FPC 3.2.0 (Windows 10, Lazarus ide 2.0.10 SVN revision 63526) said that TBitmap: "globalinclude.pp(202,18) Error: identifier idents no member "Create"")

Try this:

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

1. function GetTextWidth(const AText: string; AFont: TFont): Integer;
2. var
3.   bmp: Graphics.TBitmap; // Graphics.TBitmap, not Windows.TBitmap
4. begin
5.   Result := 0;
6.   bmp := Graphics.TBitmap.Create;
7.   try
8.     bmp.Canvas.Font.Assign(AFont);
9.     Result := bmp.Canvas.TextWidth(AText);
10.   finally
11.     bmp.Free;
12.   end;
13. end;

[SA.Blackmon]

ASerge thank you for the reply.

Unfortunately I tried it and got errors on the constructor and on the canvas.

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

1. function GetTextWidth(AText: string; AFont: TFont): integer;
2. var
3.   bmp: TBitmap;
4. begin
5.   Result := 0;
6.   bmp := Graphics.TBitmap.Create;
7.   try
8.     bmp.Canvas.Font.Assign(AFont);
9.     Result := bmp.Canvas.TextWidth(AText);
10.   finally
11.     bmp.Free;
12.   end;
13. end;  

Finally, I went with this:

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

1. function GetTextWidthEx(AText: string; AFont: TFont): integer;
2. var
3.   lbl: TLabel;
4. begin
5.   Result := 0;
6.   lbl := Tlabel.Create(nil);
7.   try
8.     lbl.Font := AFont;
9.     lbl.AutoSize := True;
10.     lbl.Caption := AText;
11.     Result := lbl.Width;
12.   finally
13.     lbl.Free;
14.   end;
15. end;    

I am much in debt to all of you. Thank you.

[SA.Blackmon]

Just call me a big dummy. Notice that in my rendering of ASerge's solution that I did not qualify the TBitmap in the declaration but I did in the instantiation.

With both of them qualified with the unit name, it works just like you would think it would.

Thank you all.