delphi - 虚拟字符串树中节点/行中的多个复选框/单选按钮

Question

在虚拟字符串树中是否可以在每一列中都有一个复选框（或单选按钮）？这是一张图片以获取更多信息：在此处输入图像描述

我试图附加单选按钮/复选框，但只附加在节点的第一列。

score 6 · Accepted Answer

我提取了我的 DSharp TreeViewPresenter 的功能并将其放入一个组件中：

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.

分配 TreeView 属性，实现树视图的 OnGetText（文本需要与 StrToBool 一起使用）和装饰器的 OnToggleCheckBox 事件以在单击复选框时处理。还将您想要复选框的列的 Tag 属性设置为 1（或 2 用于单选按钮）。

delphi - 虚拟字符串树中节点/行中的多个复选框/单选按钮

1 回答 1

Related

Reference