fcdbtreeview.pas

一套及时通讯的原码

unit fcdbtreeview;
{
//
// Components : TfcDBTreeView
//
// Copyright (c) 1999 by Woll2Woll Software
//
// 5/25/99 - RSW - Fix BorderStyle=bsNone bug where horizontal scrollbar and
//           buttons drawn in wrong position
// 6/22/99 - RSW - Support way to disable Up/Down tree buttons
// 6/22/99 - RSW - Add Select All method
// 7/4/99 -  Fire OnKeyDown event
// 7/26/99 - RSW - Support Builder notation for datasources
// 9/24/99 - RSW - Fix bug with GetHitTestInfoAtXY for detecting Image hit and activeNode hit
// 11/17/99 - RSW - Added support for Form.Print
// 11/17/99 - PYW - Don't HotTrack if this form is not active.
// 1/17/2000 - If insert state then allow changing to this dataset
// 1/20/2000 - Support dtvoShowVertScrollbar options
// 2/8/99 - Move try block before test for firstbookmark to fix potential leak
// 2/14/2000 - Unselect all before destroying
// 3/21/00 - Check for active in UpdateScrollBar to prevent exception when
//           active goes to false
// 5/20/00 - When freeing bookmarks, don't reference dataset in case its already been destroyed
// 06/17/2000 - PYW - Correct painting bug when dtvoShowRoot is not in options and paintbutton is called on the root node
// 10/19/2001 - PYW - Added dtvoFlatCheckboxes since it was in documentation.
// 7/10/02 - Call FreeLastActiveBookmark when assigning datasources
}
interface

{$i fcIfDef.pas}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, db, commctrl, stdctrls, extctrls, fccommon, fccanvas,
  fcdbcommon, buttons, fcscrollbar, fcshapebtn, fcbutton, fcimager, fcchangelink,
  fctreeheader, ImgList;

