Multiple Check Box/Radio Button in a Node/Row in Virtual String Tree

Question

Is it possible in Virtual String Tree to have a check box(or radio button) in each column? Here is a picture for further info :

I tried to attached radio button/check box but is only attached in the first column of the node.

Answer 1

I extracted the functionality of my DSharp TreeViewPresenter and put it into a component:

unit CheckBoxDecorator;

interface

uses
  Classes,
  Controls,
  Graphics,
  Types,
  VirtualTrees;

type
  TToggleCheckBoxEvent = procedure(Sender: TObject;
    Node: PVirtualNode; Column: TColumnIndex) of object;

  TCheckBoxDecorator = class(TComponent)
  private
    FChecking: Boolean;
    FHitInfo: THitInfo;
    FOnAfterCellPaint: TVTAfterCellPaintEvent;
    FOnKeyDown: TKeyEvent;
    FOnMouseDown: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;
    FOnMouseUp: TMouseEvent;
    FOnToggleCheckBox: TToggleCheckBoxEvent;
    FTreeView: TVirtualStringTree;
    function CalcCheckBoxRect(const Rect: TRect): TRect;
    procedure DrawCheckBox(TargetCanvas: TCanvas; Node: PVirtualNode;
      Column: TColumnIndex; CellRect: TRect; Value: Boolean);
    function IsMouseInCheckBox(Node: PVirtualNode; Column: TColumnIndex): Boolean;
    procedure SetTreeView(const Value: TVirtualStringTree);
    procedure ToggleCheckBox(Node: PVirtualNode; Column: TColumnIndex);
    procedure TreeViewAfterCellPaint(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect);
    procedure TreeViewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure TreeViewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure TreeViewMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  published
    property TreeView: TVirtualStringTree read FTreeView write SetTreeView;
    property OnToggleCheckBox: TToggleCheckBoxEvent read FOnToggleCheckBox write FOnToggleCheckBox;
  end;

implementation

uses
  SysUtils,
  Themes,
  Windows;

const
  CBT_CHECKBOX = 1;
  CBT_RADIOBUTTON = 2;

var
  CheckBoxSize: Byte;

{$IF CompilerVersion < 23}
type
  TThemeServicesHelper = class helper for TThemeServices
    function Enabled: Boolean;
  end;

function TThemeServicesHelper.Enabled: Boolean;
begin
  Result := ThemesEnabled;
end;

function StyleServices: TThemeServices;
begin
  Result := ThemeServices;
end;
{$IFEND}

{ TCheckBoxDecorator }

function TCheckBoxDecorator.CalcCheckBoxRect(const Rect: TRect): TRect;
begin
  Result.Left := Rect.Left + (RectWidth(Rect) - CheckBoxSize) div 2;
  Result.Top := Rect.Top + (RectHeight(Rect) - CheckBoxSize) div 2;
  Result.Right := Result.Left + CheckBoxSize;
  Result.Bottom := Result.Top + CheckBoxSize;
end;

procedure TCheckBoxDecorator.DrawCheckBox(TargetCanvas: TCanvas;
  Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect; Value: Boolean);
var
  LThemedButton: TThemedButton;
  LCheckBoxRect: TRect;
  LDetails: TThemedElementDetails;
  LState: Cardinal;
  LCheckType: Byte;
