请熟悉的人帮忙转换成bcb,谢谢。
unit Unit1;
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));
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.
