david
47aaf11578
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@38 05c56307-c608-d34a-929d-697000501d7a
3271 lines
106 KiB
ObjectPascal
3271 lines
106 KiB
ObjectPascal
|
|
{*******************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressDBTreeListControl }
|
|
{ }
|
|
{ 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 dxDBCtrl;
|
|
|
|
interface
|
|
|
|
{$I dxTLVer.inc}
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
Db, dxTL, Mask, dxTLStr, dxCntner, dxEditor, dxExEdtr, dxGrFCmn, dxDBEdtr
|
|
{$IFDEF DELPHI6}, Variants, MaskUtils, FMTBcd{$ENDIF};
|
|
|
|
const
|
|
dxDBGridIndicatorWidth = 12;
|
|
|
|
type
|
|
TdxDBTreeListColumn = class;
|
|
TdxDBTreeListControlNode = class;
|
|
TCustomdxDBTreeListControl = class;
|
|
TdxDBTreeListControlDataLink = class;
|
|
TdxDBGridSummaryItems = class;
|
|
TdxDBGridSummaryGroup = class;
|
|
TdxDBGridSummaryGroups = class;
|
|
|
|
{ TdxDBTreeListColumn }
|
|
TdxSummaryType = (cstNone, cstSum, cstMin, cstMax, cstCount, cstAvg);
|
|
|
|
TdxSummaryEvent = procedure(Sender: TObject; DataSet: TDataSet; var Value: Extended) of object;
|
|
TColumnGetText = procedure(Sender: TObject; ANode: TdxTreeListNode; var AText: string) of object;
|
|
// obsolete events
|
|
TCustomDrawEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect; ANode: TdxTreeListNode;
|
|
AColumn: TdxDBTreeListColumn; const AText: string; AFont: TFont; var AColor: TColor;
|
|
ASelected, AFocused: Boolean; var ADone: Boolean ) of object;
|
|
TCustomDrawHeaderEvent = procedure(Sender: TObject; ACanvas: TCanvas;
|
|
var ARect: TRect; AColumn: TdxDBTreeListColumn; var ADone: Boolean) of object;
|
|
TdxDrawSummaryFooter = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
|
|
var AText: string; var AAlignment: TAlignment; AFont: TFont; var AColor: TColor; var ADone: Boolean) of object;
|
|
|
|
TdxDBTreeListColumn = class(TdxTreeListColumn)
|
|
private
|
|
FDisableGrouping: Boolean;
|
|
FFieldName: string;
|
|
// summary
|
|
FSummaryType: TdxSummaryType;
|
|
FSummaryFormat: string;
|
|
FOnSummary: TdxSummaryEvent;
|
|
FOnGetText: TColumnGetText;
|
|
FSortBySummary: Boolean;
|
|
FSummaryGroupName: string;
|
|
// footer
|
|
FSummaryFooterType: TdxSummaryType;
|
|
FSummaryFooterFormat: string;
|
|
FOnSummaryFooter: TdxSummaryEvent;
|
|
// obsolete
|
|
FOnCustomDraw: TCustomDrawEvent;
|
|
FOnCustomDrawHeader: TCustomDrawHeaderEvent;
|
|
FOnDrawSummaryFooter: TdxDrawSummaryFooter;
|
|
|
|
function GetDBTreeList: TCustomdxDBTreeListControl;
|
|
function GetField: TField;
|
|
procedure SetDBTreeList(Value: TCustomdxDBTreeListControl);
|
|
procedure SetDisableGrouping(Value: Boolean);
|
|
procedure SetFieldName(const Value: string); virtual;
|
|
procedure SetGroupIndex(Value: Integer);
|
|
// summary
|
|
function GetSortBySummary: Boolean;
|
|
procedure SetSortBySummary(Value: Boolean);
|
|
procedure SetSummaryType(Value: TdxSummaryType);
|
|
procedure SetSummaryFooterType(Value: TdxSummaryType);
|
|
protected
|
|
FField: TField;
|
|
FGroupIndex: Integer;
|
|
FSmrField: TField;
|
|
FSummaryGroup: TdxDBGridSummaryGroup;
|
|
FSmrFooterField: TField;
|
|
FSummaryFooterValue: Extended;
|
|
FAssignedSummaryFooter: Boolean;
|
|
FSummaryFooterField: string;
|
|
FSummaryField: string;
|
|
function AlwaysStoredValue: Boolean; virtual;
|
|
function AssignedDrawCellEvent: Boolean; override;
|
|
function AssignEditValue(ANode: TdxTreeListNode; AInplaceEdit: TdxInplaceEdit): Variant; override;
|
|
procedure AssignNodeValues(ANode: TdxDBTreeListControlNode); virtual;
|
|
procedure ChangedReload(AllItems: Boolean);
|
|
procedure DoDrawCell(ACanvas: TCanvas; var ARect: TRect; ANode: TdxTreeListNode;
|
|
ASelected, AFocused: Boolean; ANewItemRow: Boolean; ALeftEdge, ARightEdge: Boolean; ABrush: HBRUSH;
|
|
var AText: string; var AColor: TColor; AFont: TFont; var AAlignment: TAlignment; var ADone: Boolean); override;
|
|
// function GetDisplayText: string; virtual;
|
|
function GetDisplayText(ANode: TdxTreeListNode): string; override;
|
|
function GetFilterEdit(AOwner: TComponent): TdxInplaceEdit; virtual;
|
|
function GetFilterEditClass: TdxInplaceEditClass; virtual;
|
|
procedure GetFilterEditValues(AEdit: TdxInplaceEdit; var V: Variant; var S: string); virtual;
|
|
procedure SetFilterEditValue(AEdit: TdxInplaceEdit; const V: Variant); virtual;
|
|
function GetFilterOperators: TdxDBGridOperatorTypes; virtual;
|
|
function GetFilterValue(ANode: TdxTreeListNode{; Index: ?}): Variant; virtual;
|
|
procedure GetFilterValues(ANode: TdxTreeListNode; var V: Variant; var S: string); virtual;
|
|
function GetGroupText(const Value: string): string; virtual;
|
|
function GetSummaryFooterText: string; virtual;
|
|
function GetText(const Value: Variant): string; virtual;
|
|
function GetVariantType: Integer; virtual; // override in Lookup columns !!! (for QuickSort)
|
|
function InitEditValue(ANode: TdxTreeListNode; AInplaceEdit: TdxInplaceEdit): Variant; override;
|
|
function IsBlobColumn: Boolean; virtual;
|
|
function IsEqualValues(const Value: Variant): Boolean; virtual;
|
|
procedure PrepareFilterEdit(AEdit: TdxInplaceEdit); virtual;
|
|
procedure SetIndex(Value: Integer); override;
|
|
procedure SetName(const Value: TComponentName); override;
|
|
|
|
property GroupIndex: Integer read FGroupIndex write SetGroupIndex default -1;
|
|
property SortBySummary: Boolean read GetSortBySummary write SetSortBySummary default False;
|
|
property SummaryType: TdxSummaryType read FSummaryType write SetSummaryType default cstNone;
|
|
property SummaryField: string read FSummaryField write FSummaryField;
|
|
property SummaryFormat: string read FSummaryFormat write FSummaryFormat;
|
|
property OnSummary: TdxSummaryEvent read FOnSummary write FOnSummary;
|
|
property SummaryGroupName: string read FSummaryGroupName write FSummaryGroupName;
|
|
property SummaryGroup: TdxDBGridSummaryGroup read FSummaryGroup;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
function DefaultAlignment: TAlignment; override;
|
|
function DefaultCaption: string; override;
|
|
function DefaultMaxLength: Integer; override;
|
|
function DefaultReadOnly: Boolean; override;
|
|
function DefaultWidth: Integer; override;
|
|
function IsValidChar(InputChar: Char): Boolean; virtual;
|
|
procedure RestoreDefaults; override;
|
|
|
|
property ATreeList: TCustomdxDBTreeListControl read GetDBTreeList write SetDBTreeList;
|
|
property Field: TField read GetField;
|
|
property SummaryFooterText: string read GetSummaryFooterText;
|
|
property SummaryFooterValue: Extended read FSummaryFooterValue;
|
|
property VariantType: Integer read GetVariantType;
|
|
published
|
|
property DisableGrouping: Boolean read FDisableGrouping write SetDisableGrouping default False;
|
|
property FieldName: string read FFieldName write SetFieldName;
|
|
property OnGetText: TColumnGetText read FOnGetText write FOnGetText;
|
|
// obsolete
|
|
property OnCustomDraw: TCustomDrawEvent read FOnCustomDraw write FOnCustomDraw;
|
|
property OnCustomDrawHeader: TCustomDrawHeaderEvent read FOnCustomDrawHeader write FOnCustomDrawHeader;
|
|
// summary
|
|
property SummaryFooterType: TdxSummaryType read FSummaryFooterType write SetSummaryFooterType default cstNone;
|
|
property SummaryFooterField: string read FSummaryFooterField write FSummaryFooterField;
|
|
property SummaryFooterFormat: string read FSummaryFooterFormat write FSummaryFooterFormat;
|
|
property OnSummaryFooter: TdxSummaryEvent read FOnSummaryFooter write FOnSummaryFooter;
|
|
property OnDrawSummaryFooter: TdxDrawSummaryFooter read FOnDrawSummaryFooter write FOnDrawSummaryFooter;
|
|
end;
|
|
|
|
TdxDBTreeListColumnClass = class of TdxDBTreeListColumn;
|
|
|
|
TdxGetEditColor = procedure(Sender: TObject; ANode: TdxTreeListNode;
|
|
AColumn: TdxDBTreeListColumn; var AColor: TColor) of object;
|
|
|
|
{TdxDBTreeListControlNode}
|
|
TNodeAssignedData = (nadValue, // if field in SimpleFields = [ftSmallint, ...]
|
|
nadLookupValue); // if field kind = fkLookup
|
|
TNodeAssignedValues = set of TNodeAssignedData;
|
|
|
|
PNodeVariantData = ^TNodeVariantData;
|
|
TNodeVariantData = record
|
|
AssignedValues: TNodeAssignedValues;
|
|
Value: Variant; { field value }
|
|
LookupValue: Variant; { for lookup field (KeyValue)}
|
|
end;
|
|
|
|
TdxDBTreeListControlNode = class(TdxTreeListTextNode)
|
|
private
|
|
FId: Variant; { Primary Key }
|
|
function GetVariantValue(Column: Integer): Variant;
|
|
protected
|
|
FDescription: string;
|
|
function GetVariantData(Column: Integer): TNodeVariantData;
|
|
procedure SetVariantData(Column: Integer; const Value: TNodeVariantData);
|
|
public
|
|
destructor Destroy; override;
|
|
procedure Delete; virtual;
|
|
property Id: Variant read FId write FId;
|
|
property Description: string read FDescription;
|
|
property VariantData[Column: Integer]: TNodeVariantData read GetVariantData write SetVariantData;
|
|
property VariantValues[Index: Integer]: Variant read GetVariantValue;
|
|
end;
|
|
|
|
TdxGetPreviewTextEvent = procedure(Sender: TObject; Node: TdxTreeListNode; var Text: string) of object;
|
|
|
|
{ TCustomdxDBTreeListControl }
|
|
TCustomdxDBTreeListControl = class(TCustomdxTreeListControl)
|
|
private
|
|
// Selection
|
|
FBkmList: TStringList;
|
|
FBkmCache: TBookmarkStr;
|
|
FBkmCacheFind: Boolean;
|
|
FBkmCacheIndex: Integer;
|
|
// Common
|
|
FInternalDestroying: Boolean;
|
|
FKeyFieldName: string;
|
|
FLockRefresh: Boolean;
|
|
FNodeLink: TList;
|
|
FPreviewFieldName: string;
|
|
FPreviewMaxLength: Integer;
|
|
// Style
|
|
FIndicatorWidth: Integer;
|
|
FOnGetEditColor: TdxGetEditColor;
|
|
FOnChangeNodeEx: TNotifyEvent;
|
|
FOnRefreshNodeData: TTLExpandedEvent;
|
|
FOnBeforeCalcSummary: TNotifyEvent;
|
|
FOnCalcSummary: TNotifyEvent;
|
|
FOnGetPreviewText: TdxGetPreviewTextEvent;
|
|
procedure BkmStringsChanged(Sender: TObject);
|
|
function GetColumn(Index: Integer): TdxDBTreeListColumn;
|
|
function GetFocusedField: TField;
|
|
function GetSortedColumn: TdxDBTreeListColumn;
|
|
function GetSortedColumns(Index: Integer): TdxDBTreeListColumn;
|
|
function GetVisibleColumn(Index: Integer): TdxDBTreeListColumn;
|
|
procedure SetColumn(Index: Integer; Value: TdxDBTreeListColumn);
|
|
procedure SetFocusedField(Value: TField);
|
|
procedure SetIndicatorWidth(Value: Integer);
|
|
procedure SetKeyFieldName(const Value: string);
|
|
procedure SetPreviewFieldName(const Value: string);
|
|
procedure SetPreviewMaxLength(Value: Integer);
|
|
procedure SetVisibleColumn(Index: Integer; Value: TdxDBTreeListColumn);
|
|
procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
|
|
procedure CMExit(var Message: TMessage); message CM_EXIT;
|
|
protected
|
|
FEditValue: Variant; // for InvalidateEditor
|
|
FInKeyDown: Boolean; // Temporal
|
|
FKeyField: TField;
|
|
FLoaded: Boolean;
|
|
FPreviewField: TField;
|
|
function AssignedDrawCellEvent(ANode: TdxTreeListNode; AbsoluteIndex: Integer): Boolean; override;
|
|
function AssignedDrawFooterCellEvent(ANode: TdxTreeListNode; AbsoluteIndex, FooterIndex: Integer{Column Index}): Boolean; override;
|
|
procedure DoDrawFooterCell(ACanvas: TCanvas; ARect: TRect; ANode: TdxTreeListNode; AIndex, AFooterIndex: Integer; var AText: string;
|
|
var AColor: TColor; AFont: TFont; var AAlignment: TAlignment; var ADone: Boolean); override;
|
|
procedure DoDrawHeader(AbsoluteIndex: Integer; ACanvas: TCanvas; ARect, AClipRect: TRect; var AText: string;
|
|
var AColor: TColor; AFont: TFont; var AAlignment: TAlignment; var ASorted: TdxTreeListColumnSort; var ADone: Boolean); override;
|
|
function GetEditColor: TColor; override;
|
|
// TComponent
|
|
procedure SetName(const Value: TComponentName); override;
|
|
procedure DoStartDrag(var DragObject: TDragObject); override;
|
|
// based
|
|
function GetDataLink: TdxDBTreeListControlDataLink; virtual; abstract;
|
|
function GetDataSource: TDataSource; virtual; abstract;
|
|
function GetDefaultFields: Boolean; virtual; abstract;
|
|
function IsCancelOnExit: Boolean; virtual;
|
|
function IsCanInsert: Boolean; virtual; abstract;
|
|
function IsCanNavigation: Boolean; virtual; abstract;
|
|
function IsEasySelect: Boolean; virtual;
|
|
function IsExistFooterCell(AbsoluteIndex: Integer): Boolean; override;
|
|
function IsKeyFieldEmpty: Boolean; virtual; abstract;
|
|
function IsLoadedAll: Boolean; virtual; abstract;
|
|
function IsUseBookmarks: Boolean; virtual; abstract;
|
|
procedure SetDataChangedBusy(Value: Boolean); virtual; abstract;
|
|
// Editor
|
|
function AssignEditValue(ANode: TdxTreeListNode; AColumn: Integer; AInplaceEdit: TdxInplaceEdit): Variant; override;
|
|
function CanEditAcceptKey(Key: Char): Boolean; override;
|
|
function CanEditModify: Boolean; override;
|
|
function CanEditShow: Boolean; override;
|
|
procedure DoBeforeEditing(Node: TdxTreeListNode; var AllowEditing: Boolean); override;
|
|
procedure DoBeforeEditNewItemRow(var Allow: Boolean); override;
|
|
procedure DoBeginNewItemActive; override;
|
|
function InitEditValue(ANode: TdxTreeListNode; AInplaceEdit: TdxInplaceEdit): Variant; override;
|
|
procedure InvalidateEditorValue; virtual;
|
|
|
|
procedure DataChanged; virtual;
|
|
function IsDataSetBusy: Boolean; virtual;
|
|
procedure LinkActive(Value: Boolean); virtual;
|
|
procedure RecordChanged(Field: TField); virtual;
|
|
procedure Scroll(Distance: Integer); virtual;
|
|
procedure UpdateData; virtual;
|
|
// RecordChanged
|
|
procedure NodeRecordChanged(Field: TField; var Node: TdxDBTreeListControlNode);
|
|
procedure RefreshNodeValues(var Node: TdxDBTreeListControlNode); virtual;
|
|
// Grouping
|
|
procedure ChangedGroupColumn(Column: TdxDBTreeListColumn); virtual;
|
|
procedure SetGroupIndex(AColumn: TdxDBTreeListColumn; AIndex: Integer); virtual;
|
|
// Summary
|
|
procedure AssignSummaryFields; virtual;
|
|
procedure AssignSummaryFooterFields; virtual;
|
|
procedure DoBeforeCalcSummary; virtual;
|
|
procedure DoRefreshNodeData(Node: TdxTreeListNode); virtual;
|
|
function GetSummaryValue(ANode: TdxTreeListNode): Extended; virtual;
|
|
procedure RefreshSummaryItems(const PrevName, NewName: string); virtual;
|
|
// Sorted
|
|
procedure CheckSortedColumns;
|
|
// override TL control
|
|
function GetIndicatorWidth: Integer; override;
|
|
function GetRowIndicatorKind(Node: TdxTreeListNode; ASelected: Boolean): TdxGridIndicatorKind; override;
|
|
// Navigation
|
|
procedure ResyncSelection;
|
|
// Selected
|
|
function CompareBkm(const Item1, Item2: TBookmarkStr): Integer;
|
|
function FindBkm(const Item: TBookmarkStr; var Index: Integer): Boolean;
|
|
function FindSelectedNode(Node: TdxTreeListNode; var Index: Integer): Boolean;
|
|
function GetSelectedCount: Integer; override;
|
|
function GetSelectedItem(AIndex: Integer): TdxTreeListNode; override;
|
|
function GetSelectedRow(Index: Integer): TBookmarkStr;
|
|
procedure SelectNodes(N1, N2: TdxTreeListNode); override;
|
|
// Sorting
|
|
function CompareEqual(Node1, Node2: TdxTreeListNode): Integer; override;
|
|
function IsDragScroll: Boolean; override;
|
|
procedure PrepareColumnSorted(Column: TdxTreeListColumn); override;
|
|
// Loading Data
|
|
procedure AssignNodeValues(ANode: TdxDBTreeListControlNode; AColumn: TdxDBTreeListColumn); virtual;
|
|
procedure AssignNodeAllValues(Node: TdxDBTreeListControlNode); virtual;
|
|
function GetPreviewString(const S: string): string;
|
|
function GetColumnVariantData(ANode: TdxDBTreeListControlNode; AColumn: TdxDBTreeListColumn): Variant;
|
|
function GetNodeVarData(ANode: TdxDBTreeListControlNode; AColumn: TdxDBTreeListColumn): Extended;
|
|
// Style
|
|
function AcquireFocus: Boolean; override;
|
|
procedure BeginCustomLayout; override;
|
|
// Search
|
|
function FindNodeByText(AColumnIndex: Integer; const AText: string;
|
|
ADirection: TdxTreeListSearchDirection; var ANode: TdxTreeListNode): Boolean; override;
|
|
|
|
// based
|
|
procedure AddNodeLink(ANode: Pointer);
|
|
procedure AssignPreviewField;
|
|
function CreateDefaultColumn(ColumnClass: TdxDBTreeListColumnClass): TdxDBTreeListColumn; virtual;
|
|
procedure DefineFieldMap; virtual;
|
|
function ValidateNode(ANode : Pointer) : Boolean;
|
|
|
|
// based override
|
|
procedure DeleteNode(Node, Prior, Next: TdxTreeListNode; IsLast, Redraw: Boolean); override;
|
|
procedure DeleteStrings(Node: TdxTreeListNode; Index: Integer); override;
|
|
procedure DoChangeNodeEx; virtual;
|
|
function GetNewItemCellText(AbsoluteIndex: Integer): string; override;
|
|
function GetReadOnly: Boolean; override;
|
|
function IsDisableEditing: Boolean; virtual;
|
|
function IsNewItemRowEditing: Boolean; override;
|
|
function MakeFocused(Node: TdxTreeListNode): Boolean; override;
|
|
|
|
property BkmList: TStringList read FBkmList;
|
|
property FocusedField: TField read GetFocusedField write SetFocusedField;
|
|
property GrIndicatorWidth: Integer read GetIndicatorWidth write SetIndicatorWidth default dxDBGridIndicatorWidth;
|
|
property KeyField: string read FKeyFieldName write SetKeyFieldName;
|
|
property LockRefresh: Boolean read FLockRefresh write FLockRefresh;
|
|
property NodeLinkList: TList read FNodeLink;
|
|
property PreviewFieldName: string read FPreviewFieldName write SetPreviewFieldName;
|
|
property PreviewMaxLength: Integer read FPreviewMaxLength write SetPreviewMaxLength default 0;
|
|
property SelectedRows[Index: Integer]: TBookmarkStr read GetSelectedRow;
|
|
property OnChangeNodeEx: TNotifyEvent read FOnChangeNodeEx write FOnChangeNodeEx;
|
|
property OnRefreshNodeData: TTLExpandedEvent read FOnRefreshNodeData write FOnRefreshNodeData;
|
|
property OnBeforeCalcSummary: TNotifyEvent read FOnBeforeCalcSummary write FOnBeforeCalcSummary;
|
|
property OnCalcSummary: TNotifyEvent read FOnCalcSummary write FOnCalcSummary;
|
|
property OnGetPreviewText: TdxGetPreviewTextEvent read FOnGetPreviewText write FOnGetPreviewText;
|
|
public
|
|
constructor Create(AOwner : TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure ClearColumnsSorted; override;
|
|
procedure ClearGroupColumns; virtual;
|
|
procedure ClearSelection; override;
|
|
function ColumnByFieldName(const FieldName: string): TdxDBTreeListColumn;
|
|
function ColumnByName(const AName: string): TdxDBTreeListColumn;
|
|
function CreateColumn(ColumnClass: TdxDBTreeListColumnClass): TdxDBTreeListColumn;
|
|
function CreateColumnEx(ColumnClass: TdxDBTreeListColumnClass; AOwner: TComponent): TdxDBTreeListColumn; virtual;
|
|
procedure CreateDefaultColumns(DataSet: TDataSet; AOwner: TComponent); virtual;
|
|
procedure DestroyColumns; override;
|
|
function FindColumnByFieldName(const FieldName: string): TdxDBTreeListColumn;
|
|
procedure FullRefresh; virtual;
|
|
function GetColumnAt(X, Y: Integer): TdxDBTreeListColumn;
|
|
class function GetDefaultColumnClass: TdxDBTreeListColumnClass; virtual;
|
|
class function GetDefaultFieldColumnClass(AField: TField): TdxDBTreeListColumnClass; virtual;
|
|
function GetFooterColumnAt(X, Y: Integer): TdxDBTreeListColumn;
|
|
function GetHeaderColumnAt(X, Y: Integer): TdxDBTreeListColumn;
|
|
function RefreshBookmarks: Boolean;
|
|
{$IFDEF DELPHI4}
|
|
function ExecuteAction(Action: TBasicAction): Boolean; override;
|
|
function UpdateAction(Action: TBasicAction): Boolean; override;
|
|
{$ENDIF}
|
|
property Columns[Index: Integer]: TdxDBTreeListColumn read GetColumn write SetColumn;
|
|
property VisibleColumns[Index: Integer]: TdxDBTreeListColumn read GetVisibleColumn write SetVisibleColumn;
|
|
property DataLink: TdxDBTreeListControlDataLink read GetDataLink;
|
|
property DataSource: TDataSource read GetDataSource;
|
|
property SortedColumn: TdxDBTreeListColumn read GetSortedColumn;
|
|
property SortedColumns[Index: Integer]: TdxDBTreeListColumn read GetSortedColumns;
|
|
property OnGetEditColor: TdxGetEditColor read FOnGetEditColor write FOnGetEditColor;
|
|
end;
|
|
|
|
{ TdxDBGridSummaryItem }
|
|
TdxDBGridSummaryItem = class(TCollectionItem)
|
|
private
|
|
FColumnName: string;
|
|
FSmrField: TField;
|
|
FSummaryType: TdxSummaryType;
|
|
FSummaryField: string;
|
|
FSummaryFormat: string;
|
|
FOnSummary: TdxSummaryEvent;
|
|
procedure SetColumnName(const Value: string);
|
|
procedure SetSummaryField(const Value: string);
|
|
procedure SetSummaryFormat(const Value: string);
|
|
procedure SetSummaryType(Value: TdxSummaryType);
|
|
public
|
|
procedure Assign(Source: TPersistent); override;
|
|
function GetSummaryItems: TdxDBGridSummaryItems;
|
|
property SmrField: TField read FSmrField write FSmrField;
|
|
published
|
|
property ColumnName: string read FColumnName write SetColumnName;
|
|
property SummaryField: string read FSummaryField write SetSummaryField;
|
|
property SummaryFormat: string read FSummaryFormat write SetSummaryFormat;
|
|
property SummaryType: TdxSummaryType read FSummaryType write SetSummaryType default cstNone;
|
|
property OnSummary: TdxSummaryEvent read FOnSummary write FOnSummary;
|
|
end;
|
|
|
|
TdxDBGridSummaryItemClass = class of TdxDBGridSummaryItem;
|
|
|
|
{ TdxDBGridSummaryItems }
|
|
TdxDBGridSummaryItems = class(TCollection)
|
|
private
|
|
FSummaryGroup: TdxDBGridSummaryGroup;
|
|
function GetItem(Index: Integer): TdxDBGridSummaryItem;
|
|
procedure SetItem(Index: Integer; Value: TdxDBGridSummaryItem);
|
|
protected
|
|
function GetOwner: TPersistent; {$IFDEF DELPHI3} override;{$ENDIF}
|
|
procedure Update(Item: TCollectionItem); override;
|
|
public
|
|
constructor Create(ASummaryGroup: TdxDBGridSummaryGroup; ItemClass: TdxDBGridSummaryItemClass);
|
|
function Add: TdxDBGridSummaryItem;
|
|
property Items[Index: Integer]: TdxDBGridSummaryItem read GetItem write SetItem; default;
|
|
property SummaryGroup: TdxDBGridSummaryGroup read FSummaryGroup;
|
|
end;
|
|
|
|
{ TdxDBGridSummaryGroup }
|
|
TdxDBGridSummaryGroup = class(TCollectionItem)
|
|
private
|
|
FBeginSummaryText: string;
|
|
FEndSummaryText: string;
|
|
FDefaultGroup: Boolean;
|
|
FSummaryItems: TdxDBGridSummaryItems;
|
|
FName: string;
|
|
FOnChangeName: TNotifyEvent;
|
|
function GetDefaultGroup: Boolean;
|
|
procedure SetDefaultGroup(Value: Boolean);
|
|
procedure SetSummaryItems(Value: TdxDBGridSummaryItems);
|
|
procedure SetName(const Value: string);
|
|
protected
|
|
procedure ChangedGroup;
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
function GetSummaryGroups: TdxDBGridSummaryGroups;
|
|
property OnChangeName: TNotifyEvent read FOnChangeName write FOnChangeName;
|
|
published
|
|
property BeginSummaryText: string read FBeginSummaryText write FBeginSummaryText;
|
|
property EndSummaryText: string read FEndSummaryText write FEndSummaryText;
|
|
property DefaultGroup: Boolean read GetDefaultGroup write SetDefaultGroup;
|
|
property SummaryItems: TdxDBGridSummaryItems read FSummaryItems write SetSummaryItems;
|
|
property Name: string read FName write SetName;
|
|
end;
|
|
|
|
TdxDBGridSummaryGroupClass = class of TdxDBGridSummaryGroup;
|
|
|
|
{ TdxDBGridSummaryGroups }
|
|
TdxDBGridSummaryGroups = class(TCollection)
|
|
private
|
|
FDBTreeListControl: TCustomdxDBTreeListControl;
|
|
function GetItem(Index: Integer): TdxDBGridSummaryGroup;
|
|
procedure SetItem(Index: Integer; Value: TdxDBGridSummaryGroup);
|
|
protected
|
|
function GetOwner: TPersistent; {$IFDEF DELPHI3} override;{$ENDIF}
|
|
procedure Update(Item: TCollectionItem); override;
|
|
public
|
|
constructor Create(ADBTreeListControl: TCustomdxDBTreeListControl; ItemClass: TdxDBGridSummaryGroupClass);
|
|
function Add: TdxDBGridSummaryGroup;
|
|
function GetDefaultGroup: TdxDBGridSummaryGroup;
|
|
property DBTreeListControl: TCustomdxDBTreeListControl read FDBTreeListControl;
|
|
property Items[Index: Integer]: TdxDBGridSummaryGroup read GetItem write SetItem; default;
|
|
end;
|
|
|
|
{ TdxDBTreeListControlDataLink }
|
|
TdxDBTreeListControlDataLink = class(TDataLink)
|
|
private
|
|
FDBTreeListControl: TCustomdxDBTreeListControl;
|
|
FFieldCount: Integer;
|
|
FFieldMap: Pointer;
|
|
FFieldMapSize: Integer;
|
|
FModified: Boolean;
|
|
function GetFields(I: Integer): TField;
|
|
protected
|
|
function GetMappedIndex(ColIndex: Integer): Integer;
|
|
// override TDataLink
|
|
procedure ActiveChanged; override;
|
|
procedure DataSetChanged; override;
|
|
procedure DataSetScrolled(Distance: Integer); override;
|
|
procedure RecordChanged(Field: TField); override;
|
|
procedure UpdateData; override;
|
|
property DBTreeListControl: TCustomdxDBTreeListControl read FDBTreeListControl;
|
|
public
|
|
constructor Create(ADBTreeListControl: TCustomdxDBTreeListControl);
|
|
destructor Destroy; override;
|
|
function AddMapping(const FieldName: string): Boolean;
|
|
procedure ClearMapping;
|
|
procedure Modified;
|
|
procedure Reset;
|
|
property FieldCount: Integer read FFieldCount;
|
|
property Fields[I: Integer]: TField read GetFields;
|
|
property IsModified: Boolean read FModified;
|
|
end;
|
|
|
|
{ TdxInplaceDBTreeListMaskEdit }
|
|
TdxInplaceDBTreeListMaskEdit = class(TdxInplaceMaskEdit)
|
|
end;
|
|
|
|
{ TdxDBTreeListMaskColumn }
|
|
TdxDBTreeListMaskColumn = class(TdxDBTreeListColumn)
|
|
private
|
|
FAssignedEditMask: Boolean;
|
|
FEditMask: string;
|
|
FIgnoreMaskBlank: Boolean;
|
|
protected
|
|
function AssignEditValue(ANode: TdxTreeListNode; AInplaceEdit: TdxInplaceEdit): Variant; override;
|
|
function GetdxInplaceEditClass: TdxInplaceEditClass; override;
|
|
function GetEditMask: string;
|
|
procedure InitEditProperties(AInplaceEdit: TdxInplaceEdit); override;
|
|
function InitEditValue(ANode: TdxTreeListNode; AInplaceEdit: TdxInplaceEdit): Variant; override;
|
|
function IsEditMaskStored: Boolean;
|
|
function IsEqualValues(const Value: Variant): Boolean; override;
|
|
procedure SetEditMask(const Value: string);
|
|
public
|
|
procedure Assign(Source: TPersistent); override;
|
|
function DefaultEditMask: string;
|
|
function GetBlankText: string;
|
|
procedure RestoreDefaults; override;
|
|
published
|
|
property EditMask: string read GetEditMask write SetEditMask stored IsEditMaskStored;
|
|
property IgnoreMaskBlank: Boolean read FIgnoreMaskBlank write FIgnoreMaskBlank default False;
|
|
end;
|
|
|
|
{ TCustomdxFilterEdit }
|
|
TCustomdxFilterEdit = class(TdxInplaceMaskEdit)
|
|
public
|
|
class function IsInplace: Boolean; override;
|
|
end;
|
|
|
|
{ TdxDBTreeListColumnClassInfo }
|
|
TdxDBTreeListColumnClassInfo = record
|
|
ColumnClass: TdxDBTreeListColumnClass;
|
|
Version: Integer;
|
|
end;
|
|
|
|
TInitColumnClassProc = procedure(AFieldType: TFieldType; AFieldKind: TFieldKind;
|
|
var Info: TdxDBTreeListColumnClassInfo);
|
|
|
|
function DataVarType(AFieldType: TFieldType): Integer;
|
|
procedure RegisterDBTreeListControl(ADBTreeListControl: TCustomdxDBTreeListControl);
|
|
procedure UnRegisterDBTreeListControl(ADBTreeListControl: TCustomdxDBTreeListControl);
|
|
function IsDBTreeListControlDataSetBusy(ADataSet: TDataSet): Boolean;
|
|
|
|
function CompareNodeId(Item1, Item2: Pointer): Integer;
|
|
function CompareParentNode(Item1, Item2: Pointer): Integer;
|
|
function CompareVariant(Item1, Item2: Pointer): Integer;
|
|
procedure DeleteRecurse(Node: TdxTreeListNode);
|
|
function GetSummaryString(ASummaryType: TdxSummaryType; const ASummaryFormat: string;
|
|
AValue: Extended; ADataType: TFieldType; IsFooter: Boolean): string;
|
|
|
|
var
|
|
sdxGrTitleConfirm: string; // 'Confirm';
|
|
sdxGrDeleteRecordQuestion: string; // 'Delete record?';
|
|
sdxDeleteMultipleRecordsQuestion: string; // 'Delete all selected records?';
|
|
|
|
const
|
|
DefaultDBTreeListColumnType: array[ftUnknown..ftTypedBinary] of TdxDBTreeListColumnClassInfo = (
|
|
(ColumnClass: nil; Version: 0), { ftUnknown }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftString }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftSmallint }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftInteger }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftWord }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftBoolean }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftFloat }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftCurrency }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftBCD }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftDate }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftTime }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftDateTime }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftBytes }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftVarBytes }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftAutoInc }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftBlob }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftMemo }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftGraphic }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftFmtMemo }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftParadoxOle }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0), { ftDBaseOle }
|
|
(ColumnClass: TdxDBTreeListColumn; Version: 0)); { ftTypedBinary }
|
|
DefaultDBTreeListLookupColumnType: TdxDBTreeListColumnClassInfo = (ColumnClass: TdxDBTreeListColumn; Version: 0);
|
|
|
|
procedure InitDefaultDBTreeListColumnClasses(Proc: TInitColumnClassProc);
|
|
procedure ResetDefaultDBTreeListColumnClasses;
|
|
|
|
implementation
|
|
|
|
{$IFNDEF DELPHI3}uses DBTables, BDE;{$ENDIF}
|
|
|
|
const
|
|
MaxMapSize = (MaxInt div 2) div SizeOf(Integer); { 250 million }
|
|
// global list (DBGrid, DBTreeList)
|
|
DBTreeListControls: TList = nil;
|
|
SimpleFields = [ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat, ftCurrency,
|
|
ftBCD, ftDate, ftTime, ftDateTime, ftAutoInc
|
|
{$IFDEF DELPHI6}, ftTimeStamp, ftFMTBcd, ftLargeInt{$ENDIF}];
|
|
|
|
type
|
|
TIntArray = array[0..MaxMapSize] of Integer;
|
|
PIntArray = ^TIntArray;
|
|
|
|
function DataVarType(AFieldType: TFieldType): Integer;
|
|
const
|
|
varFieldType: array[TFieldType] of Integer = (
|
|
varUnknown, { ftUnknown }
|
|
varString, { ftString }
|
|
varSmallint, { ftSmallint }
|
|
varInteger, { ftInteger }
|
|
varInteger, { ftWord }
|
|
varString, { ftBoolean }
|
|
varDouble, { ftFloat }
|
|
varCurrency, { ftCurrency }
|
|
varCurrency, { ftBCD }
|
|
varDate, { ftDate }
|
|
varDate, { ftTime }
|
|
varDate, { ftDateTime }
|
|
varString, { ftBytes }
|
|
varString, { ftVarBytes }
|
|
varInteger, { ftAutoInc }
|
|
varString, { ftBlob }
|
|
varString, { ftMemo }
|
|
varString, { ftGraphic }
|
|
varString, { ftFmtMemo }
|
|
varString, { ftParadoxOle }
|
|
varString, { ftDBaseOle }
|
|
varString, { ftTypedBinary }
|
|
varString { ftCursor }
|
|
{$IFDEF DELPHI4},
|
|
varString, { ftFixedChar }
|
|
varString, { ftWideString }
|
|
{$IFDEF DELPHI6}varInt64{$ELSE}varString{$ENDIF}, { ftLargeint }
|
|
varString, { ftADT }
|
|
varString, { ftArray }
|
|
varString, { ftReference }
|
|
varString { ftDataSet }
|
|
{$IFDEF DELPHI5},
|
|
varString, { ftOraBlob }
|
|
varString, { ftOraClob }
|
|
varString, { ftVariant }
|
|
varString, { ftInterface }
|
|
varString, { ftIDispatch }
|
|
varString { ftGuid }
|
|
{$IFDEF DELPHI6},
|
|
varDate, { ftTimeStamp }
|
|
varDouble { ftFMTBcd }
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
);
|
|
begin
|
|
Result := varFieldType[AFieldType];
|
|
end;
|
|
|
|
procedure RegisterDBTreeListControl(ADBTreeListControl: TCustomdxDBTreeListControl);
|
|
begin
|
|
if DBTreeListControls = nil then
|
|
DBTreeListControls := TList.Create;
|
|
DBTreeListControls.Add(ADBTreeListControl);
|
|
end;
|
|
|
|
procedure UnRegisterDBTreeListControl(ADBTreeListControl: TCustomdxDBTreeListControl);
|
|
begin
|
|
if DBTreeListControls <> nil then
|
|
begin
|
|
DBTreeListControls.Remove(ADBTreeListControl);
|
|
if DBTreeListControls.Count = 0 then
|
|
begin
|
|
DBTreeListControls.Free;
|
|
DBTreeListControls := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function IsDBTreeListControlDataSetBusy(ADataSet: TDataSet): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
for I := 0 to DBTreeListControls.Count - 1 do
|
|
if (TCustomdxDBTreeListControl(DBTreeListControls[I]).Datalink.DataSet = ADataSet) and
|
|
TCustomdxDBTreeListControl(DBTreeListControls[I]).IsDataSetBusy then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function CompareNodeId(Item1, Item2: Pointer): Integer;
|
|
begin
|
|
Result := VarCompare(TdxDBTreeListControlNode(Item1).Id, TdxDBTreeListControlNode(Item2).Id);
|
|
end;
|
|
|
|
function CompareParentNode(Item1, Item2: Pointer): Integer;
|
|
begin
|
|
Result := TdxTreeListNode(Item1).Level - TdxTreeListNode(Item2).Level;
|
|
end;
|
|
|
|
function CompareVariant(Item1, Item2: Pointer): Integer;
|
|
begin
|
|
Result := VarCompare(PVariant(Item1)^, PVariant(Item2)^);
|
|
end;
|
|
|
|
procedure DeleteRecurse(Node: TdxTreeListNode);
|
|
begin
|
|
if (Node.Parent <> nil) and (Node.Parent.Count = 1) then
|
|
DeleteRecurse(Node.Parent)
|
|
else
|
|
Node.Free;
|
|
end;
|
|
|
|
function GetSummaryString(ASummaryType: TdxSummaryType; const ASummaryFormat: string;
|
|
AValue: Extended; ADataType: TFieldType; IsFooter: Boolean): string;
|
|
const
|
|
stSummary: array[Boolean, cstSum..cstAvg] of string =
|
|
(('(SUM=0.00);(SUM=-0.00)', '(MIN=0.00);(MIN=-0.00)', '(MAX=0.00);(MAX=-0.00)', '(COUNT=0)', '(AVG=0.00);(AVG=-0.00)'),
|
|
('0.00;-0.00', 'MIN=0.00;MIN=-0.00', 'MAX=0.00;MAX=-0.00', '0', 'AVG=0.00;AVG=-0.00'));
|
|
stSummaryDateTime: array[Boolean, cstSum .. cstAvg] of string =
|
|
(('(SUM=', '(MIN=', '(MAX=', '(COUNT=0)', '(AVG='),
|
|
('', 'MIN=', 'MAX=', '0', 'AVG='));
|
|
var
|
|
F, F1: string;
|
|
begin
|
|
Result := '';
|
|
if ASummaryType <> cstNone then
|
|
begin
|
|
if ASummaryFormat = '' then
|
|
F := stSummary[IsFooter, ASummaryType]
|
|
else F := ASummaryFormat;
|
|
if (ASummaryType <> cstCount) and (ADataType in [ftDate, ftTime, ftDateTime]) then
|
|
begin
|
|
if ASummaryFormat = '' then
|
|
begin
|
|
F := stSummaryDateTime[IsFooter, ASummaryType];
|
|
if not IsFooter then F1 := ')'
|
|
else F1 := '';
|
|
end
|
|
else F1 := '';
|
|
case ADataType of
|
|
ftDate: Result := F + DateToStr(AValue) + F1;
|
|
ftTime: Result := F + TimeToStr(AValue) + F1;
|
|
ftDateTime: Result := F + DateTimeToStr(AValue) + F1;
|
|
end;
|
|
end
|
|
else
|
|
Result := FormatFloat(F, AValue);
|
|
end;
|
|
end;
|
|
|
|
{TdxDBTreeListColumn}
|
|
constructor TdxDBTreeListColumn.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FGroupIndex := -1;
|
|
end;
|
|
|
|
destructor TdxDBTreeListColumn.Destroy;
|
|
begin
|
|
if (ATreeList <> nil) and not (csDestroying in ATreeList.ComponentState) and
|
|
(Self.GroupIndex <> -1) then ATreeList.SetGroupIndex(Self, -1);
|
|
if ATreeList <> nil then
|
|
begin
|
|
if not (csDestroying in ATreeList.ComponentState) then
|
|
begin
|
|
ATreeList.RefreshSummaryItems(Name, '');
|
|
end;
|
|
end;
|
|
inherited Destroy; // TreeList.RemoveColumn(Self);
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TdxDBTreeListColumn then
|
|
begin
|
|
if Assigned(ATreeList) then ATreeList.BeginUpdate;
|
|
try
|
|
inherited Assign(Source);
|
|
DisableGrouping := TdxDBTreeListColumn(Source).DisableGrouping;
|
|
FieldName := TdxDBTreeListColumn(Source).FieldName;
|
|
SummaryGroupName := TdxDBTreeListColumn(Source).SummaryGroupName;
|
|
finally
|
|
if Assigned(ATreeList) then ATreeList.EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.DefaultAlignment: TAlignment;
|
|
begin
|
|
if Assigned(Field) then
|
|
Result := FField.Alignment
|
|
else Result := taLeftJustify;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.DefaultCaption: String;
|
|
begin
|
|
if Assigned(Field) then
|
|
Result := Field.DisplayName
|
|
else Result := FieldName;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.DefaultMaxLength: Integer;
|
|
begin
|
|
Result := 0;
|
|
if Assigned(Field) and (Field.DataType in [ftString{$IFDEF DELPHI4}, ftWideString{$ENDIF}]) then
|
|
Result := Field.Size;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.DefaultReadOnly: Boolean;
|
|
begin
|
|
Result := False;
|
|
if Assigned(Field) then Result := FField.ReadOnly;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.DefaultWidth: Integer;
|
|
var
|
|
W: Integer;
|
|
RestoreCanvas: Boolean;
|
|
TM: TTextMetric;
|
|
begin
|
|
Result := 64;
|
|
if ATreeList = nil then Exit;
|
|
with ATreeList do
|
|
begin
|
|
RestoreCanvas := not HandleAllocated;
|
|
if RestoreCanvas then
|
|
Canvas.Handle := GetDC(0);
|
|
try
|
|
Canvas.Font := ATreeList.HeaderFont;
|
|
if Self.Caption <> '' then
|
|
Result := Canvas.TextWidth(Self.Caption) + 4 + 1 + 1;
|
|
if Assigned(Field) then
|
|
begin
|
|
if (cvFont in AssignedValues) then
|
|
Canvas.Font := Self.Font
|
|
else Canvas.Font := ATreeList.Font;
|
|
GetTextMetrics(Canvas.Handle, TM);
|
|
W := Field.DisplayWidth * (Canvas.TextWidth('0') - TM.tmOverhang)
|
|
+ TM.tmOverhang + 4;
|
|
if Result < W then Result := W;
|
|
end;
|
|
finally
|
|
if RestoreCanvas then
|
|
begin
|
|
ReleaseDC(0, Canvas.Handle);
|
|
Canvas.Handle := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.IsValidChar(InputChar: Char): Boolean;
|
|
begin
|
|
Result := ATreeList.DataLink.Active and Assigned(Field) and Field.IsValidChar(InputChar);
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.RestoreDefaults;
|
|
begin
|
|
inherited RestoreDefaults;
|
|
FDisableGrouping := False;
|
|
FSummaryGroupName := '';
|
|
end;
|
|
|
|
// protected TdxDBTreeListColumn
|
|
function TdxDBTreeListColumn.AlwaysStoredValue: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.AssignedDrawCellEvent: Boolean;
|
|
begin
|
|
Result := inherited AssignedDrawCellEvent or Assigned(FOnCustomDraw);
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.AssignEditValue(ANode: TdxTreeListNode; AInplaceEdit: TdxInplaceEdit): Variant;
|
|
begin
|
|
if Assigned(Field) then
|
|
begin
|
|
Field.Text := TdxInplaceTreeListEdit(AInplaceEdit).Text;
|
|
// Result := Field.Value;
|
|
Result := ANode.Values[Index]; // TODO Check
|
|
end
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.AssignNodeValues(ANode: TdxDBTreeListControlNode);
|
|
var
|
|
VariantData: TNodeVariantData;
|
|
F: TField;
|
|
begin
|
|
// display text
|
|
ANode.Strings[Index] := GetText(GetDisplayText(ANode));
|
|
// variant value
|
|
F := Field;
|
|
with VariantData do
|
|
begin
|
|
AssignedValues := [];
|
|
Value := Null;
|
|
LookupValue := Null;
|
|
if Assigned(F) then
|
|
begin
|
|
if (F.DataType in SimpleFields) or F.IsNull or ((F is TStringField) and
|
|
(Assigned(F.OnGetText) or (F.EditMask <> ''))) or AlwaysStoredValue then
|
|
begin
|
|
Include(AssignedValues, nadValue);
|
|
Value := F.Value;
|
|
end;
|
|
if F.Lookup then
|
|
begin
|
|
Include(AssignedValues, nadLookupValue);
|
|
// LookupValue := F.DataSet.FieldByName(F.KeyFields).Value;
|
|
LookupValue := F.DataSet.FieldValues[F.KeyFields];
|
|
end;
|
|
end;
|
|
end;
|
|
ANode.VariantData[Index] := VariantData;
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.ChangedReload(AllItems: Boolean);
|
|
begin
|
|
if (ATreeList <> nil) and not (csLoading in ATreeList.ComponentState) and
|
|
ATreeList.Datalink.Active then
|
|
if AllItems then ATreeList.ChangedGroupColumn(nil)
|
|
else ATreeList.ChangedGroupColumn(Self);
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.DoDrawCell(ACanvas: TCanvas; var ARect: TRect; ANode: TdxTreeListNode;
|
|
ASelected, AFocused: Boolean; ANewItemRow: Boolean; ALeftEdge, ARightEdge: Boolean; ABrush: HBRUSH;
|
|
var AText: string; var AColor: TColor; AFont: TFont; var AAlignment: TAlignment; var ADone: Boolean);
|
|
begin
|
|
// obsolete
|
|
if Assigned(FOnCustomDraw) then FOnCustomDraw(Self, ACanvas, ARect, ANode, Self, AText,
|
|
AFont, AColor, ASelected, AFocused, ADone);
|
|
if not ADone then
|
|
inherited DoDrawCell(ACanvas, ARect, ANode, ASelected, AFocused, ANewItemRow,
|
|
ALeftEdge, ARightEdge, ABrush, AText, AColor, AFont, AAlignment, ADone);
|
|
end;
|
|
|
|
//function TdxDBTreeListColumn.GetDisplayText: String;
|
|
function TdxDBTreeListColumn.GetDisplayText(ANode: TdxTreeListNode): string;
|
|
begin
|
|
if Field <> nil then Result := Field.DisplayText
|
|
else Result := '';
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.GetFilterEdit(AOwner: TComponent): TdxInplaceEdit;
|
|
begin
|
|
Result := GetFilterEditClass.Create(AOwner);
|
|
PrepareFilterEdit(Result);
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.GetFilterEditClass: TdxInplaceEditClass;
|
|
begin
|
|
Result := TCustomdxFilterEdit;
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.GetFilterEditValues(AEdit: TdxInplaceEdit; var V: Variant; var S: string);
|
|
begin
|
|
S := TdxInplaceTreeListEdit(AEdit).Text;
|
|
V := S;
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.SetFilterEditValue(AEdit: TdxInplaceEdit; const V: Variant);
|
|
begin
|
|
// if AEdit is TCustomdxFilterEdit then
|
|
if AEdit is TdxInplaceEdit then
|
|
if VarIsNull(V) then
|
|
TCustomdxFilterEdit(AEdit).Text := ''
|
|
else
|
|
TCustomdxFilterEdit(AEdit).Text := V;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.GetFilterOperators: TdxDBGridOperatorTypes;
|
|
begin
|
|
Result := [gotEqual, gotNotEqual, gotGreater, gotGreaterEqual, gotLess,
|
|
gotLessEqual, gotBlank, gotNonBlank];
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.GetFilterValue(ANode: TdxTreeListNode{; Index: ?}): Variant;
|
|
begin
|
|
Result := ANode.Values[Index];
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.GetFilterValues(ANode: TdxTreeListNode; var V: Variant; var S: string);
|
|
begin
|
|
V := GetFilterValue(ANode);
|
|
S := GetGroupText(ANode.Strings[Index]);
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.GetGroupText(const Value : String) : String;
|
|
begin
|
|
Result := Value;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.GetSummaryFooterText: String;
|
|
var
|
|
DataType: TFieldType;
|
|
begin
|
|
Result := '';
|
|
if (SummaryFooterType <> cstNone) then
|
|
begin
|
|
if (SummaryFooterType <> cstCount) and Assigned(FSmrFooterField) and
|
|
(FSmrFooterField.DataType in [ftDate, ftTime, ftDateTime]) then
|
|
DataType := FSmrFooterField.DataType
|
|
else DataType := ftUnknown;
|
|
Result := GetSummaryString(SummaryFooterType, SummaryFooterFormat, FSummaryFooterValue, DataType, True);
|
|
end;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.GetText(const Value : Variant) : String;
|
|
begin
|
|
Result := Value;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.GetVariantType: Integer;
|
|
begin
|
|
if Assigned(Field) then
|
|
begin
|
|
if Field.DataType in SimpleFields then
|
|
Result := DataVarType(Field.DataType)
|
|
else
|
|
Result := varString;
|
|
end
|
|
else
|
|
Result := varUnknown;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.InitEditValue(ANode: TdxTreeListNode; AInplaceEdit: TdxInplaceEdit): Variant;
|
|
begin
|
|
if Assigned(Field) then
|
|
begin
|
|
TdxInplaceTreeListEdit(AInplaceEdit).Text := Field.Text;
|
|
Result := TdxInplaceTreeListEdit(AInplaceEdit).Text;
|
|
end
|
|
else
|
|
Result := inherited InitEditValue(ANode, AInplaceEdit);
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.IsBlobColumn: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.IsEqualValues(const Value: Variant): Boolean;
|
|
begin
|
|
if Assigned(Field) and not VarIsEmpty(Value) then
|
|
begin
|
|
if (VarType(Value) = varString) and not IsBlobColumn {TODO Check !!!} then
|
|
Result := Field.Text = Value
|
|
else Result := Field.Value = Value
|
|
end
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
type
|
|
TdxInplaceEditWrapper = class(TdxInplaceEdit);
|
|
|
|
procedure TdxDBTreeListColumn.PrepareFilterEdit(AEdit: TdxInplaceEdit);
|
|
begin
|
|
InitEditProperties(AEdit);
|
|
TdxInplaceEditWrapper(AEdit).ReadOnly := False;
|
|
if AEdit is TdxInplaceTextEdit then
|
|
with TdxInplaceTreeListTextEdit(AEdit) do
|
|
begin
|
|
OnChange := nil;
|
|
OnValidate := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.SetIndex(Value: Integer);
|
|
var
|
|
Fld: TField;
|
|
begin
|
|
if ATreeList.GetDefaultFields and (ATreeList <> nil) and (ATreeList.Datalink.Active) then
|
|
begin
|
|
Fld := ATreeList.Datalink.Fields[Value];
|
|
if Assigned(Fld) then
|
|
Field.Index := Fld.Index
|
|
else Field.Index := ATreeList.Datalink.FieldCount - 1;
|
|
end;
|
|
inherited SetIndex(Value);
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.SetName(const Value: TComponentName);
|
|
var
|
|
SaveEvent: TNotifyEvent;
|
|
PrevName: string;
|
|
begin
|
|
if not (csLoading in ComponentState) then
|
|
begin
|
|
SaveEvent := OnChangeName;
|
|
PrevName := Name;
|
|
OnChangeName := nil;
|
|
inherited SetName(Value);
|
|
OnChangeName := SaveEvent;
|
|
if (PrevName <> Name) and (ATreeList <> nil) then
|
|
ATreeList.RefreshSummaryItems(PrevName, Name);
|
|
if Assigned(OnChangeName) then OnChangeName(Self);
|
|
end
|
|
else
|
|
inherited SetName(Value);
|
|
end;
|
|
|
|
// private TdxDBTreeListColumn
|
|
function TdxDBTreeListColumn.GetDBTreeList: TCustomdxDBTreeListControl;
|
|
begin
|
|
Result := TreeList as TCustomdxDBTreeListControl;
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.GetField: TField;
|
|
begin
|
|
Result := FField;
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.SetDBTreeList(Value: TCustomdxDBTreeListControl);
|
|
begin
|
|
TreeList := Value;
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.SetDisableGrouping(Value : Boolean);
|
|
begin
|
|
if DisableGrouping <> Value then
|
|
begin
|
|
FDisableGrouping := Value;
|
|
if (GroupIndex <> -1) and FDisableGrouping then GroupIndex := -1
|
|
else Changed(True);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.SetFieldName(const Value: String);
|
|
var
|
|
OldValue: string;
|
|
FlagRefresh, FlagActive: Boolean;
|
|
AField: TField;
|
|
begin
|
|
OldValue := FieldName;
|
|
FlagRefresh := (Self.GroupIndex <> -1) and (ATreeList <> nil) and ATreeList.Datalink.Active;
|
|
FlagActive := Assigned(ATreeList) and Assigned(ATreeList.DataLink.DataSet) and
|
|
not (csLoading in ATreeList.ComponentState);
|
|
if FlagRefresh and FlagActive then
|
|
begin
|
|
AField := ATreeList.DataLink.DataSet.FindField(Value);
|
|
FField := AField;
|
|
if (FField = nil) then ATreeList.SetGroupIndex(Self, -1);
|
|
end;
|
|
// inherited SetFieldName(Value);
|
|
AField := nil;
|
|
if FlagActive and (Length(Value) > 0) and
|
|
(ATreeList.DataLink.DataSet.Active or
|
|
not ATreeList.DataLink.DataSet.DefaultFields) then
|
|
AField := ATreeList.DataLink.DataSet.FindField(Value);
|
|
FFieldName := Value;
|
|
FField := AField;
|
|
// Changed(False);
|
|
if (ATreeList <> nil) and (ATreeList.LockUpdate = 0) then Changed(False);
|
|
|
|
if (ATreeList <> nil) and
|
|
not (csLoading in ATreeList.ComponentState) and
|
|
(OldValue <> Value) then
|
|
begin
|
|
if (Self.GroupIndex <> -1) or FlagRefresh or True then
|
|
ATreeList.ChangedGroupColumn(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.SetGroupIndex(Value: Integer);
|
|
begin
|
|
if Value >= -1 then
|
|
// Delphi 5 - BUG !!!
|
|
if ({$IFDEF DELPHI5}csReading{$ELSE}csLoading{$ENDIF} in ComponentState) then
|
|
FGroupIndex := Value
|
|
else
|
|
if ATreeList <> nil then
|
|
ATreeList.SetGroupIndex(Self, Value);
|
|
end;
|
|
|
|
function TdxDBTreeListColumn.GetSortBySummary: Boolean;
|
|
begin
|
|
Result := FSortBySummary and (FSummaryType <> cstNone);
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.SetSortBySummary(Value: Boolean);
|
|
begin
|
|
FSortBySummary := Value and (FSummaryType <> cstNone);
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.SetSummaryType(Value: TdxSummaryType);
|
|
begin
|
|
if FSummaryType <> Value then
|
|
begin
|
|
FSummaryType := Value;
|
|
if FSummaryType = cstNone then FSortBySummary := False;
|
|
Changed(False); // Invalidate - no ReCalc summary (use to Refresh RefreshGroupColumns)
|
|
end;
|
|
end;
|
|
|
|
procedure TdxDBTreeListColumn.SetSummaryFooterType(Value: TdxSummaryType);
|
|
begin
|
|
if FSummaryFooterType <> Value then
|
|
begin
|
|
FSummaryFooterType := Value;
|
|
Changed(False); // Invalidate - no ReCalc summary (use to Refresh RefreshGroupColumns)
|
|
end;
|
|
end;
|
|
|
|
{TdxDBTreeListControlNode}
|
|
destructor TdxDBTreeListControlNode.Destroy;
|
|
var
|
|
PValue: PNodeVariantData;
|
|
I: Integer;
|
|
begin
|
|
// free TStrings.Objects
|
|
with FStrings do
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
PValue := PNodeVariantData(Objects[I]);
|
|
if PValue <> nil then
|
|
begin
|
|
Dispose(PValue);
|
|
Objects[I] := nil;
|
|
end;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TdxDBTreeListControlNode.Delete;
|
|
begin
|
|
end;
|
|
|
|
function TdxDBTreeListControlNode.GetVariantData(Column: Integer): TNodeVariantData;
|
|
begin
|
|
with Result do
|
|
begin
|
|
AssignedValues := [];
|
|
Value := Null;
|
|
LookupValue := Null;
|
|
end;
|
|
if Column < FStrings.Count then
|
|
if FStrings.Objects[Column] <> nil then
|
|
Result := PNodeVariantData(FStrings.Objects[Column])^;
|
|
end;
|
|
|
|
procedure TdxDBTreeListControlNode.SetVariantData(Column: Integer; const Value: TNodeVariantData);
|
|
var
|
|
PValue: PNodeVariantData;
|
|
begin
|
|
if Column >= FStrings.Count then
|
|
while FStrings.Add('') < Column do;
|
|
if FStrings.Objects[Column] <> nil then
|
|
PValue := PNodeVariantData(FStrings.Objects[Column])
|
|
else New(PValue);
|
|
PValue^ := Value;
|
|
FStrings.Objects[Column] := TObject(PValue);
|
|
end;
|
|
|
|
function TdxDBTreeListControlNode.GetVariantValue(Column: Integer): Variant;
|
|
begin
|
|
Result := Values[Column];
|
|
end;
|
|
|
|
{TCustomdxDBTreeListControl }
|
|
constructor TCustomdxDBTreeListControl.Create(AOwner : TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FBkmList := TStringList.Create;
|
|
FBkmList.OnChange := BkmStringsChanged;
|
|
FIndicatorWidth := dxDBGridIndicatorWidth;
|
|
FNodeLink := TList.Create;
|
|
end;
|
|
|
|
destructor TCustomdxDBTreeListControl.Destroy;
|
|
begin
|
|
BeforeDestroy;
|
|
FNodeLink.Free;
|
|
FNodeLink := nil;
|
|
FBkmList.Free;
|
|
FBkmList := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.ClearColumnsSorted;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
inherited ClearColumnsSorted;
|
|
for I := 0 to ColumnCount - 1 do
|
|
if Columns[I].GroupIndex = -1 then Columns[I].FSorted := csNone;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.ClearGroupColumns;
|
|
begin
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.ClearSelection;
|
|
begin
|
|
if GetSelectedCount = 0 then Exit;
|
|
if not (csDestroying in ComponentState) and not FClearNodes then
|
|
InvalidateSelection;
|
|
if FBkmList <> nil then FBkmList.Clear;
|
|
inherited ClearSelection;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.ColumnByFieldName(const FieldName: string): TdxDBTreeListColumn;
|
|
begin
|
|
Result := FindColumnByFieldName(FieldName);
|
|
if Result = nil then
|
|
InvaliddxTreeListOperation(FmtLoadStr(dxSColumnNotFound, [Name, FieldName]));
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.ColumnByName(const AName: String): TdxDBTreeListColumn;
|
|
begin
|
|
Result := inherited ColumnByName(AName) as TdxDBTreeListColumn;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.CreateColumn(ColumnClass: TdxDBTreeListColumnClass): TdxDBTreeListColumn;
|
|
begin
|
|
Result := CreateColumnEx(ColumnClass, Self);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.CreateColumnEx(ColumnClass: TdxDBTreeListColumnClass;
|
|
AOwner: TComponent): TdxDBTreeListColumn;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if GetDefaultFields then
|
|
raise Exception.Create(LoadStr(dxSDefaultFieldsError){'DefaultFields property should be set to False'});
|
|
Result := ColumnClass.Create(AOwner);
|
|
I := ColumnCount + 1;
|
|
while I <> -1 do
|
|
try
|
|
Result.Name := Name + 'Column' + IntToStr(I);
|
|
I := -1;
|
|
except
|
|
Inc(I);
|
|
end;
|
|
Result.ATreeList := Self;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DestroyColumns;
|
|
begin
|
|
if GetDefaultFields and not (FInternalDestroying or
|
|
(csDestroying in ComponentState) or (LockUpdate <> 0)) then
|
|
raise Exception.Create(LoadStr(dxSDefaultFieldsError){'DefaultFields property should be set to False'});
|
|
inherited DestroyColumns;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.FullRefresh;
|
|
begin
|
|
LayoutChanged;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetColumnAt(X, Y: Integer): TdxDBTreeListColumn;
|
|
begin
|
|
Result := TdxDBTreeListColumn(inherited GetColumnAt(X, Y));
|
|
end;
|
|
|
|
class function TCustomdxDBTreeListControl.GetDefaultColumnClass: TdxDBTreeListColumnClass;
|
|
begin
|
|
Result := TdxDBTreeListColumn;
|
|
end;
|
|
|
|
class function TCustomdxDBTreeListControl.GetDefaultFieldColumnClass(AField: TField): TdxDBTreeListColumnClass;
|
|
begin
|
|
Result := TdxDBTreeListColumn;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetFooterColumnAt(X, Y: Integer): TdxDBTreeListColumn;
|
|
begin
|
|
Result := TdxDBTreeListColumn(inherited GetFooterColumnAt(X, Y));
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetHeaderColumnAt(X, Y: Integer): TdxDBTreeListColumn;
|
|
begin
|
|
Result := TdxDBTreeListColumn(inherited GetHeaderColumnAt(X, Y));
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.RefreshBookmarks: Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
if Assigned(DataLink.Datasource.Dataset) then
|
|
with DataLink.Datasource.Dataset do
|
|
try
|
|
CheckBrowseMode;
|
|
for I := FBkmList.Count-1 downto 0 do
|
|
{$IFNDEF DELPHI3}
|
|
if DbiSetToBookmark(Handle, Pointer(FBkmList[I])) <> 0 then
|
|
{$ELSE}
|
|
if not BookmarkValid(TBookmark(FBkmList[I])) then
|
|
{$ENDIF}
|
|
begin
|
|
Result := True;
|
|
FBkmList.Delete(I);
|
|
end;
|
|
finally
|
|
UpdateCursorPos;
|
|
if Result then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.FindColumnByFieldName(const FieldName: string): TdxDBTreeListColumn;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to ColumnCount - 1 do
|
|
begin
|
|
Result := Columns[I];
|
|
if AnsiCompareText(Result.FFieldName, FieldName) = 0 then Exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
{$IFDEF DELPHI4}
|
|
function TCustomdxDBTreeListControl.ExecuteAction(Action: TBasicAction): Boolean;
|
|
begin
|
|
Result := inherited ExecuteAction(Action) or (DataLink <> nil) and
|
|
DataLink.ExecuteAction(Action);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.UpdateAction(Action: TBasicAction): Boolean;
|
|
begin
|
|
Result := inherited UpdateAction(Action) or (DataLink <> nil) and
|
|
DataLink.UpdateAction(Action);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
// protected TCustomdxDBTreeListControl
|
|
function TCustomdxDBTreeListControl.AssignedDrawCellEvent(ANode: TdxTreeListNode; AbsoluteIndex: Integer): Boolean;
|
|
begin
|
|
Result := inherited AssignedDrawCellEvent(ANode, AbsoluteIndex) or
|
|
Columns[AbsoluteIndex].AssignedDrawCellEvent;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.AssignedDrawFooterCellEvent(ANode: TdxTreeListNode; AbsoluteIndex, FooterIndex: Integer{Column Index}): Boolean;
|
|
begin
|
|
Result := inherited AssignedDrawFooterCellEvent(ANode, AbsoluteIndex, FooterIndex);
|
|
if not Result and (FooterIndex = -1) then
|
|
Result := Assigned(TdxDBTreeListColumn(Columns[AbsoluteIndex]).FOnDrawSummaryFooter);
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DoDrawFooterCell(ACanvas: TCanvas; ARect: TRect; ANode: TdxTreeListNode; AIndex, AFooterIndex: Integer; var AText: string;
|
|
var AColor: TColor; AFont: TFont; var AAlignment: TAlignment; var ADone: Boolean);
|
|
var
|
|
Column: TdxDBTreeListColumn;
|
|
begin
|
|
if AFooterIndex = -1 then
|
|
begin
|
|
Column := TdxDBTreeListColumn(Columns[AIndex]);
|
|
if Assigned(Column.FOnDrawSummaryFooter) then Column.FOnDrawSummaryFooter(Column, ACanvas, ARect,
|
|
AText, AAlignment, AFont, AColor, ADone);
|
|
end;
|
|
if not ADone then
|
|
inherited DoDrawFooterCell(ACanvas, ARect, ANode, AIndex, AFooterIndex, AText,
|
|
AColor, AFont, AAlignment, ADone);
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DoDrawHeader(AbsoluteIndex: Integer; ACanvas: TCanvas;
|
|
ARect, AClipRect: TRect; var AText: string; var AColor: TColor; AFont: TFont;
|
|
var AAlignment: TAlignment; var ASorted: TdxTreeListColumnSort; var ADone: Boolean);
|
|
var
|
|
Column: TdxDBTreeListColumn;
|
|
begin
|
|
Column := Columns[AbsoluteIndex];
|
|
// obsolete
|
|
if Assigned(Column.FOnCustomDrawHeader) then
|
|
Column.FOnCustomDrawHeader(Self, ACanvas, ARect, Column, ADone);
|
|
if not ADone then
|
|
inherited DoDrawHeader(AbsoluteIndex, ACanvas, ARect, AClipRect, AText,
|
|
AColor, AFont, AAlignment, ASorted, ADone);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetEditColor: TColor;
|
|
var
|
|
Column: TdxDBTreeListColumn;
|
|
I: Integer;
|
|
begin
|
|
Result := inherited GetEditColor;
|
|
I := FocusedAbsoluteIndex;
|
|
if I <> -1 then Column := Columns[I]
|
|
else Column := nil;
|
|
if Assigned(FOnGetEditColor) then FOnGetEditColor(Self, FocusedNode, Column, Result);
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.SetName(const Value: TComponentName);
|
|
var
|
|
I: Integer;
|
|
OldName, FieldName, NamePrefix: TComponentName;
|
|
Column: TdxDBTreeListColumn;
|
|
OldChangeEvent : TNotifyEvent;
|
|
begin
|
|
OldName := Name;
|
|
inherited SetName(Value);
|
|
if (csDesigning in ComponentState) and (Name <> OldName) then
|
|
begin
|
|
{ In design mode the name of the columns should track the data set name }
|
|
for I := 0 to ColumnCount - 1 do
|
|
begin
|
|
Column := Columns[I];
|
|
if Column.Owner = Owner then
|
|
begin
|
|
FieldName := Column.Name;
|
|
NamePrefix := FieldName;
|
|
if Length(NamePrefix) > Length(OldName) then
|
|
begin
|
|
SetLength(NamePrefix, Length(OldName));
|
|
if CompareText(OldName, NamePrefix) = 0 then
|
|
begin
|
|
System.Delete(FieldName, 1, Length(OldName));
|
|
System.Insert(Value, FieldName, 1);
|
|
OldChangeEvent := Column.OnChangeName;
|
|
Column.OnChangeName := Nil;
|
|
try
|
|
Column.Name := FieldName;
|
|
except
|
|
on EComponentError do {Ignore rename errors };
|
|
end;
|
|
Column.OnChangeName := OldChangeEvent;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{Refresh columns list}
|
|
if Assigned(Designer) then Designer.LayoutChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DoStartDrag(var DragObject: TDragObject);
|
|
begin
|
|
if Assigned(Datalink.DataSet) and (Datalink.DataSet.State in dsEditModes) then
|
|
Datalink.DataSet.Post;
|
|
// InvaliddxTreeListOperation(LoadStr(dxSInvalidDataSetMode){'Dataset in edit or insert mode'});
|
|
inherited DoStartDrag(DragObject);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.IsCancelOnExit: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.IsEasySelect: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.IsExistFooterCell(AbsoluteIndex: Integer): Boolean;
|
|
begin
|
|
Result := inherited IsExistFooterCell(AbsoluteIndex) or
|
|
(Columns[AbsoluteIndex].SummaryFooterType <> cstNone);
|
|
end;
|
|
|
|
// Editor
|
|
function TCustomdxDBTreeListControl.AssignEditValue(ANode: TdxTreeListNode;
|
|
AColumn: Integer; AInplaceEdit: TdxInplaceEdit): Variant;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := GetFocusedAbsoluteIndex(AColumn);
|
|
if (I <> -1) and DataLink.IsModified then
|
|
begin
|
|
with Columns[I] do
|
|
if Assigned(Field) and Assigned(DataLink.DataSet) and
|
|
(DataLink.DataSet.State in dsEditModes) then
|
|
begin
|
|
FActualNode := ANode;
|
|
try
|
|
AddNodeLink(ANode);
|
|
Result := AssignEditValue(ANode, AInplaceEdit);
|
|
if ValidateNode(ANode) then
|
|
begin
|
|
ANode.Strings[Index] := GetText(GetDisplayText(ANode));
|
|
if NodeLinkList <> nil then
|
|
NodeLinkList.Remove(ANode);
|
|
end;
|
|
finally
|
|
FActualNode := nil;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
Result := '';
|
|
FEditValue := Result;
|
|
inherited AssignEditValue(ANode, AColumn, AInplaceEdit);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.CanEditAcceptKey(Key: Char): Boolean;
|
|
//var
|
|
// Field: TField;
|
|
begin
|
|
if FocusedAbsoluteIndex <> -1 then
|
|
Result := Columns[FocusedAbsoluteIndex].IsValidChar(Key)
|
|
else
|
|
Result := True;
|
|
{
|
|
Result := True;
|
|
Field := FocusedField;
|
|
if Field <> nil then
|
|
Result := Datalink.Active and Assigned(Field) and Field.IsValidChar(Key);}
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.CanEditModify: Boolean;
|
|
begin
|
|
Result := False;
|
|
if not IsCanNavigation or IsKeyFieldEmpty then Exit;
|
|
if Datalink.Active and not Datalink.Readonly and (FocusedColumn <> -1) then
|
|
with Columns[FocusedAbsoluteIndex] do
|
|
begin
|
|
if (not ReadOnly) and Assigned(Field) and (Field.CanModify or (Field.Lookup and CanLookupFieldModify(Field))) and
|
|
(not {$IFDEF DELHPI3}Field.IsBlob{$else}(Field is TBlobField){$ENDIF} or
|
|
Assigned(Field.OnSetText) or IsBlobColumn) then // TODO EDIT
|
|
begin
|
|
if not IsDisableEditing then
|
|
begin
|
|
Datalink.Edit;
|
|
Result := Datalink.Editing;
|
|
if Result then Datalink.Modified;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.CanEditShow: Boolean;
|
|
begin
|
|
Result := inherited CanEditShow and (FocusedNode <> nil ) and DataLink.Active;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DoBeforeEditing(Node: TdxTreeListNode; var AllowEditing: Boolean);
|
|
begin
|
|
inherited DoBeforeEditing(Node, AllowEditing);
|
|
AllowEditing := AllowEditing and IsCanNavigation;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DoBeforeEditNewItemRow(var Allow: Boolean);
|
|
begin
|
|
Allow := False;
|
|
if (0 <= FocusedColumn) and (FocusedColumn < GetVisibleHeaderCount) and
|
|
Columns[FocusedAbsoluteIndex].GetEnableEditor then // new code * (see TCustomdxTreeListControl.DoBeforeEditing)
|
|
begin
|
|
if (DataLink.DataSet <> nil) and DataLink.DataSet.Active and
|
|
IsCanInsert and IsCanNavigation then
|
|
begin
|
|
if DataLink.DataSet.State <> dsInsert then
|
|
DataLink.DataSet.Insert;
|
|
Allow := True;
|
|
// OnEditing - (FocusedNode)
|
|
if Assigned(OnEditing) then OnEditing(Self, FocusedNode, Allow);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DoBeginNewItemActive;
|
|
var
|
|
B: Boolean;
|
|
begin
|
|
B := True;
|
|
DoBeforeEditNewItemRow(B);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.InitEditValue(ANode: TdxTreeListNode; AInplaceEdit: TdxInplaceEdit): Variant;
|
|
begin
|
|
Result := inherited InitEditValue(ANode, AInplaceEdit);
|
|
FEditValue := Result;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.InvalidateEditorValue;
|
|
begin
|
|
if State <> tsEditing then Exit;
|
|
if not Columns[FocusedAbsoluteIndex].IsEqualValues(FEditValue) then
|
|
InvalidateEditor;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DataChanged;
|
|
begin
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.IsDataSetBusy: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.LinkActive(Value: Boolean);
|
|
begin
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.RecordChanged(Field: TField);
|
|
begin
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.Scroll(Distance: Integer);
|
|
begin
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.UpdateData;
|
|
begin
|
|
HideEditor;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.NodeRecordChanged(Field: TField; var Node: TdxDBTreeListControlNode);
|
|
var
|
|
CField: TField;
|
|
begin
|
|
if not HandleAllocated then Exit;
|
|
RefreshNodeValues(Node);
|
|
if ColumnCount = 0 then Exit;
|
|
if (InplaceEditor = nil) or not InplaceEditor.IsVisible then Exit;
|
|
CField := FocusedField;
|
|
Columns[GetFocusedAbsoluteIndex(InplaceColumnIndex){FocusedAbsoluteIndex}].FActualNode := Node;
|
|
try
|
|
if ((Field = nil) or (CField = Field)) and
|
|
(Assigned(CField) and (InplaceEditor <> nil) and
|
|
not InplaceEditor.DisableRefresh and
|
|
not Columns[GetFocusedAbsoluteIndex(InplaceColumnIndex){FocusedAbsoluteIndex}].IsEqualValues(FEditValue)) then
|
|
begin
|
|
InvalidateEditor;
|
|
if InplaceEditor <> nil then InplaceEditor.Deselect;
|
|
end;
|
|
finally
|
|
Columns[GetFocusedAbsoluteIndex(InplaceColumnIndex){FocusedAbsoluteIndex}].FActualNode := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.RefreshNodeValues(var Node: TdxDBTreeListControlNode);
|
|
begin
|
|
end;
|
|
|
|
//Grouping
|
|
procedure TCustomdxDBTreeListControl.ChangedGroupColumn(Column : TdxDBTreeListColumn);
|
|
begin
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.SetGroupIndex(AColumn: TdxDBTreeListColumn; AIndex: Integer);
|
|
begin
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.AssignSummaryFields;
|
|
begin
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.AssignSummaryFooterFields;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Assigned(DataLink.DataSet) then
|
|
for I := 0 to ColumnCount - 1 do
|
|
begin
|
|
if Columns[I].SummaryFooterField <> '' then
|
|
Columns[I].FSmrFooterField := DataLink.DataSet.FindField(Columns[I].SummaryFooterField)
|
|
else Columns[I].FSmrFooterField := DataLink.DataSet.FindField(Columns[I].FieldName);
|
|
Columns[I].FSummaryFooterValue := 0;
|
|
Columns[I].FAssignedSummaryFooter := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DoBeforeCalcSummary;
|
|
begin
|
|
if Assigned(FOnBeforeCalcSummary) then FOnBeforeCalcSummary(Self);
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DoRefreshNodeData(Node: TdxTreeListNode);
|
|
begin
|
|
if Assigned(FOnRefreshNodeData) then FOnRefreshNodeData(Self, Node);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetSummaryValue(ANode: TdxTreeListNode): Extended;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.RefreshSummaryItems(const PrevName, NewName: string);
|
|
begin
|
|
end;
|
|
|
|
// Sorted
|
|
procedure TCustomdxDBTreeListControl.CheckSortedColumns;
|
|
var
|
|
I: Integer;
|
|
Found: Boolean;
|
|
begin
|
|
if IsMultiSort then Exit;
|
|
Found := False;
|
|
for I := 0 to ColumnCount - 1 do
|
|
if Columns[I].GroupIndex = -1 then
|
|
if Columns[I].Sorted <> csNone then
|
|
if Found then Columns[I].FSorted := csNone
|
|
else Found := True;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetIndicatorWidth: Integer;
|
|
begin
|
|
Result := FIndicatorWidth;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetRowIndicatorKind(Node: TdxTreeListNode; ASelected: Boolean): TdxGridIndicatorKind;
|
|
begin
|
|
Result := ikNone;
|
|
if Node.Focused then
|
|
begin
|
|
if ASelected and IsMultiSelect then
|
|
Result := ikMultiArrow
|
|
else Result := ikArrow;
|
|
if DataLink.DataSet <> nil then
|
|
case DataLink.DataSet.State of
|
|
dsEdit: Result := ikEdit;
|
|
dsInsert: Result := ikInsert;
|
|
end;
|
|
end
|
|
else
|
|
if ASelected then Result := ikMultiDot;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.ResyncSelection;
|
|
begin
|
|
if IsMultiSelect and
|
|
not (Focused or ((InplaceEditor <> nil) and (InplaceEditor.IsFocused))) then
|
|
begin
|
|
if (Count = 0) or (FocusedNode = nil) or
|
|
((SelectedCount = 1) and FocusedNode.Selected) then Exit;
|
|
BeginSelection;
|
|
try
|
|
ClearSelection;
|
|
FocusedNode.Selected := True;
|
|
finally
|
|
EndSelection;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.CompareBkm(const Item1, Item2: TBookmarkStr): Integer;
|
|
begin
|
|
if not Datalink.Active then Result := -1
|
|
{$IFNDEF DELPHI3}
|
|
else with FDatalink.Datasource.Dataset do
|
|
DB.Check(DbiCompareBookmarks(Handle, Pointer(Item1), Pointer(Item2), Result));
|
|
if Result = 2 then Result := 0;
|
|
{$ELSE}
|
|
else with Datalink.Datasource.Dataset do
|
|
Result := CompareBookmarks(TBookmark(Item1), TBookmark(Item2));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.FindBkm(const Item: TBookmarkStr; var Index: Integer): Boolean;
|
|
var
|
|
L, H, I, C: Integer;
|
|
begin
|
|
if (Item = FBkmCache) and (FBkmCacheIndex >= 0) then
|
|
begin
|
|
Index := FBkmCacheIndex;
|
|
Result := FBkmCacheFind;
|
|
Exit;
|
|
end;
|
|
Result := False;
|
|
L := 0;
|
|
H := FBkmList.Count - 1;
|
|
while L <= H do
|
|
begin
|
|
I := (L + H) shr 1;
|
|
C := CompareBkm(FBkmList[I], Item);
|
|
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;
|
|
FBkmCache := Item;
|
|
FBkmCacheIndex := Index;
|
|
FBkmCacheFind := Result;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.FindSelectedNode(Node: TdxTreeListNode; var Index: Integer): Boolean;
|
|
var
|
|
L, H, I, C: Integer;
|
|
begin
|
|
Result := False;
|
|
L := 0;
|
|
H := FBkmList.Count - 1;
|
|
while L <= H do
|
|
begin
|
|
I := (L + H) shr 1;
|
|
// C := CompareNodes(FSelectedNodes[I], Node);
|
|
C := Integer(FBkmList.Objects[I]) - Integer(Node);
|
|
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 TCustomdxDBTreeListControl.GetSelectedCount: Integer;
|
|
begin
|
|
if FBkmList = nil then Result := 0
|
|
else Result := FBkmList.Count;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetSelectedItem(AIndex: Integer): TdxTreeListNode;
|
|
begin
|
|
if (AIndex >= 0) and (AIndex < GetSelectedCount) then
|
|
Result := TdxTreeListNode(FBkmList.Objects[AIndex])
|
|
else Result := nil;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetSelectedRow(Index: Integer): TBookmarkStr;
|
|
begin
|
|
Result := FBkmList[Index];
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.SelectNodes(N1, N2: TdxTreeListNode);
|
|
var
|
|
StartNode, EndNode, OldFocused, Node: TdxTreeListNode;
|
|
I, J, C, I1, I2: Integer;
|
|
FList: TList;
|
|
begin
|
|
if (Datalink.Dataset.State in dsEditModes) or not IsMultiSelect then Exit;
|
|
BeginSelection;
|
|
try
|
|
if IsEasySelect then
|
|
inherited SelectNodes(N1, N2)
|
|
else
|
|
if not IsUseBookmarks then
|
|
begin
|
|
I := CompareByAbsoluteIndex(N1, N2);
|
|
if I > 0 then
|
|
begin
|
|
Node := N1;
|
|
N1 := N2;
|
|
N2 := Node;
|
|
end;
|
|
BeginUpdate;
|
|
try
|
|
MakeListNodes;
|
|
J := GetAbsoluteIndex(N1);
|
|
C := GetAbsoluteIndex(N2);
|
|
FList := TList.Create;
|
|
try
|
|
FList.Capacity := C - J + 1;
|
|
for I := J to C do
|
|
begin
|
|
Node := GetAbsoluteNode(I);
|
|
if FFirstSelectedNode = nil then FFirstSelectedNode := Node;
|
|
if CanNodeSelected(Node) then FList.Add(Node);
|
|
end;
|
|
FList.Sort(CompareNodes);
|
|
// [FList] or [BkmList]
|
|
J := 0;
|
|
for I := 0 to BkmList.Count - 1 do
|
|
begin
|
|
if J = -1 then
|
|
FList.Add(BkmList.Objects[I])
|
|
else
|
|
repeat
|
|
C := CompareNodes(BkmList.Objects[I], FList[J]);
|
|
if C <= 0 then
|
|
begin
|
|
if C < 0 then
|
|
begin
|
|
FList.Insert(J, BkmList.Objects[I]);
|
|
Inc(J);
|
|
end;
|
|
Break;
|
|
end;
|
|
{else C > 0}
|
|
Inc(J);
|
|
if J >= FList.Count then
|
|
begin
|
|
FList.Add(BkmList.Objects[I]);
|
|
J := -1;
|
|
Break;
|
|
end;
|
|
until False;
|
|
end;
|
|
// copy from temp list
|
|
BkmList.Clear;
|
|
BkmList.Capacity := FList.Count;
|
|
for I := 0 to FList.Count - 1 do
|
|
BkmList.AddObject('', FList[I]);
|
|
finally
|
|
FFirstSelectedNode := nil;
|
|
FList.Free;
|
|
end;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if DataLink.Active then
|
|
with Datalink.Dataset do
|
|
begin
|
|
StartNode := N1;
|
|
EndNode := N2;
|
|
i1 := GetAbsoluteIndex(N1);
|
|
i2 := GetAbsoluteIndex(N2);
|
|
if i1 > i2 then
|
|
begin
|
|
StartNode := N2;
|
|
EndNode := N1;
|
|
end;
|
|
DisableControls;
|
|
OldFocused := FocusedNode;
|
|
BeginUpdate;
|
|
try
|
|
c := 0;
|
|
while (StartNode <> Nil) Do
|
|
begin
|
|
StartNode.Focused := True;
|
|
StartNode.Selected := True;
|
|
Inc(c);
|
|
if (StartNode = EndNode) or ((c-1) >= Abs(i1-i2)) then Break;
|
|
StartNode := GetNextVisible(StartNode);
|
|
end;
|
|
finally
|
|
OldFocused.Focused := True;
|
|
SetDataChangedBusy(True);
|
|
EnableControls;
|
|
SetDataChangedBusy(False);
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
EndSelection;
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.CompareEqual(Node1, Node2: TdxTreeListNode): Integer;
|
|
begin
|
|
if (VarType(TdxDBTreeListControlNode(Node1).Id) = varEmpty) or
|
|
(VarType(TdxDBTreeListControlNode(Node2).Id) = varEmpty) then
|
|
Result := 0
|
|
else
|
|
{$IFNDEF DELPHI6}
|
|
if TdxDBTreeListControlNode(Node1).Id = TdxDBTreeListControlNode(Node2).Id then
|
|
Result := inherited CompareEqual(Node1, Node2)
|
|
else
|
|
if TdxDBTreeListControlNode(Node1).Id < TdxDBTreeListControlNode(Node2).Id then
|
|
Result := -1
|
|
else Result := 1;
|
|
{$ELSE}
|
|
begin
|
|
Result := VarCompare(TdxDBTreeListControlNode(Node1).Id, TdxDBTreeListControlNode(Node2).Id);
|
|
if Result = 0 then
|
|
Result := inherited CompareEqual(Node1, Node2);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.IsDragScroll: Boolean;
|
|
begin
|
|
Result := inherited IsDragScroll and
|
|
not (Assigned(Datalink.DataSet) and (Datalink.DataSet.State in dsEditModes));
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.PrepareColumnSorted(Column: TdxTreeListColumn);
|
|
begin
|
|
if IsAutoSort and (TdxDBTreeListColumn(Column).GroupIndex = -1) and
|
|
not (FlagMultiSort or LockSorting) then ClearColumnsSorted;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.AssignNodeValues(ANode: TdxDBTreeListControlNode; AColumn: TdxDBTreeListColumn);
|
|
begin
|
|
AColumn.AssignNodeValues(ANode);
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.AssignNodeAllValues(Node: TdxDBTreeListControlNode);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Assigned(FKeyField) then
|
|
Node.Id := FKeyField.Value
|
|
else Node.Id := Null;
|
|
for I := 0 to ColumnCount - 1 do
|
|
if Assigned(Columns[I].Field) then AssignNodeValues(Node, Columns[I]);
|
|
if Assigned(FPreviewField) then
|
|
try
|
|
if Assigned(FPreviewField.OnGetText) then
|
|
FPreviewField.OnGetText(FPreviewField, Node.FDescription, True)
|
|
else
|
|
Node.FDescription := GetPreviewString(FPreviewField.AsString);
|
|
except
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetPreviewString(const S: string): string;
|
|
begin
|
|
if PreviewMaxLength > 0 then
|
|
begin
|
|
Result := Copy(S, 1, PreviewMaxLength);
|
|
if Length(S) > PreviewMaxLength then
|
|
Result := Result + '...';
|
|
end
|
|
else
|
|
Result := S;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetColumnVariantData(ANode: TdxDBTreeListControlNode; AColumn: TdxDBTreeListColumn): Variant;
|
|
begin
|
|
if nadValue in ANode.VariantData[AColumn.Index].AssignedValues then
|
|
Result := ANode.VariantData[AColumn.Index].Value
|
|
else
|
|
begin
|
|
Result := ANode.Values[AColumn.Index];
|
|
if (VarType(Result) = varString) and (Result = '') then
|
|
Result := Null;
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetNodeVarData(ANode: TdxDBTreeListControlNode; AColumn: TdxDBTreeListColumn): Extended;
|
|
var
|
|
Val: Variant;
|
|
AVarType: Integer;
|
|
begin
|
|
Result := 0;
|
|
if AColumn <> nil then
|
|
begin
|
|
Val := GetColumnVariantData(ANode, AColumn);
|
|
AVarType := VarType(Val);
|
|
if (AVarType in [varSmallint, varInteger, varSingle, varDouble, varCurrency,
|
|
varDate, varByte]) {$IFDEF DELPHI6}or VarIsFMTBcd(Val){$ENDIF} then
|
|
Result := Val;
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.AcquireFocus: Boolean;
|
|
begin
|
|
Result := True;
|
|
if CanFocus and not (csDesigning in ComponentState) then
|
|
begin
|
|
//SetFocus;
|
|
Windows.SetFocus(Handle);
|
|
Result := Focused or (InplaceEditor <> nil) and InplaceEditor.Focused;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.BeginCustomLayout;
|
|
var
|
|
I, J, K: Integer;
|
|
Fld: TField;
|
|
Column: TdxDBTreeListColumn;
|
|
|
|
function FieldIsMapped(F: TField): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
if F = nil then Exit;
|
|
for I := 0 to Datalink.FieldCount-1 do
|
|
if Datalink.Fields[I] = F then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
inherited BeginCustomLayout;
|
|
HideEditor;
|
|
Datalink.ClearMapping;
|
|
if Datalink.Active then DefineFieldMap;
|
|
// Desc Field
|
|
AssignPreviewField;
|
|
if GetDefaultFields then
|
|
begin
|
|
// Destroy columns whose fields have been destroyed or are no longer in field map
|
|
if not DataLink.Active then
|
|
begin
|
|
FInternalDestroying := True;
|
|
try
|
|
DestroyColumns;
|
|
finally
|
|
FInternalDestroying := False;
|
|
end;
|
|
end
|
|
else
|
|
for J := ColumnCount - 1 downto 0 do
|
|
with Columns[J] do
|
|
if (FField = nil) or
|
|
not FieldIsMapped(FField) then Free;
|
|
// Validate order columns
|
|
I := DataLink.FieldCount;
|
|
for J := 0 to I - 1 do
|
|
begin
|
|
Fld := Datalink.Fields[J];
|
|
if Assigned(Fld) then
|
|
begin
|
|
K := J;
|
|
while (K < ColumnCount) and (Columns[K].Field <> Fld) do Inc(K);
|
|
if K < ColumnCount then
|
|
Column := Columns[K]
|
|
else
|
|
begin
|
|
Column := CreateDefaultColumn(GetDefaultFieldColumnClass(Fld));
|
|
Column.FFieldName := Fld.FieldName;
|
|
Column.FField := Fld;
|
|
end;
|
|
end
|
|
else
|
|
Column := CreateDefaultColumn(GetDefaultColumnClass); // simple column
|
|
// set index
|
|
if (J < Count) then Column.Index := J;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// Force columns to reaquire fields (in case dataset has changed)
|
|
for I := 0 to ColumnCount-1 do
|
|
Columns[I].FieldName := Columns[I].FieldName;
|
|
end;
|
|
RefreshDefaultColumnsWidths;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.FindNodeByText(AColumnIndex: Integer; const AText: string;
|
|
ADirection: TdxTreeListSearchDirection; var ANode: TdxTreeListNode): Boolean;
|
|
var
|
|
DataSet: TDataSet;
|
|
L: Integer;
|
|
S: string;
|
|
F: TField;
|
|
SavePos, StartPos: TBookmarkStr;
|
|
AColumn: TdxDBTreeListColumn;
|
|
|
|
procedure CalcNextRecord;
|
|
begin
|
|
with DataSet do
|
|
if ADirection = sdUp then
|
|
begin
|
|
Prior;
|
|
if BOF then
|
|
begin
|
|
Last;
|
|
StartPos := SavePos;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Next;
|
|
if EOF then
|
|
begin
|
|
First;
|
|
StartPos := SavePos;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if IsLoadedAll then
|
|
Result := inherited FindNodeByText(AColumnIndex, AText, ADirection, ANode)
|
|
else
|
|
begin
|
|
ANode := nil;
|
|
Result := False;
|
|
DataSet := nil;
|
|
if DataSource <> nil then
|
|
begin
|
|
DataSet := DataSource.DataSet;
|
|
with DataSet do
|
|
begin
|
|
if Active and not (BOF and EOF) and not (State in dsEditModes) and (AText <> '') then
|
|
begin
|
|
AColumn := Columns[AColumnIndex];
|
|
L := Length(AText);
|
|
F := AColumn.Field;
|
|
if Assigned(F) then
|
|
begin
|
|
if IsEqualText(Copy(F.AsString{DisplayText}, 1, L), AText) then
|
|
Result := True;
|
|
if (ADirection <> sdNone) or not Result then
|
|
begin
|
|
SavePos := Bookmark;
|
|
StartPos := '';
|
|
DisableControls;
|
|
try
|
|
if ADirection <> sdNone then CalcNextRecord;
|
|
while (not EOF or (ADirection <> sdNone)) and ((Length(StartPos) = 0) or
|
|
(CompareBkm(Bookmark, StartPos) <> 0)) do
|
|
begin
|
|
S := F.AsString{DisplayText};
|
|
if IsEqualText(Copy(S, 1, L), AText) then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
CalcNextRecord;
|
|
end;
|
|
finally
|
|
if not Result and BookmarkValid(TBookmark(SavePos)) then
|
|
Bookmark := SavePos;
|
|
EnableControls;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// based
|
|
procedure TCustomdxDBTreeListControl.AddNodeLink(ANode : Pointer);
|
|
begin
|
|
if FNodeLink.IndexOf(ANode) = -1 then FNodeLink.Add(ANode);
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.AssignPreviewField;
|
|
const
|
|
SupportedBlobType = [ftBlob, ftMemo, ftFmtMemo];
|
|
begin
|
|
FPreviewField := nil;
|
|
if (PreviewFieldName <> '') and Datalink.Active then
|
|
begin
|
|
FPreviewField := Datalink.DataSet.FindField(PreviewFieldName);
|
|
if (FPreviewField is TBlobField) and
|
|
not (TBlobField(FPreviewField).BlobType in SupportedBlobType) then
|
|
FPreviewField := nil;
|
|
if FPreviewField <> nil then
|
|
FPreviewField.FreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.CreateDefaultColumn(ColumnClass: TdxDBTreeListColumnClass): TdxDBTreeListColumn;
|
|
begin
|
|
Result := ColumnClass.Create(Self);
|
|
Result.TreeList := Self;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.CreateDefaultColumns(DataSet: TDataSet; AOwner: TComponent);
|
|
var
|
|
I: Integer;
|
|
Column: TdxDBTreeListColumn;
|
|
begin
|
|
with DataSet do
|
|
begin
|
|
if AOwner = nil then AOwner := Self;
|
|
for I := 0 to FieldCount - 1 do
|
|
begin
|
|
Column := CreateColumnEx(GetDefaultFieldColumnClass(Fields[I]), AOwner);
|
|
Column.FieldName := Fields[I].FieldName;
|
|
Column.Visible := Fields[I].Visible;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DefineFieldMap;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if not GetDefaultFields then
|
|
for I := 0 to ColumnCount - 1 do
|
|
DataLink.AddMapping(Columns[I].FieldName)
|
|
else
|
|
with Datalink.Dataset do
|
|
for I := 0 to FieldCount - 1 do
|
|
with Fields[I] do if Visible then Datalink.AddMapping(FieldName);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.ValidateNode(ANode : Pointer) : Boolean;
|
|
begin
|
|
Result := FNodeLink.IndexOf(ANode) <> -1;
|
|
end;
|
|
|
|
// based override
|
|
procedure TCustomdxDBTreeListControl.DeleteNode(Node, Prior, Next: TdxTreeListNode; IsLast, Redraw: Boolean);
|
|
begin
|
|
inherited DeleteNode(Node, Prior, Next, IsLast, Redraw);
|
|
if FNodeLink <> nil then FNodeLink.Remove(Node);
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DeleteStrings(Node: TdxTreeListNode; Index: Integer);
|
|
var
|
|
I: Integer;
|
|
PValue: PNodeVariantData;
|
|
begin
|
|
if Index < TdxDBTreeListControlNode(Node).FStrings.Count then
|
|
begin
|
|
PValue := PNodeVariantData(TdxDBTreeListControlNode(Node).FStrings.Objects[Index]);
|
|
if PValue <> nil then Dispose(PValue);
|
|
TdxDBTreeListControlNode(Node).FStrings.Delete(Index);
|
|
end;
|
|
for I := 0 to Node.Count - 1 do
|
|
DeleteStrings(Node[I], Index);
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.DoChangeNodeEx;
|
|
begin
|
|
if LockSelection = 0 then
|
|
begin
|
|
if (FLockSearching = 0) and not FInKeyDown then
|
|
EndSearch;
|
|
if Datalink.Active and Assigned(OnChangeNodeEx) then
|
|
OnChangeNodeEx(Self);
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.IsDisableEditing: Boolean;
|
|
begin
|
|
Result := False;
|
|
with Datalink do
|
|
if Active and (DataSet <> nil) and DataSet.Active then
|
|
Result := not IsCanInsert and DataSet.BOF and DataSet.EOF {Empty} and
|
|
(Datalink.Dataset.State = dsBrowse);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.IsNewItemRowEditing: Boolean;
|
|
begin
|
|
Result := inherited IsNewItemRowEditing and (FocusedNode <> nil) and
|
|
(DataLink.DataSet <> nil) and (DataLink.DataSet.State = dsInsert);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetNewItemCellText(AbsoluteIndex: Integer): string;
|
|
begin
|
|
if (FocusedNode <> nil) and IsNewItemRowEditing then
|
|
Result := GetCellText(FocusedNode, AbsoluteIndex)
|
|
else Result := '';
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetReadOnly: Boolean;
|
|
begin
|
|
Result := inherited GetReadOnly or IsDisableEditing or IsKeyFieldEmpty;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.MakeFocused(Node: TdxTreeListNode): Boolean;
|
|
begin
|
|
AddNodeLink(Node);
|
|
Node.Focused := True;
|
|
Result := ValidateNode(Node);
|
|
end;
|
|
|
|
// private TCustomdxDBTreeListControl
|
|
procedure TCustomdxDBTreeListControl.BkmStringsChanged(Sender: TObject);
|
|
begin
|
|
FBkmCache := '';
|
|
FBkmCacheIndex := -1;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetColumn(Index: Integer): TdxDBTreeListColumn;
|
|
begin
|
|
Result := TdxDBTreeListColumn(inherited Columns[Index]);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetFocusedField: TField;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
Index := FocusedAbsoluteIndex;
|
|
if (Index <> -1) and (Index < ColumnCount) then
|
|
Result := Columns[FocusedAbsoluteIndex].Field
|
|
else Result := nil;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetSortedColumn: TdxDBTreeListColumn;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := nil;
|
|
for I := 0 to ColumnCount - 1 do
|
|
if Columns[I].GroupIndex = -1 then
|
|
if Columns[I].Sorted <> csNone then
|
|
begin
|
|
Result := Columns[I];
|
|
Break;
|
|
end;
|
|
if IsMultiSort then
|
|
begin
|
|
if SortedColumnCount = 0 then
|
|
AddSortedColumn(Result)
|
|
else Result := SortedColumns[0];
|
|
end;
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetSortedColumns(Index: Integer): TdxDBTreeListColumn;
|
|
begin
|
|
Result := TdxDBTreeListColumn(inherited SortedColumns[Index]);
|
|
end;
|
|
|
|
function TCustomdxDBTreeListControl.GetVisibleColumn(Index: Integer): TdxDBTreeListColumn;
|
|
begin
|
|
Result := TdxDBTreeListColumn(inherited VisibleColumns[Index]);
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.SetColumn(Index: Integer; Value: TdxDBTreeListColumn);
|
|
begin
|
|
inherited Columns[Index] := Value;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.SetFocusedField(Value: TField);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Value = nil then Exit;
|
|
for I := 0 to GetHeaderAbsoluteCount - 1 do
|
|
if IsHeaderVisible(I) and (Columns[I].Field = Value) then
|
|
begin
|
|
FocusedColumn := GetFocusedVisibleIndex(I);
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.SetIndicatorWidth(Value: Integer);
|
|
begin
|
|
if Value < inherited GetIndicatorWidth then
|
|
Value := inherited GetIndicatorWidth;
|
|
if FIndicatorWidth <> Value then
|
|
begin
|
|
FIndicatorWidth := Value;
|
|
LayoutChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.SetKeyFieldName(const Value: string);
|
|
begin
|
|
if FKeyFieldName <> Value then
|
|
begin
|
|
FKeyFieldName := Value;
|
|
LinkActive(DataLink.Active);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.SetPreviewFieldName(const Value: string);
|
|
begin
|
|
if FPreviewFieldName <> Value then
|
|
begin
|
|
FPreviewFieldName := Value;
|
|
LinkActive(DataLink.Active);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.SetPreviewMaxLength(Value: Integer);
|
|
begin
|
|
if Value < 0 then Value := 0;
|
|
if FPreviewMaxLength <> Value then
|
|
begin
|
|
FPreviewMaxLength := Value;
|
|
LayoutChanged;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.SetVisibleColumn(Index: Integer; Value: TdxDBTreeListColumn);
|
|
begin
|
|
inherited VisibleColumns[Index] := Value;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.WMHScroll(var Message: TWMHScroll);
|
|
var
|
|
SI: TScrollInfo;
|
|
|
|
function GetColumnLeft(Column: Integer): Integer;
|
|
var
|
|
AAbsoluteIndex, AIndex, BIndex, CCount, RIndex, I: Integer;
|
|
XStart, W: Integer;
|
|
begin
|
|
AAbsoluteIndex := GetFocusedAbsoluteIndex(Column);
|
|
BIndex := GetVisibleBandIndex(GetHeaderBandIndex(AAbsoluteIndex));
|
|
if BIndex = GetBandFixedLeft then
|
|
begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
RIndex := 0;
|
|
CCount := GetHeaderColCount(BIndex, RIndex);
|
|
XStart := GetStartBandCoord(BIndex);
|
|
for I := 0 to CCount - 1 do
|
|
begin
|
|
AIndex := GetHeaderAbsoluteIndex(BIndex, RIndex, I);
|
|
if AIndex = AAbsoluteIndex then Break;
|
|
W := GetHeaderBoundsWidth(AIndex);
|
|
Inc(XStart, W);
|
|
end;
|
|
Result := XStart;
|
|
end;
|
|
|
|
function GetColumnCoordX(X: Integer): Integer;
|
|
var
|
|
AIndex, BIndex, CCount, RIndex, I: Integer;
|
|
XStart, W, B1, B2: Integer;
|
|
begin
|
|
Result := 0;
|
|
// calc band index
|
|
BIndex := 0;
|
|
B1 := 0;
|
|
if GetBandFixedLeft <> -1 then Inc(B1);
|
|
B2 := GetBandCount - 1;
|
|
if GetBandFixedRight <> -1 then Dec(B2);
|
|
for I := B1 to B2 do
|
|
begin
|
|
XStart := GetStartBandCoord(I);
|
|
W := GetBandWidth(I) + Byte(I = 0) * GetIndentWidth;
|
|
if (XStart <= X) and (X < (XStart + W)) then
|
|
begin
|
|
BIndex := I;
|
|
Break;
|
|
end;
|
|
end;
|
|
// calc column index
|
|
RIndex := 0;
|
|
XStart := GetStartBandCoord(BIndex);
|
|
CCount := GetHeaderColCount(BIndex, RIndex);
|
|
for I := 0 to CCount - 1 do
|
|
begin
|
|
AIndex := GetHeaderAbsoluteIndex(BIndex, RIndex, I);
|
|
W := GetHeaderBoundsWidth(AIndex);
|
|
if (XStart <= X) and (X < (XStart + W)) then
|
|
begin
|
|
Result := GetFocusedVisibleIndex(AIndex);
|
|
Break;
|
|
end;
|
|
Inc(XStart, W);
|
|
end;
|
|
end;
|
|
|
|
function GetNearestColumn(Column: Integer; LeftFlag: Boolean): Integer;
|
|
var
|
|
BIndex, CIndex, CCount, RIndex: Integer;
|
|
begin
|
|
RIndex := 0;
|
|
BIndex := GetBandCount - 1;
|
|
while (BIndex > 0) and (GetHeaderColCount(BIndex, RIndex) <= 0) do
|
|
Dec(BIndex);
|
|
CCount := GetHeaderColCount(BIndex, RIndex);
|
|
CIndex := GetFocusedVisibleIndex(GetHeaderAbsoluteIndex(BIndex, RIndex, CCount - 1));
|
|
if LeftFlag then Column := Column - 1
|
|
else Column := Column + 1;
|
|
if Column < 0 then Column := 0;
|
|
if Column >= CIndex then Column := CIndex;
|
|
Result := Column;
|
|
end;
|
|
|
|
function GetLeft(Column: Integer): Integer;
|
|
begin
|
|
if Column >= GetVisibleHeaderCount then
|
|
Result := GetScrollableBandWidth
|
|
else Result := GetColumnLeft(Column);
|
|
end;
|
|
|
|
begin
|
|
if not AcquireFocus or (GetVisibleHeaderCount = 0) then Exit;
|
|
with Message do
|
|
begin
|
|
if ScrollCode in [SB_LINEUP, SB_LINEDOWN, SB_THUMBTRACK, SB_THUMBPOSITION] then
|
|
begin
|
|
case ScrollCode of
|
|
SB_LINEUP: LeftCoord := GetLeft(GetNearestColumn(GetColumnCoordX(LeftCoord), True));
|
|
SB_LINEDOWN: LeftCoord := GetLeft(GetNearestColumn(GetColumnCoordX(LeftCoord), False));
|
|
SB_THUMBTRACK,
|
|
SB_THUMBPOSITION:
|
|
begin
|
|
SI.cbSize := SizeOf(SI);
|
|
SI.fMask := SIF_ALL;
|
|
GetScrollInfo(SB_HORZ, SI);
|
|
if SI.nTrackPos <= 0 then LeftCoord := 0
|
|
else if SI.nTrackPos >= GetScrollableBandWidth then LeftCoord := GetScrollableBandWidth
|
|
else if SI.nTrackPos <> LeftCoord then
|
|
LeftCoord := GetLeft(GetNearestColumn(GetColumnCoordX(SI.nTrackPos),
|
|
(SI.nTrackPos + GetScrollableWidth) < (GetScrollableBandWidth div 2)));
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomdxDBTreeListControl.CMExit(var Message: TMessage);
|
|
begin
|
|
FCanceling := True;
|
|
try
|
|
try
|
|
if Datalink.Active then
|
|
with Datalink.Dataset do
|
|
if IsCancelOnExit and (State = dsInsert) and
|
|
not Modified and not Datalink.IsModified then
|
|
begin
|
|
// CancelEditor;
|
|
Cancel;
|
|
end
|
|
else
|
|
DataLink.UpdateData;
|
|
except
|
|
SetFocus;
|
|
raise;
|
|
end;
|
|
{Redraw Selection}
|
|
if HideSelection and IsMultiSelect and (State = tsEditing)
|
|
and (SelectedCount > 0) then InvalidateSelection;
|
|
inherited;
|
|
finally
|
|
FCanceling := False;
|
|
end;
|
|
end;
|
|
|
|
|
|
{TdxDBGridSummaryItem}
|
|
procedure TdxDBGridSummaryItem.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TdxDBGridSummaryItem then
|
|
begin
|
|
if Assigned(Collection) then Collection.BeginUpdate;
|
|
try
|
|
ColumnName := TdxDBGridSummaryItem(Source).ColumnName;
|
|
SummaryType := TdxDBGridSummaryItem(Source).SummaryType;
|
|
SummaryField := TdxDBGridSummaryItem(Source).SummaryField;
|
|
SummaryFormat := TdxDBGridSummaryItem(Source).SummaryFormat;
|
|
finally
|
|
if Assigned(Collection) then Collection.EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TdxDBGridSummaryItem.GetSummaryItems: TdxDBGridSummaryItems;
|
|
begin
|
|
if Assigned(Collection) and (Collection is TdxDBGridSummaryItems) then
|
|
Result := TdxDBGridSummaryItems(Collection)
|
|
else Result := nil;
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryItem.SetColumnName(const Value: string);
|
|
begin
|
|
if FColumnName <> Value then
|
|
begin
|
|
FColumnName := Value;
|
|
Changed(False);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryItem.SetSummaryField(const Value: string);
|
|
begin
|
|
if FSummaryField <> Value then
|
|
begin
|
|
FSummaryField := Value;
|
|
Changed(False);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryItem.SetSummaryFormat(const Value: string);
|
|
begin
|
|
if FSummaryFormat <> Value then
|
|
begin
|
|
FSummaryFormat := Value;
|
|
Changed(False);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryItem.SetSummaryType(Value: TdxSummaryType);
|
|
begin
|
|
if FSummaryType <> Value then
|
|
begin
|
|
FSummaryType := Value;
|
|
Changed(False);
|
|
end;
|
|
end;
|
|
|
|
{TdxDBGridSummaryItems}
|
|
constructor TdxDBGridSummaryItems.Create(ASummaryGroup: TdxDBGridSummaryGroup; ItemClass: TdxDBGridSummaryItemClass);
|
|
begin
|
|
inherited Create(ItemClass);
|
|
FSummaryGroup := ASummaryGroup;
|
|
end;
|
|
|
|
function TdxDBGridSummaryItems.Add: TdxDBGridSummaryItem;
|
|
begin
|
|
Result := TdxDBGridSummaryItem(inherited Add);
|
|
end;
|
|
|
|
function TdxDBGridSummaryItems.GetOwner: TPersistent;
|
|
begin
|
|
Result := FSummaryGroup;
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryItems.Update(Item: TCollectionItem);
|
|
begin
|
|
FSummaryGroup.ChangedGroup;
|
|
end;
|
|
|
|
function TdxDBGridSummaryItems.GetItem(Index: Integer): TdxDBGridSummaryItem;
|
|
begin
|
|
Result := TdxDBGridSummaryItem(inherited GetItem(Index));
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryItems.SetItem(Index: Integer; Value: TdxDBGridSummaryItem);
|
|
begin
|
|
inherited SetItem(Index, Value);
|
|
end;
|
|
|
|
{TdxDBGridSummaryGroup}
|
|
constructor TdxDBGridSummaryGroup.Create(Collection: TCollection);
|
|
begin
|
|
inherited Create(Collection);
|
|
FSummaryItems := TdxDBGridSummaryItems.Create(Self, TdxDBGridSummaryItem);
|
|
end;
|
|
|
|
destructor TdxDBGridSummaryGroup.Destroy;
|
|
begin
|
|
FSummaryItems.Free;
|
|
FSummaryItems := nil;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryGroup.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TdxDBGridSummaryGroup then
|
|
begin
|
|
if Assigned(Collection) then Collection.BeginUpdate;
|
|
try
|
|
BeginSummaryText := TdxDBGridSummaryGroup(Source).BeginSummaryText;
|
|
EndSummaryText := TdxDBGridSummaryGroup(Source).EndSummaryText;
|
|
DefaultGroup := TdxDBGridSummaryGroup(Source).DefaultGroup;
|
|
SummaryItems.Assign(TdxDBGridSummaryGroup(Source).SummaryItems);
|
|
Name := TdxDBGridSummaryGroup(Source).Name;
|
|
finally
|
|
if Assigned(Collection) then Collection.EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TdxDBGridSummaryGroup.GetSummaryGroups: TdxDBGridSummaryGroups;
|
|
begin
|
|
if Assigned(Collection) and (Collection is TdxDBGridSummaryGroups) then
|
|
Result := TdxDBGridSummaryGroups(Collection)
|
|
else Result := nil;
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryGroup.ChangedGroup;
|
|
var
|
|
DBTreeListControl: TCustomdxDBTreeListControl;
|
|
begin
|
|
if GetSummaryGroups <> nil then
|
|
begin
|
|
DBTreeListControl := GetSummaryGroups.DBTreeListControl;
|
|
if csLoading in DBTreeListControl.ComponentState then Exit;
|
|
DBTreeListControl.LayoutChanged;
|
|
end;
|
|
end;
|
|
|
|
function TdxDBGridSummaryGroup.GetDefaultGroup: Boolean;
|
|
begin
|
|
Result := FDefaultGroup;
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryGroup.SetDefaultGroup(Value: Boolean);
|
|
var
|
|
SummaryGroups: TdxDBGridSummaryGroups;
|
|
I: Integer;
|
|
begin
|
|
// clear default
|
|
if Value then
|
|
begin
|
|
SummaryGroups := GetSummaryGroups;
|
|
if SummaryGroups <> nil then
|
|
with SummaryGroups do
|
|
begin
|
|
for I:= 0 to Count - 1 do
|
|
Items[I].FDefaultGroup := False;
|
|
end;
|
|
end;
|
|
FDefaultGroup := Value;
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryGroup.SetSummaryItems(Value: TdxDBGridSummaryItems);
|
|
begin
|
|
SummaryItems.Assign(Value);
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryGroup.SetName(const Value: string);
|
|
var
|
|
SummaryGroups: TdxDBGridSummaryGroups;
|
|
Found: Boolean;
|
|
I: Integer;
|
|
begin
|
|
// check name
|
|
if (Value = '') then
|
|
InvaliddxTreeListOperation(LoadStr(dxSInvalidGroupName));
|
|
// check duplication
|
|
SummaryGroups := GetSummaryGroups;
|
|
Found := False;
|
|
if SummaryGroups <> nil then
|
|
with SummaryGroups do
|
|
begin
|
|
for I := 0 to Count - 1 do
|
|
if (Items[I] <> Self) and (Items[I].Name = Value) then
|
|
begin
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
if Found then
|
|
InvaliddxTreeListOperation(LoadStr(dxSInvalidGroupNameDuplicate));
|
|
FName := Value;
|
|
if Assigned(FOnChangeName) then FOnChangeName(Self);
|
|
end;
|
|
|
|
{TdxDBGridSummaryGroups}
|
|
constructor TdxDBGridSummaryGroups.Create(ADBTreeListControl: TCustomdxDBTreeListControl; ItemClass: TdxDBGridSummaryGroupClass);
|
|
begin
|
|
inherited Create(ItemClass);
|
|
FDBTreeListControl := ADBTreeListControl;
|
|
end;
|
|
|
|
function TdxDBGridSummaryGroups.Add: TdxDBGridSummaryGroup;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := TdxDBGridSummaryGroup(inherited Add);
|
|
// generate name
|
|
I := Count + 1;
|
|
while I <> -1 do
|
|
try
|
|
Result.Name := FDBTreeListControl.Name + 'SummaryGroup' + IntToStr(I);
|
|
I := -1;
|
|
except
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
function TdxDBGridSummaryGroups.GetDefaultGroup: TdxDBGridSummaryGroup;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := nil;
|
|
for I := 0 to Count - 1 do
|
|
if Items[I].DefaultGroup then
|
|
begin
|
|
Result := Items[I];
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function TdxDBGridSummaryGroups.GetOwner: TPersistent;
|
|
begin
|
|
Result := FDBTreeListControl;
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryGroups.Update(Item: TCollectionItem);
|
|
begin
|
|
if FDBTreeListControl = nil then Exit;
|
|
if not (csLoading in FDBTreeListControl.ComponentState) then
|
|
FDBTreeListControl.FullRefresh;
|
|
end;
|
|
|
|
function TdxDBGridSummaryGroups.GetItem(Index: Integer): TdxDBGridSummaryGroup;
|
|
begin
|
|
Result := TdxDBGridSummaryGroup(inherited GetItem(Index));
|
|
end;
|
|
|
|
procedure TdxDBGridSummaryGroups.SetItem(Index: Integer; Value: TdxDBGridSummaryGroup);
|
|
begin
|
|
inherited SetItem(Index, Value);
|
|
end;
|
|
|
|
{TdxDBTreeListControlDataLink}
|
|
constructor TdxDBTreeListControlDataLink.Create(ADBTreeListControl: TCustomdxDBTreeListControl);
|
|
begin
|
|
inherited Create;
|
|
FDBTreeListControl := ADBTreeListControl;
|
|
{$IFDEF DELPHI5}
|
|
VisualControl := True;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
destructor TdxDBTreeListControlDataLink.Destroy;
|
|
begin
|
|
ClearMapping;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TdxDBTreeListControlDataLink.AddMapping(const FieldName: string): Boolean;
|
|
var
|
|
Field: TField;
|
|
NewSize: Integer;
|
|
begin
|
|
Result := True;
|
|
Field := DataSet.FindField(FieldName);
|
|
|
|
if FFieldCount = FFieldMapSize then
|
|
begin
|
|
NewSize := FFieldMapSize;
|
|
if NewSize = 0 then
|
|
NewSize := 8
|
|
else
|
|
Inc(NewSize, NewSize);
|
|
if (NewSize < FFieldCount) then
|
|
NewSize := FFieldCount + 1;
|
|
if (NewSize > MaxMapSize) then
|
|
NewSize := MaxMapSize;
|
|
ReallocMem(FFieldMap, NewSize * SizeOf(Integer));
|
|
FFieldMapSize := NewSize;
|
|
end;
|
|
if Assigned(Field) then
|
|
begin
|
|
PIntArray(FFieldMap)^[FFieldCount] := Field.Index;
|
|
Field.FreeNotification(FDBTreeListControl);
|
|
end
|
|
else
|
|
PIntArray(FFieldMap)^[FFieldCount] := -1;
|
|
Inc(FFieldCount);
|
|
end;
|
|
|
|
procedure TdxDBTreeListControlDataLink.ClearMapping;
|
|
begin
|
|
if FFieldMap <> nil then
|
|
begin
|
|
FreeMem(FFieldMap, FFieldMapSize * SizeOf(Integer));
|
|
FFieldMap := nil;
|
|
FFieldMapSize := 0;
|
|
FFieldCount := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxDBTreeListControlDataLink.Modified;
|
|
begin
|
|
FModified := True;
|
|
end;
|
|
|
|
procedure TdxDBTreeListControlDataLink.Reset;
|
|
begin
|
|
if FModified then RecordChanged(nil) else Dataset.Cancel;
|
|
end;
|
|
|
|
// protected TdxDBTreeListControlDataLink
|
|
function TdxDBTreeListControlDataLink.GetMappedIndex(ColIndex: Integer): Integer;
|
|
begin
|
|
if (0 <= ColIndex) and (ColIndex < FFieldCount) then
|
|
Result := PIntArray(FFieldMap)^[ColIndex]
|
|
else Result := -1;
|
|
end;
|
|
|
|
procedure TdxDBTreeListControlDataLink.ActiveChanged;
|
|
begin
|
|
FDBTreeListControl.LinkActive(Active);
|
|
end;
|
|
|
|
procedure TdxDBTreeListControlDataLink.DataSetChanged;
|
|
begin
|
|
FDBTreeListControl.DataChanged;
|
|
FModified := False;
|
|
end;
|
|
|
|
procedure TdxDBTreeListControlDataLink.DataSetScrolled(Distance: Integer);
|
|
begin
|
|
FDBTreeListControl.Scroll(-Distance);
|
|
end;
|
|
|
|
procedure TdxDBTreeListControlDataLink.RecordChanged(Field: TField);
|
|
begin
|
|
FDBTreeListControl.RecordChanged(Field);
|
|
FModified := False;
|
|
end;
|
|
|
|
procedure TdxDBTreeListControlDataLink.UpdateData;
|
|
begin
|
|
if FModified then FDBTreeListControl.UpdateData;
|
|
FModified := False;
|
|
end;
|
|
|
|
function TdxDBTreeListControlDataLink.GetFields(I: Integer): TField;
|
|
begin
|
|
if (0 <= I) and (I < FFieldCount) and (PIntArray(FFieldMap)^[I] >= 0) then
|
|
Result := DataSet.Fields[PIntArray(FFieldMap)^[I]]
|
|
else Result := nil;
|
|
end;
|
|
|
|
{ TdxDBTreeListMaskColumn }
|
|
procedure TdxDBTreeListMaskColumn.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TdxDBTreeListMaskColumn then
|
|
begin
|
|
if Assigned(ATreeList) then ATreeList.BeginUpdate;
|
|
try
|
|
inherited Assign(Source);
|
|
EditMask := TdxDBTreeListMaskColumn(Source).EditMask;
|
|
IgnoreMaskBlank := TdxDBTreeListMaskColumn(Source).IgnoreMaskBlank;
|
|
finally
|
|
if Assigned(ATreeList) then ATreeList.EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function TdxDBTreeListMaskColumn.DefaultEditMask: String;
|
|
begin
|
|
if Assigned(Field) then
|
|
Result := Field.EditMask
|
|
else Result := '';
|
|
end;
|
|
|
|
function TdxDBTreeListMaskColumn.GetBlankText: string;
|
|
begin
|
|
Result := '';
|
|
if EditMask <> '' then
|
|
Result := FormatMaskText(EditMask, '');
|
|
end;
|
|
|
|
procedure TdxDBTreeListMaskColumn.RestoreDefaults;
|
|
begin
|
|
inherited RestoreDefaults;
|
|
FAssignedEditMask := False;
|
|
EditMask := DefaultEditMask;
|
|
FIgnoreMaskBlank := False;
|
|
end;
|
|
|
|
function TdxDBTreeListMaskColumn.AssignEditValue(ANode: TdxTreeListNode; AInplaceEdit: TdxInplaceEdit): Variant;
|
|
begin
|
|
if Assigned(Field) then
|
|
begin
|
|
Field.Text := TdxInplaceDBTreeListMaskEdit(AInplaceEdit).Text;
|
|
Result := Field.Value;
|
|
end
|
|
else
|
|
Result := inherited AssignEditValue(ANode, AInplaceEdit);
|
|
end;
|
|
|
|
function TdxDBTreeListMaskColumn.GetdxInplaceEditClass: TdxInplaceEditClass;
|
|
begin
|
|
Result := TdxInplaceDBTreeListMaskEdit;
|
|
end;
|
|
|
|
function TdxDBTreeListMaskColumn.GetEditMask: string;
|
|
begin
|
|
if FAssignedEditMask then
|
|
Result := FEditMask
|
|
else Result := DefaultEditMask;
|
|
end;
|
|
|
|
procedure TdxDBTreeListMaskColumn.InitEditProperties(AInplaceEdit: TdxInplaceEdit);
|
|
begin
|
|
inherited InitEditProperties(AInplaceEdit);
|
|
if AInplaceEdit is TdxInplaceMaskEdit then
|
|
with TdxInplaceDBTreeListMaskEdit(AInplaceEdit) do
|
|
begin
|
|
EditMask := Self.EditMask;
|
|
IgnoreMaskBlank := Self.IgnoreMaskBlank;
|
|
end;
|
|
end;
|
|
|
|
function TdxDBTreeListMaskColumn.InitEditValue(ANode: TdxTreeListNode; AInplaceEdit: TdxInplaceEdit): Variant;
|
|
begin
|
|
if Assigned(Field) then
|
|
begin
|
|
TdxInplaceDBTreeListMaskEdit(AInplaceEdit).Text := Field.Text;
|
|
Result := TdxInplaceDBTreeListMaskEdit(AInplaceEdit).Text;
|
|
end
|
|
else
|
|
Result := inherited InitEditValue(ANode, AInplaceEdit);
|
|
end;
|
|
|
|
function TdxDBTreeListMaskColumn.IsEditMaskStored: Boolean;
|
|
begin
|
|
Result := FAssignedEditMask and (FEditMask <> DefaultEditMask);
|
|
end;
|
|
|
|
function TdxDBTreeListMaskColumn.IsEqualValues(const Value: Variant): Boolean;
|
|
begin
|
|
if Assigned(Field) and not VarIsEmpty(Value) then
|
|
begin
|
|
if (VarType(Value) = varString) and not IsBlobColumn {TODO Check !!!} then
|
|
begin
|
|
if (Value = GetBlankText) and (Field.Text = '') then
|
|
Result := True
|
|
else
|
|
Result := TrimRight(FormatMaskText(EditMask, Field.Text)) =
|
|
TrimRight(FormatMaskText(EditMask, Value));
|
|
end
|
|
else
|
|
Result := Field.Value = Value
|
|
end
|
|
else
|
|
Result := inherited IsEqualValues(Value);
|
|
end;
|
|
|
|
procedure TdxDBTreeListMaskColumn.SetEditMask(const Value: string);
|
|
begin
|
|
if FEditMask <> Value then
|
|
begin
|
|
FEditMask := Value;
|
|
FAssignedEditMask := True;
|
|
end;
|
|
end;
|
|
|
|
{ TCustomdxFilterEdit }
|
|
class function TCustomdxFilterEdit.IsInplace: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
procedure InitDefaultDBTreeListColumnClasses(Proc: TInitColumnClassProc);
|
|
var
|
|
I: TFieldType;
|
|
C: TdxDBTreeListColumnClassInfo;
|
|
begin
|
|
for I := ftUnknown to ftTypedBinary do
|
|
begin
|
|
C := DefaultDBTreeListColumnType[I];
|
|
Proc(I, fkData, C);
|
|
if C.Version > DefaultDBTreeListColumnType[I].Version then
|
|
DefaultDBTreeListColumnType[I] := C;
|
|
end;
|
|
C := DefaultDBTreeListLookupColumnType;
|
|
Proc(ftUnknown, fkLookup, C);
|
|
if C.Version > DefaultDBTreeListLookupColumnType.Version then
|
|
DefaultDBTreeListLookupColumnType := C;
|
|
end;
|
|
|
|
procedure ResetDefaultDBTreeListColumnClasses;
|
|
var
|
|
I: TFieldType;
|
|
begin
|
|
DefaultDBTreeListColumnType[ftUnknown].ColumnClass := nil;
|
|
DefaultDBTreeListColumnType[ftUnknown].Version := 0;
|
|
for I := Succ(ftUnknown) to ftTypedBinary do
|
|
begin
|
|
DefaultDBTreeListColumnType[ftUnknown].ColumnClass := TdxDBTreeListColumn;
|
|
DefaultDBTreeListColumnType[ftUnknown].Version := 0;
|
|
end;
|
|
DefaultDBTreeListLookupColumnType.ColumnClass := TdxDBTreeListColumn;
|
|
DefaultDBTreeListLookupColumnType.Version := 0;
|
|
end;
|
|
|
|
initialization
|
|
Classes.RegisterClasses([TdxDBTreeListColumn, TdxDBTreeListMaskColumn]);
|
|
|
|
sdxGrTitleConfirm := LoadStr(dxSTitleWarning);
|
|
sdxGrDeleteRecordQuestion := LoadStr(dxSDeleteRecordQuestion);
|
|
sdxDeleteMultipleRecordsQuestion := LoadStr(dxSDeleteMultipleRecordsQuestion);
|
|
|
|
end.
|