Delphi - ListView or similar with owner draw button

问题

How do I do create a listview (or similar) with a button on each line? The button needs to be able to have different text/color on each line as required.

I'm sure Virtual Treeview would be perfect for this, but I'm a little lost with it.

Thanks

-Brad

回答1:

With a virtualtreeview...... add vstButton to your uses and select your Virtualtreeview in the object inspector and set the following events for your tree:

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;

... this assumes the record is:

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

...add the following unit:

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.

the above code is based upon code found at this website: http://wiki.freepascal.org/VirtualTreeview_Example_for_Lazarus If you look at the unit vstButton, to get a TEdit, or TCombo...etc... just replace any TButton reference with TEdit or TCombo etc... adjust events for it etc... The above link code actually uses a TCombo

that website helped me alot to learn how to use the virtualtreeview the above code will insert a Tbutton into every cell, and when you click on the button it will open a BrowseForFolder dialog and insert the result back into the virtualtreeview cell Hope this helps

did you want a button visible in a cell column all the time? Could simulate the button with an image... like a dropdown mark on one side of the cell

来源：https://stackoverflow.com/questions/2675094/delphi-listview-or-similar-with-owner-draw-button