德爾福 - 列表視圖或類似的所有者繪製按鈕

Question

我該怎麼做每行上的按鈕創建一個列表視圖（或類似）？按鈕需要能夠根據需要在每行上具有不同的文本/顏色。

我相信Virtual Treeview對於這一點來說是完美的，但我有點迷失了它。

感謝

-Brad

Answer 1

隨着virtualtreeview ......添加vstButton到您的用途和Object Inspector中選擇您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; 

...廣告d以下單位：

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. 

上面的代碼是基於在該網站上找到代碼： http://wiki.freepascal.org/VirtualTreeview_Example_for_Lazarus 如果你看一下單元vstButton，得到TEDIT或TCombo ...等...只是用TEdit或TCombo等替換任何TButton引用...爲它調整事件等...上面的鏈接代碼實際上使用TCombo

該網站幫助我瞭解如何使用virtualtreeview 上面的代碼將插入一個Tbutton插入到每個單元格中，並且當您單擊該按鈕時，將打開一個BrowseForFolder對話框並將結果插入到virtualtreeview單元格01中希望這會有所幫助

您是否想要一個按鈕在單元格列中始終可見？可以用圖像模擬按鈕......就像單元格一側的下拉標記