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

【问题标题】：Checkbox in TVirtualStringTree is not updating properly when OnChecking opens a MessageBox当 OnChecking 打开 MessageBox 时，TVirtualStringTree 中的复选框未正确更新
【发布时间】：2015-11-12 09:35:11
【问题描述】：

选中或取消选中 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版也可以重现该问题

【问题讨论】：

您是否尝试过使用最新的 XE2 兼容版本5.5.2 或XE2 fork？
@JoachimMarder 不，我没有，因为我没有在更新日志或问题中找到条目。
我无法判断这是否是一个已知问题。有什么东西会阻止您使用最新的可用版本吗？
我不应该仅仅为了测试目的而更改我的开发机器上的组件版本。我会在测试/“玩”机器上试一试（可能在星期一或星期二），然后告诉你结果。

标签： delphi virtualtreeview

【解决方案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;

【讨论】：

【解决方案2】：

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;

【讨论】：