fctreeview.pas

一套及时通讯的原码

    FOnCollapsing: TfcTVCollapsingEvent;
    FOnChanging: TfcTVChangingEvent;
    FOnChange: TfcTVChangedEvent;
    FOnCompare: TfcTVCompareEvent;
    FOnDeletion: TfcTVExpandedEvent;
    FOnGetImageIndex: TfcTVExpandedEvent;
    FOnGetSelectedIndex: TfcTVExpandedEvent;
    FLineColor: TColor;
    FInactiveFocusColor: TColor;
    FOnMouseDown, FOnMouseUp, FOnDblClick: TfcTreeMouseEvent;
    FOnMouseMove: TfcTreeMouseMoveEvent;
    FOnToggleCheckbox: TfcToggleCheckboxEvent;

    FNodeClass: TfcTreeNodeClass;
    FMultiSelectAttributes: TfcTVMultiSelectAttributes;
    FOnCalcNodeAttributes: TfcCalcNodeAttributesEvent;
    FBorderWidth: Integer;
    FOnDrawText: TfcTVDrawTextEvent;
//    FFixBugImageList: TImageList;
    FOptions: TfcTreeViewOptions;
    FDisableThemes: boolean;

    FPaintBitmap: TBitmap;
    FIndent: Integer;
    LastSelectedNode: TfcTreeNode;
    MouseNode: TfcTreeNode;
    LastMouseMoveNode: TfcTreeNode;  // For themes with checkboxes and radiobuttons invalidation
    LastMouseHitTest: TfcHitTests;
    ClickedNode: TfcTreeNode;
    Down: boolean;
    EditNode, BeforeMouseDownNode: TfcTreeNode;
    FStreamVersion: integer;
    FUsePaintBuffering: boolean;
//    FEditControl: TWinControl;

    procedure CanvasChanged(Sender: TObject);
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure EditWndProc(var Message: TMessage);
    procedure DoDragOver(Source: TDragObject; X, Y: Integer; CanDrop: Boolean);
    function GetChangeDelay: Integer;
    function GetDropTarget: TfcTreeNode;
    function GetIndent: Integer;
    function GetNodeFromItem(const Item: TTVItem): TfcTreeNode;
    function GetSelection: TfcTreeNode;
    function GetTopItem: TfcTreeNode;
    procedure ImageListChange(Sender: TObject);
    procedure SetAutoExpand(Value: Boolean);
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetChangeDelay(Value: Integer);
    procedure SetDropTarget(Value: TfcTreeNode);
    procedure SetImageList(Value: HImageList; Flags: Integer);
    procedure SetIndent(Value: Integer);
    procedure SetImages(Value: TCustomImageList);
    procedure SetReadOnly(Value: Boolean);
    procedure SetSelection(Value: TfcTreeNode);
    procedure SetSortType(Value: TfcSortType);
    procedure SetStateImages(Value: TCustomImageList);
