How do I make a listbox same as Outlook 2013? - delphi

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.