This is a VCL that allows multiple columns in a list box. The columns may be sorted (if the AllowSorting property is set to true) by clicking on the column header title. The column headers are set up in the Sections property. They are of type THeaderSections from the THeader component and thus may also display images from an associated image list. The items in the ListBox are semi-colon delimited fields. The fields are lined up in accordance to the Section headers and may be resized by the user at run-time.

eg.
MultiColListBox.Items.Add('John Smith;jsmith@eoh.co.za');

The fields within the item line may be retrieved individually using method GetField() and the field index required (0 based).

eg.
MultiColListBox.GetField(MultiColListBox.Items[1],1)

Section Headers may be added and deleted programatically at run time. Use the Invalidate or Update method to realign the columns and reset the Section Event triggers afterwards.

eg.
MultiColListBox.Sections.Delete(1);
MultiColListBox.Invalidate;  // Realign columns

I have one problem at design time in that I cannot find a way to call FListBox.Invalidate after the Sections property has been modified to realign the columns. There is no problem at run-time though. If anyone has a solution I would be grateful. (I have tried to apply a SetFSections method as in

property Sections : THeaderSections read FSections write SetFSections;

but the write call does not seem to get called at all)

unit MultiColListbox;
interface

uses Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, ComCtrls,
     StdCtrls, Graphics;

