当OnChecking打开MessageBox时,TVirtualStringTree中的复选框无法正确更新

时间:2015-11-12 09:35:12

标签: delphi virtualtreeview

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

当我显示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版本重现

2 个答案:

答案 0 :(得分:4)

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

答案 1 :(得分:0)

Same behaviour on 5.2.1.

The following does the job modifying the state after it's changed.

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;