Delphi控件源码

开发平台：

Delphi

fcdbtreeview.pas：源码内容

unit fcdbtreeview;
{
//
// Components : TfcDBTreeView
//
//
// 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;
property BorderStyle : TBorderStyle read FBorderStyle write SetBorderStyle;
property DataSourceFirst: TDataSource read GetDataSource write SetDataSource;
property DataSourceLast: TDataSource read GetLastDataSource write SetLastDataSource;
property DataSources: String read FDataSourcesMiddle write SetDataSources;
property Options: TfcDBTreeViewOptions read FOptions write SetOptions default
[dtvoAutoExpandOnDSScroll,
dtvoShowButtons, dtvoShowNodeHint, dtvoShowLines, dtvoShowRoot, dtvoShowHorzScrollBar,
dtvoShowVertScrollBar];
property DisplayFields: TStrings read FDisplayFields write SetDisplayFields;
property Images: TCustomImageList read FImages write SetImages;
property Imager: TfcCustomImager read FImager write SetImager;
property StateImages: TCustomImageList read FStateImages write SetStateImages;
property MultiSelectAttributes: TfcDBMultiSelectAttributes
read FMultiSelectAttributes write FMultiSelectAttributes;
property OnCalcNodeAttributes: TfcDBTreeEvent read FOnCalcNodeAttributes
write FOnCalcNodeAttributes;
property OnCalcSectionAttributes: TfcDBTreeSectionEvent read FOnCalcSectionAttributes
write FOnCalcSectionAttributes;
property OnDrawSection: TfcDBTreeDrawSectionEvent read FOnDrawSection
write FOnDrawSection;
property OnChange: TfcDBTreeEvent read FOnChange write FOnChange;
property OnUserCollapse: TfcDBTreeEvent read FOnUserCollapse write FOnUserCollapse;
property OnUserExpand: TfcDBTreeEvent read FOnUserExpand write FOnUserExpand;
property OnDblClick: TfcDBTreeMouseEvent read FOnDblClick write FOnDblClick;
property OnMouseDown: TfcDBTreeMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseMove: TfcDBTreeMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseUp: TfcDBTreeMouseEvent read FOnMouseUp write FOnMouseUp;
property OnDrawText: TfcDBTreeDrawTextEvent read FOnDrawText write FOnDrawText;
property Header: TfcTreeHeader read FHeader write SetHeader;
property HideUpDownButtons: boolean read FHideUpDownButtons write SetHideUpDownButtons default False;
property DisableThemes : boolean read FDisableThemes write FDisableThemes default False;
end;
TfcDBTreeView = class(TfcDBCustomTreeView)
published
property DisableThemes;
property Align;
property BorderStyle;
property Color;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ParentColor default False;
property ParentFont;
property ParentShowHint;
property TabStop default True;
property TabOrder;
property Visible;
property Header;
{$ifdef fcDelphi4Up}
property Anchors;
property BiDiMode;
property Constraints;
property ParentBiDiMode;
{$endif}
property DataSourceFirst;
property DataSourceLast;
property DataSources;
property DisplayFields;
// {$ifdef fcDelphi4Up}
// property HideUpDownButtons;
// {$endif}
property Imager;
property InactiveFocusColor;
property LineColor;
property Options;
{$ifdef fcDelphi4Up}
property OnStartDock;
property OnEndDock;
{$endif}
property LevelIndent;
property Images;
property StateImages;
property MultiSelectAttributes;
property PopupMenu;
property HideUpDownButtons;
property OnCalcNodeAttributes;
property OnCalcSectionAttributes;
property OnDrawSection;
property OnChange;
property OnUserCollapse;
property OnUserExpand;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyUp;
property OnKeyPress;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnStartDrag;
property OnDrawText;
end;
implementation
{$ifdef fcdelphi6}
uses
{$ifdef ThemeManager}
variants, thememgr, themesrv, uxtheme;
{$else}
variants;
{$endif}
{$endif}
{$ifdef fcdelphi7}
uses
variants, themes;
{$endif}
const
CmpLess = -1;
CmpEql = 0;
CmpGtr = 1;
CmpKeyEql = 2;
type
CMPBkMkRslt = Integer; { To resolve CmpBkmkRslt type }
constructor TfcTreeDataLink.Create(ATree: TfcDBCustomTreeView);
begin
inherited Create;
FTree := ATree;
end;
procedure TfcTreeDataLink.RecordChanged(Field: TField);
begin
if (Field<>Nil) and (Dataset.State in [dsEdit, dsInsert]) then
begin
FTree.invalidateClient;
end;
end;
procedure TfcDBCustomTreeView.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
if (FBorderStyle = bsSingle) then
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end;
end;
end;
destructor TfcTreeDataLink.Destroy;
begin
inherited Destroy;
end;
procedure TfcTreeDataLink.DataSetChanged;
begin
FTree.DataChanged(self.dataset);
end;
procedure TfcTreeDataLink.DataSetScrolled(Distance: Integer);
begin
FTree.Scroll(self.dataset, Distance);
end;
type
TfcTreeVertScrollBar = class(TfcScrollBar)
protected
procedure Scroll(ScrollCode: integer; Position: integer); override;
end;
TfcTreeHorzScrollBar = class(TfcScrollBar)
protected
procedure Scroll(ScrollCode: integer; Position: integer); override;
end;
constructor TfcDBCustomTreeView.Create(AOwner: TComponent);
var i: Integer;
begin
inherited;
CacheSize:= 1;
FDataLinks:= TList.create;
FFirstDataLink:= TfcTreeDataLink.create(self);
FLastDataLink:= TfcTreeDataLink.create(self);
FFirstDataLink.BufferCount := CacheSize;
FLastDataLink.BufferCount := CacheSize;
Nodes:= TList.create;
OldNodes:= TList.create;
FPaintBitmap:= TBitmap.create;
FPaintCanvas:= TfcCanvas(FPaintBitmap.Canvas);
FOptions:=
[dtvoAutoExpandOnDSScroll, dtvoShowButtons, dtvoShowNodeHint,
dtvoShowLines, dtvoShowRoot, dtvoShowHorzScrollBar,
dtvoShowVertScrollBar];
FBorderStyle:= bsSingle;
for i:= 0 to 50 do StartOffsets[i]:= 0;
LevelIndent := 21;
LevelIndent:= 19; { Seems to be more consistent with TTreeView. Find out when 21
is better }
FixedOffset := 1;
RowHeight:= 16;
HintTimer:= TTimer.create(self);
FMultiSelectAttributes:= TfcDBMultiSelectAttributes.create(self);
FMultiSelectList:= TList.create;
HotTrackRow:= -1;
Width := 121;
Height := 97;
Color:= clWindow;
ParentColor:= False;
FLineColor:= clBtnShadow;
FInactiveFocusColor:= clBtnFace;
FDisplayFields:= TStringList.create;
VertScrollBar:= TfcTreeVertScrollBar.create(self);
VertScrollBar.Kind:= sbVertical;
VertScrollBar.Width:= GetSystemMetrics(SM_CXVSCROLL);
VertScrollBar.parent:= self;
HorzScrollBar:= TfcTreeHorzScrollBar.create(self);
HorzScrollBar.Kind:= sbHorizontal;
HorzScrollBar.Height:= GetSystemMetrics(SM_CXVSCROLL);
HorzScrollBar.Max:= 5;
HorzScrollBar.PageSize:= 10;
HorzScrollBar.visible:= false;
HorzScrollBar.parent:= self;
HorzScrollBar.SmallChange:= 10;
HorzScrollBar.ContinuousDrag:= True;
UpTreeButton:= CreateUpTreeButton;
DownTreeButton:= CreateDownTreeButton;
FScrollWithinLevel:= True;
FChangeLink := TfcChangeLink.Create;
FChangeLink.OnChange := ImagerChange;
TabStop:= True;
end;
destructor TfcDBCustomTreeView.Destroy;
var i: integer;
begin
FChangeLink.Free;
VertScrollBar.Free;
VertScrollBar:= nil;
for i:= 0 to Nodes.count-1 do TfcDBTreeNode(Nodes[i]).Free;
Nodes.Free;
FreeOldNodes;
OldNodes.Free;
for i:= 0 to FDataLinks.count-1 do begin
if FDataLinks[i]=FFirstDataLink then continue;
if FDataLinks[i]=FLastDataLink then continue;
TfcTreeDataLink(FDataLinks[i]).Free;
end;
UnselectAll; { 2/14/2000 }
FMultiSelectList.Free;
FMultiSelectAttributes.Free;
FFirstDataLink.Free;
FLastDataLink.Free;
FDataLinks.Free;
HintTimer.Free;
FreeFirstBookmark;
FreeLastActiveBookmark;
FDisplayFields.Free;
FPaintBitmap.Free;
FCanvas.Free;
FreeRootBookmark;
inherited Destroy;
end;
procedure TfcDBCustomTreeView.FreeRootBookmark;
begin
{$ifdef fcdelphi4up}
if RootDataSetBookmark<>Nil then FreeMem(RootDataSetBookmark);
RootDataSetBookmark:= nil;
{$else}
if RootDataSetBookmark<>Nil then StrDispose(RootDataSetBookmark);
RootDataSetBookmark:= nil;
{$endif}
end;
procedure TfcTreeDataLink.ActiveChanged;
begin
if (DataSource=FTree.DataSourceFirst) or (DataSource=FTree.DataSourceLast) then
FTree.RefreshDataLinks(FTree.DataSourceFirst, FTree.DataSourceLast);
FTree.LinkActive(Dataset, Active);
end;
function TfcDBCustomTreeView.GetDataSource: TDataSource;
begin
Result := FFirstDataLink.DataSource
end;
function TfcDBCustomTreeView.GetLastDataSource: TDataSource;
begin
Result := FLastDataLink.DataSource
end;
{type
TwwGetWordOption = (wwgwSkipLeadingBlanks, wwgwQuotesAsWords, wwgwStripQuotes,
wwgwSpacesInWords);
TwwGetWordOptions = set of TwwGetWordOption;
strCharSet = Set of char;
Function wwGetWord(s: string; var APos: integer;
Options: TwwGetWordOptions; DelimSet: strCharSet): string;
var i: integer;
Function max(x,y: integer): integer;
begin
if x>y then result:= x
else result:= y;
end;
Procedure StripQuotes;
begin
if not (wwgwStripQuotes in Options) then exit;
if (Result[1]='"') or (Result[1]='''') then
if (Result[length(Result)] = '"') or
(Result[length(Result)] = '''') then
Result:= copy(Result, 2, length(Result)-2)
else
Result:= copy(Result, 2, length(Result)-1);
end;
begin
result:= '';
if APos<=0 then exit;
if APos>length(s) then exit;
i:= APos;
if (wwgwSkipLeadingBlanks in Options) then
begin
while (i<=length(s)) and ((s[i]=' ') or (s[i]=#9)) do inc(i);
APos:= i;
end;
if (wwgwQuotesAsWords in Options) then
begin
if s[i]='"' then begin
inc(i);
while (i<=length(s)) and (s[i]<>'"') do inc(i);
if s[i]='"' then begin
result:= copy(s, APos, i+1-APos);
APos:= i+1;
end
else if (i>length(s)) then begin
result:= copy(s, APos, length(s));
APos:= length(s)+1;
end;
StripQuotes;
exit;
end
end;
if wwgwSpacesInWords in Options then
begin
while (i<=length(s)) and (s[i] in [#32..#255]) do begin
if (s[i] in DelimSet) then break
else inc(i);
end
end
else begin
while (i<=length(s)) and (s[i] in [#33..#255]) do begin
if (s[i] in DelimSet) then break
else inc(i);
end
end;
result:= copy(s, APos, max(i-APos, 1));
if length(result)>1 then APos:= i
else APos:= i+1;
end;
}
procedure TfcDBCustomTreeView.RefreshDataLinks(FirstDS, LastDS: TDataSource);
var i:integer;
FDataLink: TfcTreeDataLink;
tempDS, curDS: TDataSource;
index, tempIndex: integer;
token: string;
OldLinks: TList;
{ Retrieve TDataSource with the name of the datasource }
Function DataSourceFromToken(DataSourceName: string): TDataSource;
var Component: TComponent;
token1, token2: string;
begin
result:= nil;
if (pos('.', DataSourceName)<=0) and
(pos('->', DataSourceName)<=0) then
begin
Component:= GetParentForm(self).FindComponent(DataSourceName);
end
else begin
token1:= fcGetToken(DataSourceName, '.', 0);
token2:= fcGetToken(DataSourceName, '.', 1);
Component:= FindGlobalComponent(token1);
if Component<>nil then
Component:= Component.FindComponent(token2);
if Component=nil then { 7/25/99 - Builder notation }
begin
token1:= fcGetToken(DataSourceName, '->', 0);
token2:= fcGetToken(DataSourceName, '->', 1);
Component:= FindGlobalComponent(token1);
if Component<>nil then
Component:= Component.FindComponent(token2);
end
end;
if Component is TDataSource then
result:= TDataSource(Component);
end;
Function GetDataLink(curDS: TDataSource): TfcTreeDataLink;
var i: integer;
begin
for i:= 0 to OldLinks.count-1 do begin
if TfcTreeDataLink(OldLinks[i]).DataSource = curDS then
begin
result:= OldLinks[i];
OldLinks.Delete(i); { Remove from list so that its not destroyed later }
exit;
end
end;
result:= TfcTreeDataLink.Create(Self);
end;
begin
if csDestroying in ComponentState then exit;
OldLinks:= TList.Create;
try
for i:= 0 to FDataLinks.count-1 do begin
if (FDataLinks[i]<>FFirstDataLink) and
(FDataLinks[i]<>FLastDataLink) then
OldLinks.Add(FDataLinks[i]);
end;
if ((LastDS=nil) or (LastDS.DataSet=nil)) and (DataSources='') then
begin
{ Clearing datasource }
if FDataLinks.Count>0 then invalidate;
FDataLinks.Clear;
exit;
end;
FDataLinks.Clear;
if FFirstDataLink.DataSet<>nil then
begin
FDataLinks.Add(FFirstDataLink);
if FFirstDataLink.Active then // 2/23/01 - Make sure active so that recordcount gets set
FFirstDataLink.BufferCount := CacheSize;
index:= 1;
end
else index:= 0;
if FFirstDataLink.Dataset<>FLastDataLink.DataSet then
begin
FDataLinks.Add(FLastDataLink);
if FFirstDataLink.Active then // Make sure active so that recordcount gets set
FLastDataLink.BufferCount := CacheSize;
end;
if (DataSources='') then begin
{ 3/2/99 - Special case of only one level so don't add any more datalinks}
if FFirstDataLink.Dataset=FLastDataLink.DataSet then exit;
try
curDS:= LastDS;
repeat
tempDS:= fcGetControlMasterSource(curDS.dataset);
if tempDS=nil then
tempDS:= fcGetControlDataSource(curDS.dataset);
curDS:= tempDS;
if (curDS<>FirstDS) and (curDS<>nil) then
begin
FDataLink:= GetDataLink(curDS);
FDataLink.BufferCount := CacheSize;
FDataLink.DataSource := curDS;
FDataLinks.Insert(index, FDataLink);
end
until (curDS=FirstDS) or (curDS=nil);
finally
end
end
else begin
HaveBadLink:= False;
tempIndex:= 0;
repeat
token:= fcGetToken(DataSources, ';', tempIndex);
curDS:= DataSourceFromToken(token);
if (curDS=nil) and
((pos('.', token)>0) or (pos('->', token)>0)) then { 7/25/99 - Suppport Builder notation }
HaveBadLink:= True;
if (curDS<>nil) and (curDS<>FirstDS) and (curDS<>LastDS) then
begin
FDataLink:= TfcTreeDataLink.Create(Self);
FDataLink.BufferCount := CacheSize;
FDataLink.DataSource := curDS;
FDataLinks.Insert(index, FDataLink);
inc(index);
end;
inc(tempIndex);
until token = '';
end;
finally
for i:= 0 to OldLinks.Count-1 do TfcTreeDataLink(OldLinks[i]).Free;
OldLinks.Free;
end
end;
procedure TfcDBCustomTreeView.SetDataSource(Value: TDataSource);
begin
FreeLastActiveBookmark; // Free LastActiveBookmark when datasource changes
FFirstDataLink.Datasource:= Value;
RefreshDataLinks(Value, FLastDataLink.DataSource);
{ Initialize other data links }
if (Value<>nil) and (Value.DataSet<>nil) then
LinkActive(Value.DataSet, Value.Dataset.Active);
end;
procedure TfcDBCustomTreeView.SetDataSources(Value: String);
begin
if Value<>FDataSourcesMiddle then
begin
FreeLastActiveBookmark; // Free LastActiveBookmark when datasource changes
FDataSourcesMiddle:= Value;
RefreshDataLinks(FFirstDataLink.DataSource, FLastDataLink.DataSource);
if not HaveValidDataLinks then invalidate;
end
end;
procedure TfcDBCustomTreeView.SetLastDataSource(Value: TDataSource);
begin
FreeLastActiveBookmark; // Free LastActiveBookmark when datasource changes
FLastDataLink.Datasource:= Value;
RefreshDataLinks(FFirstDataLink.DataSource, Value);
{ Initialize other data links }
if (Value<>nil) and (Value.DataSet<>nil) then
LinkActive(Value.DataSet, Value.Dataset.Active);
end;
procedure TfcDBCustomTreeView.LinkActive(DataSet: TDataSet; Value: Boolean);
begin
SaveIfFirstRecordBookmark(DataSet);
if (FDataLinks.count>0) and (Dataset = TfcTreeDataLink(FDataLinks[0]).DataSet) then begin
FreeRootBookmark;
IsRootDataSetMoved;
end;
LayoutChanged;
UpdateScrollBar;
end;
{ Return true if master node has changed }
{ This code is not implemented yet }
Function TfcDBCustomTreeView.InMasterChanging(DataSet: TDataSet): boolean;
begin
if DataSet = DatasourceFirst.dataset then result:= False
else result:= True;
end;
Function TfcDBCustomTreeView.IsRootDataSetMoved: boolean;
var TempRootDataSetBookmark: TBookmark;
res: CmpBkmkRslt;
RootDataSet: TDataSet;
begin
result:= False;
if FDataLinks.count<=0 then exit;
RootDataSet:= TfcTreeDataLink(FDataLinks[0]).DataSet;
if (RootDataSet=nil) then exit;
if RootDataSet.state <> dsBrowse then exit;
TempRootDataSetBookmark:= RootDataSet.GetBookmark;
if TempRootDataSetBookmark=nil then exit;
if RootDataSetBookmark=nil then begin
RootDataSetBookmark:= TempRootDataSetBookmark;
exit;
end;
res:= RootDataSet.CompareBookmarks(RootDataSetBookmark, TempRootDataSetBookmark);
if (res=CMPKeyEql) or (res=CMPEql) then begin
RootDataSet.FreeBookmark(TempRootDataSetBookmark);
exit;
end;
result:= True;
FreeRootBookmark;
RootDataSetBookmark:= TempRootDataSetBookmark;
end;
procedure TfcDBCustomTreeView.DataChanged(DataSet: TDataSet);
var ChildDataLink: TfcTreeDataLink;
begin
if FDataLinks.Count=0 then exit;
if Dataset = TfcTreeDataLink(FDataLinks[0]).DataSet then begin
SaveIfFirstRecordBookmark(DataSet);
if IsRootDataSetMoved then
ActiveDataSet:= DataSet;
UpdateScrollBar;
end
else if FScrollWithinLevel then UpdateScrollBar;
if dataset.state = dsBrowse then
begin
ChildDataLink:= GetChildDataLink(Dataset);
if ChildDataLink<>nil then ResetStartOffsets(ChildDataLink.DataSet);
end;
// ResetStartOffsets(DataSet); { 12/23/98 }
CheckMaxWidthGrow:= True;
invalidateClient;
end;
Function TfcDBCustomTreeView.GetDataLinkIndex(Dataset: TDataset): integer;
var i:integer;
begin
result:= -1;
if DataSet =nil then exit;
for i:= 0 to FDataLinks.count-1 do begin
if TfcTreeDataLink(FDataLinks[i]).dataset = DataSet then
begin
result:= i;
break;
end
end;
end;
Function TfcDBCustomTreeView.GetDataLink(Dataset: TDataset): TfcTreeDataLink;
var i:integer;
begin
result:= nil;
if DataSet =nil then exit;
for i:= 0 to FDataLinks.count-1 do begin
if TfcTreeDataLink(FDataLinks[i]).dataset = DataSet then
result:= TfcTreeDataLink(FDataLinks[i]);
end;
end;
Function TfcDBCustomTreeView.GetParentDataLink(Dataset: TDataset): TfcTreeDataLink;
var i:integer;
begin
result:= nil;
for i:= 0 to FDataLinks.count-1 do begin
if TfcTreeDataLink(FDataLinks[i]).dataset = DataSet then
begin
if i>0 then
result:= TfcTreeDataLink(FDataLinks[i-1]);
break;
end
end;
end;
Function TfcDBCustomTreeView.GetChildDataLink(Dataset: TDataset): TfcTreeDataLink;
var i:integer;
begin
result:= nil;
for i:= 0 to FDataLinks.count-1 do begin
if TfcTreeDataLink(FDataLinks[i]).dataset = DataSet then
begin
if (i+1)<=FDataLinks.count-1 then
result:= TfcTreeDataLink(FDataLinks[i+1]);
break;
end
end;
end;
procedure TfcDBCustomTreeView.Scroll(DataSet: TDataSet; Distance: Integer);
var DataLink: TfcTreeDataLink;
begin
if not HandleAllocated then Exit;
if FDataLinks.Count>0 then begin
if Dataset = TfcTreeDataLink(FDataLinks[0]).DataSet then begin
IsRootDataSetMoved;
UpdateScrollBar;
end
else if FScrollWithinLevel then UpdateScrollBar;
end;
if IsChildDataSetOfActive(DataSet) then
begin
if (dtvoAutoExpandOnDSScroll in Options) then
LastVisibleDataSet:= dataset;
end
else LastVisibleDataSet:= dataset;
if ActiveDataSet<>DataSet then
begin
if (dtvoAutoExpandOnDSScroll in Options) then
ActiveDataSet:= DataSet;
DataLink:= GetChildDataLink(ActiveDataSet);
if DataLink<>nil then begin
ResetStartOffsets(DataLink.DataSet);
end;
end
else begin
DataLink:= GetChildDataLink(ActiveDataSet);
if DataLink<>nil then ResetStartOffsets(DataLink.DataSet);
end;
SaveIfFirstRecordBookmark(DataSet);
CheckMaxWidthGrow:= True;
InvalidateClient;
end;
Procedure TfcDBCustomTreeView.SaveIfFirstRecordBookmark(DataSet: TDataSet);
begin
if DataSet=nil then exit;
if FDataLinks.Count>0 then
begin
if Dataset <> TfcTreeDataLink(FDataLinks[0]).DataSet then exit;
if (DataSet.state = dsBrowse) and (DataSet.Bof) and (TfcTreeDataLink(FDataLinks[0]).DataSet = DataSet) then
begin
FreeFirstBookmark;
FirstBookmark:= dataset.GetBookmark;
end
end;
if DataSet.state in [dsEdit, dsInsert] then FreeFirstBookmark;
end;
Procedure TfcDBCustomTreeView.FreeFirstBookmark;
begin
{$ifdef fcdelphi4up}
if FirstBookmark<>Nil then FreeMem(FirstBookmark);
FirstBookmark:= nil;
{$else}
if FirstBookmark<>Nil then StrDispose(FirstBookmark);
FirstBookmark:= nil;
{$endif}
end;
Procedure TfcDBCustomTreeView.FreeLastActiveBookmark;
begin
{$ifdef fcdelphi4up}
if LastActiveBookmark<>Nil then FreeMem(LastActiveBookmark);
LastActiveBookmark:= nil;
{$else}
if LastActiveBookmark<>Nil then StrDispose(LastActiveBookmark);
LastActiveBookmark:= nil;
{$endif}
end;
procedure TfcDBCustomTreeView.DoCalcNodeAttributes(Node: TfcDBTreeNode);
begin
if Assigned(FOnCalcNodeAttributes) then
FOnCalcNodeAttributes(Self, Node);
end;
procedure TfcDBCustomTreeView.DoCalcSectionAttributes(Node: TfcDBTreeNode;
Section: TfcTreeHeaderSection; var DisplayText: string);
begin
if Assigned(FOnCalcSectionAttributes) then
FOnCalcSectionAttributes(Self, Node, Section, DisplayText);
end;
procedure TfcDBCustomTreeView.DoDrawSection(Node: TfcDBTreeNode;
Section: TfcTreeHeaderSection;
ARect: TRect;
s: string;
var DoDefault: boolean);
begin
if Assigned(FOnDrawSection) then
FOnDrawSection(Self, Node, Section, ARect, S, DoDefault);
end;
Function fcGetWord(s: string; var APos: integer; var IsFieldName: boolean): string;
var i: integer;
Function max(x,y: integer): integer;
begin
if x>y then result:= x
else result:= y;
end;
begin
result:= '';
IsFieldName:= False;
if APos<=0 then exit;
if APos>length(s) then exit;
i:= APos;
if s[i]='"' then begin
inc(i);
while (i<=length(s)) and (s[i]<>'"') do inc(i);
if s[i]='"' then begin
result:= copy(s, APos+1, i-APos-1);
IsFieldName:= True;
APos:= i+1;
end
end
else begin
while (i<=length(s)) and (not (s[i] in ['"'])) do inc(i);
result:= copy(s, APos, max(i-APos, 1));
APos:= i;
end;
end;
Function TfcDBCustomTreeView.GetNodeText(
DisplayFieldLine: string;
DataSet: TDataSet;
var Field: TField): string;
var line, word: string;
APos: integer;
isFieldName: boolean;
curField: TField;
i: integer;
tempStr: string;
begin
line:= '';
APos:= 1;
if Header<>nil then with Header do begin
for i:= 0 to Sections.count-1 do begin
curField:= DataSet.FindField(Sections[i].FieldName);
// Sections[i].Field:= curField;
if curField<>nil then begin
if curField.datatype=ftMemo then
tempStr:= curField.asString
else
tempStr:= curField.DisplayText;
tempStr:= fcStrRemoveChar(tempStr, #9);
end
else tempStr:= '';
if Field=nil then Field:= curField;
if i>0 then line:= line + #9 + tempstr
else line:= tempstr;
end;
result:= line;
exit;
end;
Field:= nil;
repeat
word:= fcGetWord(DisplayFieldLine, APos, isFieldName);
if (word<>'') then begin
if IsFieldName then
begin
curField:= dataset.findfield(word);
if curField<>nil then
begin
if curField.datatype=ftMemo then
line:= line + curField.asString
else
line:= line + curField.DisplayText;
if Field=nil then Field:= curField;
end
else
line:= line + '<Field not found ' + word + '>'
end
else begin
if pos('"', DisplayFieldLine)>0 then
line:= line + word
else begin
curField:= dataset.findfield(word);
if curField=nil then
line:= line + ' <Field not found ' + word + '> '
else begin
if curField.datatype=ftMemo then
line:= line + dataset.fieldbyname(word).asString
else line:= line + dataset.fieldbyname(word).DisplayText;
if Field=nil then Field:= curField;
end
end
end
end
until (word='');
result:= line;
end;
procedure TfcDBCustomTreeView.WMPaint(var Message: TWMPaint);
var
Node: TfcDBTreeNode;
NextDataLink: TfcTreeDataLink;
// Flags: integer;
FocusRect, R: TRect;
i: Integer;
ActiveNode: boolean;
PrevActiveRecord: integer;
sp: TPoint;
NewMaxTextWidth : integer;
UpdateRect: TRect;
FActiveBookmark: TBookmark;
res: CmpBkmkRslt;
NewNode: boolean;
DefaultDrawing: boolean;
MousePos: TPoint;
OrigCheckMaxWidth: boolean;
ParentForm:TCustomForm;
procedure ScanDataLink(ParentNode: TfcDBTreeNode; DataLinkIndex: integer);
var DataLink: TfcTreeDataLink;
RecIndex: integer;
PrevActiveRecord: integer;
curBookmark: TBookmark;
res: CmpBkmkRslt;
begin
if DataLinkIndex>=FDataLinks.count then exit;
DataLink:= TfcTreeDataLink(FDataLinks[DataLinkIndex]);
PrevActiveRecord:= DataLink.ActiveRecord;
for RecIndex:= 0 to DataLink.RecordCount-1 do
begin
DataLink.ActiveRecord:= RecIndex;
Node:= TfcDBTreeNode.create;
if DataLinkIndex<=DisplayFields.count-1 then
Node.Text:= GetNodeText(DisplayFields[DataLinkIndex], DataLink.DataSet, Node.Field)
else
Node.Text:= GetNodeText(DataLink.DataSet.Fields[0].FieldName, DataLink.DataSet, Node.Field);
Node.Level:= DataLinkIndex;
Node.DataLink:= DataLink;
Node.DataSet:= DataLink.DataSet;
Node.ActiveRecord:= RecIndex;
Node.Expanded:= False;
Node.HasChildren:= (DataLinkIndex < FDataLinks.count-1);
Node.Parent:= ParentNode;
Node.Selected:= False;
Node.ImageIndex:= 0;
Node.StateIndex:= -1;
Node.HasPrevSibling:= (not DataLink.DataSet.Bof) or (DataLink.ActiveRecord>0);
if Node.HasPrevSibling and (DataLinkIndex=0) then
begin
curBookmark:= DataLink.dataset.GetBookmark;
try { 2/8/99 - Move try block before test for firstbookmark to fix potential leak }
if (curBookmark<>nil) and (FirstBookmark<>nil) then
begin
res:= DataLink.DataSet.CompareBookmarks(FirstBookmark, curBookmark);
if (res=CMPKeyEql) or (res=CMPEql) then
begin
if DataLink.ActiveRecord=0 then
Node.HasPrevSibling:= False
else
FreeFirstBookmark; { First Record inserted by another application }
end;
end
finally
DataLink.dataset.FreeBookmark(curBookmark);
end;
end;
if (not Node.HasPrevSibling) and (dsInsert = DataLink.DataSet.state) then
Node.HasPrevSibling:= True;
Node.HasNextSibling:=
not ((RecIndex = DataLink.RecordCount-1) and
((DataLink.RecordCount < DataLink.BufferCount) or DataLink.DataSet.eof));
if (not Node.HasNextSibling) and (dsInsert = DataLink.DataSet.state) then
Node.HasNextSibling:= True;
Nodes.Add(Node);
if (PrevActiveRecord=RecIndex) then
begin
if (DataLink.DataSet=ActiveDataSet) then
begin
ActiveNodeIndex:= Nodes.count-1;
Node.Selected:= True;
end;
if (DataLink.DataSet=LastVisibleDataSet) or
(LastVisibleDataSet=nil) and not (csDesigning in ComponentState) then
begin
NextDataLink:= GetChildDataLink(DataLink.DataSet);
if (NextDataLink<>nil) and
NextDataLink.DataSet.eof and NextDataLink.DataSet.bof then
begin
Node.HasChildren:= False;
end;
end
else begin
Node.Expanded:= True;
ScanDataLink(Node, DataLinkIndex + 1);
end
end
end;
DataLink.ActiveRecord:= PrevActiveRecord;
end;
{ Fill with background color }
Procedure BeginPainting;
var PaintRect: TRect;
begin
InPaint:= True;
if VertScrollBar.visible then
FPaintBitmap.Width := fcMax(0, Width + HorzScrollBar.position - VertScrollBar.Width)
else
FPaintBitmap.Width := Width + HorzScrollBar.position;
// otherwise horz Scrollbar getting painted over by data when themes enabled
if HorzScrollBar.visible and fcUseThemes(self) then
FPaintBitmap.Height := HorzScrollBar.Top-1
else
FPaintBitmap.Height := Height;
FPaintCanvas.Brush.Color := Color;
if (FImager <> nil){ and (FImager.visible) }then
begin
if FImager.WorkBitmap.Empty then FImager.UpdateWorkBitmap;
if FImager.DrawStyle=dsTile then
begin
PaintRect:= Rect(0,0,FPaintBitmap.Width, FPaintBitmap.Height);
FImager.WorkBitmap.TileDraw(Canvas, PaintRect);
end
else begin
PaintRect:= Rect(horzscrollbar.position + 0, 0, horzscrollbar.position + ClientRect.Right, ClientRect.Bottom);
Canvas.StretchDraw(PaintRect, FImager.WorkBitmap);
end
end
else
FPaintCanvas.FillRect(Rect(0, 0, FPaintBitmap.Width, FPaintBitmap.Height));
end;
procedure EndPainting;
var r, sourceRect: TRect;
scrollpos: integer;
PaintClipRect: TRect;
MyPrintCanvas: TCanvas;
begin
r := ClientRect;
OffsetRect(r, 1, 0);
// 11/17/99 - Support form.print
if (csPaintCopy in ControlState) and (Message.DC<>0) then
begin
MyPrintCanvas:= TCanvas.Create;
MyPrintCanvas.Handle:= Message.DC;
end
else MyPrintCanvas:= FCanvas;
MyPrintCanvas.CopyMode:= cmSrcCopy;
scrollpos:= HorzScrollBar.position;
PaintClipRect:= FPaintCanvas.ClipRect;
if PaintClipRect.Right>ClientRect.Right then
begin
PaintClipRect.Right:= ClientRect.Right;
end;
if UpdateRect.Bottom>ClientRect.Bottom then
begin
UpdateRect.Bottom:= ClientRect.Bottom;
end;
if (UpdateRect.Top=0) and (UpdateRect.Bottom=0) and
(UpdateRect.Left=0) and (UpdateRect.Right=0) then
UpdateRect:= PaintClipRect;
SourceRect:= Rect(Scrollpos, UpdateRect.Top,
ScrollPos+PaintClipRect.Right, UpdateRect.Bottom );
MyPrintCanvas.CopyRect(
Rect(0,UpdateRect.Top, PaintClipRect.Right, UpdateRect.Bottom),
FPaintCanvas, SourceRect);
if (csPaintCopy in ControlState) and (Message.DC<>0) then
begin
MyPrintCanvas.Handle:= 0;
MyPrintCanvas.Free;
end;
InPaint:= False;
end;
begin
GetUpdateRect(Handle, UpdateRect, False);
SkipErase:= True;
inherited;
SkipErase:= False;
if FCanvas = nil then
begin
FCanvas := TControlCanvas.Create;
FCanvas.Control := Self;
end;
if (HaveBadLink) then begin { Fix data module problem }
BeginPainting;
EndPainting;
RefreshDataLinks(nil, nil);
HaveBadLink:= False; { Just do first for first paint so clear flag }
exit;
end;
if not HaveValidDataLinks then begin
BeginPainting;
EndPainting;
exit;
end;
if (Images<>nil) and (StateImages<>nil) then
begin
FixedOffset := 2;
end
else begin
FixedOffset := 2;
end;
BeginPainting;
r:= Rect(0,0,0,0);
try
if FDataLinks.count<=0 then begin
RefreshDataLinks(DataSourceFirst, DataSourceLast);
if FDataLinks.count<=0 then begin
exit;
end;
end;
if (ActiveDataSet=nil) then
ActiveDataSet:= TfcTreeDataLink(FDataLinks[0]).DataSet;
if (ActiveDataSet=nil) or (not ActiveDataSet.Active) then exit;
if dtvoHotTracking in Options then
begin
GetCursorPos(MousePos);
sp:= ScreenToClient(MousePos);
if (sp.x>0) and (sp.x<Width) and (sp.y>0) and (sp.y<height) then
MouseToRow(sp.x, sp.y, HotTrackRow)
else HotTrackRow:= -1;
end;
//11/17/99 - Don't HotTrack if this form is not active.
ParentForm := GetParentForm(self);
if (ParentForm<>nil) and (ParentForm.handle<>GetActiveWindow) then
HotTrackRow:= -1;
if not SkipReload then
begin
NodesCleared:= True;
for i:= 0 to Nodes.count-1 do begin
if SkipFreeNodes then OldNodes.Add(Nodes[i])
else TfcDBTreeNode(Nodes[i]).Free;
end;
Nodes.Clear;
ActiveNodeIndex:= TfcTreeDataLink(FDataLinks[0]).ActiveRecord;;
ScanDataLink(nil, 0);
// if ActiveNodeIndex-GetStartOffset(ActiveDataSet)>=CacheSize then
// SetStartOffset(ActiveDataSet, fcmax(ActiveNodeIndex+1-CacheSize, 0));
end;
if ActiveNodeIndex-GetStartOffset>=CacheSize then
SetStartOffset(ActiveDataSet, fcmax(ActiveNodeIndex+1-CacheSize, 0));
if (ActiveNodeIndex>=0) and (ActiveNodeIndex<=Nodes.Count-1) then
begin
FActiveNode:= TfcDBTreeNode(Nodes[ActiveNodeIndex]);
end
else FActiveNode:= nil;
NewMaxTextWidth:= 0;
for i:= 0 to Nodes.Count-1 do begin
if HorzScrollBar.Visible then
begin
if (i>=CacheSize+1) then break;
end
else if i>=CacheSize then break;
if (i+GetStartOffset>=Nodes.count) then break;
PaintingRow:= i;
Node:= TfcDBTreeNode(Nodes[i+GetStartOffset]);
FPaintCanvas.Font.Assign(Font); { Restore original font }
FPaintCanvas.Pen.Color := FLineColor; //clBtnShadow; { for line drawing }
PrevActiveRecord:= Node.DataLink.ActiveRecord;
try
Node.DataLink.ActiveRecord:= Node.ActiveRecord;
Node.MultiSelected:= FindCurrentMultiSelectIndex(Node.DataLink.DataSet)>=0;
ActiveNode:= ActiveNodeIndex=i+GetStartOffset;
if ActiveNode and not FMultiSelectAttributes.enabled then
begin
if Focused then begin
FPaintCanvas.Brush.Color:= clHighlight;
FPaintCanvas.Font.Color := clHighlightText;
end
else begin
if not (dtvoHideSelection in Options) then
begin
if InactiveFocusColor<>Color then
FPaintCanvas.Brush.Color:= InactiveFocusColor
else
FPaintCanvas.Brush.Color:= clGray;
end
else begin
FPaintCanvas.Brush.Color := Color;
end;
FPaintCanvas.Font.Color:= Font.Color;
end
end
else if FMultiSelectAttributes.enabled then
begin
if Node.MultiSelected then begin
if Focused then begin
FPaintCanvas.Brush.Color:= clHighlight;
FPaintCanvas.Font.Color := clHighlightText;
end
else begin
FPaintCanvas.Brush.Color:= InactiveFocusColor;
FPaintCanvas.Font.Color:= Font.Color;
end
end
else begin
if (Imager<>nil) and ActiveNode then
FPaintCanvas.Brush.Color := clNone
else
FPaintCanvas.Brush.Color := Color;
FPaintCanvas.Font.Color := Font.Color;
end
end
else begin
FPaintCanvas.Brush.Color := Color;
FPaintCanvas.Font.Color := Font.Color;
end;
{ 4/5/99 - Set Node.Hot property }
if dtvoHotTracking in Options then
begin
R:= TextRect(Node, i);
Node.Hot:= (PaintingRow = HotTrackRow) and (sp.x>r.left) and (sp.x<r.right);
end;
DoCalcNodeAttributes(Node);
NewMaxTextWidth:=
fcMax(Canvas.TextWidth(Node.Text) + TextRect(Node, i).Left, NewMaxTextWidth);
FocusRect:= TextRect(Node, i);
if not odd(fcRectHeight(r) div 2) and (FocusRect.Top>0) then
begin
FocusRect.top:= FocusRect.Top - 1;
end
else FocusRect.Bottom:= FocusRect.Bottom + 1;
FocusRect.Left:= FocusRect.Left - 1;
if FPaintCanvas.Brush.Color <> clNone then
begin
if dtvoRowSelect in Options then
begin
if BorderStyle=bsNone then { 5/25/99 }
FocusRect.Right:= FPaintBitmap.Width
else
FocusRect.Right:= FPaintBitmap.Width-4;
if Images <> nil then dec(FocusRect.Left, TImageList(Images).Width);
if UseStateImages(node) then dec(FocusRect.Left, GetStateImageWidth);
if (Images<>nil) and UseStateImages(node) then dec(FocusRect.Left, 1);
if (Images<>nil) or UseStateImages(node) then dec(FocusRect.Left, 2);
end;
if (Node.Selected or
(Node.MultiSelected and FMultiSelectAttributes.enabled)) then
FPaintCanvas.FillRect(FocusRect);
end;
PaintLines(node);
PaintImage(node);
R:= TextRect(Node, i);
SetBkMode(FPaintCanvas.Handle, TRANSPARENT);
try
DefaultDrawing:= True;
if dtvoHotTracking in Options then
begin
R:= TextRect(Node, i);
if Node.Hot then begin
if not node.selected then FPaintCanvas.Font.Color:= clBlue;
FPaintCanvas.Font.Style:= [fsUnderline];
if (fsBold in Font.Style) then
FPaintCanvas.Font.Style:= FPaintCanvas.Font.Style + [fsbold];
end
else if (PaintingRow = HotTrackRow) then
HotTrackRow:= -1;
end;
if odd(fcRectHeight(r) div 2) then R.Top:= R.Top + 1;
R.Left:= R.Left + 1;
DoDrawText(self, Node, r, DefaultDrawing);
if DefaultDrawing then begin
if Assigned(Header) then
begin
r.Left:= r.Left - 2; // Adjust for 1st column
DrawColumnText(Node, r)
end
else begin
FPaintCanvas.DrawText(Node.Text, R, DT_END_ELLIPSIS OR DT_NOPREFIX);
R.Left:= R.Left - 1;
if odd(fcRectHeight(r) div 2) then R.Top:= R.Top - 1;
if ActiveNode and Focused then begin
if (not (dtvoRowSelect in Options)) then
begin
FPaintCanvas.Brush.Color := clBlack;
if FMultiSelectAttributes.enabled and (Imager=nil) then
begin
SetBkColor(FPaintCanvas.Handle, ColorToRGB(Color));
SetTextColor(FPaintCanvas.Handle, ColorToRGB(Font.Color));
end
else begin
SetBkColor(FPaintCanvas.Handle, ColorToRGB(clHighlight));
SetTextColor(FPaintCanvas.Handle, ColorToRGB(clHighlightText));
end;
FPaintCanvas.DrawFocusRect(FocusRect);
end
else begin
if FMultiSelectAttributes.enabled then
begin
FPaintCanvas.DrawFocusRect(FocusRect);
end;
end;
end
end
end
finally
SetBkMode(FPaintCanvas.Handle, OPAQUE);
end;
finally
Node.DataLink.ActiveRecord:= PrevActiveRecord;
end;
end;
// 9/5/01 - Scrolling width should total columns in header
if Header<>nil then
begin
NewMaxTextWidth:= ComputeHeaderWidth;
end;
UpTreeButton.enabled:= (FFirstDataLink<>nil) and (ActiveDataSet<>FFirstDataLink.DataSet);
DownTreeButton.enabled:= (FLastDataLink<>nil) and (ActiveDataSet<>FLastDataLink.DataSet) and
(FActiveNode<>nil) and FActiveNode.hasChildren;
OrigCheckMaxWidth:= CheckMaxWidth;
if (((MaxTextWidth<>NewMaxTextWidth) and (CheckMaxWidth or CheckMaxWidthGrow))
or ResetScroll) and
(dtvoShowHorzScrollBar in Options) then
begin
CheckMaxWidth:= False;
CheckMaxWidthGrow:= False;
if (MaxTextWidth<NewMaxTextWidth) or
((HorzScrollBar.position=0) and OrigCheckMaxWidth) then
begin
MaxTextWidth:= NewMaxTextWidth;
ResetScroll:= False;
with HorzScrollBar do begin
Min:= 0;
Max:= NewMaxTextWidth+3;
InComputeHorzWidthOnly := True;
PageSize:= self.ClientRect.Right - self.ClientRect.Left;
InComputeHorzWidthOnly := False;
GetClientRect; // Updates scrollbars if necessary after PageSize is set
ScrollSize:= Max;
// if PageSize>Max then
// LayoutChanged;
HorzScrollBar.Invalidate;
end
end;
end
else begin
CheckMaxWidth:= False;
CheckMaxWidthGrow:= False;
end;
if FActiveNode<>nil then with FActiveNode.DataLink.DataSet do
begin
FActiveBookmark:= GetBookmark;
if ActiveDataSetChanged then
begin
FreeLastActiveBookmark;
LastActiveBookmark:= FActiveBookmark;
try { 4/25/99 - Catch exception }
Change(FActiveNode);
except
ActiveDataSetChanged:= False;
raise;
end;
ActiveDataSetChanged:= False;
exit;
end;
if (FActiveBookmark<>nil) then
begin
if LastActiveBookmark<>nil then
begin
res:= CompareBookmarks(LastActiveBookmark, FActiveBookmark);
NewNode:= (res<>CMPKeyEql) and (res<>CMPEql);
end
else NewNode:= True;
if NewNode then
begin
FreeLastActiveBookmark;
LastActiveBookmark:= FActiveBookmark;
Change(FActiveNode);
ActiveDataSetChanged:= False;
end
else FreeBookmark(FActiveBookmark);
end
end;
finally
EndPainting;
if HotTrackRow>=0 then
begin
SaveCursor:= Screen.Cursor;
Cursor:= crHandPoint;
end
else if Screen.Cursor<>crArrow then
Cursor:= SaveCursor;
end;
end;
procedure TfcDBCustomTreeView.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
if True or SkipErase then begin { 4/31/99 - Always Remove erase to prevent flicker when resizing }
Message.result:= 1;
exit;
end
else inherited;
end;
Procedure TfcDBCustomTreeView.MouseToRow(X, Y: integer; var Row: integer);
begin
row:= -1;
if y<0 then exit;
if y>Height then exit;
row:= y div RowHeight;
end;
function TfcDBCustomTreeView.RowToNode(Row: integer; var Node: TfcDBTreeNode): boolean;
begin
result:= false;
Node:= nil;
if row<0 then exit;
if row> cacheSize-1 then exit;
if GetStartOffset+Row<=Nodes.count-1 then
begin
Node:= Nodes[GetStartOffset + Row];
result:= true;
end
else result:= false;
end;
{function TfcDBCustomTreeView.NodeToIndex(Node: TfcDBTreeNode): integer;
var i: Integer;
begin
result:= -1;
for i:= 0 to Nodes.count-1 do begin
if nodes[i]=node then begin
result:= i;
break;
end
end
end;
}
function TfcDBCustomTreeView.NodeToRow(Node: TfcDBTreeNode; var Row: integer): boolean;
var i: integer;
begin
result:= false;
row:= -1;
for i:= 0 to Nodes.count-1 do begin
if nodes[i]=node then
begin
Row:= i - GetStartOffset;
if Row>=0 then result:= True;
break;
end
end;
end;
procedure TfcDBCustomTreeView.Collapse(Node: TfcDBTreeNode);
var DataLink: TfcTreeDataLink;
begin
if Node=nil then exit;
try
SkipFreeNodes:= True;
DoUserCollapse(Node);
DataLink:= TfcTreeDataLink(FDataLinks[Node.Level]);
ActiveDataSet:= DataLink.DataSet;
if LastVisibleDataSet<>ActiveDataSet then
begin
LastVisibleDataSet := ActiveDataSet;
CheckMaxWidth:= True;
end;
InvalidateClient;
finally
FreeOldNodes;
SkipFreeNodes:= False;
end;
end;
procedure TfcDBCustomTreeView.FreeOldNodes;
var i: integer;
begin
for i:= 0 to OldNodes.count-1 do TfcDBTreeNode(OldNodes[i]).Free;
OldNodes.Clear;
end;
procedure TfcDBCustomTreeView.Expand(Node: TfcDBTreeNode);
var DataLink: TfcTreeDataLink;
begin
if Node=nil then exit;
if ActiveNode<>Node then MoveTo(Node); { 3/9/99 }
try
SkipFreeNodes:= True;
if (Header<>nil) and (displayfields.count<=1) then
begin
displayfields.clear;
displayfields.add('');
displayfields.add('');
end;
DoUserExpand(Node); { !!!Node could be invalid after executing user event }
DataLink:= TfcTreeDataLink(FDataLinks[Node.Level]);
DataLink:= GetChildDataLink(DataLink.DataSet);
if (DataLink<>nil) and (DataLink.RecordCount>0) then begin
ActiveDataSet:= DataLink.DataSet;
if not IsChildDataSetofActive(LastVisibleDataSet) then
LastVisibleDataSet:= ActiveDataSet;
CheckMaxWidth:= True;
invalidateClient;
end;
finally
FreeOldNodes;
SkipFreeNodes:= False;
end;
end;
Procedure TfcDBCustomTreeView.MoveTo(Node: TfcDBTreeNode);
begin
UpdateDataLinkToActive(Node);
end;
function TfcDBCustomTreeView.UpdateDataLinkToActive(Node: TfcDBTreeNode): boolean;
var TempDataLink, DataLink: TfcTreeDataLink;
begin
result:= False;
if (Node=nil) or (Node.DataLink=nil) then exit;
DataLink:= Node.DataLink;
if not Node.DataLink.Active then exit; { 4/9/99 }
if DataLink.ActiveRecord<>Node.ActiveRecord then
begin
Datalink.Dataset.MoveBy(Node.ActiveRecord - DataLink.ActiveRecord);
if ActiveDataSet<>DataLink.DataSet then
begin
ActiveDataSet:= DataLink.DataSet;
TempDataLink:= GetChildDataLink(ActiveDataSet);
if TempDataLink<>nil then ResetStartOffsets(TempDataLink.DataSet);
end
else begin
TempDataLink:= GetChildDataLink(ActiveDataSet);
if TempDataLink<>nil then ResetStartOffsets(TempDataLink.DataSet);
end;
invalidateClient;
result:= True;
end
else begin { Same master record }
DataLink:= GetDataLink(DataLink.DataSet);
if (DataLink<>nil) and (ActiveDataSet<>DataLink.DataSet) then begin
ActiveDataSet:= DataLink.DataSet;
invalidateClient;
result:= True;
end
end;
end;
procedure TfcDBCustomTreeView.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var row: integer;
node: TfcDBTreeNode;
begin
inherited;
if not HaveValidDataLinks then exit;
MouseToRow(X, Y, Row);
RowToNode(Row, Node);
if Assigned(FOnMouseUp) then FOnMouseUp(self, Node, Button, Shift, X, Y);
end;
procedure TfcDBCustomTreeView.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var Node: TfcDBTreeNode;
Row: integer;
DataLink: TfcTreeDataLink;
HitTest: TfcTreeHitTests;
ValidNode: Boolean;
NodeLevelRect: TRect;
{ Function SameLevelShiftSelect: boolean;
begin
ShowMessage('not implemented yet');
result:= True;
end;
}
begin
inherited;
if not HaveValidDataLinks then exit;
SetFocus;
MouseToRow(X, Y, Row);
ValidNode:= RowToNode(Row, Node);
NodesCleared:= False; { If nodes are cleared in Paint then node is invalid }
DataLink:= nil;
if ValidNode then DataLink:= TfcTreeDataLink(FDataLinks[Node.Level]);
if Assigned(FOnMouseDown) then FOnMouseDown(self, Node, Button, Shift, X, Y);
if (ssDouble in Shift) and Assigned(FOnDblClick) then FOnDblClick(self, Node, Button, Shift, X, Y);
if not ValidNode then exit;
hitTest:= GetHitTestInfoAt(X,Y);
if hitTest=[] then exit;
NodeLevelRect:= LevelRect(Node);
if (fchtdOnButton in hitTest) and (ssLeft in Shift) then
begin
if dtvoExpandButtons3D in Options then
begin
MouseRow:= Row;
MouseLoop(X,Y);
MouseRow:= -1;
exit;
end
end;
if (not NodesCleared) and (not (ssDouble in Shift)) then
UpdateDataLinkToActive(Node);
if (fchtdOnButton in hitTest) and (ssLeft in Shift) and (not NodesCleared) then
begin
if node.expanded then Collapse(Node)
else Expand(Node);
exit;
end;
if (not NodesCleared) and (fchtdOnStateIcon in hitTest) and
MultiSelectCheckBoxNeeded(Node) then
begin
if IsSelectedRecord then UnselectRecord
else SelectRecord;
end
else if ([fchtdOnStateIcon, fchtdOnImageIcon, fchtdOnText] * hitTest <> []) and
(ssDouble in Shift) and (not NodesCleared) then
begin
DataLink:= GetChildDataLink(DataLink.DataSet);
if (DataLink<>nil) and (DataLink.RecordCount>0) then begin
if node.expanded then Collapse(Node)
else Expand(Node);
end;
invalidateClient;
end;
if FMultiSelectAttributes.Enabled and
(((dtvoRowSelect in Options) and (X >= NodeLevelRect.Left)) or // -ksw (Added to make behavior more
(not (dtvoRowSelect in Options) and (hitTest * [fchtdOnText] <> []))) then // consistent in non-databound cases)
begin
Update; { 5/5/99 - Updates active node before calling ToggleMultiSelection }
{ 7/29/99 - Support auto-unselect property }
if ([ssCtrl, ssShift] * Shift = []) and
(MultiSelectAttributes.AutoUnselect) then UnselectAll;
ToggleMultiSelection(not MultiSelectAttributes.AutoUnselect, Shift);
end;
end;
procedure TfcDBCustomTreeView.MouseLoop(X, Y: Integer);
var ACursor: TPoint;
Msg: TMsg;
Function InButton(ACursorPos: TPoint): boolean;
var sp: TPoint;
begin
sp:= ScreenToClient(ACursorPos);
Result:= (fchtdOnButton in GetHitTestInfoAt(sp.x, sp.y)) and
(sp.y>=MouseRow * RowHeight) and (sp.y<=(MouseRow+1) * RowHeight -1);
end;
procedure MouseLoop_MouseMove(X, Y: Integer; ACursorPos: TPoint);
begin
Down:= InButton(ACursorPos);
if not Down then
begin
Down:= InButton(ACursorPos);
InvalidateRow(MouseRow)
end
else
InvalidateRow(MouseRow)
end;
procedure MouseLoop_MouseUp(X, Y: Integer; ACursorPos: TPoint);
var
IsMouseInControl: Boolean;
MouseNode: TfcDBTreeNode;
begin
IsMouseInControl:= InButton(ACursorPos);
Down:= False;
InvalidateRow(MouseRow);
if IsMouseInControl then
begin
if RowToNode(MouseRow, MouseNode) then
begin
FActiveNode:= MouseNode;
UpdateDataLinkToActive(MouseNode);
if ActiveNode.expanded then
Collapse(ActiveNode)
else
Expand(ActiveNode);
end
end
end;