Как сделать список таким же, как Outlook 2013?

Question

В Delphi XE2 или XE3, как я могу создать список, похожий на список адресов электронной почты Outlook 2013?

или это список в Outlook 2013 что-то еще?

Как достичь аналогичного результата в Delphi XE2 или XE3?

Благодаря

Answer 1

Вы можете сделать что-то подобное с помощью TListView и ListGroups. Пример использования ListGroups в Delphi documentation (ссылка для XE4, но также работает в XE2 и XE3). Он не дает вам изображения, которое вы ищете, но демонстрирует их использование, и вы должны быть в состоянии взять его оттуда.

(Обратите внимание, что приведенный ниже код не является прямой копией/вставкой кода с этой ссылкой, так как этот код имеет ошибки и упущения. Я исправил, скомпилировал и запустил его сначала, чтобы исправить это, прежде чем публиковать его здесь.)

Оставьте TListView и TImageList в новом приложении форм VCL. Измените имя TImageList на DigitsLetters, а затем добавьте следующий код в форму (создайте в Инспекторе объектов FormCreate и FormDestroy, как обычно, и вставьте код в обработчики событий и просто добавьте объявление GetImageFromAscii в private раздел формы декларации):

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; 

Результаты (показаны с Digits и Small Letters групп разрушилась):

Answer 2

управления в Outlook, не стандартный список. В Outlook 2010 это окно с классом «SUPERGRID», и я полагаю, что Outlook 2013 похож.

Вы можете сделать то, что сделали разработчики Outlook, и написать свой собственный контроль, но это может быть более крупный проект, чем вам действительно интересен. Более простая задача - вместо этого использовать обычный TListBox и обрабатывать его событие OnDrawItem. Если вы хотите, чтобы элементы имели переменную высоту, вы также можете обрабатывать событие OnMeasureItem.

Если вы хотите, чтобы ваш элемент управления включал расширяемые и разборчивые группы элементов, вы можете начать с управления деревом вместо этого. TTreeView также может быть нарисован на заказ. Для большей настраиваемости вы можете попробовать TVirtualStringTree.

Answer 3

Я нашел этот код, который лучше всего подходит для работы, которая мне нужна :) Это идеальный вид на изображение выше.

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.