Tabs and colored lines in Listbox

Question

I am using a Tabbed Listbox component that was written by Fredric Rylander back in 1999 and it has been serving me well since then. :) Can't seem to find him anymore.

I now have an application that needs both Tabbed Data and alternating colored lines in the Listbox.

I can include the Component here for perusal if desired.

I tried coloring the lines from here http://delphi.about.com/cs/adptips2002/a/bltip0602_4.htm

But then it eats the Tabs, but I do get the alternating colored lines.

Can someone please show me how to incorporate the two.

Thanks

Here's the Component

unit myListBoxTabbed;
{
  Copyright © 1999 Fredric Rylander

  You can easily add a header control to this list box: drop a header
  control onto the form (it's default align property is set to alTop, if
  it's not--set it); then set the myTabbedListBox's aligned property
  to alClient; now, add the following two events and their code.

  1) HeaderControl's OnSectionResize event:
  var
    i, last: integer;
  begin
    last := 0;
    for i:=0 to HeaderControl1.Sections.Count-1 do begin
      last := last + HeaderControl1.Sections[i].Width;
      myTabbedListBox1.TabStops[i] := last;
    end;
  end;

  2) Main form's OnCreate event:
  var
    i, last: integer;
  begin
    last := 0;
    for i:=0 to HeaderControl1.Sections.Count-1 do begin
      last := last + HeaderControl1.Sections[i].Width;
      myTabbedListBox1.TabStops[i] := last;
    end;
    for i:=HeaderControl1.Sections.Count to MaxNumSections do
      myTabbedListBox1.TabStops[i] := 2000;
  end;

  To get tab characters into the list box items either use the
  string list property editor in the Delphi GUI and press
  Ctrl + Tab or add tab characters (#9) in strings as so:

  myTabbedListBox1.Items.Add( Edit1.Text + #9 + Edit2.Text );

  I hope you find this tutorial helpful! :^)

  (!) This is not a retail product, it's a tutorial and don't claim to
  meet a potential user's demands.

  If you find anything that seems odd (or incorrect even) don't hesitate to
  write me a line. You can communicate with me at fredric@rylander.nu.

  The source is available for you to use, abuse, modify and/or improve.

  Happy trails!

  / Fredric


  ___________________________________F_r_e_d_r_i_c__R_y_l_a_n_d_e_r__

  fredric@rylander.nu : www.rylander.nu : 6429296@pager.mirabilis.com

  "power to the source sharing community"
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TTabsArray = array[0..9] of integer;

type
  TmyTabbedListBox = class( TListBox )
  private
    { Private declarations }
    fTabStops: TTabsArray;
    function GetTabStops( iIndex: integer ): integer;
    procedure SetTabStops( iIndex, iValue: integer);
    function GetTabsString: string;
    procedure SetTabsString( const sValue: string );
  protected
    { Protected declarations }
    procedure UpdateTabStops;
  public
    { Public declarations }
    procedure CreateParams( var cParams: TCreateParams ); override;
    procedure CreateWnd; override;
    property TabStops[ iIndex: integer ]: integer
      read GetTabStops write SetTabStops;
  published
    { Published declarations }
    property TabsString: string
      read GetTabsString write SetTabsString;
  end;

procedure Register;

resourcestring
  STR_ALPHA_UPPERLOWER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  CHAR_SEMICOLON = ';';

implementation

procedure Register;
begin
  RegisterComponents('Additional', [TmyTabbedListBox]);
end;

{ myTabbedListBox }

procedure TmyTabbedListBox.CreateParams(var cParams: TCreateParams);
begin
  inherited CreateParams( cParams );
  // add the window style LBS_USETABSTOPS to accept tabs
  cParams.Style := cParams.Style or LBS_USETABSTOPS;
end;

procedure TmyTabbedListBox.CreateWnd;
var
  i: integer;
begin
  inherited CreateWnd;
  // set all the tabs into the box
  for i := Low( fTabStops ) to High( fTabStops ) do
    fTabStops[i] := i * 100;
  // show the real tab positions
  UpdateTabStops;
end;

function TmyTabbedListBox.GetTabsString: string;
var
  sBuffer: string;
  i: integer;
begin
  // init var
  sBuffer := SysUtils.EmptyStr;
  // set all tabstops to the string (separated by ';'-char)
  for i := Low( fTabStops ) to High( fTabStops ) do
    sBuffer := sBuffer + IntToStr( fTabStops[i] ) + CHAR_SEMICOLON;
  // and here we have the results
  Result := sBuffer;
end;

function TmyTabbedListBox.GetTabStops( iIndex: integer ): integer;
begin
  // nothing funny here
  Result := fTabStops[iIndex];
end;

procedure TmyTabbedListBox.SetTabsString( const sValue: string );
var
  sBuffer: string;
  i, len: integer;
begin
  // copy value into buffer
  sBuffer := sValue;
  // set the tabstops as specified
  for i := Low( fTabStops ) to High( fTabStops ) do begin
    len := Pos( sBuffer, CHAR_SEMICOLON );
    fTabStops[i] := StrToIntDef( Copy( sBuffer, 1, len ), 0 );
    Delete( sBuffer, 1, len );
  end;
  // show/redraw the results
  UpdateTabStops;
  Invalidate;
end;

procedure TmyTabbedListBox.SetTabStops( iIndex, iValue: integer );
begin
  // do we really need to update?
  if fTabStops[iIndex] <> iValue then begin
    // oki, let's then
    fTabStops[iIndex] := iValue;
    // show/redraw the results
    UpdateTabStops;
    Invalidate;
  end;
end;

procedure TmyTabbedListBox.UpdateTabStops;
var
  i, iHUnits: integer;
  arrConvertedTabs: TTabsArray;
begin
  // convert dialog box units to pixels.
  // dialog box unit = average character width/height div 4/8

  // determine the horizontal dialog box units used by the
  // list box (which depend on its current font)
  Canvas.Font := Font;
  iHUnits := Canvas.TextWidth( STR_ALPHA_UPPERLOWER ) div 52;

  // convert the array of tab values
  for i := Low( arrConvertedTabs ) to High( arrConvertedTabs ) do
    arrConvertedTabs[i] := ( fTabStops[i] * 4 ) div iHUnits;

  // activate the tabs stops in the list box,
  // sending a Windows list box message
  SendMessage( Handle, LB_SETTABSTOPS,
    1 + High( arrConvertedTabs ) - Low( arrConvertedTabs ),
    LongInt( @arrConvertedTabs ) );
end;

end.

Answer 1

Here's an example using a standard TListBox and it's OnDrawItem event, based on the code from the link you provided and tested in Delphi 2007. Note you need to set the ListBox.Style to lbOwnerDrawFixed. You can perhaps use this as a base for modifying the component (or just abandon it altogether).

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  LB: TListBox;
  NewColor: TColor;
  NewBrush: TBrush;
  R: TRect;
  Fmt: Cardinal;
  ItemText: string;
begin
  NewBrush := TBrush.Create;
  LB := (Control as TListBox);
  if (odSelected in State) then
  begin
    NewColor := LB.Canvas.Brush.Color;
  end
  else
  begin
    if not Odd(Index) then
      NewColor := clSilver
    else
      NewColor := clYellow;
  end;
  NewBrush.Style := bsSolid;
  NewBrush.Color := NewColor;
  // This is the ListBox.Canvas brush itself, not to be
  // confused with the NewBrush we've created above
  LB.Canvas.Brush.Style := bsClear;
  R := Rect;
  ItemText := LB.Items[Index];
  Fmt := DT_EXPANDTABS or DT_CALCRECT or DT_NOCLIP;
  DrawText(LB.Canvas.Handle, PChar(ItemText), Length(ItemText),
       R, Fmt);

  // Note we need to FillRect on the original Rect and not
  // the one we're using in the call to DrawText
  Windows.FillRect(LB.Canvas.Handle, Rect, NewBrush.Handle) ;
  DrawText(LB.Canvas.Handle, PChar(ItemText), Length(ItemText),
       R, DT_EXPANDTABS);
  NewBrush.Free;
end;

Here's the output of the above code: