8
votes

I have been having a play around with the TListBox control, and drawing images and changing the font styles etc. I want to step it up a little, and try manipulating the items some more with indentation and multi level indenting.

Take a look at this image for a better idea:

enter image description here

The idea is that items in the list that are positioned between start and end items should be indented accordingly.

So, to give an idea I edited the screenshot in Paint, so it would look something like this:

enter image description here

What would be the way to approach this? My thought was to iterate through the listbox and return in 2 separate variable the amount of start and end items, then somehow determine where the other items are and if the fit between - but my logic is never so good :(

For ease of use, I have provided below the code to show how I am drawing the images and styles:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ListBox1: TListBox;
    TabSheet2: TTabSheet;
    ListBox2: TListBox;
    TabSheet3: TTabSheet;
    ListBox3: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBox2MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure ListBox2DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBox3MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure ListBox3DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

// assign quick identifiers to image indexes
const
  imgLayout      = 0;
  imgCalculator  = 1;
  imgComment     = 2;
  imgTime        = 3;
  imgStart       = 4;
  imgEnd         = 5;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  ListStyle: TListBoxStyle;
begin
  // set the listbox style here
  ListStyle := lbOwnerDrawVariable;
  ListBox1.Style := ListStyle;
  ListBox2.Style := ListStyle;
  ListBox3.Style := ListStyle;
end;

{******************************************************************************}

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  TextPosition: Integer;
  Images: TImageList;
begin
  TListBox(Control).Canvas.FillRect(Rect);
  Images := ImageList1;

  // draw the images
  if TListBox(Control).Items.Strings[Index] = 'Layout' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top, imgLayout);
  end else
  if TListBox(Control).Items.Strings[Index] = 'Calculator' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top,
      imgCalculator);
  end else
  if TListBox(Control).Items.Strings[Index] = 'Comment' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top, imgComment);
  end else
  if TListBox(Control).Items.Strings[Index] = 'Time' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top, imgTime);
  end;

  // positions the text
  TextPosition := (Rect.Bottom - Rect.Top - TListBox(Control).Canvas.TextHeight
    (Text)) div 2;

  // displays the text
  TListBox(Control).Canvas.TextOut(Rect.Left + Images.Width + 8,
    Rect.Top + TextPosition, TListBox(Control).Items.Strings[index]);
end;

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

{******************************************************************************}

procedure TForm1.ListBox2DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  TextPosition: Integer;
  Images: TImageList;
begin
  TListBox(Control).Canvas.FillRect(Rect);
  Images := ImageList1;

  // draw the images
  if TListBox(Control).Items.Strings[Index] = 'Layout' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top, imgLayout);
    TListBox(Control).Canvas.Font.Style := [fsBold];
  end else
  if TListBox(Control).Items.Strings[Index] = 'Calculator' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top,
      imgCalculator);
    TListBox(Control).Canvas.Font.Color := clBlue;
    TListBox(Control).Canvas.Font.Style := [fsItalic];
  end else
  if TListBox(Control).Items.Strings[Index] = 'Comment' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top, imgComment);
    TListBox(Control).Canvas.Font.Color := clRed;
  end else
  if TListBox(Control).Items.Strings[Index] = 'Time' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top, imgTime);
  end;

  // positions the text
  TextPosition := (Rect.Bottom - Rect.Top - TListBox(Control).Canvas.TextHeight
    (Text)) div 2;

  // displays the text
  TListBox(Control).Canvas.TextOut(Rect.Left + Images.Width + 8,
    Rect.Top + TextPosition, TListBox(Control).Items.Strings[index]);
end;

procedure TForm1.ListBox2MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
begin
  Height := ImageList1.Height;
end;

{******************************************************************************}

procedure TForm1.ListBox3DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  TextPosition: Integer;
  Images: TImageList;
begin
  TListBox(Control).Canvas.FillRect(Rect);
  Images := ImageList1;

  // draw the images
  if TListBox(Control).Items.Strings[Index] = 'Layout' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top, imgLayout);
  end else
  if TListBox(Control).Items.Strings[Index] = 'Calculator' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top,
      imgCalculator);
  end else
  if TListBox(Control).Items.Strings[Index] = 'Comment' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top, imgComment);
  end else
  if TListBox(Control).Items.Strings[Index] = 'Time' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top, imgTime);
  end else
  if TListBox(Control).Items.Strings[Index] = 'Start' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top,
      imgStart);
    TListBox(Control).Canvas.Font.Style := [fsBold];
  end else
  if TListBox(Control).Items.Strings[Index] = 'End' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top, imgEnd);
    TListBox(Control).Canvas.Font.Style := [fsBold];
  end;

  // positions the text
  TextPosition := (Rect.Bottom - Rect.Top - TListBox(Control).Canvas.TextHeight
    (Text)) div 2;

  // displays the text
  TListBox(Control).Canvas.TextOut(Rect.Left + Images.Width + 8,
    Rect.Top + TextPosition, TListBox(Control).Items.Strings[index]);
end;

procedure TForm1.ListBox3MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
begin
  Height := ImageList1.Height;
end;

{******************************************************************************}

end.

I would appreciate some tips on how I could determine manipulating the items. I know I can change where the bitmap and texts are placed, but it is identifying if an item falls between the groups or not, and if it does set the correct indent level.

I hope this makes sense thats why I put some mock pictures up.

Thanks :)

PS, I never write small posts sorry!

UPDATE WITH WORKING DEMO

I have accepted Sertac's answer which I have working perfectly thanks Sertac.

To help others who may be viewing - and because I have been learning OOP I want to show my code to see if it is any good :)

I have made 2 units, Lib.pas contains the classes for the list items, and Unit1.pas is the Form1 unit (I shortened unit 1 to make it clearer to see what is going on):

Lib.pas

unit Lib;

interface

uses
  Classes, StdCtrls;

type
  TMyListData = class(TObject)
  public
    fCaption: string;
    fImageIndex: integer;
  public
    property Caption: string read fCaption write fCaption;
    property ImageIndex: integer read fImageIndex write fImageIndex;

    constructor Create;
    destructor Destroy; override;
  end;

type
  TLayoutItem     = class(TMyListData);
  TCalculatorItem = class(TMyListData);
  TCommentItem    = class(TMyListData);
  TTimeItem       = class(TMyListData);
  TStartItem      = class(TMyListData);
  TEndItem        = class(TMyListData);

const
  imgLayout       = 0;
  imgCalculator   = 1;
  imgComment      = 2;
  imgTime         = 3;
  imgStart        = 4;
  imgEnd          = 5;

procedure NewLayoutItem(aListBox: TListBox);
procedure NewCalculatorItem(aListBox: TListBox);
procedure NewCommentItem(aListBox: TListBox);
procedure NewTimeItem(aListBox: TListBox);
procedure NewStartItem(aListBox: TListBox);
procedure NewEndItem(aListBox: TListBox);
procedure DeleteItem(aListBox: TListBox; aIndex: integer);
procedure CalculateIndents(aListBox: TListBox);

implementation

{ TMyListData }

constructor TMyListData.Create;
begin
  inherited Create;
end;

destructor TMyListData.Destroy;
begin
  inherited;
end;

procedure NewLayoutItem(aListBox: TListBox);
var
  Obj: TLayoutItem;
begin
  Obj := TLayoutItem.Create;
  try
    Obj.Caption := 'Layout';
    Obj.ImageIndex := imgLayout;

    aListBox.AddItem(Obj.Caption, Obj);
  finally
    Obj.Free;
  end;

  CalculateIndents(aListBox);
end;

procedure NewCalculatorItem(aListBox: TListBox);
var
  Obj: TCalculatorItem;
begin
  Obj := TCalculatorItem.Create;
  try
    Obj.Caption := 'Calculator';
    Obj.ImageIndex := imgCalculator;

    aListBox.AddItem(Obj.Caption, Obj);
  finally
    Obj.Free;
  end;

  CalculateIndents(aListBox);
end;

procedure NewCommentItem(aListBox: TListBox);
var
  Obj: TCommentItem;
begin
  Obj := TCommentItem.Create;
  try
    Obj.Caption := 'Comment';
    Obj.ImageIndex := imgComment;

    aListBox.AddItem(Obj.Caption, Obj);
  finally
    Obj.Free;
  end;

  CalculateIndents(aListBox);
end;

procedure NewTimeItem(aListBox: TListBox);
var
  Obj: TTimeItem;
begin
  Obj := TTimeItem.Create;
  try
    Obj.Caption := 'Time';
    Obj.ImageIndex := imgTime;

    aListBox.AddItem(Obj.Caption, Obj);
  finally
    Obj.Free;
  end;

  CalculateIndents(aListBox);
end;

procedure NewStartItem(aListBox: TListBox);
var
  Obj: TStartItem;
begin
  Obj := TStartItem.Create;
  try
    Obj.Caption := 'Start';
    Obj.ImageIndex := imgStart;

    aListBox.AddItem(Obj.Caption, Obj);
  finally
    Obj.Free;
  end;

  CalculateIndents(aListBox);
end;

procedure NewEndItem(aListBox: TListBox);
var
  Obj: TEndItem;
begin
  Obj := TEndItem.Create;
  try
    Obj.Caption := 'End';
    Obj.ImageIndex := imgEnd;

    aListBox.AddItem(Obj.Caption, Obj);
  finally
    Obj.Free;
  end;

  CalculateIndents(aListBox);
end;


procedure DeleteItem(aListBox: TListBox; aIndex: integer);
begin
  aListBox.Items.Delete(aIndex);
  aListBox.Items.Objects[aIndex] := nil;

  CalculateIndents(aListBox);
end;

procedure CalculateIndents(aListBox: TListBox);
var
  i: Integer;
  Indent: Integer;
begin
  Indent := 0;

  for i := 0 to aListBox.Items.Count - 1 do
  begin
    if aListBox.Items[i] = 'End' then
      Dec(Indent);

    if Indent > -1 then
      aListBox.Items.Objects[i] := Pointer(Indent);

    if aListBox.Items[i] = 'Start' then
      Inc(Indent);
  end;

  for i := aListBox.Items.Count - 1 downto 0 do
  begin
    if (aListBox.Items[i] = 'End') and (Indent = -1) then
    begin
      DeleteItem(aListBox, i);
      Break;
    end;
  end;
end;

end.

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ImgList, ComCtrls, Buttons;

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    lbMain: TListBox;
    btnLayout: TBitBtn;
    btnCalculator: TBitBtn;
    btnComment: TBitBtn;
    btnTime: TBitBtn;
    btnStartGroup: TBitBtn;
    btnEndGroup: TBitBtn;
    btnDelete: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure lbMainMeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure lbMainDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure btnLayoutClick(Sender: TObject);
    procedure btnCalculatorClick(Sender: TObject);
    procedure btnCommentClick(Sender: TObject);
    procedure btnTimeClick(Sender: TObject);
    procedure btnStartGroupClick(Sender: TObject);
    procedure btnEndGroupClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Lib;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // set the listbox style here
  lbMain.Style := lbOwnerDrawVariable;
end;

procedure TForm1.lbMainDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  TextPosition: Integer;
  Images: TImageList;
begin
  TListBox(Control).Canvas.FillRect(Rect);
  Images := ImageList1;

  // draw the images
  if TListBox(Control).Items.Strings[Index] = 'Layout' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4 +
                8 * Integer(TListBox(Control).Items.Objects[Index]),
                Rect.Top, imgLayout);
  end
  else if TListBox(Control).Items.Strings[Index] = 'Calculator' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4 +
                8 * Integer(TListBox(Control).Items.Objects[Index]),
                Rect.Top, imgCalculator);
  end
  else if TListBox(Control).Items.Strings[Index] = 'Comment' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4 +
                8 * Integer(TListBox(Control).Items.Objects[Index]),
                Rect.Top, imgComment);
  end
  else if TListBox(Control).Items.Strings[Index] = 'Time' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4 +
                8 * Integer(TListBox(Control).Items.Objects[Index]),
                Rect.Top, imgTime);
  end
  else if TListBox(Control).Items.Strings[Index] = 'Start' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4 +
                8 * Integer(TListBox(Control).Items.Objects[Index]),
                Rect.Top, imgStart);
  end
  else if TListBox(Control).Items.Strings[Index] = 'End' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4 +
                8 * Integer(TListBox(Control).Items.Objects[Index]),
                Rect.Top, imgEnd);
  end;

  // positions the text
  TextPosition := (Rect.Bottom - Rect.Top - TListBox(Control).Canvas.TextHeight
    (Text)) div 2;

  // displays the text
  TListBox(Control).Canvas.TextOut(
    Rect.Left + Images.Width + 8 + 8 * Longint(TListBox(Control).Items.Objects[Index]),
    Rect.Top + TextPosition, TListBox(Control).Items.Strings[index]);
end;

procedure TForm1.lbMainMeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
begin
  Height := ImageList1.Height;
end;

procedure TForm1.btnLayoutClick(Sender: TObject);
begin
  NewLayoutItem(lbMain);
end;

procedure TForm1.btnCalculatorClick(Sender: TObject);
begin
  NewCalculatorItem(lbMain);
end;

procedure TForm1.btnCommentClick(Sender: TObject);
begin
  NewCommentItem(lbMain);
end;

procedure TForm1.btnTimeClick(Sender: TObject);
begin
  NewTimeItem(lbMain);
end;

procedure TForm1.btnStartGroupClick(Sender: TObject);
begin
  NewStartItem(lbMain);
end;

procedure TForm1.btnEndGroupClick(Sender: TObject);
begin
  NewEndItem(lbMain);
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
begin
  if lbMain.ItemIndex <> -1 then
  begin
    DeleteItem(lbMain, lbMain.ItemIndex);
  end;
