• 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;

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

  • 相关阅读:
    Ubuntu中安装XAMPP出错的解决方法
    sudo 后不用输入密码的配置
    javascript鼠标双击时触发事件大全
    PHP空值判断
    40音乐海报的创意例子
    35个令人印象深刻的创意404错误页面设计
    35个高分辨率创意苹果桌面壁纸
    38惊人的HD(高清晰度)壁纸七彩的例子
    25精心设计的联系页面例子
    pgpoolII中对 setsockopt 的利用
  • 原文地址:https://www.cnblogs.com/crwy/p/8967892.html
Copyright © 2020-2023  润新知