type
  TOnContextPopup = procedure (Sender : TObject; MousePos : TPoint;
                               var Handled : boolean) of object;

  TOnKeyDownUp = procedure(Sender : TObject; var Key : word;
                           Shift : TShiftState) of object;

  TOnMouseDownUp = procedure(Sender : TObject; Button : TMouseButton;
                             Shift : TShiftState; X, Y : integer) of object;

  TOnMouseMove = procedure(Sender : TObject; Shift : TShiftState;
                           X,Y : integer) of object;

  TOnKeyPress = procedure(Sender : TObject; var Key : char) of object;

  TMultiColListbox = class(TCustomPanel)
  private
    // Event Hooks
    FOnMouseMove : TOnMouseMove;
    FOnMouseDown,
    FOnMouseUp : TOnMouseDownUp;
    FOnKeyPress : TOnKeyPress;
    FOnKeyUp,
    FOnKeyDown : TOnKeyDownUp;
    FOnContextPopup : TOnContextPopup;
    FOnEnter,
    FOnExit,
    FOnDblClick,
    FOnClick : TNotifyEvent;
    // Property Fields
    FCurrCol : integer;
    FAllowSorting : boolean;
    FHeaderFont,
    FFont : TFont;
    FItems : TStrings;
    FSections : THeaderSections;
    FHeader : THeaderControl;
    FListBox : TListBox;

    // Get-Set Property Methods
    procedure SetFItems(Value : TStrings);
    procedure SetFFont(Value : TFont);
    procedure SetFHeaderFont(Value : TFont);
    procedure SetFColor(Value : TColor);
    function GetFColor : TColor;
    procedure SetFExtendedSelect(Value : boolean);
    function GetFExtendedSelect : boolean;
    procedure SetFIntegralHeight(Value : boolean);
    function GetFIntegralHeight : boolean;
    procedure SetFMultiSelect(Value : boolean);
    function GetFMultiSelect : boolean;
    function GetFColCount : integer;
    function GetFSelCount : integer;
    function GetFSelected(Index : integer) : boolean;
    procedure SetFSelected(Index : integer; Value : boolean);
    function GetFItemIndex : integer;
    procedure SetFItemIndex(Value : integer);
    procedure SetFHeaderHeight(Value : integer);
    function GetFHeaderHeight : integer;
    procedure SetFHeaderImages(Value : TImageList);
    function GetFHeaderImages : TImageList;
    procedure SetFAllowSorting(Value : boolean);
    procedure SetSectionEvents;

    // FListBox Event Hook Mapping
    procedure PDoClick(Sender : TObject);
    procedure PDoDblClick(Sender : TObject);
    procedure PDoEnter(Sender : TObject);
    procedure PDoExit(Sender : TObject);
    procedure PDoContextPopup(Sender : TObject; MousePos : TPoint;
                              var Handled : boolean);
    procedure PDoKeyDown(Sender : TObject; var Key : word;
                         Shift: TShiftState);
    procedure PDoKeyUp(Sender : TObject; var Key : word;
                       Shift: TShiftState);
    procedure PDoKeyPress(Sender : TObject; var Key : char);
    procedure PDoMouseDown(Sender : TObject; Button : TMouseButton;
                           Shift : TShiftState; X, Y : integer);
    procedure PDoMouseUp(Sender : TObject; Button : TMouseButton;
                         Shift : TShiftState; X, Y : integer);
    procedure PDoMouseMove(Sender : TObject; Shift : TShiftState;
                           X,Y : integer);
  protected
    // Internal Calls
    procedure ListBoxDrawItem(Control : TWinControl; Index : Integer;
                              Rect : TRect; State : TOwnerDrawState);
    procedure SectionResize(HeaderControl : THeaderControl;
                            Section : THeaderSection);
    procedure HeaderResize(Sender : TObject);
    procedure SectionClick(HeaderControl : THeaderControl;
                           Section: THeaderSection);

    function XtractField(var Source : string) : string;
    procedure QuickSort(Lo,Hi : integer; CC : TStrings);
    procedure Loaded; override;
  public
    { Public declarations }
    // TCustomPanel Virtual Method Overrides
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;
    procedure Update; override;
    procedure SetFocus; override;

    function GetField(const Line : string; Index : integer) : string;
    property ColCount : integer read GetFColCount;
    property SelCount : integer read GetFSelCount;
    property Selected[Index : integer] : boolean read GetFSelected
                                                write SetFSelected;
    property ItemIndex : integer read GetFItemIndex write SetFItemIndex;
  published
    // THeader Properties
    property Sections : THeaderSections read FSections write FSections;
    property HeaderFont : TFont read FHeaderFont write SetFHeaderFont;
    property HeaderHeight : integer read GetFHeaderHeight
                                    write SetFHeaderHeight;
    property HeaderImages : TImageList read GetFHeaderImages
                                       write SetFHeaderImages;

    // TListBox Properties
    property Items : TStrings read FItems write SetFItems;
    property Font : TFont read FFont write SetFFont;
    property Color : TColor read GetFColor write SetFColor;
    property ExtendedSelect : boolean read GetFExtendedSelect
                                      write SetFExtendedSelect;
    property IntegralHeight : boolean read GetFIntegralHeight
                                      write SetFIntegralHeight;
    property MultiSelect : boolean read GetFMultiSelect
                                   write SetFMultiSelect;
    property AllowSorting : boolean read FAllowSorting
                                    write SetFAllowSorting;

    // TListBox Events
    property OnClick : TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnContextPopup : TOnContextPopup read FOnContextPopup
                                              write FOnContextPopup;
    property OnEnter : TNotifyEvent read FOnEnter write FOnEnter;
    property OnExit : TNotifyEvent read FOnExit write FOnExit;
    property OnKeyDown : TOnKeyDownUp read FOnKeyDown write FOnKeyDown;
    property OnKeyUp : TOnKeyDownUp read FOnKeyUp write FOnKeyUp;
    property OnKeyPress : TOnKeyPress read FOnKeyPress write FOnKeyPress;
    property OnMouseDown : TOnMouseDownUp read FOnMouseDown
                                          write FOnMouseDown;
    property OnMouseUp : TOnMouseDownUp read FOnMouseUp write FOnMouseUp;
    property OnMouseMove : TOnMouseMove read FOnMouseMove write FOnMouseMove;

    // Expose required parent properties
    property Align;
    property Anchors;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderStyle;
    property BorderWidth;
    property Constraints;
    property Enabled;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
  end;

procedure Register;

// -------------------------------------------------------------------------
implementation

procedure Register;
begin
  RegisterComponents('MahExtra', [TMultiColListbox]);
