Listbox

1. Helpful Hint: Listbox-Font
2. Columns in a TListBox
3. Listbox compo. with drag&drop items reorder ?
4. Check List Component
5. Tabstops in Listboxes
6. each line in a list box a different color

Helpful Hint: Listbox-Font

Sometimes it might be useful to have fixed-pitch font in your Listbox.

One way to accomplish this is to use the System-Fixed-Font (at least with Windows 3.11 -- what about Windows 95?) The only thing you have to do is to set the font programmatically in your form-create-routine.

Here's an example (where LB is the ListBox), where the font is set after some strings have been added to the ListBox:

  LB.Items.Clear;

  for i := 0 to (SL.Count)-1 do
  begin
    LB.Items.Add(Copy(SL.Strings[i], 1, j-1));
  end;

  { !!!!! NOW SET THE DESIRED FONT !!!!! }
  { System_Fixed_Font or ANSI_Fixed_Font }
  SendMessage(LB.handle, wm_SetFont, GetStockObject(System_Fixed_Font), 1);

Columns in a TListBox

Set the TabWidth property in the ListBox property editor. Don't look for it in the help file though. Say if your listbox is 300 pixels, set the TabWidth to 100 or so.

When you add items to the listbox insert &Tabs" - ^I for example:

ListBox1.Items.Add('Column1'^I'Column2'^I'Column3');

I checked it a sec ago and it works fine. I don't know how to do varying widths though. Don't you just love all of the documentation available? (Sarcastic indeed)

Listbox compo. with drag&drop items reorder ?

The only code of interest is :

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  with (Sender as TListBox) do
      Items.Move(ItemIndex,ItemAtPos(Point(x,y),True));
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
  Accept := (Sender=Source);
end;

Remember to set set the ListBox's DragMode to dmAutomatic.

Check List Component

Mark Sellers <excalibur@why.net> wrote:

>I'm looking for a ListBox component that will display a check box for selected list items -
a CheckList component, if you will (this is a handy way to allow the editing of
>sets).

1. Download 'Adding Graphics in your listboxes and comboboxes' from Borland Technical Information. (see below)
2. Add an unchecked box (bitmap) to the listbox.
3. Use the double-click event and change the bitmap to a checked box.

Inserting graphics in Owner Drawn ListBoxes and ComboBoxes

The ability to place graphics inside ListBoxes and ComboBoxes can improve the look of your application and set your user interface apart from the others.

Q: How do I stick graphics in a Listbox or ComboBox???

Here is an step-by-step example.....

1. Create a form.
2. Place a ComboBox and Listbox component on your form.
3. Change the Style property of the ComboBox component to csOwnerDrawVariable and the Style property of the ListBox to lbOwnerDrawVariable. An Owner-Draw TListBox or TComboBox allows you to display both objects (ex. graphics) and strings as the items. For this example, we are adding both a graphic object and a string.
4. Create 5 variables of type TBitmap in the Form's VAR section.
5. Create a Procedure for the Form's OnCreate event.
6. Create a Procedure for the ComboBox's OnDraw Event.
7. Create a Procedure for the ComboBox's OnMeasureItem.
8. Free the resources in the Form's OnClose Event.

{START OWNERDRW.PAS}
unit Ownerdrw;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ComboBox1MeasureItem(Control: TWinControl; Index:
Integer;
      var Height: Integer);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBox1MeasureItem(Control: TWinControl; Index:
Integer;
      var Height: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  TheBitmap1, TheBitmap2, TheBitmap3, TheBitmap4,
  TheBitmap5 : TBitmap;
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TheBitmap1 := TBitmap.Create;
  TheBitmap1.LoadFromFile('C:\delphi\images\buttons\globe.bmp');
  TheBitmap2 := TBitmap.Create;
  TheBitmap2.LoadFromFile('C:\delphi\images\buttons\video.bmp');
  TheBitmap3 := TBitmap.Create;
  TheBitmap3.LoadFromFile('C:\delphi\images\buttons\gears.bmp');
  TheBitmap4 := TBitmap.Create;
  TheBitmap4.LoadFromFile('C:\delphi\images\buttons\key.bmp');
  TheBitmap5 := TBitmap.Create;
  TheBitmap5.LoadFromFile('C:\delphi\images\buttons\tools.bmp');
  ComboBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
  ComboBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
  ComboBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
  ComboBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
  ComboBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);
  ListBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
  ListBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
  ListBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
  ListBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
  ListBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TheBitmap1.Free;
  TheBitmap2.Free;
  TheBitmap3.Free;
  TheBitmap4.Free;
  TheBitmap5.Free;
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index:
Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap;
  Offset: Integer;
begin
  with (Control as TComboBox).Canvas do
  begin
    FillRect(Rect);
    Bitmap := TBitmap(ComboBox1.Items.Objects[Index]);
    if Bitmap <> nil then
    begin
      BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
                Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
                Bitmap.Height), clRed);
      Offset := Bitmap.width + 8;
    end;
    { display the text }
    TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index])
  end;
end;

procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index:
                                      Integer; var Height: Integer);
begin
  height:= 20;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index:
Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap;
  Offset: Integer;
