Question

我尝试在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 styles, remove a style or disable a class skinning from a TLabel 制表符停止宽度调整有效，但AutoSize功能仍然丢失。

Answer 1

这是解决方案。它没有完美地自动调整标签大小，但在某种程度上起作用：

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.

调整TLabel的制表符宽度

1 个答案: