How do I make a listbox same as Outlook 2013?

Question

In Delphi XE2 or XE3, How can I make a list box similar to Outlook 2013 list of emails ?

or is the list in Outlook 2013 something else ?

how can I achieve a similar one in Delphi XE2 or XE3 ?

Thanks

Answer 1

You can do something similar with a TListView and ListGroups. There's an example of using the ListGroups in the Delphi documentation (link for XE4, but works in XE2 and XE3 as well). It doesn't give you the image you're looking for, but it demonstrates using them, and you should be able to take it from there.

(Note the code below is not a direct copy/paste of the code from that link, as that code has errors and omissions. I've corrected, compiled, and run it first to fix those before posting it here.)

Drop a TListView and TImageList on a new VCL forms application. Change the name of the TImageList to DigitsLetters, and then add the following code to the form (create the FormCreate and FormDestroy in the Object Inspector as usual, and paste the code into the event handlers, and just add the declaration of GetImageFromAscii to the private section of the form declaration):

procedure TForm1.FormCreate(Sender: TObject);
var
  Group: TListGroup;
  ListItem: TListItem;
  Image: TBitmap;
  c: Char;
begin
  { align the list view to the form }
  ListView1.Align := alClient;

  { center and stretch the form to fit the screen }
  Self.Position := poScreenCenter;
  Self.Height := 600;
  Self.Width := 800;

  {
  change the view style of the list view
  such that the icons are displayed
  }
  ListView1.ViewStyle := vsIcon;

  { enable group view }
  ListView1.GroupView := True;

  { create a 32 by 32 image list }
  DigitsLetters := TImageList.CreateSize(32, 32);

  {
  generate the DigitsLetters image list with the digits,
  the small letters and the capital letters
  }
  GetImagesFromASCII('0', '9');
  GetImagesFromASCII('a', 'z');
  GetImagesFromASCII('A', 'Z');

  {
  add an empty image to the list
  used to emphasize the top and bottom descriptions
  of the digits group
  }
  Image := TBitmap.Create;
  Image.Height := 32;
  Image.Width := 32;
  DigitsLetters.Add(Image, nil);
  Image.Destroy;

  { create a title image for the small letters category }
  Image := TBitmap.Create;
  Image.Height := 32;
  Image.Width := 32;
  Image.Canvas.Brush.Color := clYellow;
  Image.Canvas.FloodFill(0, 0, clYellow, fsBorder);
  Image.Canvas.Font.Name := 'Times New Roman';
  Image.Canvas.Font.Size := 14;
  Image.Canvas.Font.Color := clRed;
  Image.Canvas.TextOut(3, 5, 'a..z');
  DigitsLetters.Add(Image, nil);
  Image.Destroy;

  { create a title image for the capital letters category }
  Image := TBitmap.Create;
  Image.Height := 32;
  Image.Width := 32;
  Image.Canvas.Brush.Color := clYellow;
  Image.Canvas.FloodFill(0, 0, clYellow, fsBorder);
  Image.Canvas.Font.Name := 'Times New Roman';
  Image.Canvas.Font.Size := 13;
  Image.Canvas.Font.Color := clRed;
  Image.Canvas.TextOut(2, 5, 'A..Z');
  DigitsLetters.Add(Image, nil);
  Image.Destroy;

  { associate the image list with the list view }
  ListView1.LargeImages := DigitsLetters;
  ListView1.GroupHeaderImages := DigitsLetters;

  { set up the digits group }
  Group := ListView1.Groups.Add;
  Group.State := [lgsNormal, lgsCollapsible];
  Group.Header := 'Digits';
  Group.HeaderAlign := taCenter;
  Group.Footer := 'End of the Digits category';
  Group.FooterAlign := taCenter;
  Group.Subtitle := 'The digits from 0 to 9';

  {
  use the empty image as the title image
  to emphasize the top and bottom descriptions
  }
  Group.TitleImage := DigitsLetters.Count - 3;

  { create the actual items in the digits group }
  for c := '0' to '9' do
  begin
    // add a new item to the list view
    ListItem := ListView1.Items.Add;

    // ...customize it
    ListItem.Caption := c + ' digit';
    ListItem.ImageIndex := Ord(c) - Ord('0');

    // ...and associate it with the digits group
    ListItem.GroupID := Group.GroupID;
  end;

  { set up the small letters group }
  Group := ListView1.Groups.Add;
  Group.State := [lgsNormal, lgsCollapsible];
  Group.Header := 'Small Letters';
  Group.HeaderAlign := taRightJustify;
  Group.Footer := 'End of the Small Letters category';
  Group.FooterAlign := taLeftJustify;
  Group.Subtitle := 'The small letters from ''a'' to ''z''';
  Group.TitleImage := DigitsLetters.Count - 2;

  { create the actual items in the small letters group }
  for c := 'a' to 'z' do
  begin
    // add a new item to the list view
    ListItem := ListView1.Items.Add;

    // ...customize it
    ListItem.Caption := 'letter ' + c;
    ListItem.ImageIndex := Ord(c) - Ord('a') + 10;

    // ...and associate it with the small letters group
    ListItem.GroupID := Group.GroupID;
  end;

  {
  to see how the NextGroupID property can be used,
  the following lines of code show how an item can be associated
  with a group ID, prior to creating the group
  }

  { create the actual items in the capital letters group }
  for c := 'A' to 'Z' do
  begin
    // add a new item to the list view
    ListItem := ListView1.Items.Add;

    // ...customize it
    ListItem.Caption := 'letter ' + c;
    ListItem.ImageIndex := Ord(c) - Ord('A') + 36;

    // ...and associate it with the capital letters group
    ListItem.GroupID := ListView1.Groups.NextGroupID;
  end;

  { set up the capital letters group }
  Group := ListView1.Groups.Add;
  Group.State := [lgsNormal, lgsCollapsible];
  Group.Header := 'Capital Letters';
  Group.HeaderAlign := taRightJustify;
  Group.Footer := 'End of the Capital Letters category';
  Group.FooterAlign := taLeftJustify;
  Group.Subtitle := 'The capital letters from ''A'' to ''Z''';
  Group.TitleImage := DigitsLetters.Count - 1;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  { remove the image list from memory }
  DigitsLetters.Destroy;
end;

{
Generates a series of images for the characters
starting with ASCII code First and ending with Last.
All images are added to the DigitsLetters variable.
}
procedure TForm1.GetImagesFromASCII(First, Last: Char);
var
  Image: TBitmap;
  c: Char;
begin
  for c := First to Last do
  begin
    Image := TBitmap.Create;
    Image.Height := 32;
    Image.Width := 32;
    Image.Canvas.Font.Name := 'Times New Roman';
    Image.Canvas.Font.Size := 22;
    Image.Canvas.TextOut((Image.Width - Image.Canvas.TextWidth(c)) div 2, 0, c);
    DigitsLetters.Add(Image, nil);
    Image.Destroy;
  end;
end;

Results (shown with the Digits and Small Letters groups collapsed):

Answer 2

The control in Outlook is not a standard list box. In Outlook 2010, it's a window with class "SUPERGRID," and I imagine Outlook 2013 is similar.

You can do as the Outlook developers did and write your own control, but that might be a bigger project than you're really interested in. A simpler task is to instead use an ordinary TListBox and handle its OnDrawItem event. If you want items to have variable heights, then you can also handle the OnMeasureItem event.

If you want your control to include expandable and collapsible groups of items, then you might want to start with a tree control instead. TTreeView can be custom-drawn, too. For more customizability, you could try TVirtualStringTree.

Answer 3

I found this code which is the Best to do the work I need :) It's a perfect looking to the image above.

unit Unit1;

interface

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

type
  TGroupItem = class
  private
    fItems : TObjectList;
    fCaption: string;
    fListItem: TListItem;
    fExpanded: boolean;
    function GetItems: TObjectList;
  public
    constructor Create(const caption : string; const numberOfSubItems : integer);
    destructor Destroy; override;

    procedure Expand;
    procedure Collapse;

    property Expanded : boolean read fExpanded;
    property Caption : string read fCaption;
    property Items : TObjectList read GetItems;
    property ListItem : TListItem read fListItem write fListItem;
  end;

  TItem = class
  private
    fTitle: string;
    fValue: string;
  public
    constructor Create(const title, value : string);
    property Title: string read fTitle;
    property Value : string read fValue;
  end;


  TForm1 = class(TForm)
    lvGroups: TListView;
    listViewImages: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lvGroupsAdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    procedure lvGroupsDblClick(Sender: TObject);
  private
    procedure ClearListViewGroups;
    procedure FillListViewGroups;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.ClearListViewGroups;
var
  li : TListItem;
  qng : TGroupItem;
begin
  for li in lvGroups.Items do
  begin
    if TObject(li.Data) is TGroupItem then
    begin
      qng := TGroupItem(li.Data);
      FreeAndNil(qng);
    end;
  end;
  lvGroups.Clear;