type
  TfcDBCustomTreeView = class;
  TfcTreeHitTest = (fchtdOnButton, fchtdOnStateIcon, fchtdOnImageIcon, fchtdOnText,
                    fchtdOnActiveNode);
  TfcTreeHitTests = set of TfcTreeHitTest;
  TfcTreeDataLink = class(TDataLink)
  private
    FTree: TfcDBCustomTreeView;
  protected
    procedure DataSetChanged; override;
    procedure DataSetScrolled(Distance: Integer); override;
    procedure ActiveChanged; override;
    procedure RecordChanged(Field: TField); override;
  public
    constructor Create(ATree: TfcDBCustomTreeView);
    destructor Destroy; override;
  end;

  TfcMultiSelectItem = class
     Bookmark: TBookmark;
     DataSet: TDataSet;
  end;

  TfcDBMultiSelectAttributes = class(TPersistent)
  private
     FEnabled: Boolean;
     FAutoUnselect: boolean;
     FMultiSelectLevel: integer;
     FMultiSelectCheckbox: boolean;
     TreeView: TfcDBCustomTreeView;
     procedure SetEnabled(val: boolean);
     procedure SetMultiSelectLevel(val: integer);
     procedure SetMultiSelectCheckBox(val: boolean);

  public
     constructor Create(Owner: TComponent);
     procedure Assign(Source: TPersistent); override;

  published
     property AutoUnselect : boolean read FAutoUnselect write FAutoUnselect default False;
     property Enabled: boolean read FEnabled write SetEnabled default False;
     property MultiSelectLevel: integer read FMultiSelectLevel write SetMultiSelectLevel default 0;
     property MultiSelectCheckbox: boolean read FMultiSelectCheckbox write SetMultiSelectCheckbox default True;
  end;

  TfcDBTreeViewOption = (
     dtvoKeysScrollLevelOnly,
     dtvoAutoExpandOnDSScroll,
     dtvoExpandButtons3D,
     dtvoHideSelection,
     dtvoRowSelect, dtvoShowNodeHint, dtvoShowButtons,
     dtvoShowLines, dtvoShowRoot, dtvoShowHorzScrollBar,
     dtvoShowVertScrollBar, dtvoHotTracking, dtvoFlatCheckboxes);

  TfcDBTreeViewOptions = set of TfcDBTreeViewOption;

  TfcDBTreeNode = class
    protected
     HasPrevSibling: boolean;
     HasNextSibling: boolean;
    public
     ActiveRecord: integer;
     DataLink: TfcTreeDataLink;

     Text: string;
     Level: integer;
     DataSet: TDataSet;
     Field: TField;
     Expanded: boolean;
     HasChildren: boolean;
     Parent: TfcDBTreeNode;
     ImageIndex: integer;
     StateIndex: integer;
     Selected: boolean;
     Hot: boolean;
     MultiSelected: boolean;

     function GetFieldValue(FieldName: string): Variant;
  end;


  TfcDBTreeEvent = procedure(TreeView: TfcDBCustomTreeView;
      Node: TfcDBTreeNode) of object;

  TfcDBTreeSectionEvent = procedure(TreeView: TfcDBCustomTreeView;
      Node: TfcDBTreeNode; Section: TfcTreeHeaderSection;
      var DisplayText: string) of object;

  TfcDBTreeMouseEvent = procedure(TreeView: TfcDBCustomTreeView;
      Node: TfcDBTreeNode;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;

  TfcDBTreeMouseMoveEvent = procedure(TreeView: TfcDBCustomTreeView;
      Node: TfcDBTreeNode;
      Shift: TShiftState; X, Y: Integer)of object;

  TfcDBTreeDrawTextEvent = procedure (TreeView: TfcDBCustomTreeview;
    Node: TfcDBTreeNode; ARect: TRect;
    var DefaultDrawing: boolean) of object;

  TfcDBTreeDrawSectionEvent = procedure (TreeView: TfcDBCustomTreeview;
    Node: TfcDBTreeNode; Section: TfcTreeHeaderSection;
    ARect: TRect;
    s: String;
    var DefaultDrawing: boolean) of object;

  TfcDBCustomTreeView = class(TWinControl)
  private
    FOptions: TfcDBTreeViewOptions;
    FDisplayFields: TStrings;
    FBorderStyle: TBorderStyle;
    FOnCalcNodeAttributes: TfcDBTreeEvent;
    FOnCalcSectionAttributes: TfcDBTreeSectionEvent;
    FOnDrawSection: TfcDBTreeDrawSectionEvent;
    FOnChange: TfcDBTreeEvent;
    FOnUserExpand: TfcDBTreeEvent;
    FOnUserCollapse: TfcDBTreeEvent;
    FMultiSelectAttributes: TfcDBMultiSelectAttributes;
    FOnMouseDown, FOnMouseUp, FOnDblClick: TfcDBTreeMouseEvent;
    FOnMouseMove: TfcDBTreeMouseMoveEvent;
    FLevelIndent : integer;
    FDataSourcesMiddle: string;
    FImager: TfcCustomImager;

    FMultiSelectList: TList;
    FImages: TCustomImageList;
    FStateImages: TCustomImageList;
    FLineColor: TColor;
    FInactiveFocusColor: TColor;
    FScrollWithinLevel: boolean;
    FDisableThemes: boolean;

    FDataLinks: TList;

    FCanvas: TControlCanvas;
    FPaintCanvas: TfcCanvas;
    FPaintBitmap: TBitmap;
//    InChange, InFetchData, InScroll: boolean;
//    SkipSetTop: boolean;
    SkipErase, SkipReload: boolean;
    FFirstDataLink, FLastDataLink: TfcTreeDataLink;
    FActiveDataSet: TDataSet;
    FLastVisibleDataset: TDataSet;
    ActiveDataSetChanged: boolean;
    ActiveNodeIndex: integer;
    HintTimer: TTimer;
    HintTimerCount: integer;
    LastHintRow: integer;

    Nodes: TList;
    RowHeight : integer;
    FixedOffset : integer;
    CacheSize : integer;
    FActiveNode: TfcDBTreeNode;
    MaxTextWidth: integer;
    ResetScroll: boolean;

    Down: boolean;     { Used by MouseLoop}
    MouseRow: integer; { Used by MouseLoop}
    PaintingRow: integer;
    FOnDrawText: TfcDBTreeDrawTextEvent;
    SaveCursor: TCursor;
    CheckMaxWidth: boolean; { Set to True to force wmpaint to check horzscrollbar }
    CheckMaxWidthGrow: boolean; { Set to True to force wmpaint to check horzscrollbar }
    InPaint: boolean;
    InComputeHorzWidthOnly : boolean;
    FChangeLink: TfcChangeLink;
    NodesCleared: boolean;
    HaveBadLink: boolean; { True if DataSources property is referencing external form that has not been created yet }
    {$ifdef fcDelphi4Up}
    FHideUpDownButtons: boolean;
    FHeader: TfcTreeHeader;
    procedure SetHideUpDownButtons(val: boolean);
    {$endif}

    function GetDataSource: TDataSource;
    procedure SetDataSource(Value: TDataSource);
    function GetLastDataSource: TDataSource;
    procedure SetLastDataSource(Value: TDataSource);
    procedure SetDataSources(Value: String);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure CMExit(var Message: TMessage); message CM_EXIT;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBkgnd;
//    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
//    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
//    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;

    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure TreeDownClick(Sender : TObject);
    procedure TreeUpClick(Sender : TObject);
    Function GetParentDataLink(Dataset: TDataset): TfcTreeDataLink;
    Function GetChildDataLink(Dataset: TDataset): TfcTreeDataLink;
    Procedure MouseToRow(X, Y: integer; var Row: integer);
    function RowToNode(Row: integer; var Node: TfcDBTreeNode): boolean;
//    function NodeToIndex(Node: TfcDBTreeNode): integer;
    function NodeToRow(Node: TfcDBTreeNode; var Row: integer): boolean;
    procedure SetBorderStyle(Value: TBorderStyle);
    Function GetCenterPoint(ARect: TRect): TPoint;
    procedure ResetStartOffsets(ActiveDataSet: TDataSet);
    Function GetStartOffset: integer;
    Procedure SetStartOffset(ActiveDataSet: TDataSet; val: integer);
    procedure SetImages(Value: TCustomImageList);
    procedure SetStateImages(Value: TCustomImageList);
    function UseStateImages(Node: TfcDBTreeNode): Boolean;
    function GetMultiSelectItem(Index: integer): TfcMultiSelectItem;
    procedure HintTimerEvent(Sender: TObject);
    function GetMultiSelectListCount: integer;
    Function GetStateImageWidth: integer;
    procedure ScrollRight;
    procedure ScrollLeft;
    procedure SetLineColor(Value: TColor);
    procedure SetInactiveFocusColor(Value: TColor);
    procedure SetOptions(Value: TfcDBTreeViewOptions);
    Function GetStartX(Node: TfcDBTreeNode): integer;
    procedure SetDisplayFields(Value: TStrings);
    procedure UpdateScrollBarPosition;
    procedure SetLevelIndent(val: integer);
    procedure SetImager(Value: TfcCustomImager);
    procedure ImagerChange(Sender: TObject);
    procedure SetHeader(Value: TFcTreeHeader);

  protected
    HintWindow: THintWindow;
    LastActiveBookmark, FirstBookmark: TBookmark;
    ScrollSize: integer;
    HotTrackRow: integer;
    FMouseInControl : boolean;
    SkipFreeNodes: boolean;
    OldNodes: TList;
    HorzScrollBar, VertScrollBar: TfcScrollBar;
    UpTreeButton, DownTreeButton: TfcShapeBtn;
    StartOffsets: Array[0..50] of integer;
    RootDataSetBookmark: TBookmark;

    {$ifdef fcDelphi4Up}
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    {$endif}

    Function GetNodeText(DisplayFieldLine: string;
       DataSet: TDataSet;
       var Field: TField): string;
    function ComputeHeaderWidth: integer; virtual;
    Function IsRootDataSetMoved: boolean; virtual;
    procedure DrawColumnText(
          Node: TfcDBTreeNode; ARect: TRect); virtual;
    procedure CreateWnd; override;
    procedure UpdateScrollBar; virtual;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure PaintButton(Node: TfcDBTreeNode;
              pt: TPoint; Size: integer; Expanded: Boolean); virtual;
    procedure PaintLines(Node: TfcDBTreeNode); virtual;
    procedure PaintImage(Node: TfcDBTreeNode); virtual;
    procedure DataChanged(DataSet: TDataSet); virtual;
    procedure Scroll(DataSet: TDataSet; Distance: Integer); virtual;
    procedure LinkActive(DataSet: TDataSet; Value: Boolean); virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure DoCalcNodeAttributes(Node: TfcDBTreeNode); virtual;
    procedure DoCalcSectionAttributes(Node: TfcDBTreeNode;
                Section: TfcTreeHeaderSection;
                var DisplayText: string); virtual;
    procedure DoDrawSection(Node: TfcDBTreeNode;
                Section: TfcTreeHeaderSection;
                ARect: TRect;
                s: String;
                var DoDefault: boolean); virtual;

    Function InMasterChanging(DataSet: TDataSet): boolean; virtual;
    procedure RefreshDataLinks(FirstDS, LastDS: TDataSource); virtual;
    procedure Notification(AComponent: TComponent;
         Operation: TOperation); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    Function LevelRect(Node: TfcDBTreeNode): TRect;
    Function TextRect(Node: TfcDBTreeNode; Row: integer): TRect;
    Function MultiSelectCheckboxNeeded(Node: TfcDBTreeNode): boolean;
    function ValidMultiSelectLevel(ALevel: Integer): Boolean;
    Function FindCurrentMultiSelectIndex(DataSet: TDataSet): integer; virtual;
    procedure Loaded; override;
    procedure FreeHintWindow; virtual;
    Function CreateHintWindow: THintWindow; virtual;

    procedure Change(FSelected: TfcDBTreeNode); virtual;
    Procedure SaveIfFirstRecordBookmark(DataSet: TDataSet);
    Procedure FreeFirstBookmark;
    Function HaveValidDataLinks: boolean;
    function IsChildDataSetOfActive(DataSet: TDataSet): boolean;
    function IsMasterDataSetOfActive(DataSet: TDataSet): boolean;
    Procedure ToggleMultiSelection(
       RequireControlKey: boolean; Shift: TShiftState);
    procedure MouseLoop(X, Y: Integer); virtual;

    function UpdateDataLinkToActive(Node: TfcDBTreeNode): boolean;
    procedure PriorRow(WithinLevel: boolean); virtual;
    procedure NextRow(WithinLevel: boolean); virtual;
    procedure PriorPage(WithinLevel: boolean); virtual;
    procedure NextPage(WithinLevel: boolean); virtual;
    function GetClientRect: TRect; override;
    procedure VScroll(ScrollCode: integer; Position: integer); virtual;
    procedure HScroll(ScrollCode: integer; Position: integer); virtual;
    function CreateUpTreeButton: TfcShapeBtn; virtual;
    function CreateDownTreeButton: TfcShapeBtn; virtual;
    procedure DoDrawText(TreeView: TfcDBCustomTreeView;
         Node: TfcDBTreeNode; ARect: TRect;
         var DefaultDrawing: boolean); virtual;
    procedure WndProc(var Message: TMessage); override;
    procedure FreeOldNodes;
    procedure DoUserExpand(Node: TfcDBTreeNode); virtual;
    procedure DoUserCollapse(Node: TfcDBTreeNode); virtual;
    procedure SetActiveDataSet(DataSet: TDataSet); virtual;
    procedure SetLastVisibleDataSet(DataSet: TDataSet); virtual;
    Function GetDataLink(Dataset: TDataset): TfcTreeDataLink;
    Function GetDataLinkIndex(Dataset: TDataset): integer;
  public
    Patch: Variant;
    procedure LayoutChanged; virtual;
    Procedure FreeLastActiveBookmark;
    procedure FreeRootBookmark;  // Move to public in case they change index and wish to clear old bookmark
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MoveTo(Node: TfcDBTreeNode);
    function GetHitTestInfoAt(X, Y: Integer): TfcTreeHitTests;
    procedure UnselectAll; virtual;
    {$ifdef fcDelphi4Up}
    procedure SelectAll(ADataSet: TDataSet); virtual;
    {$endif}
    procedure SelectRecord; virtual;
    procedure UnselectRecord; virtual;
    Function IsSelectedRecord: boolean;
    procedure InvalidateNode(Node: TfcDBTreeNode);
    procedure InvalidateRow(Row: integer);
    procedure InvalidateClient; virtual;
    procedure Expand(Node: TfcDBTreeNode); virtual;
    procedure Collapse(Node: TfcDBTreeNode); virtual;
    procedure MakeActiveDataSet(DataSet: TDataSet; Collapse: boolean);
    Function GetNodeAt(X,Y: integer): TfcDBTreeNode;
    procedure SortMultiSelectList;

    property ActiveNode: TfcDBTreeNode read FActiveNode;
    property Canvas : TfcCanvas read FPaintCanvas;
    property MultiSelectList[Index: Integer]: TfcMultiSelectItem read GetMultiSelectItem;
    property MultiSelectListCount : integer read GetMultiSelectListCount;
    property ActiveDataSet : TDataSet read FActiveDataSet write SetActiveDataSet;
    property LastVisibleDataSet: TDataSet read FLastVisibleDataSet write SetLastVisibleDataSet;

//  published
    property LevelIndent : integer read FLevelIndent write SetLevelIndent;
    property LineColor: TColor read FLineColor write SetLineColor default clBtnShadow;
    property InactiveFocusColor: TColor read FInactiveFocusColor write SetInactiveFocusColor default clBtnFace;
    property ParentColor default False;