end;


constructor TMultiColListBox.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Width := 200;
  Height := 110;
  Caption := '';
  BevelOuter := bvNone;
  FAllowSorting := false;
  FCurrCol := 0;

  // THeaderSection
  FHeader := THeaderControl.Create(self);
  FHeader.Parent := self;
  FSections := FHeader.Sections;
  FHeaderFont := FHeader.Font;

  // TListBox
  FListBox := TListBox.Create(self);
  FListBox.Parent := self;
  FListBox.Align := alClient;
  FListBox.Style := lbOwnerDrawFixed;
  FListBox.OnDrawItem := ListBoxDrawItem;
  FListBox.OnClick := PDoClick;
  FListBox.OnDblClick := PDoDblClick;
  FListBox.OnContextPopup := PDoContextPopup;
  FListBox.OnEnter := PDoEnter;
  FListBox.OnExit := PDoExit;
  FListBox.OnKeyDown := PDoKeyDown;
  FListBox.OnKeyUp := PDoKeyUp;
  FListBox.OnKeyPress := PDoKeyPress;
  FListBox.OnMouseDown := PDoMouseDown;
  FListBox.OnMouseUp := PDoMouseUp;
  FListBox.OnMouseMove := PDoMouseMove;
  FItems := FListBox.Items;
  FFont := FListBox.Font;
end;


destructor TMultiColListBox.Destroy;
begin
  FHeader.Free;
  FListBox.Free;
  inherited Destroy;
end;

procedure TMultiColListBox.Loaded;
begin
  inherited Loaded;
  SetSectionEvents;
  if FAllowSorting then
    QuickSort(0,FListBox.Items.Count - 1,FListBox.Items);
end;

procedure TMultiColListBox.SetFocus;
begin
  inherited SetFocus;
  FListBox.SetFocus;
end;

// =================================================================
// If Component Invalidate or Update methods are called
// then reassign any THeaderSections events and repaint ListBox
// =================================================================

procedure TMultiColListBox.Invalidate;
begin
  inherited Invalidate;
  if not (csDesigning in ComponentState) and
     (FListBox <> nil) then begin
     SetSectionEvents;
     FListBox.Invalidate;
  end;
end;

procedure TMultiColListBox.Update;
begin
  inherited Update;
  if not (csDesigning in ComponentState) and
     (FListBox <> nil) then begin
     SetSectionEvents;
     FListBox.Invalidate;
  end;
end;

// =====================================================================
// Assign OnClick etc. Event Handlers to ALL created THeaderSections
// =====================================================================

procedure TMultiColListBox.SetSectionEvents;
var i : integer;
begin
  if not (csDesigning in ComponentState) then begin
    FHeader.OnSectionResize := SectionResize;
    FHeader.OnResize := HeaderResize;
    FHeader.OnSectionClick := SectionClick;
    for i := 0 to FHeader.Sections.Count - 1 do
      FHeader.Sections.Items[i].AllowClick := FAllowSorting;
  end;
end;

// =======================================================================
// Return the field denoted by Index from line of ";" delim item string
// =======================================================================

function TMultiColListBox.GetField(const Line : string;
                                   Index : integer) : string;
var i : integer;
    S,L : string;
begin
  L := Line;
  for i := 0 to Index do S := XTractField(L);
  Result := S;
end;


// ==============================================
// INTERNAL CALL
// General Recursive quick sort routine.
// ==============================================

procedure TMultiColListBox.QuickSort(Lo,Hi : integer; CC : TStrings);

  procedure sort(l,r: integer);
  var i,j : integer;
      x,Tmp   : string;
  begin
    i := l; j:=r;
    x := GetField(CC[(l+r) DIV 2],FCurrCol);
    repeat
      while GetField(CC[i],FCurrCol) < x do inc(i);
      while x  < GetField(CC[j],FCurrCol) do dec(j);
      if i <= j then  begin
        Tmp := CC[j];
        CC[j] := CC[i];
        CC[i] := Tmp;
        inc(i); dec(j);
      end;
    until i>j;
    if l < j then sort(l,j);
    if i < r then sort(i,r);
  end;

