Delphi: 获取控件文本宽度(像素)

为适应多语言，需要对界面控件大小、位置多动态改变，因此需要根据其Caption计算实际像素大小。

找资料未有易用现成的，遂参数其它方法，写以函数处之，代码如下：

uses
  TypInfo;

function GetTextWidth(AControl: TControl): Integer;
  function GetControlFont: TFont;
  var
    PropInfo: PPropInfo;
  begin
    Result := nil;
    PropInfo := GetPropInfo(AControl.ClassInfo, 'Font');
    if Assigned(PropInfo) then
      Result :=  GetObjectProp(AControl, PropInfo) as TFont;
  end;

var
  sCaption: string;
  fnt: TFont;
  cvs: TCanvas;
begin
  Result := 0;
  if not IsPublishedProp(AControl, 'Caption') then Exit;
  sCaption := Trim(GetPropValue(AControl, 'Caption', True));
  if sCaption = '' then Exit;
  fnt := GetControlFont;
  if not Assigned(fnt) then Exit;

  cvs := TCanvas.Create;
  try
    cvs.Handle := GetDC(0);
    cvs.Font.Assign(fnt);
    Result := cvs.TextWidth(sCaption);
  finally
    cvs.Free;
  end;
end;

界面可根据控件文本长度动态做修正了。比如：

btnConvert.Width := GetTextWidth(btnConvert) + 12;

 

根据上面结论，可封装动态修改控件宽度及位置代码，函数如下：

procedure AdjustPostitionAndWidth(ACtrl: TControl; const AAlignment: TAlignment;
  AOffSet: Integer);
  function Scale(const v: Integer): Integer;
  begin
    Result := Trunc(v * Screen.PixelsPerInch / 96);
  end;

  function GetTextWidth: Integer;
    function GetControlFont: TFont;
    var
      PropInfo: PPropInfo;
    begin
      Result := nil;
      PropInfo := GetPropInfo(ACtrl.ClassInfo, 'Font');
      if Assigned(PropInfo) then
        Result :=  GetObjectProp(ACtrl, PropInfo) as TFont;
    end;

  var
    sCaption: string;
    fnt: TFont;
    cvs: TCanvas;
  begin
    Result := 0;
    if not IsPublishedProp(ACtrl, 'Caption') then Exit;
    sCaption := Trim(GetPropValue(ACtrl, 'Caption', True));
    if sCaption = '' then Exit;
    fnt := GetControlFont;
    if not Assigned(fnt) then Exit;

    cvs := TCanvas.Create;
    try
      cvs.Handle := GetDC(0);
      cvs.Font.Assign(fnt);
      Result := cvs.TextWidth(sCaption);
    finally
      cvs.Free;
    end;
  end;

var
  os, tw: Integer;
begin
  AOffSet := Scale(AOffSet);
  tw := GetTextWidth();
  if tw + AOffSet < ACtrl.Width then Exit;

  os := tw + AOffSet - ACtrl.Width;
  ACtrl.Width := tw + AOffSet;
  case AAlignment of
    taCenter:
      ACtrl.Left := ACtrl.Left - os div 2;
    taRightJustify:
      ACtrl.Left := ACtrl.Left - os;
  end;
end;

如此，多语言显未可无忧矣！