⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 etreeview.pas

📁 EasyGasDpr 瓶装液化气 钢瓶 SQL,用户名:SYSTEM 密码:空
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{ 29/5/1999 1:27 GMT }

unit ETreeView;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls,CommCtrl;

type

  TCheckKind = (ckNone, ckCheck, ckRadio, ckGroup);
  TCheckFlatness = (cfAlwaysFlat, cfAlways3d, cfHotTrack);

  TCheckTreeNode = class;

  TCheckTreeView = class(TCustomTreeView)
  private
    FDesignInteractive: Boolean;
    FGrayedIsChecked: Boolean;
    FStateImages: TImageList;
    FFlatness: TCheckFlatness;
    function GetChecked(Node: TTreeNode): Boolean;
    procedure SetChecked(Node: TTreeNode; Value: Boolean);
    function GetState(Node: TTreeNode): TCheckBoxState;
    procedure SetState(Node: TTreeNode; Value: TCheckBoxState);
    function GetKind(Node: TTreeNode): TCheckKind;
    procedure SetKind(Node: TTreeNode; Value: TCheckKind);
    procedure SetFlatness(const Value: TCheckFlatness);
    function GetNodeEnabled(Node: TTreeNode): Boolean;
    procedure SetNodeEnabled(Node: TTreeNode; const Value: Boolean);
    procedure ReadData(Stream: TStream);
    procedure WriteData(Stream: TStream);
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message
      CM_DESIGNHITTEST;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message
      WM_LBUTTONDBLCLK;
  protected
    FHoverCache: TCheckTreeNode;
    procedure ToggleNode(Node: TCheckTreeNode); dynamic;
    procedure Change(Node: TTreeNode); override;
    procedure CreateCheckMarks; dynamic;
    function CreateNode: TTreeNode; override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
      Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Loaded; override;
    procedure Click;override;
    procedure CreateParams(var Param:TCreateParams);override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MakeRadioGroup(Node: TTreeNode);
    property Checked[Node: TTreeNode]: Boolean read GetChecked write SetChecked;
    property State[Node: TTreeNode]: TCheckBoxState read GetState write
      SetState;
    property CheckKind[Node: TTreeNode]: TCheckKind read GetKind write SetKind;
    property NodeEnabled[Node: TTreeNode]: Boolean read GetNodeEnabled write
      SetNodeEnabled;
  published
    property DesignActive: Boolean read FDesignInteractive write FDesignInteractive stored False;
    property Align;
    property Anchors;
    property AutoExpand;
    property BiDiMode;
    property BorderStyle;
    property BorderWidth;
    property ChangeDelay;
    property Color;
    property Ctl3D;
    property Constraints;
    property DragKind;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property Flatness: TCheckFlatness read FFlatness write SetFlatness;
    property GrayedIsChecked: Boolean read FGrayedIsChecked write
      FGrayedIsChecked;
    property HideSelection;
    property HotTrack;
    property Images;
    property Indent;
    property Items;
    property ParentBiDiMode;
    property ParentColor default False;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly default True;
    property RightClickSelect;
    property RowSelect;
    property ShowButtons;
    property ShowHint;
    property ShowLines;
    property ShowRoot;
    property SortType;
    //property StateImages;
    property TabOrder;
    property TabStop default True;
    property ToolTips;
    property Visible;
    property OnChange;
    property OnChanging;
    property OnClick;
    property OnCollapsing;
    property OnCollapsed;
    property OnCompare;
    property OnCustomDraw;
    property OnCustomDrawItem;
    property OnDblClick;
    property OnDeletion;
    property OnDragDrop;
    property OnDragOver;
    property OnEdited;
    property OnEditing;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnExpanding;
    property OnExpanded;
    property OnGetImageIndex;
    property OnGetSelectedIndex;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

  TCheckTreeNode = class(TTreeNode)
  private
    FReflexChildren: Boolean;
    FCheckKind: TCheckKind;
    FCache: TCheckBoxState;
    FEnabled: Boolean;
    FReflexParent: Boolean;
    function IsEqual(Node: TTreeNode): Boolean;
    function GetItemIndex: Integer;
    function GetChecked: Boolean;
    procedure SetChecked(Value: Boolean);
    procedure SetCheckKind(Value: TCheckKind);
    procedure SetEnabled(Value: Boolean);
    function GetState: TCheckBoxState;
    procedure SetState(Value: TCheckBoxState);
    procedure SetItemIndex(Value: Integer);
    procedure SetReflexChildren(Value: Boolean);
    procedure SetReflexParent(Value: Boolean);
    procedure ReadSelf(Stream: TStream);
    procedure WriteSelf(Stream: TStream);
  protected
    procedure InternalSetState(Value: TCheckBoxState;
      CheckChildren: Boolean = True; CheckParent: Boolean = True);
    procedure DoCheckChildren(Cur: TCheckBoxState);
    procedure DoCheckParent(Cur: TCheckBoxState);
    procedure UpdateHotTrack(Hover: Boolean); virtual;
  public
    procedure AfterConstruction; override;
    procedure MakeRadioGroup;
    procedure Assign(Source: TPersistent); override;
    property Checked: Boolean read GetChecked write SetChecked;
    property CheckKind: TCheckKind read FCheckKind write SetCheckKind;
    property CheckState: TCheckBoxState read GetState write SetState;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    property ReflexChildren: Boolean read FReflexChildren write
      SetReflexChildren;
    property ReflexParent: Boolean read FReflexParent write SetReflexParent;
  end;

  ECheckTreeViewError = class(Exception);
  EIndexError = class(ECheckTreeViewError);

