Таким образом, проблема с ответом iamjoosy является - даже если он работает - что, как только вы прокрутить Дерево с нарисованными кнопками/изображения/все, те, которые должны покинуть Дерево снова, все еще существуют, окрашиваются в самое низкое/самое высокое место, где вы их оставили. В зависимости от суммы, которую вы просто прокручиваете, она оставляет в этой колонке меньше или больше путаницы. 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, Column, 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;
Излишне говорить, что вы можете сделать, проникающего с visibilityCheck внутри многих других OnEvents успешно. Это не должно быть в AfterCellPaint; возможно, еще одно событие может быть намного лучше.
Чтобы создать копии RunTime вашей оригинальной панели + Button, чтобы разместить внутри вашего ButtonArray или любой другой структуры, которую вы используете, вам также придется скопировать RTTI. Эта процедура берется из http://www.blong.com/Conferences/BorConUK98/DelphiRTTI/CB140.zip (дополнительной информации RTTI на http://www.blong.com/Conferences/BorConUK98/DelphiRTTI/CB140.htm) и «использует 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, tkAny, 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, PropInfo, 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, PropInfo, StrVal);
end;
tkMethod:
begin
MethodVal := GetMethodProp(ObjFrom, PropInfos^[Loop]);
if Assigned(PropInfo) then
SetMethodProp(ObjTo, PropInfo, 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, Column, False).IntersectsWith(VST.ClientRect);
end;
Спасибо, это работа. – r038tmp5
Это работа, но у меня все еще есть проблема. Если я буду расширять своего отца, у меня есть кнопка: ОК. Если я разрушу его отца: кнопка останется видимой – r038tmp5