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

Question

When checking or unchecking the box in vst, I want to ask for confirmation in some cases. (Un) validation works fine until I open MessageBoxfrom the event handler OnChecking.

When I showed MessageBox(and set Allowedto true), the state of the flag does not change, and I have to click a second time to switch this flag.

For some reason, I still do not understand, the second time the event handler is OnCheckingnot called.

This seems to be related to the trick: if I click on another node before the second click on the checkbox, this will not work. I am using Delphi XE2 and Vitual Treeview 5.3.

Can someone confirm this behavior and think about a fix / workaround?

This MCVE shows the behavior. Just add a button and vst to the form and assign event handlers:

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;

Change . The problem can also be reproduced with version 5.5.2

Answer 1

I can confirm this behavior. VST v4.5.5

The problem with implementation OnChecking( TBaseVirtualTree.HandleMouseDown) is that the message is WM_LBUTTONUPnot processed, but TBaseVirtualTree.HandleMouseUpstops synchronizing when a modal dialog is shown, and the new state is not updated. I did not go deep enough into this to suggest a general correction.

Workaround:

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;

Answer 2

The same behavior as in 5.2.1.

The following task changes state after .

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;