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

Question

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

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

出于某种原因我还没有弄清楚，第二次没有调用 OnChecking 事件处理程序。

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

有人可以确认这种行为并想出一个 fix/workaround 吗？

这个 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

在 5.2.1 上的相同行为。

下面的工作是在状态改变后修改状态。

procedure TForm3.VirtualStringTree1Checked(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
  data: TObject;
begin
  data := TObject(Sender.GetNodeData(Node)^);
  if assigned(data) and (data is TMyData) and (TMyData(data).value = 'A') then begin
    if Application.MessageBox('Are you sure?', 'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
      Exit;
    if  Node.CheckState = csUncheckedNormal then
      Node.CheckState := csCheckedNormal
    else
      Node.CheckState := csUncheckedNormal;
  end;
end;

Answer 2

我可以确认这种行为。 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;

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

Checkbox in TVirtualStringTree is not updating properly when OnChecking opens a MessageBox

delphi

virtualtreeview