resourcestring
  SIndexError       = 'Tree node index (%d) out of range';
  SInvalidKind      = 'Trying to set index (%d) of non-radio item';

procedure Register;

implementation

{ TCheckTreeView }

procedure Register;
begin
  RegisterComponents('Win32', [TCheckTreeView]);
end;

type
  PCheckNodeData = ^TCheckNodeData;
  TCheckNodeData = packed record
    Kind: TCheckKind;
    Enabled: Boolean;
  end;

procedure TCheckTreeView.CMDesignHitTest(var Message: TCMDesignHitTest);
var
  N                 : TTreeNode;
begin
  Message.Result := 0;
  if FDesignInteractive then
  begin
    N := GetNodeAt(Message.XPos, Message.YPos);
    if N <> nil then
      Message.Result := Integer(N.DisplayRect(True).Right > Message.XPos);
  end;
end;

procedure TCheckTreeView.CMMouseLeave(var Message: TMessage);
begin
  if FHoverCache <> nil then FHoverCache.UpdateHotTrack(False);
  FHoverCache := nil;
  inherited;
end;

constructor TCheckTreeView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  DesignActive :=True;
  //ReadOnly := True;
end;

procedure TCheckTreeView.CreateCheckMarks;
const
  R                 : TRect = (Left: 2; Top: 2; Right: 15; Bottom: 15);
var
  Bmp, M            : TBitmap;

  procedure Add(MaskColor: TColor = clWhite);
  begin
    FStateImages.AddMasked(Bmp, MaskColor);
  end;

