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;

如此,多语言显未可无忧矣!