2008. június 3., kedd

How to get the text width of a TControl in pixels


Problem/Question/Abstract:

How can I find the length of a string drawn in a particular font? For instance, Edit1 has the text of 'Hello World' in Arial bold, size = 16.

Answer:

Solve 1:

You measure it using the TextWidth method of a canvas into which the font has been copied. You can usually use the forms Canvas for this kind of work since it is not used anywhere else (unless you have a handler for the OnPaint event). The typcial code would be:

canvas.font := edit1.font; {edit1.font has size etc. to measure}
aTextwidth := canvas.TextWidth(someText);

One problem with this approach is that it will fail if you do the measuring at a time the form does not have a window handle yet. I prefer to use a dynamically created canvas for this kind of task:

function CalcMaxWidthOfStrings(aList: TStrings; aFont: TFont): Integer;
var
  max, n, i: Integer;
  canvas: TCanvas;
begin
  Assert(Assigned(aList));
  Assert(Assigned(aFont));
  canvas := TCanvas.Create;
  try
    canvas.Handle := CreateDC('DISPLAY', nil, nil, nil);
    try
      Canvas.Font := aFont;
      max := 0;
      for i := 0 to aList.Count - 1 do
      begin
        n := Canvas.TextWidth(aList[i]);
        if n > max then
          max := n;
      end;
      Result := max;
    finally
      DeleteDC(canvas.Handle);
      canvas.Handle := 0;
    end;
  finally
    canvas.free;
  end;
end;


Solve 2:

function GetTextWidthInPixels(AText: string; AControl: TControl): integer;
var
  propInfo: PPropInfo;
  thisFont: TFont;
begin
  Result := 0;
  propInfo := GetPropInfo(AControl.ClassInfo, 'Font');
  if propInfo <> nil then
  begin
    thisFont := TFont(GetObjectProp(AControl, 'Font'));
    if Assigned(thisFont) then
      with TControlCanvas.Create do
      try
        Control := AControl;
        Font.Assign(thisFont);
        Result := TextWidth(AText);
      finally
        Free;
      end;
  end;
end;

Call with:

twidth := GetTextWidthInPixels(Edit1.Text, Edit1);

Nincsenek megjegyzések:

Megjegyzés küldése