簡體   English   中英

調整TLabel的制表符字符寬度

[英]Adjust tab character width of TLabel

我試圖在TLabel中調整Tab字符寬度,但沒有成功。

作為原型,我采用了以下代碼:

procedure TForm1.btn1Click(Sender: TObject);
begin
  _drawTabbedText('My'#9'sample'#9'text'#9'with'#9'tab'#9'characters', 0, 8);
  _drawTabbedText('My'#9'sample'#9'text'#9'with'#9'tab'#9'characters', 15, 7);
  _drawTabbedText('My'#9'sample'#9'text'#9'with'#9'tab'#9'characters', 30, 6);
  _drawTabbedText('My'#9'sample'#9'text'#9'with'#9'tab'#9'characters', 45, 5);
  _drawTabbedText('My'#9'sample'#9'text'#9'with'#9'tab'#9'characters', 60, 4);
  _drawTabbedText('My'#9'sample'#9'text'#9'with'#9'tab'#9'characters', 75, 3);
end;

procedure TForm1._drawTabbedText(txt: string; aTop: Integer; TabWidth: DWORD);
var
  r: TRect;
begin
  r := ClientRect;
  r.Top := aTop;
  Winapi.Windows.DrawText(Canvas.Handle, LPCWSTR(txt), Length(txt), r, DT_EXPANDTABS or DT_TABSTOP or DT_LEFT or (TabWidth shl 8));
end;

哪個有效。

我將其轉換為以下內容:

TTabbedLabel = class(TLabel)
protected
  procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
end;

procedure TTabbedLabel.DoDrawText(var Rect: TRect; Flags: Integer);
var
  TabWidth: DWORD;
begin
  TabWidth := 3;
  //Flags := DT_TABSTOP or DT_LEFT;
  Flags := DWORD(Flags) or DT_TABSTOP or (TabWidth shl 8);
  inherited DoDrawText(Rect, Flags);
end;

使用此代碼,我無法實現制表符寬度調整,並且失去了AutoSize功能。

如何正確地做呢?

更新資料

使用以下問題的修改后的解決方案: Delphi XE2 VCL樣式,從TLabel選項卡的停止寬度調整有效的方式中刪除樣式或禁用類外觀 ,但是AutoSize功能仍然丟失。

這是解決方案。 它不能完美地自動調整標簽的大小,但是可以在某種程度上起作用:

unit My.StdCtrls;

interface

uses
  Vcl.StdCtrls, Winapi.Windows, System.Classes;

type
  TTabbedLabel = class(TLabel)
  private
    _tabStopWidth: Byte;
    procedure DrawNormalText(DC: HDC; const Text: UnicodeString; var TextRect: TRect; TextFlags: Cardinal);
    procedure _setTabStopWidth(const Value: Byte);
  protected
    procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
    constructor Create(AOwner: TComponent); override;
  published
    property TabStopWidth: Byte read _tabStopWidth write _setTabStopWidth;
  end;

procedure Register();

implementation

uses
  System.SysUtils, Vcl.Graphics, Vcl.Themes;

procedure Register();
begin
  System.Classes.RegisterComponents('My Standard', [TTabbedLabel]);
end;

constructor TTabbedLabel.Create(AOwner: TComponent);
begin
  _tabStopWidth := 8;
  inherited;
end;

procedure TTabbedLabel.DoDrawText(var Rect: TRect; Flags: Integer);
const
  EllipsisStr = '...';
  Ellipsis: array[TEllipsisPosition] of Longint = (0, DT_PATH_ELLIPSIS, DT_END_ELLIPSIS, DT_WORD_ELLIPSIS);
var
  Text, DText: string;
  NewRect: TRect;
  Height, Delim: Integer;
begin
  Text := GetLabelText;
  if (Flags and DT_CALCRECT <> 0) and
     ((Text = '') or ShowAccelChar and (Text[1] = '&') and (Length(Text) = 1)) then
    Text := Text + ' ';

  if Text <> '' then
  begin
    if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
    Flags := DrawTextBiDiModeFlags(Flags);
    Canvas.Font := Font;
    if (EllipsisPosition <> epNone) and not AutoSize then
    begin
      DText := Text;
      Flags := Flags and not DT_EXPANDTABS;
      Flags := Flags or Ellipsis[EllipsisPosition];
      if WordWrap and (EllipsisPosition in [epEndEllipsis, epWordEllipsis]) then
      begin
        repeat
          NewRect := Rect;
          Dec(NewRect.Right, Canvas.TextWidth(EllipsisStr));
          DrawNormalText(Canvas.Handle, DText, NewRect, Flags or DT_CALCRECT);
          Height := NewRect.Bottom - NewRect.Top;
          if (Height > ClientHeight) and (Height > Canvas.Font.Height) then
          begin
            Delim := LastDelimiter(' '#9, Text);
            if Delim = 0 then
              Delim := Length(Text);
            Dec(Delim);
            if ByteType(Text, Delim) = mbLeadByte then
              Dec(Delim);
            Text := Copy(Text, 1, Delim);
            DText := Text + EllipsisStr;
            if Text = '' then
              Break;
          end else
            Break;
        until False;
      end;
      if Text <> '' then
        Text := DText;
    end;

    if Enabled or StyleServices.Enabled then
      DrawNormalText(Canvas.Handle, Text, Rect, Flags)
    else
    begin
      OffsetRect(Rect, 1, 1);
      Canvas.Font.Color := clBtnHighlight;
      DrawNormalText(Canvas.Handle, Text, Rect, Flags);
      OffsetRect(Rect, -1, -1);
      Canvas.Font.Color := clBtnShadow;
      DrawNormalText(Canvas.Handle, Text, Rect, Flags);
    end;
  end;
end;

procedure TTabbedLabel.DrawNormalText(DC: HDC; const Text: UnicodeString;
  var TextRect: TRect; TextFlags: Cardinal);
begin
  if (TextFlags and DT_CALCRECT) = 0 then
    TextFlags := TextFlags or DT_EXPANDTABS or DT_TABSTOP or (DWORD(_tabStopWidth) shl 8);
  Winapi.Windows.DrawTextW(DC, Text, Length(Text), TextRect, TextFlags);
end;

procedure TTabbedLabel._setTabStopWidth(const Value: Byte);
begin
  if _tabStopWidth = Value then Exit();
  _tabStopWidth := Value;
  Invalidate();
end;

end.

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM