treevwex.pas

delphi编程控件

unit TreeVwEx;

{ TTreeViewEx component: Extended TTreeView component.
  Version 0.83  Nov-01-1997  (C) 1997 Christoph R. Kirchner
  !! This component is currently UNDER CONSTRUCTION !!
}
{ Users of this unit must accept this disclaimer of warranty:
    "This unit is supplied as is. The author disclaims all warranties,
    expressed or implied, including, without limitation, the warranties
    of merchantability and of fitness for any purpose.
    The author assumes no liability for damages, direct or
    consequential, which may result from the use of this unit."

  This Unit is donated to the public as public domain.

  This Unit can be freely used and distributed in commercial and
  private environments provided this notice is not modified in any way.

  If you do find this Unit handy and you feel guilty for using such a
  great product without paying someone - sorry :-)

  Please forward any comments or suggestions to Christoph Kirchner at:
  [e-mail]

  Maybe you can find an update of this component at my
  "Delphi Component Building Site":
  http://www.geocities.com/SiliconValley/Heights/7874/delphi.htm

}


interface

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

type

  TCustomTreeViewEx = class;

  TTreeViewExOption = (
    tveAllowDelete, tveAllowInsert, tveAutoDragMove, tveConfirmDelete,
    tveInsertAsChild, tveMouseMoveSelect, tveMultipleRootsAllowed,
    tveRootItemReadOnly);
  TTreeViewExOptions = set of TTreeViewExOption;

{ Options:

  tveAllowInsert:
    If tveAllowInsert is true, a new item gets created and inserted if
    the user presses the insert key.

  tveAutoDragMove:
    The user can move items by dragging them in the DBTreeView.

  tveConfirmDelete:
    The user get asked if he really want to delete the current record
    after he pressed the Del-key. If the current node has children, the
    user get asked for each of them.

  tveInsertAsChild:
    The new item that is created by pressing the insert key gets
    inserted after the selected node if tveInsertAsChild is false or
    it gets inserted as a child of the selected node if tveInsertAsChild
    is true.

  tveMouseMoveSelect:
    If the user moves the mouse, the nearest node gets selected.
    If the user moves the mouse to the upper or lower border of the
    TreeView while left button pressed, the TreeView will scroll.
    This scrolling happens anyway if the user drags a node.
    The option tveMouseMoveSelect makes sense if the TreeView is shown
    in a dropdown-panel.

  tveMultipleRootsAllowed:
    If true, the user can insert more than one root and drag a child
    to the root position.

  tveRootItemReadOnly:
    To set the root of the tree to read-only.

  }


  TTreeViewExState = (
    tvesIgnoreNextWMChar, tvesMouseStillDownAfterDoubleClick,
    tvesRightButtonPressed, tvesWaitingForPopupMenu);
  TTreeViewExStates = set of TTreeViewExState;

  TIgnoreWMChars = set of AnsiChar;


  TCustomTreeViewEx = class(TCustomTreeView)
  private
    FOnMouseSelect: TNotifyEvent;
    FDelRootID: LongInt;
    FOptions: TTreeViewExOptions;
    FState: TTreeViewExStates;
    FLastPossibleDropTarget: TTreeNode;
    FDontAcceptLastPossibleDropTarget: Boolean;
    FIgnoreWMChars: TIgnoreWMChars;
    FDragScrollTickCount: Integer;
    FLMouseDownTickCount: Integer;
    FScrollTimer: Longint;
    FMouseSelectTimer: Longint;
    function MultipleRootsAllowed: Boolean;
    procedure DoScroll(Node: TTreeNode; MouseX, MouseY: Integer);
    procedure DoDragOver(Source: TDragObject; X, Y: Integer;
                         PossibleDrop: Boolean);
    procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    procedure WMChar(var Message: TWMKeyDown); message WM_CHAR;
    procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;
    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
  protected
    FRSelected: TTreeNode;
    FDisableCount: Integer;
    procedure WndProc(var Message: TMessage); override;
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;
    procedure DragCanceled; override;
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    function CanEdit(Node: TTreeNode): Boolean; override;
    function CanDelete(Node: TTreeNode): Boolean; virtual;
    procedure Expand(Node: TTreeNode); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KillAllTimer; virtual;
    function DragAllowed(Node: TTreeNode): Boolean; virtual;
    function GetDeleteQuestion(Node: TTreeNode): string; virtual;
    function ShowDeletePrompt(Node: TTreeNode;
      var DeleteAll: Boolean; ShowDeleteAllButton: Boolean): Boolean;
    procedure InternalDeleteNode(Node: TTreeNode;
      AskForDeleteAll: Boolean; var DeleteAll, Canceled: Boolean);
    function DoDelete(Node: TTreeNode): Boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Insert(AsChild: Boolean); virtual;
    procedure Delete; virtual;
    procedure DeleteNode(Node: TTreeNode);
    function MoveNode(Source, Destination: TTreeNode;
                      Mode: TNodeAttachMode): Boolean; virtual;
  { IsRootNode is true if the node has no parent: }
    function IsRootNode(Node: TTreeNode): Boolean;
  { IsSingleRootNode is true if the node is the only one without parent: }
    function IsSingleRootNode(Node: TTreeNode): Boolean;
    property IgnoreWMChars: TIgnoreWMChars
      read FIgnoreWMChars write FIgnoreWMChars;
  { The last node that was clicked with the right mouse-button: }
    property RSelected: TTreeNode read FRSelected;
  { possible published: }
    property OnMouseSelect: TNotifyEvent
      read FOnMouseSelect write FOnMouseSelect;
    property Options: TTreeViewExOptions read FOptions write FOptions;
  public
  { possible published, inherited from TCustomTreeView: }
    property ShowButtons;
    property BorderStyle;
    property DragCursor;
    property ShowLines;
    property ShowRoot;
    property ReadOnly;
    property DragMode;
    property HideSelection;
    property Indent;
    property OnEditing;
    property OnEdited;
    property OnExpanding;
    property OnExpanded;
    property OnCollapsing;
    property OnCompare;
    property OnCollapsed;
    property OnChanging;
    property OnChange;
    property OnDeletion;
    property OnGetImageIndex;
    property OnGetSelectedIndex;
    property Align;
    property Enabled;
    property Font;
    property Color;
    property Items;
    property ParentColor;
    property ParentCtl3D;
    property Ctl3D;
    property SortType;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnDragDrop;
    property OnDragOver;
    property OnStartDrag;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDblClick;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property PopupMenu;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Images;
    property StateImages;
  end;


  TTreeViewEx = class(TCustomTreeViewEx)
  published
    property ShowButtons;
    property BorderStyle;
    property DragCursor;
    property ShowLines;
    property ShowRoot;
    property ReadOnly;
    property DragMode;
    property HideSelection;
    property Indent;
    property OnEditing;
    property OnEdited;
    property OnExpanding;
    property OnExpanded;
    property OnCollapsing;
    property OnCompare;
    property OnCollapsed;
    property OnChanging;
    property OnChange;
    property OnDeletion;
    property OnGetImageIndex;
    property OnGetSelectedIndex;
    property Align;
    property Enabled;
    property Font;
    property Color;
    property ParentColor;
    property ParentCtl3D;
    property Ctl3D;
    property SortType;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnDragDrop;
    property OnDragOver;
    property OnStartDrag;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDblClick;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property PopupMenu;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Images;
    property StateImages;
    property Items;
    property Options
      default [tveAllowDelete, tveAllowInsert, tveAutoDragMove,
               tveRootItemReadOnly, tveConfirmDelete];
    property OnMouseSelect;
  end;

