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

Question

В Delphi XE2 или XE3, как сделать список похожим на список электронных писем Outlook 2013?

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

Как я могу добиться аналогичного в Delphi XE2 или XE3?

Спасибо

Answer 1

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

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

Удалите TListView и TImageList в новом приложении форм VCL. Изменить имя TImageList в DigitsLetters и затем добавьте следующий код в форму (создайте FormCreate а также FormDestroy как обычно в Object Inspector, вставьте код в обработчики событий и просто добавьте объявление 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.