begin
  if FStateImages = nil then Exit;
  Items.BeginUpdate;
  Bmp := TBitmap.Create;
  M := TBitmap.Create;
  try
    Bmp.Width := 16;
    Bmp.Height := 16;
    M.Width := 16;
    M.Height := 16;

    { Add stub image }
    {1} Add;

    { Add flat images }
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK or
      DFCS_FLAT);
    {2} Add;
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK or
      DFCS_FLAT or DFCS_CHECKED);
    {3} Add;
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK or
      DFCS_FLAT or DFCS_CHECKED or DFCS_BUTTON3STATE);
    {4} Add;
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOIMAGE or
      DFCS_FLAT);
    DrawFrameControl(M.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOMASK or
      DFCS_FLAT);
    {5} FStateImages.Add(Bmp, M);
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOIMAGE or
      DFCS_FLAT or DFCS_CHECKED);
    DrawFrameControl(M.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOMASK or
      DFCS_FLAT or DFCS_CHECKED);
    {6} FStateImages.Add(Bmp, M);

    { Add 3d images }
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK);
    {7} Add;
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK or
      DFCS_CHECKED);
    {8} Add;
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK or
      DFCS_CHECKED or DFCS_BUTTON3STATE);
    {9} Add;
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOIMAGE);
    DrawFrameControl(M.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOMASK);
    {10} FStateImages.Add(Bmp, M);
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOIMAGE or
      DFCS_CHECKED);
    DrawFrameControl(M.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOMASK or
      DFCS_CHECKED);
    {11} FStateImages.Add(Bmp, M);

    { Add disabled images }
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK
      or DFCS_INACTIVE);
    {12} Add;
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK or
      DFCS_CHECKED or DFCS_INACTIVE);
    {13} Add;
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONCHECK or
      DFCS_CHECKED or DFCS_BUTTON3STATE or DFCS_INACTIVE);
    {14} Add;
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOIMAGE
      or DFCS_INACTIVE);
    DrawFrameControl(M.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOMASK
      or DFCS_INACTIVE);
    {15} FStateImages.Add(Bmp, M);
    DrawFrameControl(Bmp.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOIMAGE or
      DFCS_CHECKED or DFCS_INACTIVE);
    DrawFrameControl(M.Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONRADIOMASK or
      DFCS_CHECKED or DFCS_INACTIVE);
    {16} FStateImages.Add(Bmp, M);

  finally
    M.Free;
    Bmp.Free;
    Items.EndUpdate;
  end;
end;

function TCheckTreeView.CreateNode: TTreeNode;
begin
  Result := TCheckTreeNode.Create(Items);
{  with TCheckTreeNode(Result) do
  begin
    ReflexChildren := True;
    ReflexParent := True;
  end;}
end;

destructor TCheckTreeView.Destroy;
begin
  inherited Destroy;
end;

function TCheckTreeView.GetChecked(Node: TTreeNode): Boolean;
begin
  Result := TCheckTreeNode(Node).Checked
end;

function TCheckTreeView.GetNodeEnabled(Node: TTreeNode): Boolean;
begin
  Result := TCheckTreeNode(Node).Enabled;
end;

function TCheckTreeView.GetKind(Node: TTreeNode): TCheckKind;
begin
  Result := TCheckTreeNode(Node).CheckKind
end;

function TCheckTreeView.GetState(Node: TTreeNode): TCheckBoxState;
begin
  Result := TCheckTreeNode(Node).CheckState
end;

procedure TCheckTreeView.Loaded;
begin
  FStateImages := TImageList.Create(Self);
  StateImages := FStateImages;
  CreateCheckMarks;
  FDesignInteractive := True;
  inherited Loaded;
end;

procedure TCheckTreeView.MakeRadioGroup(Node: TTreeNode);
begin
  TCheckTreeNode(Node).MakeRadioGroup;
end;

procedure TCheckTreeView.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and (htOnStateIcon in GetHitTestInfoAt(X, Y)) then
    ToggleNode(TCheckTreeNode(GetNodeAt(X, Y)));
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TCheckTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  N                 : TCheckTreeNode;
begin
  N := TCheckTreeNode(GetNodeAt(X, Y));
  if HotTrack and (Flatness = cfHotTrack) then
  begin
    if (FHoverCache <> N) then
    begin
      if FHoverCache <> nil then FHoverCache.UpdateHotTrack(False);
      if N <> nil then N.UpdateHotTrack(True);
      FHoverCache := N;
    end;
  end;
  inherited MouseMove(Shift, X, Y);
end;

procedure TCheckTreeView.SetChecked(Node: TTreeNode; Value: Boolean);
begin
  TCheckTreeNode(Node).Checked := Value
end;

procedure TCheckTreeView.SetNodeEnabled(Node: TTreeNode; const Value: Boolean);
begin
  TCheckTreeNode(Node).Enabled := Value

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -