delphi - 如何根据 TListBox.TabWidth 属性扩展 TListBox.OnDrawItem 事件中的制表符？

Question

我正在使用 Delphi XE4，下面是我的示例应用程序。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
        State: TOwnerDrawState);
  public
    procedure AfterConstruction; override;
  end;

var
  Form1: TForm1;

implementation

uses System.Math;

{$R *.dfm}

procedure TForm1.AfterConstruction;
begin
  inherited;
  ListBox1.Style := lbOwnerDrawVariable;

  ListBox1.Items.Add('o'#9'Line 1');
  ListBox1.Items.Add('o'#9'Line 2');
  ListBox1.Items.Add('o'#9'Line 3');
  ListBox1.Items.Add('o'#9'Line 4');
  ListBox1.Items.Add('o'#9'Line 5');
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect:
    TRect; State: TOwnerDrawState);
const C: array[boolean] of TColor = (clRed, clGreen);
var L: TListBox;
    S: string;
    iTextHeight: integer;
begin
  L := Control as TListBox;
  L.Canvas.Font.Color := C[Index < 2];

  S := L.Items[Index];

  iTextHeight := Max(Rect.Height, L.Canvas.TextHeight(S) + 2);
  SendMessage(L.Handle, LB_SETITEMHEIGHT, Index, iTextHeight);
  Rect.Height := iTextHeight;
  L.Canvas.FillRect(Rect);

  L.Canvas.TextOut(Rect.Left, Rect.Top + 1, S);
end;

end.

使用 TListBox.OnDrawItem 事件的目的是在我的实际应用程序中显示一些具有不同字体颜色的项目。有没有办法在TListBox.TabWidth的基础上扩展TListBox.DrawItem事件中的制表符？

Answer 1

这段代码对我有用。

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect:
    TRect; State: TOwnerDrawState);
var //...
    P: TDrawTextParams;
begin
  //...

  P.cbSize := SizeOf(P);
  P.iTabLength := 5;
  P.iLeftMargin := 0;
  P.iRightMargin := 0;
  DrawTextEx(L.Canvas.Handle, PChar(S), S.Length, Rect, DT_EXPANDTABS or DT_TABSTOP, @P);
end;