begin
  with (Control as TListBox).Canvas do
  begin

    FillRect(Rect);
    Bitmap := TBitmap(ListBox1.Items.Objects[Index]);
    if Bitmap <> nil then
    begin
      BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
                Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
                Bitmap.Height), clRed);
      Offset := Bitmap.width + 8;
    end;
    { display the text }
    TextOut(Rect.Left + Offset, Rect.Top, Listbox1.Items[Index])
  end;
end;

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index:
Integer;
  var Height: Integer);
begin
  height:= 20;
end;

end.
{END OWNERDRW.PAS}

{START OWNERDRW.DFM}
object Form1: TForm1
  Left = 211
  Top = 155
  Width = 435
  Height = 300
  Caption = 'Form1'
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'System'
  Font.Style = []
  PixelsPerInch = 96
  OnClose = FormClose
  OnCreate = FormCreate
  TextHeight = 16
  object ComboBox1: TComboBox
    Left = 26
    Top = 30
    Width = 165
    Height = 22
    Style = csOwnerDrawVariable
    ItemHeight = 16
    TabOrder = 0
    OnDrawItem = ComboBox1DrawItem
    OnMeasureItem = ComboBox1MeasureItem
  end
  object ListBox1: TListBox
    Left = 216
    Top = 28
    Width = 151
    Height = 167
    ItemHeight = 16

    Style = lbOwnerDrawVariable
    TabOrder = 1
    OnDrawItem = ListBox1DrawItem
    OnMeasureItem = ListBox1MeasureItem
  end
end
{END OWNERDRW.DFM}

Tabstops in Listboxes

unit TabsLBox;
{enables tabs in a listbox}
interface

uses WinTypes, Classes, Controls, StdCtrls;

type
TMyListBox = class(TListBox)
   protected
   procedure CreateParams(var Params: TCreateParams); override;
   end;

procedure register;

implementation

procedure register;
begin
RegisterComponents('Samples',[TMyListBox]);
end;

procedure TMyListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style:= Params.Style or LBS_USETABSTOPS;
end;

end.

each line in a list box a different color

I have two examples ( repost ) of OnDrawItem procedures:

procedure TTest.ListBox1DrawItem(Control: TWinControl;
          Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  With ( Control As TListBox ).Canvas Do
  Begin
    Case Index Of
      0:
      Begin
        Font.Color  := clBlue;
        Brush.Color := clYellow;
      End;
      1:
      Begin
        Font.Color  := clRed;
        Brush.Color := clLime;
      End;
      2:
      Begin
        Font.Color  := clGreen;
        Brush.Color := clFuchsia;
      End;
    End;
    FillRect(Rect);
    TextOut(Rect.Left, Rect.Top, ( Control As TListBox ).Items[Index]);
  End;
end;

procedure TListTest.ListBox1DrawItem( Control: TWinControl;
          Index: Integer; Rect: TRect; State: TOwnerDrawState );

Const
  HighLight = 'LINE';

Var
  TempLine, TempText, TempHigh: String;
  TempLeft, TempTop, TempStart: Integer;
  OldColor: TColor;

begin
  with ( Control as TListBox ).Canvas do
  begin
    FillRect( Rect );
    TempLeft := Rect.Left + 3;
    TempTop  := Rect.Top  + 1;
    TempLine := ( Control as TListBox ).Items[ Index ];

    While TempLine > '' Do
    Begin
      TempStart := Pos( HighLight, AnsiUpperCase( TempLine ) );

      If TempStart > 0 Then
      Begin
        TempText := Copy( TempLine, 1, TempStart - 1 );
        TempHigh := Copy( TempLine, TempStart, Length( HighLight ) );
        Delete( TempLine, 1, TempStart + Length( HighLight ) - 1 );
      End
      Else
      Begin
        TempText := TempLine;
        TempHigh := '';
        TempLine := '';
      End;

      If TempText > '' Then
      Begin
        TextOut( TempLeft, TempTop, TempText );
        Inc( TempLeft, TextWidth( TempText ) );
      End;

      If TempHigh > '' Then
      Begin
        OldColor := Font.Color;
        If odSelected In State Then
          Font.Color := clYellow
        Else
          Font.Color := clBlue;
        TextOut( TempLeft, TempTop, TempHigh );
        Inc( TempLeft, TextWidth( TempHigh ) );
        Font.Color := OldColor;
      End;
    End;
  end;
end;

'Line number one'
'The second line'
'This line is number three'
There is a few thing to notice:

I use the Control parameter with a validitated typecast - ( Control as TListBox ).Items[ Index ], to make sure that it's the calling listbox data that is written on the canvas, and it also give the chance to share the eventhandler between several TListBox, e.g. if you have a couple of ListBoxes on different pages on a TNoteBook.

The OldColor and the test of State parameter ensures that a selected line is written with a visible fontcolor ( many videodrivers use white text on blue background on a selected line )

I make a litle more space around the text - increased TListBox.ItemHeight by, three, TempLeft := Rect.Left + 3 and TempTop := Rect.Top + 1 statements.

Please email me and tell me if you liked this page.