var
  stveDefaultDeleteQuestion: string = 'Delete item ?';

implementation

const
  TimerIDScroll = 1001;
  TimerIDMouseSelect = 1003;
  DoNextScrollTickCount = 200;
  DragScrollBorder = 16;



{ TCustomTreeViewEx ---------------------------------------------------------- }

constructor TCustomTreeViewEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csClickEvents, csSetCaption, csDoubleClicks,
                   csDisplayDragImage, csCaptureMouse];
  FDisableCount := 0;
  FOptions := [tveAllowDelete, tveAllowInsert, tveAutoDragMove,
               tveRootItemReadOnly, tveConfirmDelete];
  FState := [];
  FLastPossibleDropTarget := nil;
  FIgnoreWMChars := [];
  FScrollTimer := 0;
  FMouseSelectTimer := 0;
  FRSelected := nil;
  FOnMouseSelect := nil;
end;

destructor TCustomTreeViewEx.Destroy;
begin
  KillAllTimer;
  Items.Clear;
  inherited Destroy;
end;

procedure TCustomTreeViewEx.KillAllTimer;
begin
  if (FScrollTimer <> 0) then
    KillTimer(Handle, TimerIDScroll);
  if (FMouseSelectTimer <> 0) then
    KillTimer(Handle, TimerIDMouseSelect);
  FScrollTimer := 0;
  FMouseSelectTimer := 0;
end;

procedure TCustomTreeViewEx.Expand(Node: TTreeNode);
begin
  inherited Expand(Node);
{
  if (FDisableCount = 0) and (Selected <> nil) then
    Selected.MakeVisible;
}
end;

function TCustomTreeViewEx.IsRootNode(Node: TTreeNode): Boolean;
begin
  if (Node = nil) then
    Result := false
  else
    Result := (Node.Parent = nil);
end;

{ This function was improved by Zlatko Ivankovic: THANKS! }
function TCustomTreeViewEx.IsSingleRootNode(Node: TTreeNode): Boolean;
var
  hItem: HTreeItem;
  hItemPrev: HTreeItem;
  hItemNext: HTreeItem;
begin
  Result := false;
  if not IsRootNode(Node) then
    exit;
  hItem := TreeView_GetRoot(Handle);
  if hItem <> nil then begin
    hItemNext := TreeView_GetNextSibling(Handle, hItem);
    hItemPrev :=  TreeView_GetPrevSibling(Handle, hItem);
    if (hItemNext = nil) and (hItemPrev = nil) then
      Result := true;
  end;
end;
(*
Original IsSingleRootNode:
Look at this, and you will see how elegant the above
solution from Zlatko Ivankovic is:
function TCustomTreeViewEx.IsSingleRootNode(Node: TTreeNode): Boolean;
var
  i: Integer;
begin
  Result := false;
  if not IsRootNode(Node) then
    exit;
  for i := 0 to Items.Count - 1 do
    if (Items[i] <> Node) and IsRootNode(Items[i]) then
      exit; { found another root }
  Result := true;
end;
*)
function TCustomTreeViewEx.CanDelete(Node: TTreeNode): Boolean;
var
  i: Integer;
begin
  if (Node = nil) then
    result := false
  else