delphi - 当 OnChecking 打开 MessageBox 时，TVirtualStringTree 中的复选框未正确更新

Question

在选中或取消选中 vst 中的复选框时，我想在某些情况下要求确认。(取消)检查工作正常，直到我从 OnChecking 事件处理程序打开 MessageBox 为止。

当我显示 MessageBox (并将 Allowed 设置为 true)时，复选框状态不会更改，我必须再次单击才能切换复选框。

出于我尚未弄清楚的原因，第二次未调用 OnChecking 事件处理程序。

这似乎与焦点有关:如果我在第二次单击复选框之前单击另一个节点，则它不起作用。我正在使用 Delphi XE2 和 Vitual Treeview 5.3。

有人可以确认这种行为并想出修复/解决方法吗？

此 MCVE 显示了该行为。只需向表单添加一个按钮和一个 vst 并分配事件处理程序:

type
  TMyData = class
  public
    value: String;
    constructor Create(str: String);
  end;

constructor TMyData.Create(str: String);
begin
  value := str;
end;

procedure TForm3.btnInitTreeClick(Sender: TObject);
begin
  VirtualStringTree1.NodeDataSize := Sizeof(TObject);
  VirtualStringTree1.TreeOptions.MiscOptions := VirtualStringTree1.TreeOptions.MiscOptions + [toCheckSupport];
  VirtualStringTree1.CheckImageKind := ckSystemDefault;

  with VirtualStringTree1.Header.Columns.Add do
  begin
    Text := 'Colum header';
    Width := 150;
  end;

  VirtualStringTree1.AddChild(nil, TMyData.Create('1')).CheckType := ctCheckBox;
  VirtualStringTree1.AddChild(nil, TMyData.Create('2')).CheckType := ctCheckBox;
  VirtualStringTree1.AddChild(nil, TMyData.Create('A')).CheckType := ctCheckBox;
  VirtualStringTree1.AddChild(nil, TMyData.Create('B')).CheckType := ctCheckBox;
end;

procedure TForm3.VirtualStringTree1Checking(Sender: TBaseVirtualTree;
  Node: PVirtualNode; var NewState: TCheckState; var Allowed: Boolean);
var
  data: TObject;
begin
  data := TObject(Sender.GetNodeData(Node)^);
  if assigned(data) and (data is TMyData) and (TMyData(data).value = 'A') then
    Allowed := Application.MessageBox('Are you sure?', 'Confirmation', MB_YESNO or MB_ICONQUESTION) = ID_YES
  else
    Allowed := true;
end;

procedure TForm3.VirtualStringTree1GetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var
  data: TObject;
begin
  data := TObject(Sender.GetNodeData(Node)^);
  if assigned(data) and (data is TMyData) then
    CellText := TMyData(data).value
end;

编辑:5.5.2版本也可以重现该问题

Answer 1

我可以确认此行为。 VST v4.5.5

OnChecking 实现 (TBaseVirtualTree.HandleMouseDown) 的问题是 WM_LBUTTONUP 消息未得到处理，TBaseVirtualTree.显示模式对话框时，HandleMouseUp 不同步，并且新状态不会更新。我还没有深入研究这个问题，无法提出一般性修复建议。

解决方法:

type
  TBaseVirtualTreeAccess = class(TBaseVirtualTree);

procedure TForm1.VirtualStringTree1Checking(Sender: TBaseVirtualTree;
  Node: PVirtualNode; var NewState: TCheckState; var Allowed: Boolean);
var
  data: TObject;
begin
  data := TObject(Sender.GetNodeData(Node)^);
  if assigned(data) and (data is TMyData) and (TMyData(data).value = 'A') then
  begin    
    Allowed := False; // We will handle this ourself
    if Application.MessageBox('Are you sure?', 'Confirmation', MB_YESNO or MB_ICONQUESTION) = ID_YES then
    begin
      // Update the state and trigger OnCheck if needed
      TBaseVirtualTreeAccess(Sender).DoCheckClick(Node, NewState);
    end;
  end
  else
    Allowed := True;
end;