//    procedure SetToolTips(Value: Boolean);
    procedure SeTfcTreeNodes(Value: TfcTreeNodes);
    procedure SetTopItem(Value: TfcTreeNode);
    procedure OnChangeTimer(Sender: TObject);
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBkgnd;
    procedure CMExit(var Message: TMessage); message CM_EXIT;
    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;

    procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
    function ValidMultiSelectLevel(ALevel: Integer): Boolean;
    Function CheckboxNeeded(Node: TfcTreeNode): boolean;
    Function GetCenterPoint(ARect: TRect): TPoint;
    procedure SetOptions(Value: TfcTreeViewOptions);
    procedure SetLineColor(Value: TColor);
    procedure SetInactiveFocusColor(Value: TColor);
    function GetItemHeight: ShortInt;
    procedure SetItemHeight(Value: ShortInt);
    function GetScrollTime: Integer;
    procedure SetScrollTime(Value: Integer);
    function GetMultiSelectListCount: integer;
    function GetMultiSelectItem(Index: integer): TfcTreeNode;
    procedure HintTimerEvent(Sender: TObject);
    function GetPaintCanvas: TfcCanvas;
  protected
    FMultiSelectList: TList;
    SkipErase: boolean;
    SkipChangeMessages: boolean;  { Notify method skips processing of change notifications }
    InLoading: boolean; { During expansion of Reference tree,
                          do not recursively expand item's children.
                          Calling MoveTo expands parent so we prevent this}

    FChangeTimer: TTimer;
    DisplayedItems: integer;
    FMouseInControl : boolean;

    { Implement hint handling }
    HintWindow: THintWindow;
    HintTimer: TTimer;
    HintTimerCount: integer;
    LastHintNode: TfcTreeNode;

    function CanEdit(Node: TfcTreeNode): Boolean; dynamic;
    function CanChange(Node: TfcTreeNode): Boolean; dynamic;
    function CanCollapse(Node: TfcTreeNode): Boolean; dynamic;
    function CanExpand(Node: TfcTreeNode): Boolean; dynamic;
    procedure Change(Node: TfcTreeNode); dynamic;
    procedure Collapse(Node: TfcTreeNode); dynamic;
    function CreateNode: TfcTreeNode; virtual;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Delete(Node: TfcTreeNode); dynamic;
    procedure DestroyWnd; override;
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
    procedure DoStartDrag(var DragObject: TDragObject); override;
    procedure Edit(const Item: TTVItem); dynamic;
    procedure Expand(Node: TfcTreeNode); dynamic;
    function GetDragImages: {$ifdef fcDelphi4Up}TDragImageList{$else}TCustomImageList{$endif}; override;
    procedure GetImageIndex(Node: TfcTreeNode); virtual;
    procedure GetSelectedIndex(Node: TfcTreeNode); virtual;
    procedure Loaded; override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure SetDragMode(Value: TDragMode); override;
    procedure WndProc(var Message: TMessage); override;
    property AutoExpand: Boolean read FAutoExpand write SetAutoExpand default False;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property ChangeDelay: Integer read GetChangeDelay write SetChangeDelay default 0;
    property Images: TCustomImageList read FImages write SetImages;
    property Indent: Integer read GetIndent write SetIndent;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
    property RightClickSelects: Boolean read FRightClickSelects write FRightClickSelects default False;
    property SortType: TfcSortType read FSortType write SetSortType default fcstNone;
    property StateImages: TCustomImageList read FStateImages write SetStateImages;
    property StreamExpandedNode: Boolean read FStreamExpandedNode write FStreamExpandedNode default False;
//    property ToolTips: Boolean read FToolTips write SetToolTips default False;
    property OnEditing: TfcTVEditingEvent read FOnEditing write FOnEditing;
    property OnEdited: TfcTVEditedEvent read FOnEdited write FOnEdited;
    property OnExpanding: TfcTVExpandingEvent read FOnExpanding write FOnExpanding;
    property OnExpanded: TfcTVExpandedEvent read FOnExpanded write FOnExpanded;
    property OnCollapsing: TfcTVCollapsingEvent read FOnCollapsing write FOnCollapsing;
    property OnCollapsed: TfcTVExpandedEvent read FOnCollapsed write FOnCollapsed;
    property OnChanging: TfcTVChangingEvent read FOnChanging write FOnChanging;
    property OnChange: TfcTVChangedEvent read FOnChange write FOnChange;
    property OnCompare: TfcTVCompareEvent read FOnCompare write FOnCompare;
    property OnDeletion: TfcTVExpandedEvent read FOnDeletion write FOnDeletion;
    property OnGetImageIndex: TfcTVExpandedEvent read FOnGetImageIndex write FOnGetImageIndex;
    property OnGetSelectedIndex: TfcTVExpandedEvent read FOnGetSelectedIndex write FOnGetSelectedIndex;

    procedure MultiSelectNode(Node: TfcTreeNode; Select: boolean; redraw: boolean); virtual;
    function IsVisible(Node: TfcTreeNode; PartialOK: Boolean): Boolean; virtual;
    function ItemRect(Node: TfcTreeNode; LabelOnly: Boolean): TRect;
    procedure PaintButton(Node: TfcTreeNode; pt: TPoint; size: integer);
    procedure PaintLines(Node: TfcTreeNode);
    procedure PaintImage(Node: TfcTreeNode; State: TfcItemStates);
    function LevelRect(ANode: TfcTreeNode): TRect;
    procedure DoDrawText(TreeView: TfcCustomTreeView;
         Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates;
         var DefaultDrawing: boolean); virtual;
    procedure Compare(Node1, Node2: TfcTreeNode; lParam: integer; var Result: integer); virtual;
    procedure CalcNodeAttributes(Node: TfcTreeNode; AItemState: TfcItemStates); virtual;
    function GetDisplayText(Node: TfcTreeNode): string; virtual;
    procedure LoadCanvasDefaults(Node: TfcTreeNode; AItemState: TfcItemStates);
    function ProcessKeyPress(Key: char; shift: TShiftState): boolean; virtual;
    function IsRowSelect: boolean; virtual;
    procedure MouseLoop(X, Y: Integer); virtual;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                 X, Y: Integer); override;
    function UseImages(Node: TfcTreeNode): Boolean;
    function UseStateImages(Node: TfcTreeNode): Boolean;
    procedure BeginPainting; virtual;
    procedure EndPainting; virtual;
    procedure BeginItemPainting(Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates); virtual;
    procedure EndItemPainting(Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates); virtual;
    procedure PaintItem(Node: TfcTreeNode); virtual;
    procedure ClearStateImageIndexes;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure DoToggleCheckbox(Node: TfcTreeNode); virtual;
    procedure FreeHintWindow; virtual;
    Function CreateHintWindow(Node: TfcTreeNode): THintWindow; virtual;
    Procedure UnselectAllNodes(IgnoreNode: TfcTreeNode);
    procedure InvalidateNoErase;

    property ItemHeight: ShortInt read GetItemHeight write SetItemHeight;
    property OnCalcNodeAttributes: TfcCalcNodeAttributesEvent read FOnCalcNodeAttributes write FOnCalcNodeAttributes;
    property ScrollTime: Integer read GetScrollTime write SetScrollTime;
    property NodeClass: TfcTreeNodeClass read FNodeClass write FNodeClass;
  public
    Patch: Variant;

    procedure ResetStateImages;
    property StreamVersion: integer read FStreamVersion;
    Function GetFirstSibling(Node: TfcTreeNode): TfcTreeNode;
    Procedure InvalidateNode(Node: TfcTreeNode);
    Function MultiSelectCheckboxNeeded(Node: TfcTreeNode): boolean;
    Procedure UnselectAll;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function AlphaSort: Boolean;
    function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
    procedure FullCollapse;
    procedure FullExpand;
    function GetHitTestInfoAt(X, Y: Integer): TfcHitTests;
    function GetNodeAt(X, Y: Integer): TfcTreeNode;
    function IsEditing: Boolean;
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream);
    property Canvas: TfcCanvas read GetPaintCanvas;
    property DropTarget: TfcTreeNode read GetDropTarget write SetDropTarget;
    property Selected: TfcTreeNode read GetSelection write SetSelection;
    property TopItem: TfcTreeNode read GetTopItem write SetTopItem;

    property RightClickNode: TfcTreeNode read FRClickNode;
    property Options: TfcTreeViewOptions read FOptions write SetOptions default
        [tvoExpandOnDblClk, tvoShowButtons, tvoShowRoot, tvoShowLines, tvoHideSelection, tvoToolTips];
    property Items: TfcTreeNodes read FTreeNodes write SeTfcTreeNodes;
    property MultiSelectAttributes: TfcTVMultiSelectAttributes
        read FMultiSelectAttributes write FMultiSelectAttributes;
    property OnDrawText: TfcTVDrawTextEvent read FOnDrawText write FOnDrawText;
    property OnItemChange: TfcItemChangeEvent read FOnItemChange write FOnItemChange;

    property MultiSelectList[Index: Integer]: TfcTreeNode read GetMultiSelectItem;
    property MultiSelectListCount : integer read GetMultiSelectListCount;
    property LineColor: TColor read FLineColor write SetLineColor default clBtnShadow;
    property InactiveFocusColor: TColor read FInactiveFocusColor write SetInactiveFocusColor default clBtnFace;
    property OnMouseMove: TfcTreeMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseDown: TfcTreeMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseUp: TfcTreeMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnDblClick: TfcTreeMouseEvent read FOnDblClick write FOnDblClick;
    property OnToggleCheckbox: TfcToggleCheckboxEvent read FOnToggleCheckbox write FOnToggleCheckbox;
    property UsePaintBuffering: boolean read FUsePaintBuffering write FUsePaintBuffering default False;
    property DisableThemes : boolean read FDisableThemes write FDisableThemes default False;

  end;

  TfcTreeView = class(TfcCustomTreeView)
  published
    property DisableThemes;
    property Align;
    {$ifdef fcDelphi4Up}
    property Anchors;
    {$endif}
    property AutoExpand;
    {$ifdef fcDelphi4Up}
    property BiDiMode;
    {$endif}
    property BorderStyle;