begin
  sort(Lo,Hi);
end;

// =============================================================
// INTERNAL CALL
// Extracts a field from a string delimited by ";"
// The source string is returned with the field and ";" removed
// =============================================================

function TMultiColListBox.XtractField(var Source : string) : string;
var Retvar : string;
    L,P : integer;
begin
  P := pos(';',Source);

  if P = 0 then begin
     RetVar := Source;
     Source := '';
  end
  else begin
     RetVar := '';
     L := length(Source);
     RetVar := copy(Source,1,P - 1);
     L := L - (length(RetVar) + 1);
     Source := copy(Source,P + 1,L);
  end;

  Result := Retvar;
end;

// =====================================================
// ListBox OWNERDRAW routine.
// Draw the columns lined up with header control
// =====================================================

procedure TMultiColListBox.ListBoxDrawItem(Control : TWinControl;
                                           Index : Integer;
                                           Rect : TRect;
                                           State : TOwnerDrawState);
var Line : string;
    LB : TListBox;
    i : integer;
begin
  LB := (Control as TListBox);
  Line := LB.Items[Index];
  LB.Canvas.FillRect(Rect);

  if FHeader.Sections.Count = 0 then begin
    // No Header Sections Defined - Display raw ";" delimited
    for i := 1 to length(Line) do if Line[i] = ';' then Line[i] := ' ';
   LB.Canvas.TextOut(Rect.Left + 2, Rect.Top,Line);
  end
  else begin
    // Align ";" delimited fields to Header Sections
    for i := 0 to FHeader.Sections.Count - 1 do begin
     LB.Canvas.TextOut(Rect.Left + FHeader.Sections.Items[i].Left + 2,
                        Rect.Top,XTractField(Line));
    end;
  end;
end;


// ===============================
// THeaderSections Events
// ===============================

procedure TMultiColListBox.SectionResize(HeaderControl : THeaderControl;
                                         Section : THeaderSection);
begin
  HeaderResize(nil);
end;

procedure TMultiColListBox.HeaderResize(Sender : TObject);
begin
  FListBox.InValidate;
end;

procedure TMultiColListBox.SectionClick(HeaderControl : THeaderControl;
                                        Section: THeaderSection);
begin
  FCurrCol := Section.Index;
  QuickSort(0,FListBox.Items.Count - 1,FListBox.Items);
  FListBox.SetFocus;
end;

// =========================================================================
// TListBox user Event Handlers - call user action if assigned
// =========================================================================

procedure TMultiColListBox.PDoClick(Sender : TObject);
begin
  if Assigned(FOnClick) then FOnClick(self);
end;

procedure TMultiColListBox.PDoDblClick(Sender : TObject);
begin
  if Assigned(FOnDblClick) then FOnDblClick(self);
end;

procedure TMultiColListBox.PDoContextPopup(Sender : TObject;
                                           MousePos : TPoint;
                                           var Handled : Boolean);
begin
  if Assigned(FOnContextPopup) then FOnContextPopup(self,MousePos,Handled);
end;

procedure TMultiColListBox.PDoEnter(Sender : TObject);
begin
  if Assigned(FOnEnter) then FOnEnter(self);
end;

procedure TMultiColListBox.PDoExit(Sender : TObject);
begin
  if Assigned(FOnExit) then FOnExit(self);
end;

procedure TMultiColListBox.PDoKeyDown(Sender : TObject; var Key : Word;
                                      Shift : TShiftState);
begin
  if Assigned(FOnKeyDown) then FOnKeyDown(self,Key,Shift);
end;

procedure TMultiColListBox.PDoKeyUp(Sender : TObject; var Key : Word;
                                      Shift : TShiftState);
begin
  if Assigned(FOnKeyUp) then FOnKeyUp(self,Key,Shift);
end;