begin
  LCheckBoxRect := CalcCheckBoxRect(CellRect);
  LCheckType := CBT_CHECKBOX;

  if (Column > -1) and (Column < FTreeView.Header.Columns.Count)
    and (coAllowClick in FTreeView.Header.Columns[Column].Options) then
  begin
    LCheckType := FTreeView.Header.Columns[Column].Tag;

    if Value then
      LThemedButton := tbCheckBoxCheckedNormal
    else
      LThemedButton := tbCheckBoxUncheckedNormal;

    if IsMouseInCheckBox(Node, Column) then
      Inc(LThemedButton);
  end
  else
  begin
    if Value then
      LThemedButton := tbCheckBoxCheckedDisabled
    else
      LThemedButton := tbCheckBoxUncheckedDisabled;
  end;

  if (FHitInfo.HitNode = Node) and (FHitInfo.HitColumn = Column)
    and (hiOnItemCheckbox in FHitInfo.HitPositions)
    and (GetAsyncKeyState(VK_LBUTTON) <> 0)
    and (coAllowClick in FTreeView.Header.Columns[FHitInfo.HitColumn].Options) then
  begin
    if Value then
      LThemedButton := tbCheckBoxCheckedPressed
    else
      LThemedButton := tbCheckBoxUncheckedPressed;
  end;

  if LCheckType = CBT_RADIOBUTTON then
    Dec(LThemedButton, 8);

  if StyleServices.Enabled and
    (toThemeAware in FTreeView.TreeOptions.PaintOptions) then
  begin
    LDetails := StyleServices.GetElementDetails(LThemedButton);
    StyleServices.DrawElement(TargetCanvas.Handle, LDetails, LCheckBoxRect);
  end
  else
  begin
    if LCheckType = CBT_RADIOBUTTON then
      LState := DFCS_BUTTONRADIO
    else
      LState := DFCS_BUTTONCHECK;

    if LThemedButton in [tbRadioButtonCheckedNormal..tbRadioButtonCheckedDisabled,
      tbCheckBoxCheckedNormal..tbCheckBoxCheckedDisabled] then
      LState := LState or DFCS_CHECKED;

    if LThemedButton in [tbRadioButtonUncheckedDisabled, tbRadioButtonCheckedDisabled,
      tbCheckBoxUncheckedDisabled, tbCheckBoxCheckedDisabled] then
      LState := LState or DFCS_INACTIVE;

    DrawFrameControl(TargetCanvas.Handle, LCheckBoxRect, DFC_BUTTON, LState);
  end;
end;

function TCheckBoxDecorator.IsMouseInCheckBox(Node: PVirtualNode;
  Column: TColumnIndex): Boolean;
var
  LCursorPos: TPoint;
  LHitInfo: THitInfo;
  LRect: TRect;
begin
  if Assigned(Node) and (Column > -1)
    and (Column < FTreeView.Header.Columns.Count)
    and (FTreeView.Header.Columns[Column].Tag > 0) then
  begin
    LCursorPos := FTreeView.ScreenToClient(Mouse.CursorPos);
    FTreeView.GetHitTestInfoAt(LCursorPos.X, LCursorPos.Y, True, LHitInfo);
    LRect := FTreeView.GetDisplayRect(Node, Column, False);
    LRect := CalcCheckBoxRect(LRect);
    Result := PtInRect(LRect, LCursorPos);
  end
  else
    Result := False;
end;

procedure TCheckBoxDecorator.SetTreeView(const Value: TVirtualStringTree);
begin
  if FTreeView <> Value then
  begin
    if Assigned(FTreeView) then
    begin
      FTreeView.OnAfterCellPaint := FOnAfterCellPaint;
      FTreeView.OnKeyDown := FOnKeyDown;
      FTreeView.OnMouseDown := FOnMouseDown;
      FTreeView.OnMouseMove := FOnMouseMove;
      FTreeView.OnMouseUp := FOnMouseUp;

      FTreeView.RemoveFreeNotification(Self);
    end;

    FTreeView := Value;

    if Assigned(FTreeView) then
    begin
      FOnAfterCellPaint := FTreeView.OnAfterCellPaint;
      FOnKeyDown := FTreeView.OnKeyDown;
      FOnMouseDown := FTreeView.OnMouseDown;
      FOnMouseMove := FTreeView.OnMouseMove;
      FOnMouseUp := FTreeView.OnMouseUp;

      FTreeView.OnAfterCellPaint := TreeViewAfterCellPaint;
      FTreeView.OnKeyDown := TreeViewKeyDown;
      FTreeView.OnMouseDown := TreeViewMouseDown;
      FTreeView.OnMouseMove := TreeViewMouseMove;
      FTreeView.OnMouseUp := TreeViewMouseUp;

      FTreeView.FreeNotification(Self);
    end;
  end;
end;

procedure TCheckBoxDecorator.ToggleCheckBox(Node: PVirtualNode; Column: TColumnIndex);
begin
  if Assigned(FOnToggleCheckBox) then
    FOnToggleCheckBox(FTreeView, Node, Column);
end;

procedure TCheckBoxDecorator.TreeViewAfterCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellRect: TRect);
var
  LValue: Boolean;
