CODEWITHSUNDEEP
delphi
lmengyew
lmengyew

Reputation: 371

How to expand tab character in TListBox.OnDrawItem event based on TListBox.TabWidth property?

I'm using Delphi XE4 and below is my sample application.

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.

The purpose of using TListBox.OnDrawItem event is to show some items with different font colour in my real application. Is there any way to expand the tab character in TListBox.DrawItem event based on TListBox.TabWidth?

Upvotes: 3

Views: 978

Answers (2)

lmengyew
lmengyew

Reputation: 371

This code works for me.

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;

Upvotes: 1

Graymatter
Graymatter

Reputation: 6587

I would do something like this. Basically use the tab width to work out where things should be painted. The code below would replace your last TextOut call. I am stripping out the tabs and whenever I encounter one I am indenting the output by the listbox tab width:

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

  LeftIndent := 0;
  while Pos(#9,S) > 0 do
  begin
    L.Canvas.TextOut(Rect.Left + LeftIndent, Rect.Top + 1, Copy(S, 1, Pos(#9,S)-1));
    Delete(S, 1, Pos(#9,S));
    LeftIndent := LeftIndent + L.TabWidth;
  end;
  L.Canvas.TextOut(Rect.Left + LeftIndent, Rect.Top + 1, S);
end;

Upvotes: 0

Related Questions