procedure TMultiColListBox.PDoKeyPress(Sender : TObject; var Key : char);
begin
  if Assigned(FOnKeyPress) then FOnKeyPress(self,Key);
end;

procedure TMultiColListBox.PDoMouseDown(Sender : TObject;
                                        Button : TMouseButton;
                                        Shift : TShiftState;
                                        X, Y : integer);
begin
  if Assigned(FOnMouseDown) then FOnMouseDown(self,Button,Shift,X,Y);
end;

procedure TMultiColListBox.PDoMouseUp(Sender : TObject;
                                      Button : TMouseButton;
                                      Shift : TShiftState;
                                      X, Y : integer);
begin
  if Assigned(FOnMouseUp) then FOnMouseUp(self,Button,Shift,X,Y);
end;

procedure TMultiColListBox.PDoMouseMove(Sender : TObject;
                                        Shift : TShiftState;
                                        X,Y : integer);
begin
  if Assigned(FOnMouseMove) then FOnMouseMove(self,Shift,X,Y);
end;

// =========================================================================
// GET/SET Property Methods
// =========================================================================

procedure TMultiColListBox.SetFItems(Value : TStrings);
begin
  FItems.Assign(Value);
end;

procedure TMultiColListBox.SetFFont(Value : TFont);
begin
  FFont.Assign(Value);
end;

procedure TMultiColListBox.SetFHeaderFont(Value : TFont);
begin
  FHeaderFont.Assign(Value);
end;

procedure TMultiColListBox.SetFColor(Value : TColor);
begin
  FListBox.Color := Value;
end;

function TMultiColListBox.GetFColor : TColor;
begin
  Result := FListBox.Color;
end;

procedure TMultiColListBox.SetFExtendedSelect(Value : boolean);
begin
  FListBox.ExtendedSelect := Value;
end;

function TMultiColListBox.GetFExtendedSelect : boolean;
begin
  Result := FListBox.ExtendedSelect;
end;

procedure TMultiColListBox.SetFIntegralHeight(Value : boolean);
begin
  FListBox.IntegralHeight := Value;
end;

function TMultiColListBox.GetFIntegralHeight : boolean;
begin
  Result := FListBox.IntegralHeight;
end;

procedure TMultiColListBox.SetFMultiSelect(Value : boolean);
begin
  FListBox.MultiSelect := Value;
end;

function TMultiColListBox.GetFMultiSelect : boolean;
begin
  Result := FListBox.MultiSelect;
end;

function TMultiColListBox.GetFColCount : integer;
begin
  Result := FHeader.Sections.Count;
end;

function TMultiColListBox.GetFSelCount : integer;
begin
  Result := FListBox.SelCount;
end;

function TMultiColListBox.GetFSelected(Index : integer) : boolean;
begin
  Result := FListBox.Selected[Index];
end;

procedure TMultiColListBox.SetFSelected(Index : integer;
                                        Value : boolean);
begin
  FListBox.Selected[Index] := Value;
end;

function TMultiColListBox.GetFItemIndex : integer;
begin
  Result := FListBox.ItemIndex;
end;

procedure TMultiColListBox.SetFItemIndex(Value : integer);
begin
  FListBox.ItemIndex := Value;
end;

procedure TMultiColListBox.SetFAllowSorting(Value : boolean);
begin
  FAllowSorting := Value;
  if not (csDesigning in ComponentState) then SetSectionEvents;
  if FAllowSorting then
    QuickSort(0,FListBox.Items.Count - 1,FListBox.Items);
end;

procedure TMultiColListBox.SetFHeaderHeight(Value : integer);
begin
  FHeader.Height := Value;
end;

function TMultiColListBox.GetFHeaderHeight : integer;
begin
  Result := FHeader.Height;
end;

procedure TMultiColListBox.SetFHeaderImages(Value : TImageList);
begin
  FHeader.Images := Value;
end;

function TMultiColListBox.GetFHeaderImages : TImageList;
begin
  Result := TImageList(FHeader.Images);
end;

{EOF}
end.