end;

procedure TForm1.FillListViewGroups;

  procedure AddGroupItem(gi : TGroupItem);
  var
    li : TListItem;
  begin
    li := lvGroups.Items.Add;

    li.Caption := gi.Caption;
    li.ImageIndex := 1; //collapsed

    li.Data := gi;
    gi.ListItem := li; //link "back"
  end;
begin
  ClearListViewGroups;

  AddGroupItem(TGroupItem.Create('Group A', 3));
  AddGroupItem(TGroupItem.Create('Group B', 1));
  AddGroupItem(TGroupItem.Create('Group C', 4));
  AddGroupItem(TGroupItem.Create('Group D', 5));
 AddGroupItem(TGroupItem.Create('Group D', 5));
  AddGroupItem(TGroupItem.Create('Group D', 5));
   AddGroupItem(TGroupItem.Create('Group D', 5));

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FillListViewGroups;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ClearListViewGroups;
end;

procedure TForm1.lvGroupsAdvancedCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
begin
  //bold group items
  if TObject(item.Data) is TGroupItem then
  begin
    lvGroups.Canvas.Font.Style := lvGroups.Canvas.Font.Style + [fsBold];
  end;
end;

//handles TListView OnDblClick even
procedure TForm1.lvGroupsDblClick(Sender: TObject);
var
  hts : THitTests;
  gi : TGroupItem;
begin
  inherited;

  hts := lvGroups.GetHitTestInfoAt(lvGroups.ScreenToClient(Mouse.CursorPos).X, lvGroups.ScreenToClient(Mouse.CursorPos).y);

  if (lvGroups.Selected <> nil) then
  begin
    if TObject(lvGroups.Selected.Data) is (TGroupItem) then
    begin
      gi := TGroupItem(lvGroups.Selected.Data);

      if NOT gi.Expanded then
        gi.Expand
      else
        gi.Collapse;
    end;
  end;
end;


{$region 'TGroupItem'}

procedure TGroupItem.Collapse;
var
  li : TListItem;
begin
  if NOT Expanded then Exit;

  ListItem.ImageIndex := 1;
  fExpanded := false;

  li := TListView(ListItem.ListView).Items[ListItem.Index + 1];
  while (li <> nil) AND (TObject(li.Data) is TItem) do
  begin
    TListView(ListItem.ListView).Items.Delete(li.Index);
    li := TListView(ListItem.ListView).Items[ListItem.Index + 1];
  end;
end;

constructor TGroupItem.Create(const caption: string; const numberOfSubItems : integer);
var
  cnt : integer;
begin
  fCaption := caption;

  for cnt := 1 to numberOfSubItems do
  begin
    Items.Add(TItem.Create(caption + ' item ' + IntToStr(cnt), IntToStr(cnt)));
  end;
end;

destructor TGroupItem.Destroy;
begin
  FreeAndNil(fItems);
  inherited;
end;

procedure TGroupItem.Expand;
var
  cnt : integer;
  item : TItem;
begin
  if Expanded then Exit;

  ListItem.ImageIndex := 0;
  fExpanded := true;

  for cnt := 0 to -1 + Items.Count do
  begin
    item := TItem(Items[cnt]);
    with TListView(ListItem.ListView).Items.Insert(1 + cnt + ListItem.Index) do
    begin
      Caption := item.Title;
      SubItems.Add(item.Value);
      Data := item;
      ImageIndex := -1;
    end;
  end;
end;

function TGroupItem.GetItems: TObjectList;
begin
  if fItems = nil then fItems := TObjectList.Create(true);
  result := fItems;
end;
{$endregion}

{$region 'TItem' }

constructor TItem.Create(const title, value: string);
begin
  fTitle := title;
  fValue := value;
end;
{$endregion}

end.