Delphi-ListView或类似产品，带有所有者绘制按钮

如何创建一个在每行上都有按钮的列表视图（或类似视图）？按钮需要能够根据需要在每行上显示不同的文本/颜色

我相信虚拟树视图将是完美的，但我有点迷茫

谢谢

---

-布拉德

拥有虚拟视窗。。。。。。将vstButton添加到uses中，并在对象检查器中选择Virtualtreeview，然后为树设置以下事件：

procedure TForm1.VSTCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; out EditLink: IVTEditLink);
begin
  EditLink:=TStringEditLink.Create;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  VST.NodeDataSize := SizeOf(TTreeData);
  AddRandomNodesToTree(Vst);
end;

procedure TForm1.VSTFreeNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
 Data: PTreeData;
begin
 Data:=VST.GetNodeData(Node);
 if Assigned(Data) then begin
   Data^.Column0 := '';
   Data^.Column1 := '';
   Data^.Column2 := '';
 end;
end;

procedure TForm1.VSTGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var
  Data: PTreeData;
begin
  Data := VST.GetNodeData(Node);
  case Column of
    0: CellText := Data^.Column0;
    1: CellText := Data^.Column1;
    2: CellText := Data^.Column2;
  end;
end;

procedure TForm1.VSTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; NewText: string);
Var
  Data: PTreeData;
begin
  Data := VST.GetNodeData(Node);
  Case Column of
     0: Data^.Column0:= NewText;
     1: Data^.Column1:= NewText;
     2: Data^.Column2:= NewText;
  End;
end;

procedure TForm1.VSTPaintText(Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType);
Var
 Data: PTreeData;
begin
  if Odd(Node.Index) then 
    TargetCanvas.Font.Color:= clRed;
end;

。。。这假设记录为：

type
  PTreeData = ^TTreeData;
  TTreeData = record
    Column0: String;
    Column1: String;
    Column2: String;
  end;

…添加以下单位：

unit vstButton;


interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, VirtualTrees,
  messages, windows, StdCtrls, ShlObj;

type
  TStringEditLink = class(TInterfacedObject, IVTEditLink)
  private
    FEdit: TWinControl;
    FTree: TVirtualStringTree;
    FNode: PVirtualNode;
    FColumn: Integer;
    FSelectedFolder: string;
  protected
    procedure ButtonClick(Sender: TObject);
  public
    destructor Destroy; override;
    function BeginEdit: Boolean; stdcall;
    function CancelEdit: Boolean; stdcall;
    function EndEdit: Boolean; stdcall;
    function GetBounds: TRect; stdcall;
    function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
    procedure ProcessMessage(var Message: TMessage); stdcall;
    procedure SetBounds(R: TRect); stdcall;
  end;

  function GetFolderDialog(Handle: Integer; Caption: string; var strFolder: string): Boolean;

implementation

destructor TStringEditLink.Destroy;
begin
  FEdit.Free;
  inherited;
end;

procedure TStringEditLink.ButtonClick(Sender: TObject);
var
  s: string;
begin
  s := 'c:\';
  if GetFolderDialog(Application.Handle, 'Select a folder', s) then
    FSelectedFolder := s;

  FTree.EndEditNode;
  FTree.setfocus;
end;

function TStringEditLink.BeginEdit: Boolean;
begin
  Result := True;
  FSelectedFolder := FTree.Text[FNode, FColumn];
  TButton(FEdit).CAption := FTree.Text[FNode, FColumn];
  FEdit.Show;
  FEdit.SetFocus;
end;

function TStringEditLink.CancelEdit: Boolean;
begin
  Result := True;
  FEdit.Hide;
  FTree.EndEditNode;
  FTree.setfocus;
end;

function TStringEditLink.EndEdit: Boolean;
var
  S: WideString;
begin
  Result := True;
  FTree.Text[FNode, FColumn] := FSelectedFolder;

  FTree.InvalidateNode(FNode);
  FEdit.Hide;
  FTree.SetFocus;
end;

function TStringEditLink.GetBounds: TRect;
begin
  Result := FEdit.BoundsRect;
end;

function TStringEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
begin
  Result := True;
  FTree := Tree as TVirtualStringTree;
  FNode := Node;
  FColumn := Column;

  FEdit.Free;
  FEdit := nil;

  FEdit := TButton.Create(nil);
   with FEdit as TButton do
     begin
          Visible := False;
          Parent := Tree;
          Font.Color := FTree.Colors.HeaderHotColor;
          OnClick := ButtonClick;
      end;
end;

procedure TStringEditLink.ProcessMessage(var Message: TMessage);
begin
  FEdit.WindowProc(Message);
end;

procedure TStringEditLink.SetBounds(R: TRect);
var
  Dummy: Integer;
begin
  FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right);
  FEdit.BoundsRect := R;
end;

//------------------------------------------------------------------------------\\

function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData: LPARAM): Integer; stdcall;
begin
  if (uMsg = BFFM_INITIALIZED) then
    SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);
  BrowseCallbackProc := 0;
end;

function GetFolderDialog(Handle: Integer; Caption: string; var strFolder: string): Boolean;
const
  BIF_STATUSTEXT           = $0004;
  BIF_NEWDIALOGSTYLE       = $0040;
  BIF_RETURNONLYFSDIRS     = $0080;
  BIF_SHAREABLE            = $0100;
  BIF_USENEWUI             = BIF_EDITBOX or BIF_NEWDIALOGSTYLE;

var
  BrowseInfo: TBrowseInfo;
  ItemIDList: PItemIDList;
  JtemIDList: PItemIDList;
  Path: PChar;
