david
47aaf11578
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@38 05c56307-c608-d34a-929d-697000501d7a
2327 lines
68 KiB
ObjectPascal
2327 lines
68 KiB
ObjectPascal
{*******************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ Express data-aware tree view edit controls }
|
|
{ }
|
|
{ Copyright (c) 1998-2009 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE and ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL and PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSGRID and ALL ACCOMPANYING VCL }
|
|
{ CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE and ALL RELATED }
|
|
{ FILES or ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, or OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ and PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{*******************************************************************}
|
|
|
|
unit dxdbtrel;
|
|
|
|
interface
|
|
{$I cxVer.inc}
|
|
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
|
dxdbtree, DB, StdCtrls, ExtCtrls, ComCtrls, Menus {$IFNDEF DELPHI3}, DBTables {$ENDIF},
|
|
dxtree, dbctrls {$IFDEF DELPHI4}, ImgList{$ENDIF},
|
|
dxCommon {$IFDEF DELPHI6}, Variants, Types {$ENDIF};
|
|
|
|
type
|
|
TTVTextStyle = (tvtsShort, tvtsFull);
|
|
|
|
TdxTreeViewCloseUp = procedure (Sender: TObject; Accept: Boolean) of object;
|
|
|
|
TCustomdxVTreeViewEdit = class(TCustomControl)
|
|
private
|
|
FCanSelectParents: Boolean;
|
|
FAlignment: TAlignment;
|
|
FFocused: Boolean;
|
|
FButtonWidth: Integer;
|
|
FDividedChar: Char;
|
|
FDropDownRows: Integer;
|
|
FListVisible: Boolean;
|
|
FOnDropDown: TNotifyEvent;
|
|
FOnCloseUp: TdxTreeViewCloseUp;
|
|
FText: string;
|
|
FTextStyle: TTVTextStyle;
|
|
FOnGetSelectedIndex: TTVExpandedEvent;
|
|
FOnGetImageIndex: TTVExpandedEvent;
|
|
FDropDownWidth: Integer;
|
|
FPressed: Boolean;
|
|
FOldParentForm: {$IFDEF DELPHI3}TCustomForm{$ELSE}TForm{$ENDIF};
|
|
|
|
procedure SetDividedChar(Value: Char);
|
|
procedure SetText(Value: string);
|
|
|
|
function CanSelectTreeNode(ANode: TTreeNode): Boolean;
|
|
function GetCustomDraw: TTreeViewCustomDraw;
|
|
function GetTreeViewColor: TColor;
|
|
function GetTreeViewCursor: TCursor;
|
|
function GetTreeViewFont: TFont;
|
|
function GetTreeViewHint: string;
|
|
function GetTreeViewImages: {$IFDEF DELPHI4}TCustomImageList{$ELSE}TImageList{$ENDIF};
|
|
function GetTreeViewIndent: Integer;
|
|
function GetTreeViewPopupMenu: TPopupMenu;
|
|
function GetTreeViewReadOnly: Boolean;
|
|
function GetSelectedTreeNode: TTreeNode;
|
|
function GetTreeViewShowButtons: Boolean;
|
|
function GetTreeViewShowHint: Boolean;
|
|
function GetTreeViewShowLines: Boolean;
|
|
function GetTreeViewShowRoot: Boolean;
|
|
function GetTreeViewSortType: TSortType;
|
|
function GetTreeViewStateImages: {$IFDEF DELPHI4}TCustomImageList{$ELSE}TImageList{$ENDIF};
|
|
|
|
procedure SetCustomDraw(Value: TTreeViewCustomDraw);
|
|
procedure SetTreeViewColor(Value: TColor);
|
|
procedure SetTreeViewCursor(Value: TCursor);
|
|
procedure SetTreeViewFont(Value: TFont);
|
|
procedure SetTreeViewHint(Value: string);
|
|
procedure SetTreeViewImages(Value: {$IFDEF DELPHI4}TCustomImageList{$ELSE}TImageList{$ENDIF});
|
|
procedure SetTreeViewIndent(Value: Integer);
|
|
procedure SetTreeViewPopupMenu(Value: TPopupMenu);
|
|
procedure SetTreeViewReadOnly(Value: Boolean);
|
|
procedure SetTreeViewShowButtons(Value: Boolean);
|
|
procedure SetTreeViewShowHint(Value: Boolean);
|
|
procedure SetTreeViewShowLines(Value: Boolean);
|
|
procedure SetTreeViewShowRoot(Value: Boolean);
|
|
procedure SetTreeViewSortType(Value: TSortType);
|
|
procedure SetTreeViewStateImages(Value: {$IFDEF DELPHI4}TCustomImageList{$ELSE}TImageList{$ENDIF});
|
|
|
|
procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
|
|
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
|
|
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
|
|
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
|
|
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
|
|
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
|
|
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
|
|
|
|
function GetBorderSize: Integer;
|
|
function GetTextHeight: Integer;
|
|
procedure AllowChangeTreeNode(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
|
|
procedure ClickTreeView(Sender: TObject);
|
|
procedure DblClickTreeView(Sender: TObject);
|
|
protected
|
|
function VirtualTreeView: TCustomdxTreeView; virtual; abstract;
|
|
|
|
function IsReadOnly: Boolean; virtual;
|
|
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure Paint; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure DropDownOk; virtual;
|
|
procedure CreateVirtualTreeView; virtual;
|
|
procedure PrepareDropDown; virtual;
|
|
function GetPaintedText: string; virtual;
|
|
|
|
property Alignment: TAlignment read FAlignment write FAlignment;
|
|
property DividedChar: Char read FDividedChar write SetDividedChar;
|
|
property TextStyle: TTVTextStyle read FTextStyle write FTextStyle;
|
|
|
|
property Selected: TTreeNode read GetSelectedTreeNode;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
|
|
procedure CloseUp(Accept: Boolean); virtual;
|
|
procedure DropDown; virtual;
|
|
published
|
|
property CanSelectParents: Boolean read FCanSelectParents write FCanSelectParents;
|
|
property Color;
|
|
property Ctl3D;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property DropDownRows: Integer read FDropDownRows write FDropDownRows default 7;
|
|
property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 0;
|
|
property Enabled;
|
|
property Font;
|
|
property ParentColor;
|
|
property ParentCtl3D;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Text: string read FText write SetText;
|
|
property TreeViewColor: TColor read GetTreeViewColor write SetTreeViewColor;
|
|
property TreeViewCursor: TCursor read GetTreeViewCursor write SetTreeViewCursor;
|
|
property TreeViewFont: TFont read GetTreeViewFont write SetTreeViewFont;
|
|
property TreeViewHint: string read GetTreeViewHint write SetTreeViewHint;
|
|
property TreeViewImages: {$IFDEF DELPHI4}TCustomImageList{$ELSE}TImageList{$ENDIF} read GetTreeViewImages write SetTreeViewImages;
|
|
property TreeViewIndent: Integer read GetTreeViewIndent write SetTreeViewIndent;
|
|
property TreeViewPopupMenu: TPopupMenu read GetTreeViewPopupMenu write SetTreeViewPopupMenu;
|
|
property TreeViewReadOnly: Boolean read GetTreeViewReadOnly write SetTreeViewReadOnly;
|
|
property TreeViewShowButtons: Boolean read GetTreeViewShowButtons write SetTreeViewShowButtons;
|
|
property TreeViewShowHint: Boolean read GetTreeViewShowHint write SetTreeViewShowHint;
|
|
property TreeViewShowLines: Boolean read GetTreeViewShowLines write SetTreeViewShowLines;
|
|
property TreeViewShowRoot: Boolean read GetTreeViewShowRoot write SetTreeViewShowRoot;
|
|
property TreeViewSortType: TSortType read GetTreeViewSortType write SetTreeViewSortType;
|
|
property TreeViewStateImages: {$IFDEF DELPHI4}TCustomImageList{$ELSE}TImageList{$ENDIF} read GetTreeViewStateImages write SetTreeViewStateImages;
|
|
property Visible;
|
|
property OnCloseUp: TdxTreeViewCloseUp read FOnCloseUp write FOnCloseUp;
|
|
property OnClick;
|
|
property OnCustomDraw: TTreeViewCustomDraw read GetCustomDraw write SetCustomDraw;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetSelectedIndex: TTVExpandedEvent read FOnGetSelectedIndex write FOnGetSelectedIndex;
|
|
property OnGetImageIndex: TTVExpandedEvent read FOnGetImageIndex write FOnGetImageIndex;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnStartDrag;
|
|
{$IFDEF DELPHI4}
|
|
property Anchors;
|
|
property Constraints;
|
|
property OnStartDock;
|
|
property OnEndDock;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
TCustomdxTreeViewEdit = class(TCustomdxVTreeViewEdit)
|
|
private
|
|
FMemStream: TMemoryStream;
|
|
FImagesStream: TMemoryStream;
|
|
FOldSelected: TTreeNode;
|
|
FTreeView: TdxTreeView;
|
|
|
|
function GetItems: TTreeNodes;
|
|
procedure SetItems(Value: TTreeNodes);
|
|
procedure SaveNodesToStream;
|
|
protected
|
|
procedure Loaded; override;
|
|
function VirtualTreeView: TCustomdxTreeView; override;
|
|
procedure CreateWnd; override;
|
|
procedure DestroyWnd; override;
|
|
procedure DestroyWindowHandle; override;
|
|
|
|
procedure PrepareDropDown; override;
|
|
procedure SearchTreeNode;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure CloseUp(Accept: Boolean); override;
|
|
procedure DropDown; override;
|
|
function GetTreeNodeByText(ParentTreeNode: TTreeNode; Text: string; flag: Boolean): TTreeNode;
|
|
|
|
property Selected;
|
|
published
|
|
property DividedChar;
|
|
property Items: TTreeNodes read GetItems write SetItems;
|
|
property TextStyle;
|
|
end;
|
|
|
|
TdxTreeViewEdit = class(TCustomdxTreeViewEdit)
|
|
published
|
|
property Alignment;
|
|
end;
|
|
|
|
TdxDBTreeViewEdit = class(TCustomdxTreeViewEdit)
|
|
private
|
|
FDataLink: TFieldDataLink;
|
|
FCanvas: TControlCanvas;
|
|
|
|
procedure DataChange(Sender: TObject);
|
|
function GetDataField: string;
|
|
function GetDataSource: TDataSource;
|
|
function GetField: TField;
|
|
function GetReadOnly: Boolean;
|
|
procedure SetDataField(const Value: string);
|
|
procedure SetDataSource(Value: TDataSource);
|
|
procedure SetReadOnly(Value: Boolean);
|
|
procedure UpdateData(Sender: TObject);
|
|
procedure CMExit(var Message: TCMExit); message CM_EXIT;
|
|
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
|
|
protected
|
|
procedure DropDownOk; override;
|
|
function GetPaintedText: string; override;
|
|
|
|
function IsReadOnly: Boolean; override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure DropDown; override;
|
|
|
|
property Field: TField read GetField;
|
|
property Text;
|
|
published
|
|
property DataField: string read GetDataField write SetDataField;
|
|
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
|
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
|
end;
|
|
|
|
TCustomdxLookupTreeView = class;
|
|
|
|
TDataLinkLookupTreeView = class(TDataLink)
|
|
private
|
|
LookupTreeView: TCustomdxLookupTreeView;
|
|
protected
|
|
procedure ActiveChanged; override;
|
|
end;
|
|
|
|
TCustomdxLookupTreeView = class(TCustomdxVTreeViewEdit)
|
|
private
|
|
DBTreeView: TdxDBTreeView;
|
|
ListLink: TDataLinkLookupTreeView;
|
|
FKeyFieldValue: Variant;
|
|
FAssignFieldName: string;
|
|
FKeyFieldName: string;
|
|
FParentFieldName: string;
|
|
FListFieldName: string;
|
|
FDisplayFieldName: string;
|
|
FImageIndexFieldName: string;
|
|
FStateIndexFieldName: string;
|
|
FDropDownKeyValue: Variant;
|
|
|
|
FOnSetDisplayItemText: TSetDisplayItemText;
|
|
|
|
function GetAddNewItem: TAddNewDBTreeNodeEvent;
|
|
function GetListSource: TDataSource;
|
|
function GetOptions: TdxDBTreeViewOptions;
|
|
function GetRootValue: {$IFNDEF DELPHI6}string{$ELSE}Variant{$ENDIF};
|
|
procedure SetAddNewItem(Value: TAddNewDBTreeNodeEvent);
|
|
procedure SetAssignField(Value: string);
|
|
procedure SetKeyField(Value: string);
|
|
procedure SetListField(Value: string);
|
|
procedure SetOptions(Value: TdxDBTreeViewOptions);
|
|
procedure SetParentField(Value: string);
|
|
procedure SetRootValue(Value: {$IFNDEF DELPHI6}string{$ELSE}Variant{$ENDIF});
|
|
procedure SetListSource(Value: TDataSource);
|
|
protected
|
|
FAssignField: TField;
|
|
FKeyField: TField;
|
|
FListField: TField;
|
|
FParentField: TField;
|
|
|
|
function VirtualTreeView: TCustomdxTreeView; override;
|
|
procedure DropDownOk; override;
|
|
procedure DataLinkActiveChanged; virtual;
|
|
procedure ResetDropDown; virtual;
|
|
|
|
property AssignField: string read FAssignFieldName write SetAssignField;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure DropDown; override;
|
|
procedure CloseUp(Accept: Boolean); override;
|
|
published
|
|
property DisplayField: string read FDisplayFieldName write FDisplayFieldName;
|
|
property DividedChar;
|
|
property ImageIndexField: string read FImageIndexFieldName write FImageIndexFieldName;
|
|
property ListSource: TDataSource read GetListSource write SetListSource;
|
|
property KeyField: string read FKeyFieldName write SetKeyField;
|
|
property ListField: string read FListFieldName write SetListField;
|
|
property Options: TdxDBTreeViewOptions read GetOptions write SetOptions default [];
|
|
property ParentField: string read FParentFieldName write SetParentField;
|
|
property RootValue: {$IFNDEF DELPHI6}string{$ELSE}Variant{$ENDIF} read GetRootValue write SetRootValue;
|
|
property StateIndexField: string read FStateIndexFieldName write FStateIndexFieldName;
|
|
property TextStyle;
|
|
property OnAddNewItem: TAddNewDBTreeNodeEvent read GetAddNewItem write SetAddNewItem;
|
|
property OnSetDisplayItemText: TSetDisplayItemText read FOnSetDisplayItemText
|
|
write FOnSetDisplayItemText;
|
|
end;
|
|
|
|
TdxLookupTreeView = class(TCustomdxLookupTreeView)
|
|
published
|
|
property Alignment;
|
|
end;
|
|
|
|
TdxDBLookupTreeView = class(TCustomdxLookupTreeView)
|
|
private
|
|
FDataLink: TFieldDataLink;
|
|
FCanvas: TControlCanvas;
|
|
FCloseUpFlag: Boolean;
|
|
FUpdateDataFlag: Boolean;
|
|
|
|
procedure ActiveChange(Sender: TObject);
|
|
procedure DataChange(Sender: TObject);
|
|
function GetDataField: string;
|
|
function GetDataSource: TDataSource;
|
|
function GetField: TField;
|
|
function GetReadOnly: Boolean;
|
|
procedure SetDataField(const Value: string);
|
|
procedure SetDataSource(Value: TDataSource);
|
|
procedure SetReadOnly(Value: Boolean);
|
|
procedure UpdateData(Sender: TObject);
|
|
procedure CMExit(var Message: TCMExit); message CM_EXIT;
|
|
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
|
|
|
|
procedure CheckNotCircular;
|
|
protected
|
|
procedure DataLinkActiveChanged; override;
|
|
procedure DropDownOk; override;
|
|
function GetPaintedText: string; override;
|
|
function IsReadOnly: Boolean; override;
|
|
function GetDisplayText: string;
|
|
function GetLookupValue: Variant;
|
|
procedure Notification(AComponent: TComponent;
|
|
Operation: TOperation); override;
|
|
procedure PrepareDropDown; override;
|
|
procedure SearchTreeNode;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure DropDown; override;
|
|
procedure CloseUp(Accept: Boolean); override;
|
|
|
|
property Field: TField read GetField;
|
|
property Text;
|
|
published
|
|
property AssignField;
|
|
property DataField: string read GetDataField write SetDataField;
|
|
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
|
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
|
|
end;
|
|
|
|
implementation
|
|
uses dxlocate, commctrl, DBConsts
|
|
;
|
|
|
|
const
|
|
TreeBorderHeight = 19;
|
|
|
|
var
|
|
FUser32DLL: HMODULE;
|
|
|
|
function GetWorkArea(const P: TPoint): TRect;
|
|
const
|
|
MONITOR_DEFAULTTONEAREST = $2;
|
|
type
|
|
HMONITOR = Integer;
|
|
PMonitorInfo = ^TMonitorInfo;
|
|
TMonitorInfo = record
|
|
cbSize: DWORD;
|
|
rcMonitor: TRect;
|
|
rcWork: TRect;
|
|
dwFalgs: DWORD;
|
|
end;
|
|
var
|
|
Info: TMonitorInfo;
|
|
GetMonitorInfo: function(hMonitor: HMONITOR; lpMonitorInfo: PMonitorInfo): Boolean; stdcall;
|
|
MonitorFromPoint: function(ptScreenCoords: TPoint; dwFlags: DWORD): HMONITOR; stdcall;
|
|
begin
|
|
if FUser32DLL > 32 then
|
|
begin
|
|
GetMonitorInfo := GetProcAddress(FUser32DLL, {$IFNDEF DELPHI12}'GetMonitorInfoA'{$ELSE}'GetMonitorInfoW'{$ENDIF});
|
|
MonitorFromPoint := GetProcAddress(FUser32DLL, 'MonitorFromPoint');
|
|
end
|
|
else
|
|
begin
|
|
GetMonitorInfo := nil;
|
|
MonitorFromPoint := nil;
|
|
end;
|
|
|
|
if @GetMonitorInfo = nil then
|
|
SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0)
|
|
else
|
|
begin
|
|
Info.cbSize := SizeOf(Info);
|
|
GetMonitorInfo(MonitorFromPoint(P, MONITOR_DEFAULTTONEAREST), @Info);
|
|
Result := Info.rcWork;
|
|
end;
|
|
end;
|
|
|
|
function VarEquals(const V1, V2: Variant): Boolean;
|
|
begin
|
|
Result := False;
|
|
try
|
|
Result := V1 = V2;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
function GetFullTreeNodeName(TreeNode: TTreeNode; DividedChar: Char): string;
|
|
var
|
|
tr: TTreeNode;
|
|
begin
|
|
Result := '';
|
|
tr := TreeNode;
|
|
while tr <> nil do begin
|
|
if (Length(Result) > 0 ) and (Length(tr.Text) > 0 ) then
|
|
Result := DividedChar + Result;
|
|
Result := tr.Text + Result;
|
|
tr := tr.Parent;
|
|
end;
|
|
end;
|
|
|
|
function GetRealParentForm(AControl: TWinControl): {$IFDEF DELPHI3}TCustomForm{$ELSE}TForm{$ENDIF};
|
|
var
|
|
AForm: {$IFDEF DELPHI3}TCustomForm{$ELSE}TForm{$ENDIF};
|
|
begin
|
|
Result := GetParentForm(AControl);
|
|
if Result <> nil then
|
|
begin
|
|
AForm := GetParentForm(Result);
|
|
while (AForm <> nil) and (AForm <> Result) do
|
|
begin
|
|
Result := AForm;
|
|
AForm := GetParentForm(AForm);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetParentWinControl(AControl: TWinControl): TWinControl;
|
|
begin
|
|
Result := GetParentForm(AControl);
|
|
{$IFDEF DELPHI5}
|
|
if Result = nil then
|
|
begin
|
|
Result := AControl;
|
|
while Result.Parent <> nil do
|
|
Result := Result.Parent;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{TPopupTreeView}
|
|
type
|
|
TPopupTreeView = class(TdxTreeView)
|
|
private
|
|
FHScrollWidth: Integer;
|
|
FVScrollWidth: Integer;
|
|
FCloseButtonRect, FGripRect: TRect;
|
|
FCloseButtonIsTracking: Boolean;
|
|
FMouseAboveCloseButton: Boolean;
|
|
FCorner: TdxCorner;
|
|
IsDestroying: Boolean;
|
|
|
|
procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
|
|
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
|
|
procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
|
|
|
|
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
|
|
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
|
|
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
|
|
procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
|
|
procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED;
|
|
|
|
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
|
|
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
|
|
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure WndProc(var Message: TMessage); override;
|
|
end;
|
|
|
|
constructor TPopupTreeView.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
|
|
DragMode := dmManual;
|
|
end;
|
|
|
|
procedure TPopupTreeView.WMActivate(var Message: TWMActivate);
|
|
begin
|
|
inherited;
|
|
if (Message.Active = WA_INACTIVE) and
|
|
TCustomdxVTreeViewEdit(Owner).FListVisible then
|
|
TCustomdxVTreeViewEdit(Owner).CloseUp(False);
|
|
end;
|
|
|
|
procedure TPopupTreeView.WMGetDlgCode(var Message: TWMGetDlgCode);
|
|
begin
|
|
inherited;
|
|
Message.Result := Message.Result + DLGC_WANTALLKEYS;
|
|
end;
|
|
|
|
procedure TPopupTreeView.WMMouseActivate(var Message: TWMMouseActivate);
|
|
begin
|
|
inherited;
|
|
Message.Result := MA_NOACTIVATE;
|
|
end;
|
|
|
|
procedure TPopupTreeView.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
begin
|
|
Style := Style and not WS_CHILD or WS_POPUP or WS_BORDER ;
|
|
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
|
|
|
|
WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
|
|
WndParent := GetParentWinControl(TWinControl(Owner)).Handle;
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupTreeView.WndProc(var Message: TMessage);
|
|
begin
|
|
with Message do
|
|
if (Msg = WM_KEYDOWN) and ((wParam = VK_ESCAPE) or (wParam = VK_RETURN)) then
|
|
TCustomdxVTreeViewEdit(Owner).CloseUp(wParam = VK_RETURN)
|
|
else
|
|
begin
|
|
if (Msg = WM_DESTROY) and (Owner <> nil) and not IsDestroying then
|
|
TCustomdxTreeViewEdit(Owner).SaveNodesToStream;
|
|
inherited WndProc(Message);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupTreeView.CreateWnd;
|
|
begin
|
|
inherited;
|
|
FHScrollWidth := GetSystemMetrics(SM_CYHSCROLL);
|
|
FVScrollWidth := GetSystemMetrics(SM_CXVSCROLL);
|
|
end;
|
|
|
|
procedure TPopupTreeView.WMCaptureChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if FCloseButtonIsTracking then
|
|
begin
|
|
FCloseButtonIsTracking := False;
|
|
FMouseAboveCloseButton := False;
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupTreeView.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
|
|
begin
|
|
inherited;
|
|
Message.MinMaxInfo^.ptMinTrackSize := Point(100, 100);
|
|
end;
|
|
|
|
procedure TPopupTreeView.WMNCCalcSize(var Message: TWMNCCalcSize);
|
|
var
|
|
R: TRect;
|
|
AControl: TWinControl;
|
|
begin
|
|
inherited;
|
|
if TCustomdxVTreeViewEdit(Owner).FListVisible then
|
|
begin
|
|
GetWindowRect(Handle, R);
|
|
AControl := TWinControl(Owner);
|
|
MapWindowPoints(0, AControl.Handle, R, 2);
|
|
FCorner := GetCornerForRects(AControl.ClientRect, R);
|
|
with Message.CalcSize_Params^ do
|
|
if FCorner in [coBottomLeft, coBottomRight] then
|
|
Dec(rgrc[0].Bottom, dxDropDownNCHeight)
|
|
else
|
|
Inc(rgrc[0].Top, dxDropDownNCHeight);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupTreeView.WMNCHitTest(var Message: TWMNCHitTest);
|
|
var
|
|
PrevMouseAboveCloseButton: Boolean;
|
|
begin
|
|
inherited;
|
|
with Message do
|
|
if PtInRect(FGripRect, SmallPointToPoint(Pos)) then
|
|
Result := GetHitTestByCorner(FCorner)
|
|
else
|
|
begin
|
|
PrevMouseAboveCloseButton := FMouseAboveCloseButton;
|
|
FMouseAboveCloseButton := PtInRect(FCloseButtonRect, SmallPointToPoint(Pos));
|
|
if FMouseAboveCloseButton then Result := HTBORDER;
|
|
if PrevMouseAboveCloseButton <> FMouseAboveCloseButton then
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupTreeView.WMNCPaint(var Message: TWMNCPaint);
|
|
var
|
|
R, R1, CR: TRect;
|
|
B: Integer;
|
|
DC: HDC;
|
|
AStyle: Longint;
|
|
begin
|
|
inherited;
|
|
if not TCustomdxVTreeViewEdit(Owner).FListVisible then
|
|
Exit;
|
|
|
|
GetWindowRect(Handle, R);
|
|
FCloseButtonRect := R;
|
|
FGripRect := R;
|
|
Windows.GetClientRect(Handle, CR);
|
|
MapWindowPoints(0, Handle, R, 2);
|
|
B := -R.Left;
|
|
OffsetRect(CR, -R.Left, -R.Top);
|
|
OffsetRect(R, -R.Left, -R.Top);
|
|
InflateRect(R, -B, -B);
|
|
|
|
DC := GetWindowDC(Handle);
|
|
|
|
if FCorner in [coBottomLeft, coBottomRight] then
|
|
begin
|
|
R.Top := R.Bottom - dxDropDownNCHeight + 1;
|
|
SetRect(R1, R.Left, R.Top - 1, R.Right, R.Top);
|
|
FillRect(DC, R1, GetSysColorBrush(COLOR_WINDOWFRAME));
|
|
end
|
|
else
|
|
begin
|
|
R.Bottom := R.Top + dxDropDownNCHeight - 1;
|
|
SetRect(R1, R.Left, R.Bottom, R.Right, R.Bottom + 1);
|
|
FillRect(DC, R1, GetSysColorBrush(COLOR_WINDOWFRAME));
|
|
end;
|
|
|
|
CR := R;
|
|
DrawSizeGrip(DC, CR, FCorner);
|
|
with CR do
|
|
ExcludeClipRect(DC, Left, Top, Right, Bottom);
|
|
InflateRect(CR, 2, 2);
|
|
if CR.Top < R.Top then CR.Top := R.Top;
|
|
if CR.Bottom > R.Bottom then CR.Bottom := R.Bottom;
|
|
OffsetRect(CR, FGripRect.Left, FGripRect.Top);
|
|
FGripRect := CR;
|
|
|
|
CR := R;
|
|
DrawCloseButton(DC, CR, FMouseAboveCloseButton or FCloseButtonIsTracking,
|
|
FMouseAboveCloseButton and FCloseButtonIsTracking, FCorner);
|
|
with CR do
|
|
ExcludeClipRect(DC, Left, Top, Right, Bottom);
|
|
with FCloseButtonRect do OffsetRect(CR, Left, Top);
|
|
FCloseButtonRect := CR;
|
|
|
|
FillRect(DC, R, GetSysColorBrush(COLOR_BTNFACE));
|
|
if FCorner in [coBottomLeft, coBottomRight] then
|
|
begin
|
|
AStyle := GetWindowLong(Handle, GWL_STYLE);
|
|
if (AStyle and WS_HSCROLL <> 0) and (AStyle and WS_VSCROLL <> 0) then
|
|
with R do
|
|
begin
|
|
Left := Right - GetSystemMetrics(SM_CXVSCROLL);
|
|
Bottom := Top - 1;
|
|
Top := Bottom - GetSystemMetrics(SM_CYHSCROLL);
|
|
FillRect(DC, R, GetSysColorBrush(COLOR_BTNFACE));
|
|
end;
|
|
end;
|
|
|
|
ReleaseDC(Handle, DC);
|
|
end;
|
|
|
|
procedure TPopupTreeView.CMMouseLeave(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if FMouseAboveCloseButton then
|
|
begin
|
|
FMouseAboveCloseButton := False;
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupTreeView.WMLButtonUp(var Message: TWMLButtonUp);
|
|
begin
|
|
inherited;
|
|
if FCloseButtonIsTracking then
|
|
begin
|
|
FCloseButtonIsTracking := False;
|
|
ReleaseCapture;
|
|
if FMouseAboveCloseButton then
|
|
TCustomdxVTreeViewEdit(Owner).CloseUp(False)
|
|
else
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupTreeView.WMNCLButtonDown(var Message: TWMNCLButtonDown);
|
|
begin
|
|
inherited;
|
|
if FMouseAboveCloseButton then
|
|
begin
|
|
FCloseButtonIsTracking := True;
|
|
SetCapture(Handle);
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
{ TPopupDBTreeView }
|
|
|
|
type
|
|
TPopupDBTreeView = class(TdxDBTreeView)
|
|
private
|
|
FHScrollWidth: Integer;
|
|
FVScrollWidth: Integer;
|
|
FCloseButtonRect, FGripRect: TRect;
|
|
FCloseButtonIsTracking: Boolean;
|
|
FMouseAboveCloseButton: Boolean;
|
|
FCorner: TdxCorner;
|
|
|
|
procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
|
|
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
|
|
procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
|
|
|
|
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
|
|
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
|
|
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
|
|
procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
|
|
procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED;
|
|
|
|
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
|
|
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
|
|
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure WndProc(var Message: TMessage); override;
|
|
end;
|
|
|
|
constructor TPopupDBTreeView.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
|
|
DragMode := dmManual;
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.WMActivate(var Message: TWMActivate);
|
|
begin
|
|
inherited;
|
|
if (Message.Active = WA_INACTIVE) and
|
|
TCustomdxVTreeViewEdit(Owner).FListVisible then
|
|
TCustomdxVTreeViewEdit(Owner).CloseUp(False);
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.WMGetDlgCode(var Message: TWMGetDlgCode);
|
|
begin
|
|
inherited;
|
|
Message.Result := Message.Result + DLGC_WANTALLKEYS;
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.WMMouseActivate(var Message: TWMMouseActivate);
|
|
begin
|
|
inherited;
|
|
Message.Result := MA_NOACTIVATE;
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
begin
|
|
Style := Style and not WS_CHILD or WS_POPUP or WS_BORDER ;
|
|
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
|
|
|
|
WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
|
|
WndParent := GetParentWinControl(TWinControl(Owner)).Handle;
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.WndProc(var Message: TMessage);
|
|
begin
|
|
with Message do
|
|
if (Msg = WM_KEYDOWN) and ((wParam = VK_ESCAPE) or (wParam = VK_RETURN)) then
|
|
TCustomdxVTreeViewEdit(Owner).CloseUp(wParam = VK_RETURN)
|
|
else
|
|
inherited WndProc(Message);
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.CreateWnd;
|
|
begin
|
|
inherited;
|
|
|
|
FHScrollWidth := GetSystemMetrics(SM_CYHSCROLL);
|
|
FVScrollWidth := GetSystemMetrics(SM_CXVSCROLL);
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.WMCaptureChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if FCloseButtonIsTracking then
|
|
begin
|
|
FCloseButtonIsTracking := False;
|
|
FMouseAboveCloseButton := False;
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
|
|
begin
|
|
inherited;
|
|
Message.MinMaxInfo^.ptMinTrackSize := Point(100, 100);
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.WMNCCalcSize(var Message: TWMNCCalcSize);
|
|
var
|
|
R: TRect;
|
|
AControl: TWinControl;
|
|
begin
|
|
inherited;
|
|
if TCustomdxVTreeViewEdit(Owner).FListVisible then
|
|
begin
|
|
GetWindowRect(Handle, R);
|
|
AControl := TWinControl(Owner);
|
|
MapWindowPoints(0, AControl.Handle, R, 2);
|
|
FCorner := GetCornerForRects(AControl.ClientRect, R);
|
|
with Message.CalcSize_Params^.rgrc[0] do
|
|
if FCorner in [coBottomLeft, coBottomRight] then
|
|
Dec(Bottom, dxDropDownNCHeight)
|
|
else
|
|
Inc(Top, dxDropDownNCHeight);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.WMNCHitTest(var Message: TWMNCHitTest);
|
|
var
|
|
PrevMouseAboveCloseButton: Boolean;
|
|
begin
|
|
inherited;
|
|
with Message do
|
|
if PtInRect(FGripRect, SmallPointToPoint(Pos)) then
|
|
Result := GetHitTestByCorner(FCorner)
|
|
else
|
|
begin
|
|
PrevMouseAboveCloseButton := FMouseAboveCloseButton;
|
|
FMouseAboveCloseButton := PtInRect(FCloseButtonRect, SmallPointToPoint(Pos));
|
|
if FMouseAboveCloseButton then Result := HTBORDER;
|
|
if PrevMouseAboveCloseButton <> FMouseAboveCloseButton then
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.WMNCPaint(var Message: TWMNCPaint);
|
|
var
|
|
R, R1, CR: TRect;
|
|
B: Integer;
|
|
DC: HDC;
|
|
AStyle: Longint;
|
|
begin
|
|
inherited;
|
|
if not TCustomdxVTreeViewEdit(Owner).FListVisible then Exit;
|
|
|
|
GetWindowRect(Handle, R);
|
|
FCloseButtonRect := R;
|
|
FGripRect := R;
|
|
Windows.GetClientRect(Handle, CR);
|
|
MapWindowPoints(0, Handle, R, 2);
|
|
B := -R.Left;
|
|
OffsetRect(CR, -R.Left, -R.Top);
|
|
OffsetRect(R, -R.Left, -R.Top);
|
|
InflateRect(R, -B, -B);
|
|
|
|
DC := GetWindowDC(Handle);
|
|
|
|
if FCorner in [coBottomLeft, coBottomRight] then
|
|
begin
|
|
R.Top := R.Bottom - dxDropDownNCHeight + 1;
|
|
SetRect(R1, R.Left, R.Top - 1, R.Right, R.Top);
|
|
FillRect(DC, R1, GetSysColorBrush(COLOR_WINDOWFRAME));
|
|
end
|
|
else
|
|
begin
|
|
R.Bottom := R.Top + dxDropDownNCHeight - 1;
|
|
SetRect(R1, R.Left, R.Bottom, R.Right, R.Bottom + 1);
|
|
FillRect(DC, R1, GetSysColorBrush(COLOR_WINDOWFRAME));
|
|
end;
|
|
|
|
CR := R;
|
|
DrawSizeGrip(DC, CR, FCorner);
|
|
with CR do
|
|
ExcludeClipRect(DC, Left, Top, Right, Bottom);
|
|
InflateRect(CR, 2, 2);
|
|
if CR.Top < R.Top then CR.Top := R.Top;
|
|
if CR.Bottom > R.Bottom then CR.Bottom := R.Bottom;
|
|
OffsetRect(CR, FGripRect.Left, FGripRect.Top);
|
|
FGripRect := CR;
|
|
|
|
CR := R;
|
|
DrawCloseButton(DC, CR, FMouseAboveCloseButton or FCloseButtonIsTracking,
|
|
FMouseAboveCloseButton and FCloseButtonIsTracking, FCorner);
|
|
with CR do
|
|
ExcludeClipRect(DC, Left, Top, Right, Bottom);
|
|
with FCloseButtonRect do OffsetRect(CR, Left, Top);
|
|
FCloseButtonRect := CR;
|
|
|
|
FillRect(DC, R, GetSysColorBrush(COLOR_BTNFACE));
|
|
if FCorner in [coBottomLeft, coBottomRight] then
|
|
begin
|
|
AStyle := GetWindowLong(Handle, GWL_STYLE);
|
|
if (AStyle and WS_HSCROLL <> 0) and (AStyle and WS_VSCROLL <> 0) then
|
|
with R do
|
|
begin
|
|
Left := Right - GetSystemMetrics(SM_CXVSCROLL);
|
|
Bottom := Top - 1;
|
|
Top := Bottom - GetSystemMetrics(SM_CYHSCROLL);
|
|
FillRect(DC, R, GetSysColorBrush(COLOR_BTNFACE));
|
|
end;
|
|
end;
|
|
|
|
ReleaseDC(Handle, DC);
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.CMMouseLeave(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
if FMouseAboveCloseButton then
|
|
begin
|
|
FMouseAboveCloseButton := False;
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.WMLButtonUp(var Message: TWMLButtonUp);
|
|
begin
|
|
inherited;
|
|
if FCloseButtonIsTracking then
|
|
begin
|
|
FCloseButtonIsTracking := False;
|
|
ReleaseCapture;
|
|
if FMouseAboveCloseButton then
|
|
TCustomdxVTreeViewEdit(Owner).CloseUp(False)
|
|
else
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TPopupDBTreeView.WMNCLButtonDown(var Message: TWMNCLButtonDown);
|
|
begin
|
|
inherited;
|
|
if FMouseAboveCloseButton then
|
|
begin
|
|
FCloseButtonIsTracking := True;
|
|
SetCapture(Handle);
|
|
SendMessage(Handle, WM_NCPAINT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
{TCustomdxTreeViewEdit}
|
|
|
|
constructor TCustomdxVTreeViewEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := [csOpaque, csReplicatable];
|
|
if not NewStyleControls then
|
|
ControlStyle := ControlStyle + [csFramed];
|
|
ParentColor := False;
|
|
TabStop := True;
|
|
FCanSelectParents := True;
|
|
|
|
Width := 145;
|
|
Height := 0;
|
|
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
|
|
FDropDownWidth := 0;
|
|
FDividedChar := '.';
|
|
FDropDownRows := 7;
|
|
FOldParentForm := GetRealParentForm(Self);
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.CreateVirtualTreeView;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
begin
|
|
VirtualTreeView.Visible := False;
|
|
VirtualTreeView.ShowNodeHint := False;
|
|
VirtualTreeView.OnChanging := AllowChangeTreeNode;
|
|
VirtualTreeView.OnDblClick := DblClickTreeView;
|
|
VirtualTreeView.OnClick := ClickTreeView;
|
|
end;
|
|
end;
|
|
|
|
destructor TCustomdxVTreeViewEdit.Destroy;
|
|
begin
|
|
VirtualTreeView.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetBorderSize: Integer;
|
|
var
|
|
Params: TCreateParams;
|
|
R: TRect;
|
|
begin
|
|
CreateParams(Params);
|
|
SetRect(R, 0, 0, 0, 0);
|
|
AdjustWindowRectEx(R, Params.Style, False, Params.ExStyle);
|
|
Result := R.Bottom - R.Top;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.AllowChangeTreeNode(Sender: TObject; Node: TTreeNode;
|
|
var AllowChange: Boolean);
|
|
begin
|
|
AllowChange := CanSelectTreeNode(Node);
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.ClickTreeView(Sender: TObject);
|
|
begin
|
|
Click;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.DblClickTreeView(Sender: TObject);
|
|
var
|
|
p: TPoint;
|
|
begin
|
|
if (VirtualTreeView.Selected <> nil)
|
|
and CanSelectTreeNode(VirtualTreeView.Selected) then
|
|
begin
|
|
GetCursorPos(p);
|
|
Windows.ScreenToClient(VirtualTreeView.Handle, p);
|
|
if ((VirtualTreeView.GetHitTestInfoAt(p.X, p.Y) * [htOnItem, htOnIcon, htOnLabel, htOnStateIcon] <> [])
|
|
and (VirtualTreeView.GetNodeAt(p.X, p.Y) = VirtualTreeView.Selected)) then
|
|
CloseUp(True);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.CloseUp(Accept: Boolean);
|
|
begin
|
|
if FListVisible then
|
|
begin
|
|
FDropDownWidth := VirtualTreeView.Width;
|
|
FDropDownRows := (VirtualTreeView.Height - 7 - TreeBorderHeight) div GetTextHeight;
|
|
if FDropDownRows < 2 then
|
|
FDropDownRows := 2;
|
|
|
|
if GetCapture = VirtualTreeView.Handle then ReleaseCapture;
|
|
FListVisible := False;
|
|
if IsWindowVisible(VirtualTreeView.Handle) then
|
|
begin
|
|
SetWindowPos(VirtualTreeView.Handle, 0, 0, 0, 0, 0,
|
|
SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_HIDEWINDOW);
|
|
Windows.SetFocus(GetParentWinControl(Self).Handle);
|
|
end;
|
|
|
|
Invalidate;
|
|
|
|
if Accept and not IsReadOnly then DropDownOk;
|
|
if Assigned(FOnCloseUp) then FOnCloseUp(Self, Accept);
|
|
if Self is TCustomdxLookupTreeView then
|
|
TdxDBTreeView(VirtualTreeView).DataSource := nil;
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.IsReadOnly: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
if NewStyleControls and Ctl3D then
|
|
ExStyle := ExStyle or WS_EX_CLIENTEDGE
|
|
else
|
|
Style := Style or WS_BORDER;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.DropDown;
|
|
var
|
|
P: TPoint;
|
|
AWidth, AHeight: Integer;
|
|
AWorkArea: TRect;
|
|
begin
|
|
if not FListVisible then
|
|
begin
|
|
if Assigned(FOnDropDown) then FOnDropDown(Self);
|
|
PrepareDropDown;
|
|
|
|
P := Parent.ClientToScreen(Point(Left, Top));
|
|
Inc(P.Y , Height);
|
|
|
|
AHeight := FDropDownRows * GetTextHeight + 7 + TreeBorderHeight;
|
|
if FDropDownWidth > 0 then
|
|
AWidth := FDropDownWidth
|
|
else
|
|
AWidth := Width;
|
|
AWorkArea := GetWorkArea(P);
|
|
|
|
if P.X < AWorkArea.Left then P.X := AWorkArea.Left;
|
|
if P.X + AWidth > AWorkArea.Right then Dec(P.X, P.X + AWidth - AWorkArea.Right);
|
|
if P.Y < AWorkArea.Top then P.Y := AWorkArea.Top;
|
|
if P.Y + AHeight > AWorkArea.Bottom then Dec(P.Y, Height + AHeight);
|
|
|
|
VirtualTreeView.SetBounds(P.X, P.Y, AWidth, AHeight);
|
|
FListVisible := True;
|
|
SetWindowPos(VirtualTreeView.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_FRAMECHANGED);
|
|
|
|
ShowWindow(VirtualTreeView.Handle, SW_SHOWNORMAL);
|
|
Windows.SetFocus(VirtualTreeView.Handle);
|
|
SendMessage(GetParentWinControl(TWinControl(Owner)).Handle, WM_NCACTIVATE, Longint(True), 0);
|
|
Repaint;
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTextHeight: Integer;
|
|
var
|
|
DC: HDC;
|
|
SaveFont: HFont;
|
|
Metrics: TTextMetric;
|
|
begin
|
|
DC := GetDC(0);
|
|
SaveFont := SelectObject(DC, Font.Handle);
|
|
GetTextMetrics(DC, Metrics);
|
|
SelectObject(DC, SaveFont);
|
|
ReleaseDC(0, DC);
|
|
Result := Metrics.tmHeight;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
if (Key = VK_DOWN) and (ssAlt in Shift) then
|
|
DropDown;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
pt, ListPos: TPoint;
|
|
MousePos: TSmallPoint;
|
|
r: TRect;
|
|
begin
|
|
if (Button = mbLeft) and Enabled then
|
|
begin
|
|
SetFocus;
|
|
if not FListVisible then
|
|
begin
|
|
SetRect(r, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
|
|
pt.X := X; pt.Y := Y;
|
|
FPressed := PtInRect(r, pt);
|
|
DropDown;
|
|
end
|
|
else
|
|
begin
|
|
pt.X := X; pt.Y := Y;
|
|
ListPos := VirtualTreeView.ScreenToClient(ClientToScreen(pt));
|
|
with VirtualTreeView do
|
|
SetRect(r, 0, 0, Width, Height);
|
|
if PtInRect(r, ListPos) then
|
|
begin
|
|
MousePos := PointToSmallPoint(ListPos);
|
|
SendMessage(VirtualTreeView.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
|
|
end
|
|
else
|
|
CloseUp(False);
|
|
end;
|
|
end;
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
R: TRect;
|
|
pt: TPoint;
|
|
begin
|
|
R := ClientRect;
|
|
R.Left := R.Right - FButtonWidth;
|
|
pt.X := X; pt.Y := Y;
|
|
if FPressed and not PtInRect(R, pt) then
|
|
begin
|
|
FPressed := False;
|
|
InvalidateRect(Handle, @R, True);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
if FPressed then
|
|
begin
|
|
FPressed := False;
|
|
Repaint;
|
|
end;
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.Paint;
|
|
var
|
|
W, X, Flags: Integer;
|
|
Selected: Boolean;
|
|
R: TRect;
|
|
AText: string;
|
|
begin
|
|
Canvas.Font := Font;
|
|
Canvas.Brush.Color := Color;
|
|
Selected := FFocused and not FListVisible and not (csPaintCopy in ControlState);
|
|
if Selected then
|
|
begin
|
|
Canvas.Font.Color := clHighlightText;
|
|
Canvas.Brush.Color := clHighlight;
|
|
end;
|
|
if not Enabled then
|
|
Canvas.Font.Color := clGrayText;
|
|
|
|
AText := GetPaintedText;
|
|
W := ClientWidth - FButtonWidth;
|
|
X := 2;
|
|
case FAlignment of
|
|
taRightJustify: X := W - Canvas.TextWidth(AText) - 3;
|
|
taCenter: X := (W - Canvas.TextWidth(AText)) div 2;
|
|
end;
|
|
SetRect(R , 1, 1, W - 1, ClientHeight - 1);
|
|
Canvas.TextRect(R, X, 2, AText);
|
|
if Selected then
|
|
Canvas.DrawFocusRect(R);
|
|
SetRect(R, W , 0, ClientWidth, ClientHeight);
|
|
Flags := DFCS_SCROLLCOMBOBOX;
|
|
if FPressed then
|
|
Flags := Flags or DFCS_FLAT or DFCS_PUSHED;
|
|
if not Enabled then
|
|
Flags := Flags or DFCS_INACTIVE;
|
|
DrawFrameControl(Canvas.Handle, R, DFC_SCROLL, Flags);
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetPaintedText: string;
|
|
begin
|
|
Result := FText;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.DropDownOk;
|
|
begin
|
|
if (VirtualTreeView <> nil) and (VirtualTreeView.Selected <> nil) then
|
|
begin
|
|
if (FTextStyle = tvtsFull) then
|
|
Text := GetFullTreeNodeName(VirtualTreeView.Selected, FDividedChar)
|
|
else
|
|
Text := VirtualTreeView.Selected.Text;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.PrepareDropDown;
|
|
var
|
|
Style: Integer;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
with VirtualTreeView do
|
|
begin
|
|
VirtualTreeView.OnGetImageIndex := FOnGetImageIndex;
|
|
VirtualTreeView.OnGetSelectedIndex := FOnGetSelectedIndex;
|
|
Style := GetWindowLong(Handle, GWL_STYLE);
|
|
Style := Style or TVS_HASBUTTONS or TVS_HASLINES or TVS_LINESATROOT;
|
|
SetWindowLong(Handle, GWL_STYLE, Style);
|
|
if not TreeViewShowButtons then
|
|
Style := Style and not TVS_HASBUTTONS;
|
|
if not TreeViewShowLines then
|
|
Style := Style and not TVS_HASLINES;
|
|
if not TreeViewShowRoot then
|
|
Style := Style and not TVS_LINESATROOT;
|
|
SetWindowLong(Handle, GWL_STYLE, Style);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
|
begin
|
|
inherited SetBounds(ALeft, ATop, AWidth, GetTextHeight + GetBorderSize + 4);
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.CMCtl3DChanged(var Message: TMessage);
|
|
begin
|
|
if NewStyleControls then
|
|
begin
|
|
RecreateWnd;
|
|
Height := 0;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.CMFontChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
Height := 0;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.CMEnabledChanged(var Message: TMessage);
|
|
begin
|
|
Invalidate;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.CMMouseLeave(var Message: TMessage);
|
|
begin
|
|
if FPressed then
|
|
begin
|
|
FPressed := False;
|
|
Invalidate;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
|
|
begin
|
|
Message.Result := DLGC_WANTARROWS;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.WMKillFocus(var Message: TWMKillFocus);
|
|
begin
|
|
inherited;
|
|
FFocused := False;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.WMSetFocus(var Message: TWMSetFocus);
|
|
begin
|
|
inherited;
|
|
FFocused := True;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetText(Value: string);
|
|
begin
|
|
FText := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetDividedChar(Value: Char);
|
|
begin
|
|
FDividedChar := Value;
|
|
if (VirtualTreeView <> nil) and (VirtualTreeView.Selected <> nil) then
|
|
GetFullTreeNodeName(VirtualTreeView.Selected, FDividedChar);
|
|
Invalidate;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.CanSelectTreeNode(ANode: TTreeNode): Boolean;
|
|
begin
|
|
Result := (ANode <> nil) and (not ANode.HasChildren or CanSelectParents);
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetCustomDraw: TTreeViewCustomDraw;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.OnCustomDraw
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewColor: TColor;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.Color
|
|
else
|
|
Result := clNone;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewCursor: TCursor;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.Cursor
|
|
else
|
|
Result := crNone;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewFont: TFont;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.Font
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewHint: string;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.Hint;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewImages: {$IFDEF DELPHI4}TCustomImageList{$ELSE}TImageList{$ENDIF};
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.Images
|
|
else Result := nil;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewIndent: Integer;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.Indent
|
|
else Result := -1;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewPopupMenu: TPopupMenu;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.PopupMenu
|
|
else Result := nil;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewReadOnly: Boolean;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.ReadOnly
|
|
else Result := False;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetSelectedTreeNode: TTreeNode;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.Selected
|
|
else Result := nil;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewShowButtons: Boolean;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.ShowButtons
|
|
else Result := False;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewShowHint: Boolean;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.ShowHint
|
|
else Result := False;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewShowLines: Boolean;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.ShowLines
|
|
else Result := False;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewShowRoot: Boolean;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.ShowRoot
|
|
else Result := False;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewSortType: TSortType;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.SortType
|
|
else Result := stNone;
|
|
end;
|
|
|
|
function TCustomdxVTreeViewEdit.GetTreeViewStateImages: {$IFDEF DELPHI4}TCustomImageList{$ELSE}TImageList{$ENDIF};
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
Result := VirtualTreeView.StateImages
|
|
else Result := nil;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetCustomDraw(Value: TTreeViewCustomDraw);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.OnCustomDraw := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewColor(Value: TColor);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.Color := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewCursor(Value: TCursor);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.Cursor := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewFont(Value: TFont);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.Font := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewHint(Value: string);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.Hint := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewImages(Value: {$IFDEF DELPHI4}TCustomImageList{$ELSE}TImageList{$ENDIF});
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.Images := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewIndent(Value: Integer);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.Indent := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewPopupMenu(Value: TPopupMenu);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.PopupMenu := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewReadOnly(Value: Boolean);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.ReadOnly := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewShowButtons(Value: Boolean);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.ShowButtons := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewShowHint(Value: Boolean);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.ShowHint := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewShowLines(Value: Boolean);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.ShowLines := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewShowRoot(Value: Boolean);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.ShowRoot := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewSortType(Value: TSortType);
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.SortType := Value;
|
|
end;
|
|
|
|
procedure TCustomdxVTreeViewEdit.SetTreeViewStateImages(Value: {$IFDEF DELPHI4}TCustomImageList{$ELSE}TImageList{$ENDIF});
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
VirtualTreeView.StateImages := Value;
|
|
end;
|
|
|
|
{TdxTreeViewEdit}
|
|
|
|
constructor TCustomdxTreeViewEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FTreeView := TPopupTreeView.Create(Self);
|
|
CreateVirtualTreeView;
|
|
end;
|
|
|
|
destructor TCustomdxTreeViewEdit.Destroy;
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
TPopupTreeView(VirtualTreeView).IsDestroying := True;
|
|
FMemStream.Free;
|
|
FImagesStream.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TCustomdxTreeViewEdit.VirtualTreeView: TCustomdxTreeView;
|
|
begin
|
|
Result := FTreeView;
|
|
end;
|
|
|
|
procedure TCustomdxTreeViewEdit.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
end;
|
|
|
|
procedure TCustomdxTreeViewEdit.CreateWnd;
|
|
var
|
|
ANode: TTreeNode;
|
|
Index: Integer;
|
|
begin
|
|
inherited CreateWnd;
|
|
if FMemStream <> nil then
|
|
begin
|
|
if VirtualTreeView <> nil then
|
|
begin
|
|
VirtualTreeView.LoadFromStream(FMemStream);
|
|
ANode := VirtualTreeView.Items[0];
|
|
while ANode <> nil do
|
|
begin
|
|
FImagesStream.Read(Index, SizeOf(Integer));
|
|
ANode.ImageIndex := Index;
|
|
FImagesStream.Read(Index, SizeOf(Integer));
|
|
ANode.SelectedIndex := Index;
|
|
FImagesStream.Read(Index, SizeOf(Integer));
|
|
ANode.StateIndex := Index;
|
|
ANode := ANode.GetNext;
|
|
end;
|
|
end;
|
|
FMemStream.Free;
|
|
FMemStream := nil;
|
|
FImagesStream.Free;
|
|
FImagesStream := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxTreeViewEdit.DestroyWnd;
|
|
begin
|
|
SaveNodesToStream;
|
|
inherited DestroyWnd;
|
|
end;
|
|
|
|
procedure TCustomdxTreeViewEdit.DestroyWindowHandle;
|
|
begin
|
|
SaveNodesToStream;
|
|
inherited DestroyWindowHandle;
|
|
end;
|
|
|
|
procedure TCustomdxTreeViewEdit.SaveNodesToStream;
|
|
var
|
|
ANode: TTreeNode;
|
|
begin
|
|
if not (csDestroying in ComponentState) and (VirtualTreeView <> nil) and (VirtualTreeView.Items.Count > 0) and (FMemStream = nil) then
|
|
begin
|
|
FMemStream := TMemoryStream.Create;
|
|
VirtualTreeView.SaveToStream(FMemStream);
|
|
FMemStream.Position := 0;
|
|
FImagesStream := TMemoryStream.Create;
|
|
ANode := VirtualTreeView.Items[0];
|
|
while ANode <> nil do
|
|
begin
|
|
FImagesStream.Write(ANode.ImageIndex, SizeOf(Integer));
|
|
FImagesStream.Write(ANode.SelectedIndex, SizeOf(Integer));
|
|
FImagesStream.Write(ANode.StateIndex, SizeOf(Integer));
|
|
ANode := ANode.GetNext;
|
|
end;
|
|
FImagesStream.Position := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxTreeViewEdit.PrepareDropDown;
|
|
begin
|
|
inherited;
|
|
SearchTreeNode;
|
|
end;
|
|
|
|
procedure TCustomdxTreeViewEdit.DropDown;
|
|
begin
|
|
if GetRealParentForm(Self) <> FOldParentForm then
|
|
begin
|
|
FOldParentForm := GetRealParentForm(Self);
|
|
TPopupTreeView(VirtualTreeView).RecreateWnd;
|
|
end;
|
|
FOldSelected := Selected;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomdxTreeViewEdit.CloseUp(Accept: Boolean);
|
|
begin
|
|
if FListVisible and not Accept and (VirtualTreeView <> nil) then
|
|
VirtualTreeView.Selected := FOldSelected;
|
|
inherited CloseUp(Accept);
|
|
end;
|
|
|
|
procedure TCustomdxTreeViewEdit.SearchTreeNode;
|
|
var
|
|
i: Integer;
|
|
St: string;
|
|
begin
|
|
if Length(FText) = 0 then
|
|
Exit;
|
|
if TextStyle = tvtsShort then
|
|
begin
|
|
for i := 0 to VirtualTreeView.Items.Count - 1 do
|
|
if FText = VirtualTreeView.Items[i].Text then
|
|
begin
|
|
VirtualTreeView.Selected := VirtualTreeView.Items[i];
|
|
VirtualTreeView.Selected.MakeVisible;
|
|
Break;
|
|
end;
|
|
end
|
|
else
|
|
for i := 0 to VirtualTreeView.Items.Count - 1 do
|
|
begin
|
|
St := GetFullTreeNodeName(VirtualTreeView.Items[i], FDividedChar);
|
|
if FText = St then
|
|
begin
|
|
VirtualTreeView.Selected := VirtualTreeView.Items[i];
|
|
VirtualTreeView.Selected.MakeVisible;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxTreeViewEdit.GetTreeNodeByText(ParentTreeNode: TTreeNode;
|
|
Text: string; flag: Boolean): TTreeNode;
|
|
var
|
|
tmp: TTreeNode;
|
|
begin
|
|
Result := nil;
|
|
if ParentTreeNode = nil then
|
|
begin
|
|
tmp := VirtualTreeView.Items.GetFirstNode;
|
|
while (tmp <> nil) and (Result = nil) do
|
|
if tmp.Text = Text then
|
|
Result := tmp
|
|
else
|
|
tmp := tmp.GetNext;
|
|
end
|
|
else
|
|
begin
|
|
tmp := ParentTreeNode.GetFirstChild;
|
|
while (tmp <> nil) and (Result = nil) do
|
|
if tmp.Text = Text then
|
|
Result := tmp
|
|
else
|
|
begin
|
|
if flag and tmp.HasChildren then
|
|
Result := GetTreeNodeByText(tmp, Text, flag);
|
|
if Result = nil then
|
|
tmp := ParentTreeNode.GetNextChild(tmp);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxTreeViewEdit.GetItems: TTreeNodes;
|
|
begin
|
|
Result := VirtualTreeView.Items;
|
|
end;
|
|
|
|
procedure TCustomdxTreeViewEdit.SetItems(Value: TTreeNodes);
|
|
begin
|
|
VirtualTreeView.Items := Value;
|
|
end;
|
|
|
|
{ TdxDBTreeViewEdit }
|
|
|
|
constructor TdxDBTreeViewEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csReplicatable];
|
|
|
|
FDataLink := TFieldDataLink.Create;
|
|
FDataLink.Control := Self;
|
|
FDataLink.OnDataChange := DataChange;
|
|
FDataLink.OnUpdateData := UpdateData;
|
|
end;
|
|
|
|
destructor TdxDBTreeViewEdit.Destroy;
|
|
begin
|
|
FDataLink.Free;
|
|
FDataLink := nil;
|
|
FCanvas.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TdxDBTreeViewEdit.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then
|
|
DataSource := nil;
|
|
end;
|
|
|
|
procedure TdxDBTreeViewEdit.DataChange(Sender: TObject);
|
|
begin
|
|
if FDataLink.Field <> nil then
|
|
begin
|
|
if FAlignment <> FDataLink.Field.Alignment then
|
|
FAlignment := FDataLink.Field.Alignment;
|
|
Text := FDataLink.Field.Text
|
|
end
|
|
else
|
|
if csDesigning in ComponentState then
|
|
Text := Name
|
|
else
|
|
Text := '';
|
|
end;
|
|
|
|
procedure TdxDBTreeViewEdit.UpdateData(Sender: TObject);
|
|
begin
|
|
if (FDataLink.Field <> nil) and FDataLink.Edit then
|
|
FDataLink.Field.Text := Text
|
|
else
|
|
Text := '';
|
|
end;
|
|
|
|
procedure TdxDBTreeViewEdit.DropDown;
|
|
begin
|
|
inherited DropDown;
|
|
FDataLink.Modified;
|
|
end;
|
|
|
|
procedure TdxDBTreeViewEdit.DropDownOk;
|
|
var
|
|
AStoredText: string;
|
|
begin
|
|
inherited DropDownOk;
|
|
AStoredText := FText;
|
|
if (FDataLink.Field <> nil) and (FDataLink.Edit) then
|
|
FDataLink.Field.Text := AStoredText
|
|
else Text := '';
|
|
end;
|
|
|
|
function TdxDBTreeViewEdit.GetPaintedText: string;
|
|
begin
|
|
if FDataLink.Field <> nil then
|
|
Result := FDataLink.Field.Text
|
|
else Result := '';
|
|
end;
|
|
|
|
function TdxDBTreeViewEdit.IsReadOnly: Boolean;
|
|
begin
|
|
Result := ReadOnly;
|
|
end;
|
|
|
|
function TdxDBTreeViewEdit.GetDataSource: TDataSource;
|
|
begin
|
|
Result := FDataLink.DataSource;
|
|
end;
|
|
|
|
procedure TdxDBTreeViewEdit.SetDataSource(Value: TDataSource);
|
|
begin
|
|
FDataLink.DataSource := Value;
|
|
if Value <> nil then
|
|
Value.FreeNotification(Self);
|
|
end;
|
|
|
|
function TdxDBTreeViewEdit.GetDataField: string;
|
|
begin
|
|
Result := FDataLink.FieldName;
|
|
end;
|
|
|
|
procedure TdxDBTreeViewEdit.SetDataField(const Value: string);
|
|
begin
|
|
FDataLink.FieldName := Value;
|
|
end;
|
|
|
|
function TdxDBTreeViewEdit.GetReadOnly: Boolean;
|
|
begin
|
|
Result := FDataLink.ReadOnly;
|
|
end;
|
|
|
|
procedure TdxDBTreeViewEdit.SetReadOnly(Value: Boolean);
|
|
begin
|
|
FDataLink.ReadOnly := Value;
|
|
end;
|
|
|
|
function TdxDBTreeViewEdit.GetField: TField;
|
|
begin
|
|
Result := FDataLink.Field;
|
|
end;
|
|
|
|
procedure TdxDBTreeViewEdit.CMExit(var Message: TCMExit);
|
|
begin
|
|
try
|
|
FDataLink.UpdateRecord;
|
|
except
|
|
SetFocus;
|
|
raise;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxDBTreeViewEdit.CMGetDatalink(var Message: TMessage);
|
|
begin
|
|
Message.Result := Integer(FDataLink);
|
|
end;
|
|
|
|
{ TDataLinkLookupTreeView }
|
|
|
|
procedure TDataLinkLookupTreeView.ActiveChanged;
|
|
begin
|
|
if LookupTreeView <> nil then
|
|
LookupTreeView.DataLinkActiveChanged;
|
|
end;
|
|
|
|
{ TCustomdxLookupTreeView }
|
|
constructor TCustomdxLookupTreeView.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ListLink := TDataLinkLookupTreeView.Create;
|
|
ListLink.LookupTreeView := Self;
|
|
FKeyFieldValue := Null;
|
|
DBTreeView := TPopupDBTreeView.Create(Self);
|
|
CreateVirtualTreeView;
|
|
end;
|
|
|
|
destructor TCustomdxLookupTreeView.Destroy;
|
|
begin
|
|
ListLink.LookupTreeView := nil;
|
|
ListLink.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TCustomdxLookupTreeView.VirtualTreeView: TCustomdxTreeView;
|
|
begin
|
|
Result := DBTreeView;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.DropDown;
|
|
begin
|
|
with DBTreeView do
|
|
begin
|
|
if GetRealParentForm(Self) <> FOldParentForm then
|
|
begin
|
|
FOldParentForm := GetRealParentForm(Self);
|
|
TPopupDBTreeView(DBTreeView).RecreateWnd;
|
|
end;
|
|
KeyField := FKeyFieldName;
|
|
ParentField := FParentFieldName;
|
|
ListField := FListFieldName;
|
|
DisplayField := FDisplayFieldName;
|
|
OnSetDisplayItemText := FOnSetDisplayItemText;
|
|
ImageIndexField := FImageIndexFieldName;
|
|
StateIndexField := FStateIndexFieldName;
|
|
DataSource := ListSource;
|
|
end;
|
|
if not VarIsNull(FKeyFieldValue) then
|
|
DBTreeView.GotoKeyFieldValue(FKeyFieldValue);
|
|
if FAssignField <> nil then
|
|
FDropDownKeyValue := FAssignField.Value
|
|
else
|
|
if FKeyField <> nil then
|
|
FDropDownKeyValue := FKeyField.Value;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.CloseUp(Accept: Boolean);
|
|
begin
|
|
inherited CloseUp(Accept);
|
|
if not Accept then
|
|
ResetDropDown;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.DropDownOk;
|
|
begin
|
|
inherited;
|
|
FKeyFieldValue := Null;
|
|
if FKeyField <> nil then
|
|
FKeyFieldValue := FKeyField.Value;
|
|
if (FTextStyle <> tvtsFull) and (FListField <> nil) then
|
|
Text := FListField.DisplayText;
|
|
end;
|
|
|
|
function TCustomdxLookupTreeView.GetListSource: TDataSource;
|
|
begin
|
|
Result := ListLink.DataSource;
|
|
end;
|
|
|
|
function TCustomdxLookupTreeView.GetAddNewItem: TAddNewDBTreeNodeEvent;
|
|
begin
|
|
Result := DBTreeView.onAddNewItem;
|
|
end;
|
|
|
|
function TCustomdxLookupTreeView.GetOptions: TdxDBTreeViewOptions;
|
|
begin
|
|
Result := DBTreeView.Options;
|
|
end;
|
|
|
|
function TCustomdxLookupTreeView.GetRootValue: {$IFNDEF DELPHI6}string{$ELSE}Variant{$ENDIF};
|
|
begin
|
|
Result := DBTreeView.RootValue;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.SetAddNewItem(Value: TAddNewDBTreeNodeEvent);
|
|
begin
|
|
DBTreeView.OnAddNewItem := Value;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.SetKeyField(Value: string);
|
|
begin
|
|
if Value <> FKeyFieldName then
|
|
begin
|
|
FKeyFieldName := Value;
|
|
DataLinkActiveChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.SetListField(Value: string);
|
|
begin
|
|
if Value <> FListFieldName then
|
|
begin
|
|
FListFieldName := Value;
|
|
DataLinkActiveChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.SetOptions(Value: TdxDBTreeViewOptions);
|
|
begin
|
|
DBTreeView.Options := Value;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.SetRootValue(Value: {$IFNDEF DELPHI6}string{$ELSE}Variant{$ENDIF});
|
|
begin
|
|
DBTreeView.RootValue := Value;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.SetParentField(Value: string);
|
|
begin
|
|
if Value <> FParentFieldName then
|
|
begin
|
|
FParentFieldName := Value;
|
|
DataLinkActiveChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.SetListSource(Value: TDataSource);
|
|
begin
|
|
if Value <> ListLink.DataSource then
|
|
ListLink.DataSource := Value;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.SetAssignField(Value: string);
|
|
begin
|
|
if Value <> FAssignFieldName then
|
|
begin
|
|
FAssignFieldName := Value;
|
|
DataLinkActiveChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.DataLinkActiveChanged;
|
|
begin
|
|
FKeyField := nil;
|
|
FListField := nil;
|
|
FAssignField := nil;
|
|
FParentField := nil;
|
|
if ListLink.Active then
|
|
begin
|
|
if FKeyFieldName <> '' then
|
|
FKeyField := ListLink.DataSet.FieldByName(FKeyFieldName);
|
|
if FListFieldName <> '' then
|
|
FListField := ListLink.DataSet.FieldByName(FListFieldName);
|
|
if FAssignFieldName <> '' then
|
|
FAssignField := ListLink.DataSet.FieldByName(FAssignFieldName);
|
|
if FParentFieldName <> '' then
|
|
FParentField := ListLink.DataSet.FieldByName(FParentFieldName);
|
|
if FKeyField <> nil then
|
|
FKeyFieldValue := FKeyField.Value;
|
|
if FListField <> nil then
|
|
Text := FListField.DisplayText;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxLookupTreeView.ResetDropDown;
|
|
begin
|
|
if FAssignField <> nil then
|
|
DBTrDataSetLocate(ListLink.DataSet, FAssignFieldName, FDropDownKeyValue, [])
|
|
else
|
|
if FKeyField <> nil then
|
|
DBTrDataSetLocate(ListLink.DataSet, FKeyFieldName, FDropDownKeyValue, []);
|
|
end;
|
|
|
|
{ TdxDBLookupTreeView }
|
|
|
|
constructor TdxDBLookupTreeView.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csReplicatable];
|
|
FDataLink := TFieldDataLink.Create;
|
|
FDataLink.Control := Self;
|
|
FDataLink.OnDataChange := DataChange;
|
|
FDataLink.OnActiveChange := ActiveChange;
|
|
FDataLink.OnUpdateData := UpdateData;
|
|
FCloseUpFlag := False;
|
|
end;
|
|
|
|
destructor TdxDBLookupTreeView.Destroy;
|
|
begin
|
|
FDataLink.Free;
|
|
FDataLink := nil;
|
|
FCanvas.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then
|
|
DataSource := nil;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.SearchTreeNode;
|
|
begin
|
|
if (FDataLink.Field <> nil) and (DBTreeView <> nil) then
|
|
DBTreeView.GotoKeyFieldValue(FDataLink.Field.Value);
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.PrepareDropDown;
|
|
begin
|
|
inherited;
|
|
SearchTreeNode;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.ActiveChange(Sender: TObject);
|
|
begin
|
|
CheckNotCircular;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.DataChange(Sender: TObject);
|
|
begin
|
|
if FUpdateDataFlag then Exit;
|
|
|
|
if (FListField <> nil) and (FAlignment <> FListField.Alignment) then
|
|
FAlignment := FListField.Alignment;
|
|
if FDataLink.Field <> nil then
|
|
Text := GetDisplayText
|
|
else
|
|
if csDesigning in ComponentState then
|
|
Text := Name
|
|
else
|
|
Text := '';
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.UpdateData(Sender: TObject);
|
|
begin
|
|
FUpdateDataFlag := True;
|
|
if FDataLink.Active then
|
|
begin
|
|
if not FDataLink.Editing then
|
|
FDataLink.Edit;
|
|
if (FDataLink.DataSet.State = dsInsert) or (FDataLink.dataSet.State = dsEdit) then
|
|
FDataLink.Field.Value := GetLookupValue;
|
|
end;
|
|
FUpdateDataFlag := False;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.DropDown;
|
|
begin
|
|
inherited DropDown;
|
|
FDataLink.Modified;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.DataLinkActiveChanged;
|
|
begin
|
|
CheckNotCircular;
|
|
inherited DataLinkActiveChanged;
|
|
DataChange(nil);
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.DropDownOk;
|
|
begin
|
|
inherited DropDownOk;
|
|
UpdateData(Self);
|
|
end;
|
|
|
|
function TdxDBLookupTreeView.GetPaintedText: string;
|
|
begin
|
|
Result := GetDisplayText;
|
|
end;
|
|
|
|
function TdxDBLookupTreeView.IsReadOnly: Boolean;
|
|
begin
|
|
Result := ReadOnly;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.CloseUp(Accept: Boolean);
|
|
begin
|
|
if FCloseUpFlag then Exit;
|
|
FCloseUpFlag := True;
|
|
inherited CloseUp(Accept);
|
|
FCloseUpFlag := False;
|
|
end;
|
|
|
|
function TdxDBLookupTreeView.GetDisplayText: string;
|
|
var
|
|
b: Boolean;
|
|
AKeyValue: Variant;
|
|
begin
|
|
Result := '';
|
|
if (FDataLink.Field = nil) or (FKeyField = nil) or (FListField = nil) or (FParentField = nil) then
|
|
Exit;
|
|
if ListLink.Active then
|
|
begin
|
|
ListLink.DataSet.DisableControls;
|
|
if FAssignField <> nil then
|
|
b:= DBTrDataSetLocate(ListLink.DataSet, FAssignFieldName, FDataLink.Field.Value, [])
|
|
else
|
|
b := DBTrDataSetLocate(ListLink.DataSet, FKeyFieldName, FDataLink.Field.Value, []);
|
|
if b then
|
|
begin
|
|
Result := FListField.Text;
|
|
if FTextStyle = tvtsFull then
|
|
begin
|
|
AKeyValue := FKeyField.Value;
|
|
while DBTrDataSetLocate(ListLink.DataSet, FKeyFieldName, FParentField.Value, [])
|
|
and not VarEquals(FParentField.Value, FKeyField.Value) do
|
|
Result := FListField.Text + FDividedChar + Result;
|
|
DBTrDataSetLocate(ListLink.DataSet, FKeyFieldName, AKeyValue, []);
|
|
end;
|
|
end;
|
|
ListLink.DataSet.EnableControls;
|
|
end;
|
|
end;
|
|
|
|
function TdxDBLookupTreeView.GetLookupValue: Variant;
|
|
begin
|
|
if not ListLink.Active then
|
|
Result := Null
|
|
else
|
|
if FAssignField <> nil then
|
|
Result := FAssignField.Value
|
|
else
|
|
Result := FKeyField.Value;
|
|
end;
|
|
|
|
function TdxDBLookupTreeView.GetDataSource: TDataSource;
|
|
begin
|
|
Result := FDataLink.DataSource;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.SetDataSource(Value: TDataSource);
|
|
begin
|
|
FDataLink.DataSource := Value;
|
|
if Value <> nil then
|
|
Value.FreeNotification(Self);
|
|
end;
|
|
|
|
function TdxDBLookupTreeView.GetDataField: string;
|
|
begin
|
|
Result := FDataLink.FieldName;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.SetDataField(const Value: string);
|
|
begin
|
|
FDataLink.FieldName := Value;
|
|
end;
|
|
|
|
function TdxDBLookupTreeView.GetReadOnly: Boolean;
|
|
begin
|
|
Result := FDataLink.ReadOnly;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.SetReadOnly(Value: Boolean);
|
|
begin
|
|
FDataLink.ReadOnly := Value;
|
|
end;
|
|
|
|
function TdxDBLookupTreeView.GetField: TField;
|
|
begin
|
|
Result := FDataLink.Field;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.CMExit(var Message: TCMExit);
|
|
begin
|
|
try
|
|
FDataLink.UpdateRecord;
|
|
except
|
|
SetFocus;
|
|
raise;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.CMGetDatalink(var Message: TMessage);
|
|
begin
|
|
Message.Result := Integer(FDataLink);
|
|
end;
|
|
|
|
procedure TdxDBLookupTreeView.CheckNotCircular;
|
|
begin
|
|
{$IFDEF DELPHI3}
|
|
if FDataLink.Active and ListLink.Active and (FDataLink.DataSet.IsLinkedTo(ListSource)
|
|
or ListLink.DataSet.IsLinkedTo(DataSource)) then
|
|
DatabaseError(SCircularDataLink);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
initialization
|
|
FUser32DLL := LoadLibrary('USER32');
|
|
|
|
end.
|