如何製作與Outlook 2013相同的列表框？

Question

在Delphi XE2或XE3中，如何製作類似於Outlook 2013電子郵件列表的列表框？

或者是Outlook 2013中的其他名稱？

我該如何在Delphi XE2或XE3中實現類似的功能？

感謝

Answer 1

你可以用TListView和ListGroups做類似的事情。有一個在Delphi documentation中使用ListGroups的示例（XE4的鏈接，但也適用於XE2和XE3）。它不會給你你想要的圖像，但它展示了使用它們，你應該能夠從那裏拿走它。 （請注意下面的代碼不是從該鏈接直接複製/粘貼代碼，因爲代碼有錯誤和遺漏，我已經更正，編譯並運行它，先在此處發佈它們以修復它們。 ）

在新的VCL表單應用程序中刪除TListView和TImageList。將TImageList的名稱更改爲DigitsLetters，然後將以下代碼添加到窗體中（像往常一樣在Object Inspector中創建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.