//    property BorderWidth;
    property ChangeDelay;
    property Color;
    property LineColor;
    property InactiveFocusColor;
    property Ctl3D;
    {$ifdef fcDelphi4Up}
    property Constraints;
    property DragKind;
    {$endIf}
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property Images;
    property Indent;
    property MultiSelectAttributes;
    property Options;
    property Items;
    {$ifdef fcDelphi4Up}
    property ParentBiDiMode;
    {$endif}
    property ParentColor default False;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property UsePaintBuffering;
    property PopupMenu;
    property ReadOnly;
    property RightClickSelects;
    {$ifdef fcDelphi4Up}
    property ShowHint;
    {$endif}
    property SortType;
    property StateImages;
    property StreamExpandedNode;
    property TabOrder;
    property TabStop default True;
//    property ToolTips;
    property Visible;
    property OnChange;
    property OnChanging;
    property OnClick;
    property OnCollapsing;
    property OnCollapsed;
    property OnCompare;
    property OnDblClick;
    property OnDeletion;
    property OnDragDrop;
    property OnDragOver;
    property OnEdited;
    property OnEditing;
    {$ifdef fcDelphi4Up}
    property OnEndDock;
    {$endif}
    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 OnToggleCheckbox;
    {$ifdef fcDelphi4Up}
    property OnStartDock;
    {$endif}
    property OnStartDrag;

    property OnCalcNodeAttributes;
    property OnDrawText;

  end;

  procedure fcTreeViewError(const Msg: string);

implementation
{ TfcTreeNode }

{$ifdef fcDelphi6Up}
uses RTLConsts;
{$endif}

const MaxCheckboxSize = 6;
      FixBugImageListSize = 16;

var FFixBugImageList: TImageList;
    RefCount: integer;

procedure SetComCtlStyle(Ctl: TWinControl; Value: Integer; UseStyle: Boolean);
var
  Style: Integer;
begin
  if Ctl.HandleAllocated then
  begin
    Style := GetWindowLong(Ctl.Handle, GWL_STYLE);
    if not UseStyle then Style := Style and not Value
    else Style := Style or Value;
    SetWindowLong(Ctl.Handle, GWL_STYLE, Style);
  end;
end;

function DefaultTreeViewSort(Node1, Node2: TfcTreeNode; lParam: Integer): Integer; stdcall;
begin
//    Result := lstrcmp(PChar(Node1.Text), PChar(Node2.Text));
   Node1.TreeView.Compare(Node1, Node2, lParam, Result);
end;

{
function DefaultTreeViewSort(Node1, Node2: TfcTreeNode; lParam: Integer): Integer; stdcall;
begin
  with Node1 do
    if Assigned(TreeView.OnCompare) then
      TreeView.OnCompare(TreeView, Node1, Node2, lParam, Result)
    else Result := lstrcmp(PChar(Node1.Text), PChar(Node2.Text));
end;
}

procedure TreeViewError(const Msg: string);
begin
  raise ETreeViewError.Create(Msg);
end;

{procedure TreeViewErrorFmt(const Msg: string; Format: array of const);
begin
  raise ETreeViewError.CreateFmt(Msg, Format);
end;
}
constructor TfcTreeNode.Create(AOwner: TfcTreeNodes);
begin
  inherited Create;
  FOverlayIndex := -1;
  FStateIndex := -1;
  FOwner := AOwner;
end;

destructor TfcTreeNode.Destroy;
var
  Node: TfcTreeNode;
  CheckValue: Integer;
  i: integer;
  MultiSelectList: TList;