end;

end.

enter image description here

It can be made better, ie assigning the image indexes based on the Items.Objects[] property but this works perfectly :)

2
Just out of curiousity, why are you trying to do this with TListBox. This seems like a perfect place to be using a TTreeView instead; it has built-in support for the indentation, images based on content type, and so forth. It seems like you're doing a lot of extra work for no reason. (I thought at first you must be using FireMonkey, but a review of the code doesn't indicate that you are.)Ken White
If you want an entirely custom look-and-feel list, you can also use TScrollBox and design your elements on TFrames. Set up a simple Managed Array to handle items in the same way as TListBox.Items (easily done), and then there are literally no limits on what you can create.LaKraven
@KenWhite I don't have Delphi XE2 unfortunately, also I am fully aware of the Treeview which would provide a better way of displaying the data as you say. On the other hand however, for a simple listbox display I thought this would be a good thing to try and do. I was just experimenting with the TListbox, and having read some more on Fire monkey after your comment I see that Treeview cannot be used as it is a Windows control, so doing this with a listbox has its advantages in that respect.user741875
Craig, no. This code will not help you eventually with FireMonkey - FM's ListBox is in no way compatible with the VCL one. And the VCL's TListBox is a wrapper around the underlying Windows common control, and isn't designed to be used the way you're trying to use it (which is why you're finding it difficult). Looks like @Sertac did a good job with an answer, though (as usual).Ken White
But it also all depends on having a good idea of how it is going to work before re-building it. It's a technique called "making a prototype".Jerry Dodge

2 Answers

6
votes

One way is to iterate over items and modify the text to indicate indentation:

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  Indent: Integer;
begin

  ...

  Indent := 0;
  for i := 0 to ListBox3.Items.Count - 1 do begin
    if Pos('End', ListBox3.Items[i]) > 0 then
      Dec(Indent);
    if Indent > 0 then
      ListBox3.Items[i] := StringOfChar(#32, 2 * Indent) + ListBox3.Items[i];
    if Pos('Start', ListBox3.Items[i]) > 0 then
      Inc(Indent);
  end;
end;

Since items' text are changed, this approach requires to test the text accordingly when drawing:

procedure TForm1.ListBox3DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  TextPosition: Integer;
  Images: TImageList;
begin
  TListBox(Control).Canvas.FillRect(Rect);
  Images := ImageList1;

  // draw the images
  if Pos('Layout', TListBox(Control).Items.Strings[Index]) > 0 then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4, Rect.Top, imgLayout);
  end else
  if Pos('Calculator', TListBox(Control).Items.Strings[Index]) > 0 then
    ..

(With this approach, indenting images would be a little work, count the leading spaces in item text, and so on..)


If items' objects are not used already, a slightly better approach can be to store indentation as an integer, and use that information when drawing. E.g. when iterating:

Indent := 0;
for i := 0 to ListBox3.Items.Count - 1 do begin
  if ListBox3.Items[i] = 'Start' then
    Inc(Indent);
  ListBox3.Items.Objects[i] := Pointer(Indent);
  if ListBox3.Items[i] = 'End' then
    Dec(Indent);
end;

When drawing:

  ..
  if TListBox(Control).Items.Strings[Index] = 'Layout' then
  begin
    Images.Draw(TListBox(Control).Canvas, Rect.Left + 4 +
                8 * Integer(TListBox(Control).Items.Objects[Index]),
                Rect.Top, imgLayout);

  ..
  // displays the text
  TListBox(Control).Canvas.TextOut(
    Rect.Left + Images.Width + 8 + 8 * Longint(TListBox(Control).Items.Objects[Index]),
    Rect.Top + TextPosition, TListBox(Control).Items.Strings[index]);
  ..  
3
votes

I think you should probably use the TTreeView instead, which already supports indenting child items.

To answer your question, I think you could use recursion to draw the items in your TListBox. Using recursion, it is easy to see how many levels deep you are.

This is how most parsers work, such as HTML parsers.

Here's some pseudo code that illustrates the concept:

procedure DrawBranch(branch: TMyList; indent: Integer);
var
  i: Integer;
begin
  // Draw the current branch, using the indent value
  branch.Draw;
  // Iterate through all of the child branches
  for i := 0 to branch.Children.Count - 1 do
  begin
    // Each time we recurse further, we add 1 to the indent 
    DrawBranch(branch.Child[i], indent + 1);
  end;
end;

procedure DrawTree;
begin
  // Start the whole thing off with the root branch
  // We start the indent at 0
  DrawBranch(root, 0);
end;

You'll want a "hidden" root node in your case.

You'd use similar same logic to add your items to a TTreeView.