delphi – 单元格中的VirtualTreeView嵌入按钮

type
  TNodeData = record
    TextValue: string;
    Button: TButton;
  end;
  PNodeData = ^TNodeData;

procedure TForm1.FormCreate(Sender: TObject);

  procedure AddButton(__Node: PVirtualNode);
  var
    NodeData: PNodeData;
  begin
    NodeData := VirtualStringTree1.GetNodeData(__Node);
    NodeData.Button := TButton.Create(nil);
    with NodeData.Button do
    begin
      Parent := VirtualStringTree1;
      Height := VirtualStringTree1.DefaultNodeHeight;
      Caption := '+';
      Visible := false;
    end;
  end;

  procedure InitializeNodeData(__Node: PVirtualNode; __Text: string);
  var
    NodeData: PNodeData;
  begin
    NodeData := VirtualStringTree1.GetNodeData(__Node);
    NodeData.TextValue := __Text;
  end;

var
  Node: PVirtualNode;
begin
  VirtualStringTree1.NodeDataSize := SizeOf(TNodeData);

  Node := VirtualStringTree1.AddChild(nil);
  InitializeNodeData(Node,'a');      
  Node := VirtualStringTree1.AddChild(Node);
  InitializeNodeData(Node,'a.1');

  Node := VirtualStringTree1.AddChild(nil);
  InitializeNodeData(Node,'b');
  Node := VirtualStringTree1.AddChild(Node);
  InitializeNodeData(Node,'Here the button');
  AddButton(Node);
end;

procedure TForm1.VirtualStringTree1AfterCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect);
var
 NodeData: PNodeData;
begin
  if (Column = 0) then
    Exit;

  NodeData := VirtualStringTree1.GetNodeData(Node);
  if (Assigned(NodeData)) and (Assigned(NodeData.Button)) then
  begin
    with NodeData.Button Do
    begin
      Visible := (vsVisible in Node.States)
                 and ((Node.Parent = VirtualStringTree1.RootNode) or   (vsExpanded in Node.Parent.States));
      BoundsRect := CellRect;
    end;
  end;
end;

所以iamjoosy的答案问题是 – 即使它有效 – 只要你用绘制的按钮/ images /滚动滚动这个树,那些应该再次离开Tree的那些仍然存在,被绘制在最低层/你离开他们的最高位置.根据您刚刚滚动的数量,它会在该列中留下更小或更大的按钮杂乱. AfterCellPaint不再移动它们,因为现在隐藏在底部/顶部上方的隐藏节点的单元格不再被绘制.

您可以做的是遍历所有树节点(如果您有很多节点,可能非常昂贵)并检查它们是否实际位于树的可见区域并隐藏面板(您可能需要在面板内部绘制按钮)相应地使用你的按钮/ whatevers,而不是后面的树的顶部：

procedure TMyTree.MyTreeAfterCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellRect: TRect);
var
  InitialIndex: Integer;
// onInitNode I AddOrSetValue a "DataIndexList" TDictionary<PVirtualNode,LongInt>
// to preserve an original index "InitialIndex" (violating the virtual paradigm),// because I need it for something else anyways
  Data: PMyData;
  ANode: PVirtualNode;
begin
  if Node <> nil then
  begin
    if Column = 2 then
    begin
      ANode := MyTree.GetFirst;
      while Assigned(ANode) do
      begin
        DataIndexList.TryGetValue(ANode,InitialIndex);
        if not ( CheckVisibility(Sender.GetDisplayRect(ANode,Column,False)) ) then
        begin
          MyBtnArray[InitialIndex].Visible := False;
          MyPanelArray[InitialIndex].Visible := False;
        end
        else
        begin
          MyBtnArray[InitialIndex].Visible := True;
          MyPanelArray[InitialIndex].Visible := True;
        end;
        ANode := MyTree.GetNext(ANode);
      end;
      DataIndexList.TryGetValue(Node,InitialIndex);
      Data := MyTree.GetNodeData(Node);
      MyPanelArray[InitialIndex].BoundsRect := Sender.GetDisplayRect(Node,False);
    end;
  end;
end;

function TMyTree.CheckVisibility(R: TRect): Boolean;
begin
// in my case these checks are the way to go,because
// MyTree is touching the top border of the TForm.  You will have
// to adjust accordingly if your placement is different
  if (R.Bottom < MyTree.Top) or (R.Bottom > MyTree.Top + MyTree.Height) then
    Result := False
  else
    Result := True;
end;

不用说,您可以成功地在许多其他OnEvents中使用visibilityCheck进行遍历.它不必在AfterCellPaint中;也许另一个事件可能是更好的表现明智.

要创建一个原始Panel Button的RunTime副本,要放置在ButtonArray或您正在使用的任何结构中,您还必须复制它们的RTTI.此过程取自http://www.blong.com/Conferences/BorConUK98/DelphiRTTI/CB140.zip(http://www.blong.com/Conferences/BorConUK98/DelphiRTTI/CB140.htm的进一步RTTI信息)和“使用TypInfo”：

procedure CopyObject(ObjFrom,ObjTo: TObject);
var
  PropInfos: PPropList;
  PropInfo: PPropInfo;
  Count,Loop: Integer;
  OrdVal: Longint;
  StrVal: String;
  FloatVal: Extended;
  MethodVal: TMethod;
begin
  { Iterate thru all published fields and properties of source }
  { copying them to target }

  { Find out how many properties we'll be considering }
  Count := GetPropList(ObjFrom.ClassInfo,tkAny,nil);
  { Allocate memory to hold their RTTI data }
  GetMem(PropInfos,Count * SizeOf(PPropInfo));
  try
    { Get hold of the property list in our new buffer }
    GetPropList(ObjFrom.ClassInfo,PropInfos);
    { Loop through all the selected properties }
    for Loop := 0 to Count - 1 do
    begin
      PropInfo := GetPropInfo(ObjTo.ClassInfo,PropInfos^[Loop]^.Name);
      { Check the general type of the property }
      { and read/write it in an appropriate way }
      case PropInfos^[Loop]^.PropType^.Kind of
        tkInteger,tkChar,tkEnumeration,tkSet,tkClass{$ifdef Win32},tkWChar{$endif}:
        begin
          OrdVal := GetOrdProp(ObjFrom,PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetOrdProp(ObjTo,PropInfo,OrdVal);
        end;
        tkFloat:
        begin
          FloatVal := GetFloatProp(ObjFrom,PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetFloatProp(ObjTo,FloatVal);
        end;
        {$ifndef DelphiLessThan3}
        tkWString,{$endif}
        {$ifdef Win32}
        tkLString,{$endif}
        tkString:
        begin
          { Avoid copying 'Name' - components must have unique names }
          if UpperCase(PropInfos^[Loop]^.Name) = 'NAME' then
            Continue;
          StrVal := GetStrProp(ObjFrom,PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetStrProp(ObjTo,StrVal);
        end;
        tkMethod:
        begin
          MethodVal := GetMethodProp(ObjFrom,PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetMethodProp(ObjTo,MethodVal);
        end
      end
    end
  finally
    FreeMem(PropInfos,Count * SizeOf(PPropInfo));
  end;
end;

看到我以后的这个旧答案,我现在有一个不同的解决方案运行VisibilityCheck,这是更可靠和更容易：

function TFoo.IsNodeVisibleInClientRect(Node: PVirtualNode; Column: TColumnIndex = NoColumn): Boolean;
begin
  Result := VST.IsVisible[Node] and
    VST.GetDisplayRect(Node,False).IntersectsWith(VST.ClientRect);
end;