Componentes.Terceros.DevExp.../internal/x.44/1/ExpressQuantumTreeList 3/Sources/dxDBTL.pas
2009-06-29 12:09:02 +00:00

2571 lines
81 KiB
ObjectPascal

{*******************************************************************}
{ }
{ Developer Express Visual Component Library }
{ ExpressQuantumDBTreeList }
{ }
{ 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 }
{ }
{ 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 dxDBTL;
interface
{$I dxTLVer.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, dxUtils, dxTL, Mask, dxTLStr, dxCntner, dxEditor, dxDBCtrl{$IFDEF DELPHI6},
Variants{$ENDIF};
type
TdxDBTreeListOptionBehavior = (etoAnsiSort, etoAutoCopySelectedToClipboard,
etoAutoDragDrop, etoAutoDragDropCopy,
etoAutoSearch, etoAutoSort, etoBandButtonClicking, etoCaseInsensitive, etoDblClick,
etoDragCollapse, etoDragExpand, etoDragScroll, etoEditing, etoEnterShowEditor,
etoEnterThrough, etoHeaderButtonClicking, etoHorzThrough, etoImmediateEditor,
etoMouseScroll, etoMultiSelect, etoShowHourGlass, etoStoreToIniFile,
etoStoreToRegistry, etoTabs, etoTabThrough, etoVertThrough);
TdxDBTreeListOptionCustomize = (etoBandMoving, etoBandPanelSizing, etoBandSizing,
etoColumnMoving, etoColumnSizing, etoExtCustomizing, etoFullSizing,
etoHeaderPanelSizing, etoKeepColumnWidth, etoRowSizing);
TdxDBTreeListOptionDB = (etoAutoCalcKeyValue, etoCancelOnExit, etoCanDelete,
etoCanInsert, etoCanNavigation, etoCheckHasChildren, etoConfirmDelete,
etoLoadAllRecords, etoResetColumnFocus, etoSyncSelection, etoUseBookmarks);
TdxDBTreeListOptionView = (etoAutoCalcPreviewLines, etoAutoHeaderPanelHeight,
etoAutoWidth, etoBandHeaderWidth, etoDrawEndEllipsis, etoHideFocusRect, etoHotTrack,
etoIndicator, etoInvertSelect, etoPreview, etoRowAutoHeight, etoRowSelect,
etoShowButtonAlways, etoUseBitmap, etoUseImageIndexForSelected);
TdxDBTreeListOptionsBehavior = set of TdxDBTreeListOptionBehavior;
TdxDBTreeListOptionsCustomize = set of TdxDBTreeListOptionCustomize;
TdxDBTreeListOptionsDB = set of TdxDBTreeListOptionDB;
TdxDBTreeListOptionsView = set of TdxDBTreeListOptionView;
TdxChangeDBTreeListNodeInfo = record
Id: Variant;
Selected: Boolean;
end;
const
dxDBTreeListOptionsBehaviorDefault = [etoAutoDragDrop, etoAutoDragDropCopy,
{etoAutoSearch, }etoAutoSort, etoDragExpand, etoDragScroll, etoEditing,
etoEnterShowEditor, etoImmediateEditor, etoTabThrough];
dxDBTreeListOptionsCustomizeDefault = [etoBandMoving, etoBandSizing,
etoColumnMoving, etoColumnSizing, etoKeepColumnWidth];
dxDBTreeListOptionsDBDefault = [etoAutoCalcKeyValue, etoCancelOnExit,
etoCanDelete, {etoCanInsert, }etoCanNavigation, etoCheckHasChildren,
etoConfirmDelete, etoLoadAllRecords];
dxDBTreeListOptionsViewDefault = [etoBandHeaderWidth, {etoInvertSelect,}
etoRowSelect, etoUseBitmap, etoUseImageIndexForSelected];
type
TCustomdxDBTreeList = class;
{TdxDBTreeListDataLink}
TdxDBTreeListDataLink = class(TdxDBTreeListControlDataLink)
private
function GetDBTreeList: TCustomdxDBTreeList;
protected
// override TDataLink
procedure FocusControl(Field: TFieldRef); override;
procedure LayoutChanged; override;
property DBTreeList: TCustomdxDBTreeList read GetDBTreeList;
end;
{TdxDBTreeListNode}
TdxDBTreeListNode = class(TdxDBTreeListControlNode)
private
FParentId: Variant;
public
procedure Delete; override;
property ParentId: Variant read FParentId;
end;
{TCustomdxDBTreeList}
TdxDBTLGetUniqueKeyValueEvent = procedure(Sender: TObject; var UniqueKeyValue: Variant) of object;
TdxDBTLMoveToEvent = procedure(Sender: TObject; AttachNode: TdxDBTreeListNode;
AttachMode: TdxTreeListNodeAttachMode; Nodes: TList; var IsCopy, Done: Boolean) of object;
TCustomdxDBTreeList = class(TCustomdxDBTreeListControl)
private
FDataChangedBusy: Boolean;
FDataChangedLocate, FDataChangedLocateResync: Boolean;
FDataLink: TdxDBTreeListDataLink;
FFlagChangedGroupColumn: Boolean;
FImageIndexField: TField;
FImageIndexFieldName: string;
FInUpdateActive: Boolean;
FLocateByNode: Boolean;
FLockLayout: Integer;
FOptionsBehavior: TdxDBTreeListOptionsBehavior;
FOptionsCustomize: TdxDBTreeListOptionsCustomize;
FOptionsDB: TdxDBTreeListOptionsDB;
FOptionsView: TdxDBTreeListOptionsView;
FParentField: TField;
FParentFieldName: string;
FPrevNodeInfo: TdxChangeDBTreeListNodeInfo;
FRefreshTreeList: Boolean;
FRootValue: Variant;
FStateIndexField: TField;
FStateIndexFieldName: string;
FSelectAllFlag: Boolean;
FSelectedIndex: Integer;
FTotalSummaryCount: Integer;
FUpdatingNode: TdxDBTreeListNode;
FOnGetUniqueKeyValue: TdxDBTLGetUniqueKeyValueEvent;
FOnMoveTo: TdxDBTLMoveToEvent;
procedure CheckChangeNodeEx;
function GetOptionsBehavior: TdxDBTreeListOptionsBehavior;
function GetOptionsCustomize: TdxDBTreeListOptionsCustomize;
function GetOptionsDB: TdxDBTreeListOptionsDB;
function GetOptionsView: TdxDBTreeListOptionsView;
function GetRootValue: string;
function GetRootValueAsVariant: Variant;
procedure InsertNode(FAppend: Boolean);
procedure LoadChangeNodeInfo(var NodeInfo: TdxChangeDBTreeListNodeInfo);
procedure SetDataSource(Value: TDataSource);
procedure SetImageIndexFieldName(const Value: string);
procedure SetOptionsBehavior(Value: TdxDBTreeListOptionsBehavior);
procedure SetOptionsCustomize(Value: TdxDBTreeListOptionsCustomize);
procedure SetOptionsDB(Value: TdxDBTreeListOptionsDB);
procedure SetOptionsView(Value: TdxDBTreeListOptionsView);
procedure SetParentFieldName(const Value: string);
procedure SetRootValue(const Value: string);
procedure SetSelectedIndex(Value: Integer);
procedure SetStateIndexFieldName(const Value: string);
procedure UpdateActive;
protected
// override TComponent
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
// Selected
procedure DoSelectedCountChange; override;
function IsNodeSelected(ANode: TdxTreeListNode): Boolean; override;
procedure NodeSelected(ANode: TdxTreeListNode; ASelected: Boolean); override;
// Sorting
procedure SetColumnSorted(Column: TdxTreeListColumn); override;
// Style
function CanDblClick: Boolean; override;
procedure DoBeforeExpand(Node: TdxTreeListNode; var AllowExpand: Boolean); override;
procedure EndCustomLayout; override;
// based override
function CreateNode: TdxTreeListNode; override;
procedure DeleteNode(Node, Prior, Next: TdxTreeListNode; IsLast, Redraw: Boolean); override;
function GetFooterCellText(Node: TdxTreeListNode; AbsoluteIndex, FooterIndex: Integer): string; override;
function GetNodeString(Node: TdxTreeListNode; Column: Integer{AbsoluteIndex}): string; override;
function GetNodeValue(Node: TdxTreeListNode; Column: Integer{AbsoluteIndex}): Variant; override;
function GetNodeVariant(Node: TdxTreeListNode; Column: Integer{AbsoluteIndex}): Variant; override;
function GetPreviewText(Node: TdxTreeListNode): string; override;
procedure ResetAutoHeaderPanelRowCountOption; override;
procedure SetFocusedNode(Node: TdxTreeListNode; Column: Integer; MakeVisibleFlag: Boolean); override;
// DBTreeListControl
procedure ChangedGroupColumn(Column: TdxDBTreeListColumn); override;
function GetDataLink: TdxDBTreeListControlDataLink; override;
function GetDataSource: TDataSource; override;
function GetDefaultFields: Boolean; override;
function IsAutoCalcKeyValue: Boolean; virtual;
function IsAutoDragCopy: Boolean; override;
function IsAutoDragDrop: Boolean; virtual;
function IsAutoSearch: Boolean; override;
function IsCancelOnExit: Boolean; override;
function IsCanInsert: Boolean; override;
function IsCanNavigation: Boolean; override;
function IsKeyFieldEmpty: Boolean; override;
function IsLoadAllRecords: Boolean;
function IsLoadedAll: Boolean; override;
function IsUseBookmarks: Boolean; override;
procedure SetDataChangedBusy(Value: Boolean); override;
// DataSet
procedure DataChanged; override;
function IsDataSetBusy: Boolean; override;
procedure LinkActive(Value: Boolean); override;
procedure RecordChanged(Field: TField); override;
procedure Scroll(Distance: Integer); override;
// based
procedure AssignKeyFields;
procedure AssignNodeAllValues(Node: TdxDBTreeListControlNode); override;
procedure AssignSummaryFooterFields; override;
procedure CalcSummary; // Count , Average
procedure FindNodeById;
function GetUniqueKeyValue(const Delta: Variant): Variant; virtual;
procedure LoadTreeList(LoadingNode: TdxDBTreeListNode);
function LocateByNode(OldNode, Node: TdxDBTreeListNode; const Value: Variant): Boolean;
procedure RefreshNodeValues(var Node: TdxDBTreeListControlNode); override;
procedure RefreshTreeList;
procedure ReloadTreeList(AClearNodes: Boolean);
// Drag Drop
procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override;
function GetNodeAttachMode(X, Y: Integer; var DestNode: TdxTreeListNode;
var AttachMode: TdxTreeListNodeAttachMode): boolean; virtual;
// Save/Load
procedure BeginReadSettings(ARegIniWrapper: TdxRegIniWrapper); override;
procedure EndReadSettings(ARegIniWrapper: TdxRegIniWrapper); override;
procedure ReadSettings(ARegIniWrapper: TdxRegIniWrapper; const APath: string); override;
procedure WriteSettings(ARegIniWrapper: TdxRegIniWrapper; const APath: string); override;
// Navigation
function GetNodeByNavigation(ANode: TdxTreeListNode; ANavigationMode: TdxTreeListNavigationMode;
AGotoHidden: Boolean): TdxTreeListNode; override;
property DataChangedLocate: Boolean read FDataChangedLocate;
property LockLayout: Integer read FLockLayout;
property ImageIndexFieldName: string read FImageIndexFieldName write SetImageIndexFieldName;
property OptionsBehavior: TdxDBTreeListOptionsBehavior read GetOptionsBehavior
write SetOptionsBehavior default dxDBTreeListOptionsBehaviorDefault;
property OptionsCustomize: TdxDBTreeListOptionsCustomize read GetOptionsCustomize
write SetOptionsCustomize default dxDBTreeListOptionsCustomizeDefault;
property OptionsDB: TdxDBTreeListOptionsDB read GetOptionsDB
write SetOptionsDB default dxDBTreeListOptionsDBDefault;
property OptionsView: TdxDBTreeListOptionsView read GetOptionsView
write SetOptionsView default dxDBTreeListOptionsViewDefault;
property RootValue: string read GetRootValue write SetRootValue;
property RootValueAsVariant: Variant read GetRootValueAsVariant;
property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex default -1;
property StateIndexFieldName: string read FStateIndexFieldName write SetStateIndexFieldName;
// TL override
property HideFocusRect default False;
property HideSelection default False;
// Events
property OnGetUniqueKeyValue: TdxDBTLGetUniqueKeyValueEvent read FOnGetUniqueKeyValue write FOnGetUniqueKeyValue;
property OnMoveTo: TdxDBTLMoveToEvent read FOnMoveTo write FOnMoveTo;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BeginLayout;
procedure BeginSelection; override;
procedure DeleteSelection; override;
procedure DragDrop(Source: TObject; X, Y: Integer); override;
procedure EndLayout;
procedure EndSelection; override;
function FindNodeByKeyValue(const Value: Variant): TdxDBTreeListNode;
procedure FullRefresh; override;
class function GetDefaultFieldColumnClass(AField: TField): TdxDBTreeListColumnClass; override;
procedure RefreshSorting; override;
procedure SelectAll;
property DataLink: TdxDBTreeListDataLink read FDataLink;
property DataSetChangedBusy: Boolean read FDataChangedBusy;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property LockRefresh;
published
property KeyField;
property ParentField: string read FParentFieldName write SetParentFieldName;
end;
{TdxDBTreeList}
TdxDBTreeList = class(TCustomdxDBTreeList)
public
property DragNode;
property EditingText;
property FocusedField;
property HotTrackInfo;
property RootValueAsVariant;
property SelectedCount;
property SelectedNodes;
property SelectedRows;
property TopIndex;
published
// standard
property Align;
property BorderStyle;
property Color;
property Ctl3D;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
{$IFDEF DELPHI4}
property Anchors;
property Constraints;
{$ENDIF}
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
{$IFDEF DELPHI5}
property OnContextPopup;
{$ENDIF}
// original
property ArrowsColor;
property AutoExpandOnSearch;
property AutoSearchColor;
property AutoSearchTextColor;
property BandColor;
property BandFont;
property CustomizingRowCount;
property DataSource;
property DefaultRowHeight;
property DblClkExpanding;
property FixedBandLineColor;
property FixedBandLineWidth;
property GridLineColor;
property GrIndicatorWidth;
property GroupNodeColor;
property GroupNodeTextColor;
property HeaderColor;
property HeaderFont;
property HideFocusRect;
property HideSelection;
property HideSelectionColor;
property HideSelectionTextColor;
property HighlightColor;
property HighlightTextColor;
property ImageIndexFieldName;
property Images;
property IndentDesc;
property IniFileName;
property IniSectionName;
property LookAndFeel;
property MaxRowLineCount;
property OptionsBehavior;
property OptionsCustomize;
property OptionsDB;
property OptionsView;
property PaintStyle;
property PreviewFieldName;
property PreviewFont;
property PreviewLines;
property PreviewMaxLength;
property RegistryPath;
property RootValue;
property RowSeparatorLineWidth;
property ScrollBars;
property SelectedIndex;
property ShowBands;
property ShowButtons;
property ShowFooter;
property ShowGrid;
property ShowHeader;
property ShowHiddenInCustomizeBox;
property ShowLines;
property ShowNewItemRow;
property ShowPreviewGrid;
property ShowRoot;
property SimpleCustomizeBox;
property StateImages;
property StateIndexFieldName;
property TreeLineColor;
property TreeLineStyle;
property WaitForExpandNodeTime;
// events
property OnGetUniqueKeyValue;
property OnMoveTo;
property OnGetImageIndex;
property OnGetSelectedIndex;
property OnGetStateIndex;
property OnBandButtonClick;
property OnBandClick;
property OnBeforeCalcSummary;
property OnBeginDragNode;
property OnCalcRowLineHeight;
property OnCalcSummary;
property OnCanBandDragging;
property OnCanHeaderDragging;
property OnCanNodeSelected;
property OnChangeColumn;
property OnChangedColumnsWidth;
property OnChangeLeftCoord;
property OnChangeNode;
property OnChangeNodeEx;
property OnChangeTopVisibleNode;
property OnCollapsed;
property OnCollapsing;
property OnColumnClick;
property OnColumnSorting;
property OnCompare;
property OnCustomDrawBand;
property OnCustomDrawCell;
property OnCustomDrawColumnHeader;
property OnCustomDrawFooter;
property OnCustomDrawFooterNode;
property OnCustomDrawPreview;
property OnCustomDrawPreviewCell;
property OnDragEndBand;
property OnDragEndHeader;
property OnDragOverBand;
property OnDragOverHeader;
property OnDeletion;
property OnEditChange;
property OnEdited;
property OnEditing;
property OnEditValidate;
property OnEndColumnsCustomizing;
property OnExpanded;
property OnExpanding;
property OnGetEditColor;
property OnGetLevelColor;
property OnGetNodeDragText;
property OnGetPreviewText;
property OnHeaderButtonClick;
property OnHeaderMoved;
property OnHideBand;
property OnHideHeader;
property OnHotTrackNode;
property OnIsExistFooterCell;
property OnRefreshNodeData;
property OnSelectedCountChange;
property OnShowBand;
property OnShowHeader;
property OnStartBandDragging;
property OnStartHeaderDragging;
end;
implementation
type
TdxDBTreeListControlColumn = class(TdxDBTreeListColumn);
TDummyDataSet = class(TDataSet);
PNodeBuffer =^TNodeBuffer;
TNodeBuffer = record
Key: Variant;
Buffer: Variant;
Items: TList;
end;
{TdxDBTreeListDataLink}
procedure TdxDBTreeListDataLink.FocusControl(Field: TFieldRef);
begin
if Assigned(Field) and Assigned(Field^) then
begin
with DBTreeList do
begin
if IsCanNavigation and not IsRowSelect and (FocusedNode <> nil) then
begin
FocusedNode.MakeVisible;
if IsNewItemRowVisible then NewItemRowActive := True; // new item row
FocusedField := Field^;
if (FocusedField = Field^) and AcquireFocus then
begin
Field^ := nil;
ShowEditor;
end;
end;
end;
end;
end;
procedure TdxDBTreeListDataLink.LayoutChanged;
begin
DBTreeList.ReloadTreeList(False);
end;
function TdxDBTreeListDataLink.GetDBTreeList: TCustomdxDBTreeList;
begin
Result := DBTreeListControl as TCustomdxDBTreeList;
end;
{ TdxDBTreeListNode }
procedure TdxDBTreeListNode.Delete;
var
DBTreeList: TCustomdxDBTreeList;
List: TList;
I: Integer;
procedure LoadListByNode(ANode: TdxDBTreeListNode);
var
P: PVariant;
I: Integer;
begin
New(P);
P^ := ANode.Id;
List.Add(P);
for I := 0 to ANode.Count - 1 do
LoadListByNode(TdxDBTreeListNode(ANode[I]));
end;
procedure LoadListByID(const AKeyValue: Variant);
var
P: PVariant;
TempList: TList;
I: Integer;
begin
New(P);
P^ := AKeyValue;
List.Add(P);
with DBTreeList.DataLink.DataSet do
if Locate(DBTreeList.ParentField, AKeyValue, []) then
begin
TempList := TList.Create;
try
while not Eof and (DBTreeList.FParentField.Value = AKeyValue) do
begin
New(P);
P^ := DBTreeList.FKeyField.Value;
TempList.Add(P);
Next;
end;
for I := 0 to TempList.Count - 1 do
LoadListByID(PVariant(TempList[I])^);
finally
for I := 0 to TempList.Count - 1 do
Dispose(TempList[I]);
TempList.Free;
end;
end;
end;
begin
DBTreeList := TCustomdxDBTreeList(Owner);
if DBTreeList.DataLink.Active then
begin
if not HasChildren then
begin
if DBTreeList.DataLink.DataSet.Locate(DBTreeList.KeyField, Self.Id, []) then
DBTreeList.DataLink.DataSet.Delete;
end
else
with DBTreeList.DataLink.DataSet do
begin
DisableControls;
try
List := TList.Create;
try
if DBTreeList.IsLoadAllRecords then
LoadListByNode(Self)
else
LoadListByID(Self.Id);
// Delete Nodes
for I := List.Count - 1 downto 0 do
if Locate(DBTreeList.KeyField, PVariant(List[I])^, []) then
Delete;
finally
for I := 0 to List.Count - 1 do
Dispose(List[I]);
List.Free;
end;
finally
EnableControls;
end;
end;
end;
end;
{TCustomdxDBTreeList}
constructor TCustomdxDBTreeList.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TdxDBTreeListDataLink.Create(Self);
RegisterDBTreeListControl(Self); // add self to grid list
// Options
FOptionsBehavior := dxDBTreeListOptionsBehaviorDefault;
FOptionsCustomize := dxDBTreeListOptionsCustomizeDefault;
FOptionsDB := dxDBTreeListOptionsDBDefault;
FOptionsView := dxDBTreeListOptionsViewDefault;
inherited Options := [aoColumnSizing, aoColumnMoving, aoEditing, aoTabThrough,
aoImmediateEditor, aoExtMultiSelect, aoAutoSort, aoRowSelect];
inherited OptionsEx := [aoUseBitmap, aoBandHeaderWidth, aoBandSizing, aoBandMoving,
aoEnterShowEditor, aoDragScroll, aoDragExpand, aoMultiSort, aoKeepColumnWidth
{, aoAutoSearch, aoInvertSelect}];
FRootValue := Null;
FSelectedIndex := -1;
// TL override
HideFocusRect := False;
HideSelection := False;
end;
destructor TCustomdxDBTreeList.Destroy;
begin
try
DoSaveLayout;
finally
BeforeDestroy;
ClearListNodes;
ClearSelection;
FDataLink.Free;
FDataLink := nil;
UnRegisterDBTreeListControl(Self); // remove self from grid list
inherited Destroy;
end;
end;
procedure TCustomdxDBTreeList.BeginLayout;
begin
BeginUpdate;
if FLockLayout = 0 then
FDataChangedBusy := True;
Inc(FLockLayout);
end;
procedure TCustomdxDBTreeList.BeginSelection;
begin
if (LockSelection = 0) and Assigned(OnChangeNodeEx) then
LoadChangeNodeInfo(FPrevNodeInfo);
inherited BeginSelection;
end;
procedure TCustomdxDBTreeList.DeleteSelection;
var
List: TList;
I: Integer;
begin
inherited DeleteSelection;
if Datalink.Active then
with Datalink.Datasource.Dataset do
begin
DisableControls;
try
BeginUpdate;
List := TList.Create;
try
// Make List
for I := 0 to SelectedCount - 1 do
List.Add(SelectedNodes[I]);
// Clear Selection
ClearSelection;
// sort and remove dublicate
List.Sort(CompareParentNode);
for I := List.Count - 1 downto 1 do
if TdxTreeListNode(List[I]).HasAsParent(TdxTreeListNode(List[I - 1])) then
List.Delete(I);
if State in dsEditModes then Cancel;
// Delete
for I := 0 to List.Count - 1 do
TdxDBTreeListNode(List[I]).Delete;
finally
List.Free;
EndUpdate;
end;
finally
EnableControls;
end;
end;
end;
procedure TCustomdxDBTreeList.DragDrop(Source: TObject; X, Y: Integer);
var
Node: TdxTreeListNode;
NodeAttachMode: TdxTreeListNodeAttachMode;
Accept, Done, DragCopy: Boolean;
I: Integer;
List: TList;
NewParentValue, KeyValue, Delta: Variant;
// Drag Copy
AFieldList: TList;
F: TField;
BufferList: TList;
function LoadBufferValues(const AKeyValue: Variant): PNodeBuffer;
var
I: Integer;
begin
New(Result);
Result^.Items := nil;
Result^.Key := AKeyValue;
Result^.Buffer := VarArrayCreate([0, AFieldList.Count - 1], varVariant);
for I := 0 to AFieldList.Count - 1 do
Result^.Buffer[I] := TField(AFieldList[I]).Value;
end;
procedure LoadSubItems(PBuffer: PNodeBuffer);
var
AParentValue: Variant;
I: Integer;
begin
with Datalink.DataSet do
begin
AParentValue := PBuffer^.Key;
if Locate(ParentField, AParentValue, []) then
begin
PBuffer^.Items := TList.Create;
while not EOF and (FParentField.Value = AParentValue) do
begin
PBuffer^.Items.Add(LoadBufferValues(FKeyField.Value));
Next;
end;
for I := 0 to PBuffer^.Items.Count - 1 do
LoadSubItems(PNodeBuffer(PBuffer^.Items[I]));
end;
end;
end;
procedure AddNewNode(PBuffer: PNodeBuffer; const AParentValue: Variant);
var
I: Integer;
Key: Variant;
begin
with Datalink.DataSet do
begin
Insert;
if (etoAutoCalcKeyValue in OptionsDB) and FKeyField.IsNull then
begin
FKeyField.Value := GetUniqueKeyValue(Delta);
Inc(Delta);
end;
Key := FKeyField.Value;
FParentField.Value := AParentValue;
for I := 0 to AFieldList.Count - 1 do
TField(AFieldList[I]).Value := PBuffer^.Buffer[I];
Post;
// add children
if PBuffer^.Items <> nil then
for I := 0 to PBuffer^.Items.Count - 1 do
AddNewNode(PBuffer^.Items[I], Key);
end;
end;
procedure FreeBuffer(PBuffer: PNodeBuffer);
var
I: Integer;
L: TList;
begin
L := PBuffer^.Items;
if L <> nil then
begin
for I := 0 to L.Count - 1 do
FreeBuffer(L[I]);
L.Free;
end;
Dispose(PBuffer);
end;
begin
if IsAutoDragDrop then
begin
DragCopy := IsAutoDragCopy and (GetAsyncKeyState(VK_CONTROL) < 0);
Accept := (Source = Self) and GetNodeAttachMode(X, Y, Node, NodeAttachMode);
if Accept then
begin
// Make List Nodes
List := TList.Create;
try
if SelectedCount = 0 then
List.Add(DragNode)
else
for I := 0 to SelectedCount - 1 do
List.Add(SelectedNodes[I]);
Done := False;
if Assigned(FOnMoveTo) then
FOnMoveTo(Self, TdxDBTreeListNode(Node), NodeAttachMode, List, DragCopy, Done);
// Move
if not Done then
with Datalink.DataSet do
begin
if NodeAttachMode in [natlAddChild, natlAddChildFirst] then
NewParentValue := TdxDBTreeListNode(Node).Id
else NewParentValue := TdxDBTreeListNode(Node).ParentId;
DisableControls;
try
if not DragCopy then
begin
// move drag nodes
for I := 0 to List.Count - 1 do
if Locate(KeyField, TdxDBTreeListNode(List[I]).Id, []) then
begin
Edit;
FParentField.Value := NewParentValue;
Post;
end;
end
else
begin
// copy drag nodes
AFieldList := TList.Create;
try
// create Field List
for I := 0 to FieldCount - 1 do
begin
F := Fields[I];
if F.FieldKind = fkLookup then
F := FindField(F.KeyFields)
else
if (F = FKeyField) or (F = FParentField) or (F.FieldKind <> fkData) then
F := nil;
if Assigned(F) and F.CanModify then
AFieldList.Add(F);
end;
if AFieldList.Count > 0 then
begin
// sort and remove dublicate
List.Sort(CompareParentNode);
for I := List.Count - 1 downto 1 do
if TdxTreeListNode(List[I]).HasAsParent(TdxTreeListNode(List[I - 1])) then
List.Delete(I);
// make Buffer List
BufferList := TList.Create;
try
for I := 0 to List.Count - 1 do
begin
KeyValue := TdxDBTreeListNode(List[I]).Id;
if Locate(KeyField, KeyValue, []) then
begin
BufferList.Add(LoadBufferValues(KeyValue));
LoadSubItems(BufferList[I]);
end;
end;
// create new nodes
Delta := 0;
for I := 0 to BufferList.Count - 1 do
AddNewNode(BufferList[I], NewParentValue);
finally
for I := 0 to BufferList.Count - 1 do
FreeBuffer(PNodeBuffer(BufferList[I]));
BufferList.Free;
end;
end;
finally
AFieldList.Free;
end;
end;
finally
EnableControls;
end;
end;
finally
List.Free;
end;
end;
end;
inherited;
end;
procedure TCustomdxDBTreeList.EndLayout;
begin
Dec(FLockLayout);
if FLockLayout = 0 then
begin
FDataChangedBusy := False;
FullRefresh;
end;
EndUpdate;
end;
procedure TCustomdxDBTreeList.EndSelection;
begin
inherited EndSelection;
if (LockSelection = 0) and Assigned(OnChangeNodeEx) then
CheckChangeNodeEx;
end;
function TCustomdxDBTreeList.FindNodeByKeyValue(const Value: Variant): TdxDBTreeListNode;
function Find(ANode: TdxTreeListNode; var Node: TdxDBTreeListNode): Boolean;
var
I: Integer;
begin
Result := False;
if TdxDBTreeListNode(ANode).Id = Value then
begin
Node := TdxDBTreeListNode(ANode);
Result := True;
end
else
for I := 0 to ANode.Count - 1 do
if Find(ANode[I], Node) then
begin
Result := True;
Break;
end;
end;
var
I: Integer;
begin
Result := nil;
for I := 0 to Count - 1 do
if Find(Items[I], Result) then Break;
end;
procedure TCustomdxDBTreeList.FullRefresh;
begin
if FLockLayout = 0 then
ReloadTreeList(True{ClearNodes});
end;
class function TCustomdxDBTreeList.GetDefaultFieldColumnClass(AField: TField): TdxDBTreeListColumnClass;
begin
if AField.FieldKind = fkLookup then
Result := DefaultDBTreeListLookupColumnType.ColumnClass
else
if AField.FieldKind = fkData then
if AField.DataType in [ftUnknown..ftTypedBinary] then
Result := DefaultDBTreeListColumnType[AField.DataType].ColumnClass
else Result := TdxDBTreeListColumn
else Result := TdxDBTreeListColumn;
end;
procedure TCustomdxDBTreeList.RefreshSorting;
var
Column: TdxDBTreeListColumn;
begin
if IsAutoSort then
begin
BeginUpdate;
try
Column := SortedColumn;
if (Column <> nil) and (Column.Sorted <> csNone) then
DoSortColumn(-1{all levels}, Column.Index, Column.Sorted = csDown);
finally
EndUpdate;
end;
end;
end;
procedure TCustomdxDBTreeList.SelectAll;
var
N1, N2: TdxTreeListNode;
begin
if not IsMultiSelect or not DataLink.Active or (Count = 0) then Exit;
BeginSelection;
try
BeginUpdate;
try
ClearSelection;
FullExpand;
if IsUseBookmarks then
begin
FSelectAllFlag := True;
FRefreshTreeList := True;
try
RefreshTreeList;
if not FLocateByNode then FindNodeById;
finally
FRefreshTreeList := False;
FSelectAllFlag := False;
end;
end
else
begin
{ Start Node }
N1 := Items[0];
{ End Node }
N2 := Items[Count - 1];
while N2.Count > 0 do N2 := N2[N2.Count - 1];
SelectNodes(N1, N2);
end;
finally
EndUpdate;
end;
finally
EndSelection;
end;
end;
procedure TCustomdxDBTreeList.KeyDown(var Key: Word; Shift: TShiftState);
function DeletePrompt: Boolean;
var
Title, Msg: string;
begin
Title := sdxGrTitleConfirm{LoadStr(dxSTitleWarning)};
Msg := sdxGrDeleteRecordQuestion{LoadStr(dxSDeleteRecordQuestion)};
if SelectedCount > 0{1} then
Msg := sdxDeleteMultipleRecordsQuestion{LoadStr(dxSDeleteMultipleRecordsQuestion)};
Result := not (etoConfirmDelete in OptionsDB) or
(MessageBox(Self.Handle, PChar(Msg), PChar(Title), MB_ICONQUESTION or MB_OKCANCEL) <> IDCANCEL);
end;
var
KeyDownEvent: TKeyEvent;
begin
KeyDownEvent := OnKeyDown;
OnKeyDown := nil;
BeginSelection;
try
if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
if not (FSearching and ((Key in [VK_DELETE, VK_BACK, VK_ESCAPE]) or
((Key = VK_RETURN) and (Shift*[ssCtrl, ssShift] <> [])))) then
if FDatalink.Active and CanTreeListAcceptKey(Key, Shift) then
with FDatalink.DataSet do
begin
if ssCtrl in Shift then
if not NewItemRowActive and (Key = VK_DELETE) and (etoCanDelete in OptionsDB) and
IsCanNavigation and not ReadOnly and (FocusedNode <> nil) then
begin
if not {$IFDEF DELPHI3}IsEmpty {$ELSE}(FDataLink.RecordCount = 0){$ENDIF}and CanModify and DeletePrompt then
if SelectedCount > 0{1} then DeleteSelection
else TdxDBTreeListNode(FocusedNode).Delete;
Exit;
end;
if (Key = VK_ESCAPE) and (Self.State <> tsEditing) then
FDatalink.Reset
else
begin
if not IsRowSelect and CanModify then
if ((Key = VK_INSERT) and not (ssCtrl in Shift)) and
IsCanInsert and IsCanNavigation and not IsKeyFieldEmpty then
begin
if (Self.State = tsEditing) then CloseEditor;
ClearSelection;
Insert;
ShowEditor;
end;
// Post
case Key of
VK_UP: if (State in dsEditModes) then
begin
if (State = dsInsert) and not Modified and EOF and
not Datalink.IsModified then
begin
Cancel;
FocusedNumber := GetAbsoluteCount - 1;
Exit;
end
else
if FocusedNumber = 0 then Post;
end;
VK_DOWN: if FocusedNumber = (GetAbsoluteCount - 1) then
begin
if (State = dsInsert) and not Modified and
not Datalink.IsModified then // TODO Exit;
else
if (State in dsEditModes) then Post;
end;
end;
end;
end;
inherited KeyDown(Key, Shift);
finally
OnKeyDown := KeyDownEvent;
EndSelection;
end;
end;
procedure TCustomdxDBTreeList.Loaded;
begin
FLoaded := True;
BeginUpdate;
try
inherited Loaded;
FullRefresh;
{RefreshDefWidth before LoadFromReg}
RefreshDefaultColumnsWidths;
// Load From Ini/Regsirty
DoRestoreLayout;
// calc best panel size
if IsAutoHeaderPanelRowCount then HeaderPanelBestFit;
finally
EndUpdate;
FLoaded := False;
end;
end;
procedure TCustomdxDBTreeList.Notification(AComponent: TComponent; Operation: TOperation);
var
I: Integer;
NeedLayout, IsKeyField: Boolean;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) then
begin
if (FDataLink <> nil) then
if (AComponent = DataSource) then
DataSource := nil
else
if (AComponent is TField) then
begin
// check KeyField or ParentField (OnChangeNodeEx)
IsKeyField := (FKeyField = AComponent) or (FParentField = AComponent);
if IsKeyField then
begin
FKeyField := nil;
FParentField := nil;
end;
NeedLayout := False;
for I := 0 to ColumnCount-1 do
with TdxDBTreeListControlColumn(Columns[I]) do
if (Field = AComponent) or (FPreviewField = AComponent) or
(IsKeyField and FDataLink.Active) then
begin
NeedLayout := True;
FField := nil;
end;
// reset if needed
if NeedLayout and Assigned(FDatalink.Dataset) and
(not FDatalink.Dataset.ControlsDisabled) then
begin
BeginUpdate;
try
for I := 0 to ColumnCount-1 do
with Columns[I] do
if Field = AComponent then
FieldName := FieldName;
if IsKeyField and FDataLink.Active then
LinkActive(FDataLink.DataSet.Active);
if (FPreviewField = AComponent) then FPreviewField := Nil;
finally
EndUpdate;
end;
end;
end;
end;
end;
// Selection
procedure TCustomdxDBTreeList.DoSelectedCountChange;
begin
inherited DoSelectedCountChange;
if not (csDestroying in ComponentState) and (LockSelection = 0) and
Assigned(OnChangeNodeEx) then
begin
CheckChangeNodeEx;
LoadChangeNodeInfo(FPrevNodeInfo);
end;
end;
function TCustomdxDBTreeList.IsNodeSelected(ANode: TdxTreeListNode): Boolean;
var
Index: Integer;
begin
Result := False;
if GetSelectedCount = 0 then Exit;
if IsUseBookmarks then
Result := BkmList.IndexOfObject(ANode) <> -1
else Result := FindSelectedNode(ANode, Index); {Sorted List}
end;
procedure TCustomdxDBTreeList.NodeSelected(ANode: TdxTreeListNode; ASelected: Boolean);
var
Index: Integer;
Current: TBookmarkStr;
begin
if not IsMultiSelect or not DataLink.Active then Exit;
if IsUseBookmarks then
begin
if ASelected and not CanNodeSelected(ANode) then Exit;
Current := Datalink.Datasource.Dataset.Bookmark;
Index := BkmList.IndexOfObject(ANode);
if (Index <> -1) = ASelected then Exit;
if ASelected then FindBkm(Current, Index);
if Index = -1 then Index := 0;
if ASelected then
begin
BkmList.Insert(Index, Current);
BkmList.Objects[Index] := ANode;
end
else
if Index <> -1 then BkmList.Delete(Index);
end
else
begin
if ASelected then
begin
if not CanNodeSelected(ANode) then Exit;
if not FindSelectedNode(ANode, Index) then
BkmList.InsertObject(Index, '', ANode);
end
else
if FindSelectedNode(ANode, Index) then
BkmList.Delete(Index);
end;
UpdateNode(ANode, False{no Below});
inherited NodeSelected(ANode, ASelected);
end;
procedure TCustomdxDBTreeList.SetColumnSorted(Column: TdxTreeListColumn);
begin
if IsMultiSort and (SortedColumn <> nil) then; // check SortedColumns[]
inherited SetColumnSorted(Column);
if IsAutoSort and not LockSorting then
DoSortColumn(-1{all levels}, Column.Index, Column.Sorted = csDown);
end;
function TCustomdxDBTreeList.CanDblClick: Boolean;
begin
Result := etoDblClick in OptionsBehavior;
end;
procedure TCustomdxDBTreeList.DoBeforeExpand(Node: TdxTreeListNode; var AllowExpand: Boolean);
begin
inherited DoBeforeExpand(Node, AllowExpand);
if AllowExpand and not IsLoadAllRecords and
(Node.Count = 0) and not FDatachangedBusy then
begin
LoadTreeList(TdxDBTreeListNode(Node));
Node.HasChildren := Node.Count > 0;
AllowExpand := Node.HasChildren;
end;
end;
procedure TCustomdxDBTreeList.EndCustomLayout;
begin
inherited EndCustomLayout;
AssignKeyFields;
UpdateActive;
end;
// based override
function TCustomdxDBTreeList.CreateNode: TdxTreeListNode;
begin
Result := TdxDBTreeListNode.Create(Self);
end;
procedure TCustomdxDBTreeList.DeleteNode(Node, Prior, Next: TdxTreeListNode; IsLast, Redraw: Boolean);
begin
inherited DeleteNode(Node, Prior, Next, IsLast, Redraw);
if FUpdatingNode = Node then
FUpdatingNode := nil;
end;
function TCustomdxDBTreeList.GetFooterCellText(Node: TdxTreeListNode; AbsoluteIndex, FooterIndex: Integer): string;
begin
if FooterIndex = -1 then // summary footer
Result := TdxDBTreeListControlColumn(Columns[AbsoluteIndex]).GetSummaryFooterText
else Result := inherited GetFooterCellText(Node, AbsoluteIndex, FooterIndex);
end;
function TCustomdxDBTreeList.GetNodeString(Node: TdxTreeListNode; Column: Integer): string;
var
DrawColumn: TdxDBTreeListColumn;
begin
Result := inherited GetNodeString(Node, Column);
DrawColumn := Columns[Column];
// OnGetText
if Assigned(DrawColumn.OnGetText) then
DrawColumn.OnGetText(DrawColumn, Node, Result);
end;
function TCustomdxDBTreeList.GetNodeValue(Node: TdxTreeListNode; Column: Integer): Variant;
begin
with TdxDBTreeListControlNode(Node) do
if nadValue in VariantData[Column].AssignedValues then
Result := VariantData[Column].Value
else Result := Node.Strings[Column];
end;
function TCustomdxDBTreeList.GetNodeVariant(Node: TdxTreeListNode; Column: Integer): Variant;
var
S: string;
begin
if Columns[Column].VariantType = varString then
begin
S := Node.Strings[Column];
if IsCaseInsensitive then
Result := AnsiUpperCase(S)
else Result := S;
end
else
Result := TdxDBTreeListControlNode(Node).VariantData[Column].Value;
end;
function TCustomdxDBTreeList.GetPreviewText(Node: TdxTreeListNode): string;
begin
Result := TdxDBTreeListControlNode(Node).Description;
if Assigned(OnGetPreviewText) then OnGetPreviewText(Self, Node, Result);
end;
procedure TCustomdxDBTreeList.ResetAutoHeaderPanelRowCountOption;
begin
inherited ResetAutoHeaderPanelRowCountOption;
FOptionsView := FOptionsView - [etoAutoHeaderPanelHeight];
end;
procedure TCustomdxDBTreeList.SetFocusedNode(Node: TdxTreeListNode; Column: Integer; MakeVisibleFlag: Boolean);
begin
if Node = nil then Exit;
AddNodeLink(Node);
if not FInUpdateActive then
begin
inherited SetFocusedNode(FocusedNode, Column, False);
if not FRefreshTreeList then
if not LocateByNode(TdxDBTreeListNode(FocusedNode), TdxDBTreeListNode(Node),
TdxDBTreeListNode(Node).Id) then Exit
end;
if not ValidateNode(Node) then Exit
else if NodeLinkList <> nil then {FNodeLink.Remove(Node)}; {WARNING}
inherited SetFocusedNode(Node, Column, MakeVisibleFlag);
end;
procedure TCustomdxDBTreeList.ChangedGroupColumn(Column: TdxDBTreeListColumn);
begin
if FFlagChangedGroupColumn {or FLoaded TODO} then Exit;
FFlagChangedGroupColumn := True;
try
// ReloadTreeList(False);
FullRefresh;
finally
FFlagChangedGroupColumn := False;
end;
end;
function TCustomdxDBTreeList.GetDataLink: TdxDBTreeListControlDataLink;
begin
Result := FDataLink;
end;
function TCustomdxDBTreeList.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TCustomdxDBTreeList.GetDefaultFields: Boolean;
begin
Result := False;
end;
function TCustomdxDBTreeList.IsAutoCalcKeyValue: Boolean;
begin
Result := etoAutoCalcKeyValue in OptionsDB;
if not IsLoadAllRecords and not Assigned(FOnGetUniqueKeyValue) then
Result := False;
end;
function TCustomdxDBTreeList.IsAutoDragCopy: Boolean;
begin
Result := etoAutoDragDropCopy in OptionsBehavior;
end;
function TCustomdxDBTreeList.IsAutoDragDrop: Boolean;
begin
Result := etoAutoDragDrop in OptionsBehavior;
end;
function TCustomdxDBTreeList.IsAutoSearch: Boolean;
begin
Result := IsLoadedAll and inherited IsAutoSearch;
end;
function TCustomdxDBTreeList.IsCancelOnExit: Boolean;
begin
Result := etoCancelOnExit in OptionsDB;
end;
function TCustomdxDBTreeList.IsCanInsert: Boolean;
begin
Result := etoCanInsert in OptionsDB;
end;
function TCustomdxDBTreeList.IsCanNavigation: Boolean;
begin
Result := etoCanNavigation in OptionsDB;
end;
function TCustomdxDBTreeList.IsKeyFieldEmpty: Boolean;
begin
Result := (FKeyField = nil) or (FParentField = nil);
end;
function TCustomdxDBTreeList.IsLoadAllRecords: Boolean;
begin
Result := etoLoadAllRecords in OptionsDB;
end;
function TCustomdxDBTreeList.IsLoadedAll: Boolean;
begin
Result := IsLoadAllRecords;
end;
function TCustomdxDBTreeList.IsUseBookmarks: Boolean;
begin
Result := etoUseBookmarks in OptionsDB;
end;
procedure TCustomdxDBTreeList.SetDataChangedBusy(Value: Boolean);
begin
FDataChangedBusy := Value;
end;
procedure TCustomdxDBTreeList.DataChanged;
begin
// ChangeNodeEx
if (LockSelection = 0) and Assigned(OnChangeNodeEx) then
begin
CheckChangeNodeEx;
LoadChangeNodeInfo(FPrevNodeInfo);
end;
if DataChangedLocate and not DataSetChangedBusy then
FDataChangedLocateResync := True
else FDataChangedLocateResync := False;
if (Datalink.DataSet.State <> dsInsert) then FUpdatingNode := nil;
if DataChangedLocate then
begin
FDataChangedLocate := False;
Exit;
end;
if DataSetChangedBusy then Exit;
if (IsDBTreeListControlDataSetBusy(Datalink.DataSet) or LockRefresh) then
begin
Scroll(0);
Exit;
end;
if DataSetChangedBusy or (DataLink.DataSet.State = dsEdit) or
(DataLink.DataSet.State = dsSetKey) then Exit;
if Assigned(FKeyField) and (DataLink.DataSet.State = dsInsert) then
begin
InsertNode(DataLink.DataSet.EOF);
if etoResetColumnFocus in OptionsDB then FocusedColumn := 0;
Exit;
end;
FRefreshTreeList := True;
try
RefreshTreeList;
if not FLocateByNode then FindNodeById;
finally
FRefreshTreeList := False;
end;
end;
function TCustomdxDBTreeList.IsDataSetBusy: Boolean;
begin
Result := DataSetChangedBusy or DataChangedLocate;
end;
procedure TCustomdxDBTreeList.LinkActive(Value: Boolean);
begin
if not Value then HideEditor;
// ReloadTreeList(True); {<-ClearSelection}
FullRefresh;
end;
procedure TCustomdxDBTreeList.RecordChanged(Field: TField);
var
Node: TdxDBTreeListControlNode;
begin
if (Datalink.Dataset.State = dsInsert) and
(FUpdatingNode = nil) then Exit;
if Datalink.Dataset.State = dsSetKey then Exit;
Node := TdxDBTreeListControlNode(FocusedNode);
NodeRecordChanged(Field, Node);
FUpdatingNode := TdxDBTreeListNode(Node);
end;
procedure TCustomdxDBTreeList.Scroll(Distance: Integer);
begin
UpdateActive;
// new
if etoSyncSelection in OptionsDB then ResyncSelection;
DoChangeNodeEx;
end;
procedure TCustomdxDBTreeList.AssignKeyFields;
begin
FKeyField := nil;
FParentField := nil;
FImageIndexField := nil;
FStateIndexField := nil;
if DataLink.Active then
begin
if KeyField <> '' then
FKeyField := DataLink.DataSet.FindField(KeyField);
if ParentField <> '' then
FParentField := DataLink.DataSet.FindField(ParentField);
if ImageIndexFieldName <> '' then
FImageIndexField := DataLink.DataSet.FindField(ImageIndexFieldName);
if StateIndexFieldName <> '' then
FStateIndexField := DataLink.DataSet.FindField(StateIndexFieldName);
end;
end;
procedure TCustomdxDBTreeList.AssignNodeAllValues(Node: TdxDBTreeListControlNode);
begin
inherited AssignNodeAllValues(Node);
if Assigned(FImageIndexField) then
TdxDBTreeListNode(Node).FImageIndex := FImageIndexField.AsInteger;
if Assigned(FStateIndexField) then
TdxDBTreeListNode(Node).FStateIndex := FStateIndexField.AsInteger;
if etoUseImageIndexForSelected in OptionsView then
TdxDBTreeListNode(Node).FSelectedIndex := TdxDBTreeListNode(Node).FImageIndex
else TdxDBTreeListNode(Node).FSelectedIndex := Self.SelectedIndex;
// Assign propery Data: Pointer
DoRefreshNodeData(Node);
end;
procedure TCustomdxDBTreeList.AssignSummaryFooterFields;
begin
inherited AssignSummaryFooterFields;
FTotalSummaryCount := 0;
end;
procedure TCustomdxDBTreeList.CalcSummary;
var
I: Integer;
Col: TdxDBTreeListControlColumn;
begin
// footer summary
for I := 0 to ColumnCount - 1 do
begin
Col := TdxDBTreeListControlColumn(Columns[I]);
case Col.SummaryFooterType of
cstCount: Col.FSummaryFooterValue := FTotalSummaryCount;
cstAvg: if FTotalSummaryCount > 0 then
Col.FSummaryFooterValue := Col.FSummaryFooterValue / FTotalSummaryCount;
end;
end;
if Assigned(OnCalcSummary) then OnCalcSummary(Self);
end;
procedure TCustomdxDBTreeList.FindNodeById;
procedure GotoNode(Node: TdxTreeListNode);
begin
Node.MakeVisible;
Node.Focused := True;
end;
var
Node: TdxDBTreeListNode;
begin
if FDataChangedBusy or IsKeyFieldEmpty or not IsCanNavigation then Exit;
Node := FindNodeByKeyValue(FKeyField.Value);
if Node <> nil then
GotoNode(Node)
else RefreshTreeList;
end;
function TCustomdxDBTreeList.GetUniqueKeyValue(const Delta: Variant): Variant;
procedure FindMaxValue(Node: TdxDBTreeListNode);
var
I: Integer;
begin
{$IFNDEF DELPHI6}
if Node.Id > Result then
Result := Node.Id;
{$ELSE}
if VarCompare(Node.Id, Result) > 0 then
Result := Node.Id;
{$ENDIF}
for I := 0 to Node.Count - 1 do
FindMaxValue(TdxDBTreeListNode(Node[I]));
end;
var
I: Integer;
begin
Result := Null;
if Assigned(FOnGetUniqueKeyValue) then
FOnGetUniqueKeyValue(Self, Result)
else
if IsLoadAllRecords then
begin
if not IsKeyFieldEmpty and (Count > 0) then
begin
Result := TdxDBTreeListNode(Items[0]).Id;
for I := 0 to Count - 1 do
FindMaxValue(TdxDBTreeListNode(Items[I]));
end;
try
if VarType(Result) in [varSmallint, varInteger, varSingle, varDouble, varCurrency] then
Result := Result + 1 + Delta
else Result := 0;
except
Result := Null;
end;
end;
end;
procedure TCustomdxDBTreeList.LoadTreeList(LoadingNode: TdxDBTreeListNode);
var
FLoadedNodes: TList;
FNodes: TList;
FHasChildrenNodes: TList;
procedure LoadNodes(Node: TdxTreeListNode);
var
I: Integer;
begin
for I := 0 to Node.Count - 1 do LoadNodes(Node[I]);
FLoadedNodes.Add(Node);
end;
function FindParentNode(const Value: Variant; var Index: Integer): Boolean;
var
L, H, I, C: Integer;
begin
Result := False;
L := 0;
H := FLoadedNodes.Count - 1;
while L <= H do
begin
I := (L + H) shr 1;
C := VarCompare(TdxDBTreeListNode(FLoadedNodes[I]).Id{FParentId}, Value);
if C < 0 then L := I + 1 else
begin
H := I - 1;
if C = 0 then
begin
Result := True;
L := I;
end;
end;
end;
Index := L;
end;
function FindNodeId(var Node: TdxDBTreeListNode; const Value: Variant): Boolean;
var
L, H, I: Integer;
begin
Result := False;
L := 0;
H := FNodes.Count - 1;
while L <= H do
begin
I := (L + H) shr 1;
try
if (TdxDBTreeListNode(FNodes[I]).Id = Value) then
begin
Node := TdxDBTreeListNode(FNodes[I]);
FNodes.Delete(I);
Result := True;
Break;
end
else
if (TdxDBTreeListNode(FNodes[I]).Id < Value) then L := I + 1
else H := I - 1;
except
Result := False; // Variant Error
Break;
end;
end;
end;
var
ASavePos: TBookmarkStr;
ASaveBOF, ASaveEOF: Boolean;
ASaveActiveRecord: Integer;
OldCursor: TCursor;
Node: TdxDBTreeListNode;
I, Index: Integer;
IdValue, ParentValue: Variant;
KeyValue, KeyParentValue: Variant;
PrevDataSetState: TDataSetState;
function LoadValues: TdxDBTreeListNode;
var
FoundNode: Boolean;
begin
Result := nil;
FoundNode := FindNodeId(Result, IdValue);
if FoundNode then
begin
if (Result.FParentId <> ParentValue) or
((Result.Parent <> nil) and (TdxDBTreeListNode(Result.Parent).Id <> ParentValue))then
begin
if FindParentNode(ParentValue, I) and Result.CanMove(TdxTreeListNode(FLoadedNodes[I]), natlAddChild) then
Result.InternalMove(TdxTreeListNode(FLoadedNodes[I]), natlAddChild)
else
Result.InternalMove(Items[0], natlAdd);
end;
end
else
begin
if FindParentNode(ParentValue, I) then
Result := TdxDBTreeListNode(TdxTreeListNode(FLoadedNodes[I]).AddChild)
else
Result := TdxDBTreeListNode(Add);
end;
Result.FParentId := ParentValue;
// Load Values
AssignNodeAllValues(Result);
if not FoundNode then
begin
if not FindParentNode(Result.Id, I) then
FLoadedNodes.Insert(I, Result);
end;
// select all
if FSelectAllFlag then //LoadBookamrk(Node);
Result.Selected := True;
end;
procedure LoadSummaryFooterValues;
var
SType: TdxSummaryType;
Col: TdxDBTreeListControlColumn;
V: Extended;
I: Integer;
begin
for I := 0 to ColumnCount - 1 do
begin
Col := TdxDBTreeListControlColumn(Columns[I]);
SType := Col.SummaryFooterType;
if (SType <> cstNone) then
begin
if Assigned(Col.FSmrFooterField) and (SType <> cstCount) then
V := Col.FSmrFooterField.AsFloat
else V := 0;
if Assigned(Col.OnSummaryFooter) and Assigned(Datalink.DataSet) then
Col.OnSummaryFooter(Col{Self}, Datalink.DataSet, V);
with Col do
if not FAssignedSummaryFooter then
begin
FSummaryFooterValue := V;
FAssignedSummaryFooter := True;
end
else
case SType of
cstMin: if V < FSummaryFooterValue then FSummaryFooterValue := V;
cstMax: if V > FSummaryFooterValue then FSummaryFooterValue := V;
cstSum, cstAvg: FSummaryFooterValue := FSummaryFooterValue + V;
end;
end;
end;
Inc(FTotalSummaryCount);
end;
procedure LoadLevel(ANode: TdxDBTreeListNode; const AParentValue: Variant; NewNodes: TList);
function IsExistChildren(Node: TdxDBTreeListNode): Boolean;
begin
Result := not (etoCheckHasChildren in OptionsDB) or
DataLink.DataSet.Locate(ParentField, Node.Id, []);
end;
var
I: Integer;
Item: TdxDBTreeListNode;
List: TList;
begin
ParentValue := AParentValue;
with DataLink.DataSet do
if Locate(ParentField, ParentValue, []) then
begin
List := TList.Create;
try
while not EOF and (FParentField.Value = ParentValue) do
begin
IdValue := FKeyField.Value;
Item := LoadValues;
if NewNodes <> nil then NewNodes.Add(Item);
if ANode = nil then List.Add(Item);
Next;
end;
// load children if expanded
if ANode = nil then
begin
for I := 0 to List.Count - 1 do
begin
Item := TdxDBTreeListNode(List[I]);
if Item.Expanded then
LoadLevel(Item, Item.Id, nil)
else
if IsExistChildren(Item) then FHasChildrenNodes.Add(Item);
end;
end
else
begin
for I := 0 to ANode.Count - 1 do
begin
Item := TdxDBTreeListNode(ANode[I]);
if Item.Expanded then
LoadLevel(Item, Item.Id, nil)
else
if IsExistChildren(Item) then FHasChildrenNodes.Add(Item);
end;
end;
finally
List.Free;
end;
end;
end;
procedure LoadLevelBack(AParentValue: Variant);
var
I, Index: Integer;
NewNodes: TList;
Node: TdxDBTreeListNode;
begin
NewNodes := TList.Create;
try
repeat
if FindParentNode(AParentValue, I) then
begin
LoadLevel(TdxDBTreeListNode(FLoadedNodes[I]), AParentValue, nil);
Break;
end
else
begin
LoadLevel(nil, AParentValue, NewNodes);
if not Datalink.DataSet.Locate(KeyField, AParentValue, []) then Break;
AParentValue := FParentField.Value;
end;
until False;
// Correct Parent
for I := 0 to NewNodes.Count - 1 do
begin
Node := TdxDBTreeListNode(NewNodes[I]);
if FindParentNode(Node.FParentId, Index) and
Node.CanMove(TdxTreeListNode(FLoadedNodes[Index]), natlAddChild) then
Node.InternalMove(TdxTreeListNode(FLoadedNodes[Index]), natlAddChild);
end;
finally
NewNodes.Free;
end;
end;
function IsExistKeyRoot(AParentValue: Variant): Boolean;
var
ARootValue: Variant;
begin
Result := False;
ARootValue := RootValueAsVariant;
repeat
if AParentValue = ARootValue then
begin
Result := True;
Break;
end;
if not Datalink.DataSet.Locate(KeyField, AParentValue, []) or
(FKeyField.Value = FParentField.Value) then Break;
AParentValue := FParentField.Value;
until False;
end;
begin
if (csLoading in ComponentState) or (DataLink.DataSet = nil) or
not DataLink.DataSet.Active then Exit;
FDataChangedBusy := True;
try
// Assign Key, Parent Fields
AssignKeyFields;
if IsKeyFieldEmpty then Exit;
with DataLink.DataSet do
begin
AssignPreviewField;
if IsLoadAllRecords then
begin
AssignSummaryFooterFields;
DoBeforeCalcSummary; // before summary
end;
DisableControls;
OldCursor := Screen.Cursor;
try
// save DataSet Position
if DataLink.DataSet.State in dsEditModes then
begin
PrevDataSetState := DataLink.DataSet.State;
DataLink.DataSet.Cancel;
if FUpdatingNode <> nil then
begin
if PrevDataSetState = dsEdit then
RefreshNodeValues(TdxDBTreeListControlNode(FUpdatingNode))
else FUpdatingNode.Free;
end;
FUpdatingNode := nil;
end;
ASavePos := Bookmark;
ASaveBOF := BOF;
ASaveEOF := EOF;
ASaveActiveRecord := TDummyDataSet(DataLink.DataSet).ActiveRecord;
if IsShowHourGlass then Screen.Cursor := crHourglass;
// refresh list
FLoadedNodes := TList.Create;
FNodes := TList.Create;
FHasChildrenNodes := TList.Create;
try
// Load Nodes
for I := 0 to Count - 1 do LoadNodes(Items[I]);
FLoadedNodes.Sort(CompareNodeId);
// Copy Nodes
if LoadingNode = nil then // RefreshTreeList
begin
FNodes.Count := FLoadedNodes.Count;
System.Move(FLoadedNodes.List^, FNodes.List^, FLoadedNodes.Count * SizeOf(Pointer));
end;
if IsLoadAllRecords then
begin
// Load From DataSet
First;
while not EOF do
begin
IdValue := FKeyField.Value;
ParentValue := FParentField.Value;
LoadValues;
// Load Summary Footer for current record
LoadSummaryFooterValues;
Next;
end;
// Correct Parent
for I := Count - 1 downto 0 do
begin
Node := TdxDBTreeListNode(Items[I]);
if FindParentNode(Node.FParentId, Index) and
Node.CanMove(TdxTreeListNode(FLoadedNodes[Index]), natlAddChild) then
// if TdxDBTreeListNode(FLoadedNodes[Index]).ParentId <> Node.ParentId then
Node.InternalMove(TdxTreeListNode(FLoadedNodes[Index]), natlAddChild);
end;
end
else
begin
if LoadingNode = nil then
begin
KeyValue := FKeyField.Value;
KeyParentValue := FParentField.Value;
LoadLevel(nil, RootValueAsVariant, nil);
// check FocusedNode
{$DEFINE CHECK_EXIST_KEY_ROOT}
{$IFDEF CHECK_EXIST_KEY_ROOT}
if (FKeyField <> FParentField) and IsExistKeyRoot(KeyParentValue) then
{$ENDIF}
if not FindParentNode(KeyValue, I) then
LoadLevelBack(KeyParentValue);
end
else LoadLevel(LoadingNode, LoadingNode.Id, nil);
end;
// free deleted nodes
FNodes.Sort(CompareParentNode);
for I := FNodes.Count - 1 downto 0 do
TdxDBTreeListNode(FNodes[I]).Free;
// set HasChildren
for I := 0 to FHasChildrenNodes.Count - 1 do
TdxDBTreeListNode(FHasChildrenNodes[I]).HasChildren := True;
// Check TopVisibleNode
if TopIndex < 0 then ResetTopFocusedNodes;
finally
FHasChildrenNodes.Free;
FNodes.Free;
FLoadedNodes.Free;
end;
// sorting
RefreshSorting;
// calc summary
CalcSummary;
// restore dataset pos
with TDummyDataSet(Datalink.DataSet) do
begin
if (Length(ASavePos) > 0) and BookmarkValid(TBookmark(ASavePos)) then
Bookmark := ASavePos;
if ActiveRecord > ASaveActiveRecord then
begin
MoveBy(BufferCount - ActiveRecord - 1 + ActiveRecord - ASaveActiveRecord);
MoveBy(ASaveActiveRecord - BufferCount + 1);
end
else
if ActiveRecord < ASaveActiveRecord then
begin
MoveBy(-ActiveRecord + ActiveRecord - ASaveActiveRecord);
MoveBy(ASaveActiveRecord);
end;
if ASaveBOF and not BOF then Prior;
if ASaveEOF and not EOF then Next;
end;
finally
Screen.Cursor := OldCursor;
EnableControls;
end;
end;
finally
FDataChangedBusy := False;
end;
end;
function TCustomdxDBTreeList.LocateByNode(OldNode, Node: TdxDBTreeListNode; const Value: Variant): Boolean;
begin
Result := True;
if FDataChangedBusy then Exit;
if not IsKeyFieldEmpty and (FKeyField.Value = Node.Id) and
(OldNode = Node) or ((Node = FUpdatingNode) and Datalink.Active and
(Datalink.DataSet.State = dsInsert)) then Exit;
if not IsCanNavigation then Exit;
FDataChangedBusy := True;
try
try
if Datalink.Active then
begin
FDataChangedBusy := not (Datalink.DataSet.State in dsEditModes);
FDataChangedLocate := True;
Datalink.DataSet.Locate(KeyField, Value, []);
end;
except
Result := False;
raise;
end;
finally
FDataChangedLocate := False;
FDataChangedBusy := False;
end;
end;
procedure TCustomdxDBTreeList.RefreshNodeValues(var Node: TdxDBTreeListControlNode);
begin
if (Node <> nil) and IsCanNavigation and not IsKeyFieldEmpty then
begin
AssignNodeAllValues(Node);
end;
if IsRowAutoHeight or (IsShowPreview and IsAutoCalcPreviewLines) then
begin
// reset node height
ClearNodeRowHeight;
Invalidate;
end
else InvalidateRect(GetRectNode(Node));
end;
procedure TCustomdxDBTreeList.RefreshTreeList;
begin
BeginUpdate;
try
// reload nodes
LoadTreeList(nil);
finally
EndUpdate;
end;
end;
procedure TCustomdxDBTreeList.ReloadTreeList(AClearNodes: Boolean);
var
I: Integer;
begin
BeginUpdate;
try
HideEditor;
if AClearNodes then ClearNodes;
// Reset and Assign Fields
Datalink.ClearMapping;
if Datalink.Active then DefineFieldMap;
// Force columns to reaquire fields (in case dataset has changed)
for I := 0 to ColumnCount-1 do
Columns[I].FieldName := Columns[I].FieldName;
RefreshTreeList;
finally
EndUpdate;
end;
end;
procedure TCustomdxDBTreeList.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
Node: TdxTreeListNode;
NodeAttachMode: TdxTreeListNodeAttachMode;
PrevAccept: Boolean;
begin
PrevAccept := IsAutoDragDrop and (Source = Self) and
GetNodeAttachMode(X, Y, Node, NodeAttachMode);
Accept := PrevAccept;
inherited DragOver(Source, X, Y, State, Accept);
if not Assigned(OnDragOver) then Accept := PrevAccept;
end;
function TCustomdxDBTreeList.GetNodeAttachMode(X, Y: Integer; var DestNode: TdxTreeListNode;
var AttachMode: TdxTreeListNodeAttachMode): Boolean;
function CalcAccept(ADragNode: TdxTreeListNode): Boolean;
begin
Result := (IsAutoDragCopy and (GetAsyncKeyState(VK_CONTROL) < 0)) or
ADragNode.CanMove(DestNode, AttachMode);
end;
var
AHitInfo: TdxTreeListHitInfo;
ADrawInfo: TdxGridDrawInfo;
I: Integer;
begin
DestNode := nil;
AttachMode := natlAddChild;
Result := False;
// get hit info
AHitInfo := GetHitInfo(Point(X, Y));
if AHitInfo.hitType in [htNowhere, htButton, htIcon, htStateIcon, htIndent,
htLabel, htSummaryNodeFooter, htPreview] then
begin
DestNode := AHitInfo.Node;
if AHitInfo.hitType in [htButton, htIcon, htStateIcon, htLabel, htSummaryNodeFooter, htPreview] then
AttachMode := natlAddChild
else
if AHitInfo.hitType = htNowhere then
begin
CalcRectInfo(ADrawInfo);
if Y >= ADrawInfo.CellsRect.Top then
begin
AttachMode := natlAdd;
DestNode := Items[0];
end;
end
else
if AHitInfo.hitType = htIndent then
AttachMode := natlInsert;
// check parent
if SelectedCount = 0 then
Result := CalcAccept(DragNode)
else
for I := 0 to SelectedCount - 1 do
begin
Result := CalcAccept(SelectedNodes[I]);
if not Result then Break;
end;
end;
end;
procedure TCustomdxDBTreeList.BeginReadSettings(ARegIniWrapper: TdxRegIniWrapper);
begin
inherited BeginReadSettings(ARegIniWrapper);
BeginLayout;
end;
procedure TCustomdxDBTreeList.EndReadSettings(ARegIniWrapper: TdxRegIniWrapper);
begin
EndLayout;
inherited EndReadSettings(ARegIniWrapper);
end;
procedure TCustomdxDBTreeList.ReadSettings(ARegIniWrapper: TdxRegIniWrapper; const APath: string);
begin
inherited ReadSettings(ARegIniWrapper, APath);
with ARegIniWrapper do
begin
ShowNewItemRow := ReadBool(APath, 'ShowNewItemRow', ShowNewItemRow);
ShowFooter := ReadBool(APath, 'ShowFooter', ShowFooter);
end;
end;
procedure TCustomdxDBTreeList.WriteSettings(ARegIniWrapper: TdxRegIniWrapper; const APath: string);
begin
inherited WriteSettings(ARegIniWrapper, APath);
with ARegIniWrapper do
begin
WriteBool(APath, 'ShowNewItemRow', ShowNewItemRow);
WriteBool(APath, 'ShowFooter', ShowFooter);
end;
end;
function TCustomdxDBTreeList.GetNodeByNavigation(ANode: TdxTreeListNode; ANavigationMode: TdxTreeListNavigationMode;
AGotoHidden: Boolean): TdxTreeListNode;
begin
if not IsLoadAllRecords and AGotoHidden then
begin
if (ANavigationMode = tlnmNext) and ANode.HasChildren and not ANode.Expanded then
ANode.Expanded := True;
end;
Result := inherited GetNodeByNavigation(ANode, ANavigationMode, AGotoHidden);
end;
procedure TCustomdxDBTreeList.CheckChangeNodeEx;
var
NodeInfo: TdxChangeDBTreeListNodeInfo;
begin
LoadChangeNodeInfo(NodeInfo);
if (FPrevNodeInfo.Selected <> NodeInfo.Selected) or
(VarType(FPrevNodeInfo.Id) <> VarType(NodeInfo.Id)) or
(FPrevNodeInfo.Id <> NodeInfo.Id) then DoChangeNodeEx;
end;
function TCustomdxDBTreeList.GetOptionsBehavior: TdxDBTreeListOptionsBehavior;
begin
Result := FOptionsBehavior;
end;
function TCustomdxDBTreeList.GetOptionsCustomize: TdxDBTreeListOptionsCustomize;
begin
Result := FOptionsCustomize;
end;
function TCustomdxDBTreeList.GetOptionsDB: TdxDBTreeListOptionsDB;
begin
Result := FOptionsDB;
end;
function TCustomdxDBTreeList.GetOptionsView: TdxDBTreeListOptionsView;
begin
Result := FOptionsView;
end;
function TCustomdxDBTreeList.GetRootValue: string;
begin
if VarIsNull(FRootValue) then
Result := ''
else Result := {VarToStr}(FRootValue);
end;
function TCustomdxDBTreeList.GetRootValueAsVariant: Variant;
begin
if (VarType(FRootValue) = varString) and (FRootValue = '') then
Result := Null
else Result := FRootValue;
end;
procedure TCustomdxDBTreeList.InsertNode(FAppend: Boolean);
var
ANode: TdxTreeListNode;
PrevNewItemRowActive: Boolean;
begin
if FocusedNode <> nil then
begin
if FocusedNode.Parent <> nil then
ANode := FocusedNode.Parent.AddChild
else ANode := Add;
end
else ANode := Add;
TdxDBTreeListNode(ANode).Id := Null;
if IsAutoCalcKeyValue then
FKeyField.Value := GetUniqueKeyValue(0);
AssignNodeAllValues(TdxDBTreeListNode(ANode));
if Assigned(FParentField) then
TdxDBTreeListNode(ANode).FParentId := FParentField.Value;
FUpdatingNode := TdxDBTreeListNode(ANode);
if TdxDBTreeListNode(ANode).ParentId <> Null then
begin
ANode := FindNodeByKeyValue(TdxDBTreeListNode(ANode).ParentId);
if ANode <> nil then
FUpdatingNode.MoveTo(ANode, natlAddChild);
end;
PrevNewItemRowActive := NewItemRowActive;
FUpdatingNode.Focused := True;
FUpdatingNode.MakeVisible;
NewItemRowActive := PrevNewItemRowActive;
end;
procedure TCustomdxDBTreeList.LoadChangeNodeInfo(var NodeInfo: TdxChangeDBTreeListNodeInfo);
begin
if (FocusedNode <> nil) and
Assigned(DataLink.DataSet) and DataLink.DataSet.Active then
begin
NodeInfo.Selected := FocusedNode.Selected;
if Assigned(FKeyField) and Assigned(FKeyField.DataSet) then
NodeInfo.Id := FKeyField.Value
else NodeInfo.Id := Null;
end
else
begin
NodeInfo.Id := Null;
NodeInfo.Selected := False;
end;
end;
procedure TCustomdxDBTreeList.SetDataSource(Value: TDataSource);
begin
if FDatalink.Datasource = Value then Exit;
ClearSelection;
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
procedure TCustomdxDBTreeList.SetImageIndexFieldName(const Value: string);
begin
if FImageIndexFieldName <> Value then
begin
FImageIndexFieldName := Value;
LinkActive(DataLink.Active);
end;
end;
procedure TCustomdxDBTreeList.SetOptionsBehavior(Value: TdxDBTreeListOptionsBehavior);
var
NewOptions: TdxTreeListOptions;
NewOptionsEx: TdxTreeListOptionsEx;
begin
if FOptionsBehavior <> Value then
begin
BeginUpdate;
try
NewOptions := inherited Options;
NewOptionsEx := inherited OptionsEx;
if etoAnsiSort in Value then
Include(NewOptionsEx, aoAnsiSort)
else Exclude(NewOptionsEx, aoAnsiSort);
if etoAutoCopySelectedToClipboard in Value then
Include(NewOptionsEx, aoAutoCopySelectedToClipboard)
else Exclude(NewOptionsEx, aoAutoCopySelectedToClipboard);
if etoAutoSearch in Value then
Include(NewOptionsEx, aoAutoSearch)
else Exclude(NewOptionsEx, aoAutoSearch);
if etoAutoSort in Value then
Include(NewOptions, aoAutoSort)
else Exclude(NewOptions, aoAutoSort);
if etoBandButtonClicking in Value then
Include(NewOptionsEx, aoBandButtonClicking)
else Exclude(NewOptionsEx, aoBandButtonClicking);
if etoCaseInsensitive in Value then
Include(NewOptions, aoCaseInsensitive)
else Exclude(NewOptions, aoCaseInsensitive);
if etoDragCollapse in Value then
Include(NewOptionsEx, aoDragCollapse)
else Exclude(NewOptionsEx, aoDragCollapse);
if etoDragExpand in Value then
Include(NewOptionsEx, aoDragExpand)
else Exclude(NewOptionsEx, aoDragExpand);
if etoDragScroll in Value then
Include(NewOptionsEx, aoDragScroll)
else Exclude(NewOptionsEx, aoDragScroll);
if etoEditing in Value then
Include(NewOptions, aoEditing)
else Exclude(NewOptions, aoEditing);
if etoEnterShowEditor in Value then
Include(NewOptionsEx, aoEnterShowEditor)
else Exclude(NewOptionsEx, aoEnterShowEditor);
if etoEnterThrough in Value then
Include(NewOptionsEx, aoEnterThrough)
else Exclude(NewOptionsEx, aoEnterThrough);
if etoHeaderButtonClicking in Value then
Include(NewOptionsEx, aoHeaderButtonClicking)
else Exclude(NewOptionsEx, aoHeaderButtonClicking);
if etoHorzThrough in Value then
Include(NewOptionsEx, aoHorzThrough)
else Exclude(NewOptionsEx, aoHorzThrough);
if etoImmediateEditor in Value then
Include(NewOptions, aoImmediateEditor)
else Exclude(NewOptions, aoImmediateEditor);
if etoMouseScroll in Value then
Include(NewOptionsEx, aoMouseScroll)
else Exclude(NewOptionsEx, aoMouseScroll);
if etoMultiSelect in Value then
Include(NewOptions, aoMultiSelect)
else Exclude(NewOptions, aoMultiSelect);
if etoShowHourGlass in Value then
Include(NewOptionsEx, aoShowHourGlass)
else Exclude(NewOptionsEx, aoShowHourGlass);
if etoStoreToIniFile in Value then
Include(NewOptions, aoStoreToIniFile)
else Exclude(NewOptions, aoStoreToIniFile);
if etoStoreToRegistry in Value then
Include(NewOptions, aoStoreToRegistry)
else Exclude(NewOptions, aoStoreToRegistry);
if etoTabs in Value then
Include(NewOptions, aoTabs)
else Exclude(NewOptions, aoTabs);
if etoTabThrough in Value then
Include(NewOptions, aoTabThrough)
else Exclude(NewOptions, aoTabThrough);
if etoVertThrough in Value then
Include(NewOptionsEx, aoVertThrough)
else Exclude(NewOptionsEx, aoVertThrough);
inherited Options := NewOptions;
inherited OptionsEx := NewOptionsEx;
FOptionsBehavior := Value;
finally
EndUpdate;
end;
end;
end;
procedure TCustomdxDBTreeList.SetOptionsCustomize(Value: TdxDBTreeListOptionsCustomize);
var
NewOptions: TdxTreeListOptions;
NewOptionsEx: TdxTreeListOptionsEx;
begin
if FOptionsCustomize <> Value then
begin
BeginUpdate;
try
NewOptions := inherited Options;
NewOptionsEx := inherited OptionsEx;
if etoBandMoving in Value then
Include(NewOptionsEx, aoBandMoving)
else Exclude(NewOptionsEx, aoBandMoving);
if etoBandPanelSizing in Value then
Include(NewOptionsEx, aoBandPanelSizing)
else Exclude(NewOptionsEx, aoBandPanelSizing);
if etoBandSizing in Value then
Include(NewOptionsEx, aoBandSizing)
else Exclude(NewOptionsEx, aoBandSizing);
if etoColumnMoving in Value then
Include(NewOptions, aoColumnMoving)
else Exclude(NewOptions, aoColumnMoving);
if etoColumnSizing in Value then
Include(NewOptions, aoColumnSizing)
else Exclude(NewOptions, aoColumnSizing);
if etoExtCustomizing in Value then
Include(NewOptions, aoExtCustomizing)
else Exclude(NewOptions, aoExtCustomizing);
if etoFullSizing in Value then
Include(NewOptionsEx, aoFullSizing)
else Exclude(NewOptionsEx, aoFullSizing);
if etoHeaderPanelSizing in Value then
Include(NewOptionsEx, aoHeaderPanelSizing)
else Exclude(NewOptionsEx, aoHeaderPanelSizing);
if etoKeepColumnWidth in Value then
Include(NewOptionsEx, aoKeepColumnWidth)
else Exclude(NewOptionsEx, aoKeepColumnWidth);
if etoRowSizing in Value then
Include(NewOptionsEx, aoRowSizing)
else Exclude(NewOptionsEx, aoRowSizing);
inherited Options := NewOptions;
inherited OptionsEx := NewOptionsEx;
FOptionsCustomize := Value;
finally
EndUpdate;
end;
end;
end;
procedure TCustomdxDBTreeList.SetOptionsDB(Value: TdxDBTreeListOptionsDB);
var
PrevOptions: TdxDBTreeListOptionsDB;
begin
if FOptionsDB <> Value then
begin
BeginUpdate;
try
PrevOptions := OptionsDB;
FOptionsDB := Value;
if PrevOptions*[etoUseBookmarks] <> OptionsDB*[etoUseBookmarks] then
ClearSelection;
if ((etoCanNavigation in OptionsDB) and not (etoCanNavigation in PrevOptions)) or
((etoCheckHasChildren in OptionsDB) and not (etoCheckHasChildren in PrevOptions)) or
((etoLoadAllRecords in OptionsDB) <> (etoLoadAllRecords in PrevOptions)) then
FullRefresh;
finally
EndUpdate;
end;
end;
end;
procedure TCustomdxDBTreeList.SetOptionsView(Value: TdxDBTreeListOptionsView);
var
NewOptions: TdxTreeListOptions;
NewOptionsEx: TdxTreeListOptionsEx;
PrevOptions: TdxDBTreeListOptionsView;
begin
if FOptionsView <> Value then
begin
BeginUpdate;
try
PrevOptions := OptionsView;
NewOptions := inherited Options;
NewOptionsEx := inherited OptionsEx;
if etoAutoCalcPreviewLines in Value then
Include(NewOptionsEx, aoAutoCalcPreviewLines)
else Exclude(NewOptionsEx, aoAutoCalcPreviewLines);
if etoAutoHeaderPanelHeight in Value then
Include(NewOptionsEx, aoAutoHeaderPanelHeight)
else Exclude(NewOptionsEx, aoAutoHeaderPanelHeight);
if etoAutoWidth in Value then
Include(NewOptions, aoAutoWidth)
else Exclude(NewOptions, aoAutoWidth);
if etoBandHeaderWidth in Value then
Include(NewOptionsEx, aoBandHeaderWidth)
else Exclude(NewOptionsEx, aoBandHeaderWidth);
if etoDrawEndEllipsis in Value then
Include(NewOptions, aoDrawEndEllipsis)
else Exclude(NewOptions, aoDrawEndEllipsis);
if etoHideFocusRect in Value then
Include(NewOptions, aoHideFocusRect)
else Exclude(NewOptions, aoHideFocusRect);
if etoHotTrack in Value then
Include(NewOptionsEx, aoHotTrack)
else
Exclude(NewOptionsEx, aoHotTrack);
ShowIndicator := etoIndicator in Value;
if etoInvertSelect in Value then
begin
Include(NewOptionsEx, aoInvertSelect);
Exclude(Value, etoRowSelect);
end
else Exclude(NewOptionsEx, aoInvertSelect);
if etoPreview in Value then
Include(NewOptions, aoPreview)
else Exclude(NewOptions, aoPreview);
if etoRowAutoHeight in Value then
Include(NewOptionsEx, aoRowAutoHeight)
else Exclude(NewOptionsEx, aoRowAutoHeight);
if etoRowSelect in Value then
begin
Include(NewOptions, aoRowSelect);
Exclude(NewOptionsEx, aoInvertSelect);
end
else Exclude(NewOptions, aoRowSelect);
if etoShowButtonAlways in Value then
Include(NewOptionsEx, aoShowButtonAlways)
else Exclude(NewOptionsEx, aoShowButtonAlways);
if etoUseBitmap in Value then
Include(NewOptionsEx, aoUseBitmap)
else Exclude(NewOptionsEx, aoUseBitmap);
inherited Options := NewOptions;
inherited OptionsEx := NewOptionsEx;
FOptionsView := Value;
if (etoUseImageIndexForSelected in OptionsView) <>
(etoUseImageIndexForSelected in PrevOptions) then FullRefresh;
finally
EndUpdate;
end;
end;
end;
procedure TCustomdxDBTreeList.SetParentFieldName(const Value: string);
begin
if FParentFieldName <> Value then
begin
FParentFieldName := Value;
LinkActive(DataLink.Active);
end;
end;
procedure TCustomdxDBTreeList.SetRootValue(const Value: string);
begin
if FRootValue <> Value then
begin
FRootValue := Value;
LinkActive(DataLink.Active);
end;
end;
procedure TCustomdxDBTreeList.SetSelectedIndex(Value: Integer);
begin
if FSelectedIndex <> Value then
begin
FSelectedIndex := Value;
LinkActive(DataLink.Active);
end;
end;
procedure TCustomdxDBTreeList.SetStateIndexFieldName(const Value: string);
begin
if FStateIndexFieldName <> Value then
begin
FStateIndexFieldName := Value;
LinkActive(DataLink.Active);
end;
end;
procedure TCustomdxDBTreeList.UpdateActive;
begin
FInUpdateActive := True;
try
if FDatalink.Active and not (csLoading in ComponentState) and
Datalink.DataSet.Active then
begin
// if not HandleAllocated and (Parent <> nil) then HandleNeeded; {WARNING}
if not FRefreshTreeList then FindNodeById;
if HandleAllocated then inherited UpdateScrollBars;
// if Assigned(FocusedField) and (FocusedField.Text <> FEditValue) then
// InvalidateEditor;
InvalidateEditorValue;
end;
finally
FInUpdateActive := False;
end;
end;
end.