begin
  if TryStrToBool(FTreeView.Text[Node, Column], LValue) then
  begin
    if not (toFullRowSelect in FTreeView.TreeOptions.SelectionOptions) then
      TargetCanvas.Brush.Color := clWindow;
    TargetCanvas.FillRect(CellRect);
    DrawCheckBox(TargetCanvas, Node, Column, CellRect, LValue);
  end;

  if Assigned(FOnAfterCellPaint) then
    FOnAfterCellPaint(Sender, TargetCanvas, Node, Column, CellRect);
end;

procedure TCheckBoxDecorator.TreeViewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Shift = [] then
  begin
    case Key of
      VK_SPACE:
      begin
        if (FTreeView.FocusedColumn > -1)
          and (FTreeView.FocusedColumn < FTreeView.Header.Columns.Count)
          and (FTreeView.Header.Columns[FTreeView.FocusedColumn].Tag > 0) then
        begin
          ToggleCheckBox(FTreeView.FocusedNode, FTreeView.FocusedColumn);
          Key := 0;
        end;
      end;
    end;
  end;

  if Assigned(FOnKeyDown) then
    FOnKeyDown(Sender, Key, Shift);
end;

procedure TCheckBoxDecorator.TreeViewMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  LHitInfo: THitInfo;
begin
  FChecking := False;
  if not (ssDouble in Shift)
    and not (tsVCLDragPending in FTreeView.TreeStates) then
  begin
    FTreeView.GetHitTestInfoAt(X, Y, True, LHitInfo);
    if Assigned(LHitInfo.HitNode)
      and IsMouseInCheckBox(LHitInfo.HitNode, LHitInfo.HitColumn) then
    begin
      FChecking := True;
      if toExtendedFocus in FTreeView.TreeOptions.SelectionOptions then
      begin
        FTreeView.FocusedColumn := LHitInfo.HitColumn;
        FTreeView.FocusedNode := LHitInfo.HitNode;
        FTreeView.Selected[LHitInfo.HitNode] := True;
      end;
      FTreeView.RepaintNode(LHitInfo.HitNode);
    end;
  end;

  if Assigned(FOnMouseDown) then
    FOnMouseDown(Sender, Button, Shift, X, Y);
end;

procedure TCheckBoxDecorator.TreeViewMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  LHitInfo: THitInfo;
begin
  if GetAsyncKeyState(VK_LBUTTON) = 0 then
  begin
    FTreeView.GetHitTestInfoAt(X, Y, True, LHitInfo);

    if Assigned(FHitInfo.HitNode) and (FHitInfo.HitNode <> LHitInfo.HitNode) then
      FTreeView.RepaintNode(FHitInfo.HitNode);

    if Assigned(LHitInfo.HitNode) then
      FTreeView.RepaintNode(LHitInfo.HitNode);

    FHitInfo := LHitInfo;

    if IsMouseInCheckBox(LHitInfo.HitNode, LHitInfo.HitColumn) then
      FHitInfo.HitPositions := [hiOnItem, hiOnItemCheckbox];
  end;

  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self, Shift, X, Y);
end;

procedure TCheckBoxDecorator.TreeViewMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  LHitInfo: THitInfo;
begin
  if Assigned(FHitInfo.HitNode)
    and not (tsVCLDragPending in FTreeView.TreeStates) then
  begin
    FTreeView.GetHitTestInfoAt(X, Y, True, LHitInfo);
    if (FHitInfo.HitNode = LHitInfo.HitNode)
      and (FHitInfo.HitColumn = LHitInfo.HitColumn)
      and (LHitInfo.HitColumn > -1)
      and (LHitInfo.HitColumn < FTreeView.Header.Columns.Count) then
    begin
      if IsMouseInCheckBox(LHitInfo.HitNode, LHitInfo.HitColumn) and FChecking  then
        ToggleCheckBox(LHitInfo.HitNode, LHitInfo.HitColumn);
    end;

    FTreeView.RepaintNode(FHitInfo.HitNode);
    if LHitInfo.HitNode <> FHitInfo.HitNode then
      FTreeView.RepaintNode(LHitInfo.HitNode);
  end;

  if Assigned(FOnMouseUp) then
    FOnMouseUp(Sender, Button, Shift, X, Y);
end;

initialization
  CheckBoxSize := GetSystemMetrics(SM_CYMENUCHECK);

end.

Assign the TreeView property, implement the OnGetText of the treeview (the text needs to be something that works with StrToBool) and the OnToggleCheckBox event of the decorator to handle when the checkbox gets clicked. Also set the Tag property of the columns you want to have checkboxes to 1 (or 2 for radio buttons).