begin
  Result := False;
  Path := StrAlloc(MAX_PATH);
  SHGetSpecialFolderLocation(Handle, CSIDL_DRIVES, JtemIDList);
  with BrowseInfo do
  begin
    hwndOwner := GetActiveWindow;
    pidlRoot := JtemIDList;
    SHGetSpecialFolderLocation(hwndOwner, CSIDL_DRIVES, JtemIDList);

    { return display name of item selected }
    pszDisplayName := StrAlloc(MAX_PATH);

    { set the title of dialog }
    lpszTitle := PChar(Caption);//'Select the folder';
    { flags that control the return stuff }
    lpfn := @BrowseCallbackProc;
    { extra info that's passed back in callbacks }
    lParam := LongInt(PChar(strFolder));
  end;

  ItemIDList := SHBrowseForFolder(BrowseInfo);

  if (ItemIDList <> nil) then
    if SHGetPathFromIDList(ItemIDList, Path) then
    begin
      strFolder := Path;
      Result := True
    end;
end;

End.

单位vstButton；
接口
使用
类、系统工具、窗体、控件、图形、对话框、虚拟树、，
消息、窗口、StdCtrls、ShlObj；
类型
TStringEditLink=class（TInterfacedObject，IVTEditLink）
私有的
FEdit：双控制；
FTree:TVirtualStringTree；
FNode:PVirtualNode；
FColumn：整数；
FSelectedFolder：字符串；
受保护的
程序按钮点击（发送方：ToObject）；
公众的
毁灭者毁灭；推翻
函数BeginEdit:Boolean；stdcall；
函数取消编辑：布尔；stdcall；
函数EndEdit：布尔型；stdcall；
函数GetBounds:TRect；stdcall；
函数PrepareEdit（树：TBaseVirtualTree；节点：PVirtualNode；列：TColumnIndex）：布尔；stdcall；
过程ProcessMessage（var消息：TMessage）；stdcall；
程序设定点（R:TRCT）；stdcall；
结束；
函数GetFolderDialog（句柄：整数；标题：字符串；变量strFolder:string）：布尔；
实施
析构函数TStringEditLink.Destroy；
开始
免费；
继承；
结束；
程序TStringEditLink.ButtonClick（发送方：TObject）；
变量
s:字符串；
开始
s:=“c:\”；
如果GetFolderDialog（Application.Handle，'选择文件夹'），则
FSelectedFolder:=s；
FTree.EndEditNode；
FTree.setfocus；
结束；
函数TStringEditLink.BeginEdit:Boolean；
开始
结果：=真；
FSelectedFolder:=FTree.Text[FNode，FColumn]；
TButton（FEdit）.CAption:=FTree.Text[FNode，FColumn]；
FEdit.Show；
FEdit.SetFocus；
结束；
函数TStringEditLink.CancelEdit:布尔值；
开始
结果：=真；
隐藏；
FTree.EndEditNode；
FTree.setfocus；
结束；
函数TStringEditLink.EndEdit:布尔值；
变量
S：宽弦；
开始
结果：=真；
FTree.Text[FNode，FColumn]：=FSelectedFolder；
失效节点（FNode）；
隐藏；
FTree.SetFocus；
结束；
函数TStringEditLink.GetBounds:TRect；
开始
结果：=FEdit.BoundsRect；
结束；
函数TStringEditLink.PrepareEdit（树：TBaseVirtualTree；节点：PVirtualNode；列：TColumnIndex）：布尔；
开始
结果：=真；
FTree:=作为TVirtualStringTree的树；
FNode:=节点；
FColumn:=列；
免费；
FEdit:=零；
FEdit:=TButton.Create（nil）；
使用FEdit作为TButton do
开始
可见：=假；
父：=树；
Font.Color:=FTree.Colors.HeaderHotColor；
OnClick:=按钮单击；
结束；
结束；
过程TStringEditLink.ProcessMessage（var消息：TMessage）；
开始
WindowProc（消息）；
结束；
程序TStringEditLink.SetBounds（R:TRect）；
变量
虚拟：整数；
开始
FTree.Header.Columns.GetColumnBounds（FColumn，Dummy，R.Right）；
FEdit.BoundsRect:=R；
结束；
//------------------------------------------------------------------------------\\
函数BrowseCallbackProc（hwnd:hwnd；uMsg:UINT；lParam:lParam；lpData:lParam）：整数；stdcall；
开始
如果（uMsg=BFFM_已初始化），则
发送消息（hwnd、BFFM_设置选择、1、lpData）；
BrowseCallbackProc:=0；
结束；
函数GetFolderDialog（句柄：整数；标题：字符串；变量strFolder:string）：布尔；
常数
BIF_STATUSTEXT=$0004；
新对话风格=0040美元；
BIF_RETURNONLYFSDIRS=0080美元；
BIF_可分享=0100美元；
BIF_USENEWUI=BIF_EDITBOX或BIF_NEWDIALOGSTYLE；
变量
BrowseInfo:TBrowseInfo；
ItemIDList：PItemIDList；
JtemIDList:PItemIDList；
路径：PChar；
开始
结果：=假；
路径：=StrAlloc（最大路径）；
SHGetSpecialFolderLocation（手柄、CSIDL_驱动器、JtemIDList）；
用browseinfodo
开始
hwnowner:=GetActiveWindow；
pidlRoot:=JtemIDList；
SHGetSpecialFolderLocation（Hwnowner、CSIDL_驱动器、JtemIDList）；
{返回所选项目的显示名称}
pszDisplayName:=StrAlloc（最大路径）；
{设置对话框的标题}
lpszTitle:=PChar（标题）；/'选择文件夹'；
{控制返回内容的标志}
lpfn:=@BrowseCallbackProc；
{在回调中传回的额外信息}
lParam:=LongInt（PChar（strFolder））；
结束；
ItemIDList:=SHBrowseForFolder（BrowseInfo）；
如果（ItemIDList nil）那么
如果SHGetPathFromIDList（ItemIDList，Path），则
开始
strFolder:=路径；
结果：=真
结束；
结束；
结束。

上述代码基于本网站上的代码： 如果你看一看单位vstButton，得到一个TEdit，或TCombo…等等。。。只要用TEdit或TCombo等替换任何TButton参考即可。。。为它调整事件等。。。上面的链接代码实际上使用了TCombo

那个网站帮助我学会了如何使用virtualtreeview 上面的代码将在每个单元格中插入一个Tbutton，当您单击该按钮时，它将打开一个BrowseForFolder对话框，并将结果插入到virtualtreeview单元格中 希望这有帮助

是否希望单元格列中的按钮始终可见？可以用图像模拟按钮。。。就像单元格一侧的下拉标记一样

这应该可以工作…：）我没想过看Lazarus的维基