home *** CD-ROM | disk | FTP | other *** search
- {
- BUSINESS CONSULTING
- s a i n t - p e t e r s b u r g
-
- Components Library for Borland Delphi 4.x, 5.x
- Copyright (c) 1998-2001 Alex'EM
-
- }
- unit DCKnots;
-
- interface
- {$I DCConst.inc}
-
- uses
- Windows, SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Menus,
- Controls, Dialogs, Forms, StdCtrls, Buttons, ExtCtrls, ImgList,
- ComCtrls, DB, DCGrids, grids, DCDBGrids, DCChoice, DCPopupWindow, DCEditTools,
- DCConst
- {$IFDEF DELPHI_V5UP}, DCADOCtrl {$ENDIF};
-
- type
- TKnotsColumnValue = (cvColor, cvWidth, cvFont, cvAlignment, cvReadOnly, cvTitleColor,
- cvTitleCaption, cvTitleAlignment, cvTitleFont, cvComment, cvDisplayFormat);
- TKnotsColumnValues = set of TKnotsColumnValue;
-
- const
- ColumnTitleValues = [cvTitleColor..cvTitleFont];
-
- type
- TDCCustomTreeGrid = class;
- TKnotColumn = class;
-
- TKnotColumnTitle = class(TPersistent)
- private
- FColumn: TKnotColumn;
- FCaption: string;
- FFont: TFont;
- FColor: TColor;
- FAlignment: TAlignment;
- procedure FontChanged(Sender: TObject);
- function GetAlignment: TAlignment;
- function GetColor: TColor;
- function GetCaption: string;
- function GetFont: TFont;
- function IsAlignmentStored: Boolean;
- function IsColorStored: Boolean;
- function IsFontStored: Boolean;
- function IsCaptionStored: Boolean;
- procedure SetAlignment(Value: TAlignment);
- procedure SetColor(Value: TColor);
- procedure SetFont(Value: TFont);
- procedure SetCaption(const Value: string); virtual;
- protected
- procedure RefreshDefaultFont;
- public
- constructor Create(Column: TKnotColumn);
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- function DefaultAlignment: TAlignment;
- function DefaultColor: TColor;
- function DefaultFont: TFont;
- function DefaultCaption: string;
- procedure RestoreDefaults; virtual;
- property Column: TKnotColumn read FColumn;
- published
- property Alignment: TAlignment read GetAlignment write SetAlignment stored
- IsAlignmentStored;
- property Caption: string read GetCaption write SetCaption stored
- IsCaptionStored;
- property Color: TColor read GetColor write SetColor stored IsColorStored;
- property Font: TFont read GetFont write SetFont stored IsFontStored;
- end;
-
- TKnotColumnFooter = class(TDCFooter)
- public
- property Index;
- published
- property AutoSize;
- property Style;
- property Height;
- property Visible;
- end;
-
- TKnotColumnFooterPanel = class(TDCFooterTextPanel)
- protected
- function GetColIndex: integer; override;
- procedure SetColIndex(const Value: integer); override;
- published
- property Visible default False;
- property Style default beLowered;
- end;
-
- TKnotOption = (kcIndexed, kcReadOnly, kcShowEdit, kcSizing, kcVisible, kcDrawTreeCell);
- TKnotOptions = set of TKnotOption;
- TKnotColumnClass = class of TKnotColumn;
-
- TKnotColumn = class(TCollectionItem)
- private
- FAlignment: TAlignment;
- FAssignedValues: TKnotsColumnValues;
- FColor: TColor;
- FComment: string;
- FDisplayFormat: string;
- FFont: TFont;
- FFooterPanel: TKnotColumnFooterPanel;
- FItemIndex: integer;
- FIndexStyle: TColumnIndexStyle;
- FName: string;
- FOptions: TKnotOptions;
- FTitle: TKnotColumnTitle;
- FWidth: TWidth;
- procedure SetColor(const Value: TColor);
- procedure SetFont(const Value: TFont);
- procedure SetTitle(const Value: TKnotColumnTitle);
- function GetAlignment: TAlignment;
- function GetColor: TColor;
- function GetFont: TFont;
- procedure FontChanged(Sender: TObject);
- procedure SetItemIndex(const Value: integer);
- procedure SetIndexStyle(const Value: TColumnIndexStyle);
- function GetWidth: TWidth;
- procedure SetAlignment(const Value: TAlignment);
- procedure SetName(const Value: string);
- procedure SetWidth(const Value: TWidth);
- procedure SetDisplayFormat(const Value: string);
- function IsAlignmentStored: Boolean;
- function IsColorStored: Boolean;
- function IsFontStored: Boolean;
- function IsWidthStored: Boolean;
- function IsCommentStored: Boolean;
- procedure SetOptions(const Value: TKnotOptions);
- procedure SetComment(const Value: string);
- function GetComment: string;
- function GetActualWidth: TWidth;
- procedure SetFooterPanel(const Value: TKnotColumnFooterPanel);
- protected
- procedure Changed(AllItems: Boolean);
- function GetDisplayName: string; override;
- procedure RefreshDefaultFont;
- procedure SetIndex(Value: Integer); override;
- public
- constructor Create(Collection: TCollection); override;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- function GetGrid: TDCCustomTreeGrid;
- function DefaultAlignment: TAlignment;
- function DefaultColor: TColor;
- function DefaultFont: TFont;
- function DefaultWidth: Integer;
- function DefaultComment: string;
- procedure RestoreDefaults; virtual;
- property AssignedValues: TKnotsColumnValues read FAssignedValues;
- property Grid: TDCCustomTreeGrid read GetGrid;
- published
- property ActualWidth:TWidth read GetActualWidth stored False;
- property Alignment: TAlignment read GetAlignment write SetAlignment stored
- IsAlignmentStored;
- property Color: TColor read GetColor write SetColor stored IsColorStored;
- property Comment: string read GetComment write SetComment stored IsCommentStored;
- property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
- property Font: TFont read GetFont write SetFont stored IsFontStored;
- property FooterPanel: TKnotColumnFooterPanel read FFooterPanel write SetFooterPanel;
- property ItemIndex: integer read FItemIndex write SetItemIndex default -1;
- property IndexStyle: TColumnIndexStyle read FIndexStyle write SetIndexStyle default idxNone;
- property Name: string read FName write SetName;
- property Options: TKnotOptions read FOptions write SetOptions default
- [kcShowEdit, kcSizing, kcVisible];
- property Title: TKnotColumnTitle read FTitle write SetTitle;
- property Width: TWidth read GetWidth write SetWidth stored IsWidthStored;
- end;
-
- TKnotColumns = class(TCollection)
- private
- FGrid: TDCCustomTreeGrid;
- function GetItem(Index: Integer): TKnotColumn;
- procedure SetItem(Index: Integer; Value: TKnotColumn);
- protected
- function GetOwner: TPersistent; override;
- procedure Update(Item: TCollectionItem); override;
- public
- constructor Create(AGrid: TDCCustomTreeGrid; AKnotColumnClass: TKnotColumnClass);
- function Add: TKnotColumn;
- property Grid: TDCCustomTreeGrid read FGrid;
- property Items[Index: Integer]: TKnotColumn read GetItem write SetItem; default;
- end;
-
- {
- < 0 if Item1 is less and Item2
- 0 if they are equal
- > 0 if Item1 is greater than Item2
- }
- TGridSortCompare = function (Sender: TObject; Item1, Item2: Pointer; Data: integer): Integer;
- TKnotState = (ksBrowse, ksInsert, ksEdit, ksUpdate, ksCreate);
-
- TKnotItems = class;
- TKnotItem = class;
- TKnotItemClass = class of TKnotItem;
-
- TKnotItem = class(TObject)
- private
- FFlag: WORD;
- FOwner: TKnotItems;
- FParent: TKnotItem;
- FName: string;
- FData: Pointer;
- FKnotID: integer;
- FChildKnots: TList;
- FIndex: integer;
- FNormalImage: shortint;
- FSelectImage: shortint;
- FState: TKnotState;
- FLastIndex: integer;
- function GetChildCount: integer;
- procedure SetData(const Value: Pointer);
- procedure SetName(const Value: string);
- procedure SetState(const Value: TKnotState);
- function GetFlagValue(const Index: Integer): boolean;
- procedure SetFlagValue(const Index: Integer; const Value: boolean);
- procedure SetValueEx(const Index: Integer; const Value: boolean);
- function GetVisibleChildCount: integer;
- function GetVisibleKnotCount: integer;
- procedure SetNormalImage(const Value: shortint);
- procedure SetSelectImage(const Value: shortint);
- function GetLevel: integer;
- procedure SetVisible(const Value: boolean);
- function GetVisible: boolean;
- protected
- function GetChild(Index: integer): TKnotItem;
- function GetGrid: TDCCustomTreeGrid;
- function GetOwner: TKnotItems;
- function GetParent: TKnotItem;
- procedure SetChild(Index: integer; const Value: TKnotItem);
- procedure SetParent(const Value: TKnotItem);
- public
- constructor Create(AOwner: TKnotItems; AParent: TKnotItem; AName: string); virtual;
- procedure Clear;
- procedure Collapse(Recurse: boolean);
- destructor Destroy; override;
- function DisplayRect(TextOnly: boolean): TRect;
- procedure Expand(Recurse: boolean);
- procedure EditText;
- procedure EndEdit(Cancel: boolean);
- function GetNext: TKnotItem;
- function GetNextSibling: TKnotItem;
- function GetNextVisible: TKnotItem;
- function GetNextSiblingVisible: TKnotItem;
- function GetPrev: TKnotItem;
- function GetPrevSibling: TKnotItem;
- function GetPrevVisible: TKnotItem;
- function GetPrevSiblingVisible: TKnotItem;
- property Changed: boolean index 5 read GetFlagValue write SetFlagValue;
- property ChildCount: integer read GetChildCount;
- property Childs[Index: integer]: TKnotItem read GetChild write SetChild;
- property Data: Pointer read FData write SetData;
- property Enabled: boolean index 2 read GetFlagValue write SetValueEx;
- property Expanded: boolean index 0 read GetFlagValue write SetValueEx;
- property Grid: TDCCustomTreeGrid read GetGrid;
- property Owner: TKnotItems read GetOwner;
- property Index: integer read FIndex;
- property HasChildren: boolean index 3 read GetFlagValue write SetValueEx;
- property KnotID: integer read FKnotID;
- property Level: integer read GetLevel;
- property LockItems: boolean index 4 read GetFlagValue write SetFlagValue;
- property Name: string read FName write SetName;
- property NormalImage: shortint read FNormalImage write SetNormalImage;
- property Parent: TKnotItem read GetParent write SetParent;
- property SelectImage: shortint read FSelectImage write SetSelectImage;
- property State: TKnotState read FState write SetState;
- property Visible: boolean read GetVisible write SetVisible;
- property VisibleChilds: integer read GetVisibleChildCount;
- property VisibleKnotCount: integer read GetVisibleKnotCount;
- end;
-
- TKnotItems = class(TPersistent)
- private
- FKnotItemClass: TKnotItemClass;
- FLastKnotID: integer;
- FOwner: TDCCustomTreeGrid;
- FState: TKnotState;
- FRootKnot: TKnotItem;
- FUpdateCount: integer;
- function GetCount: integer;
- function GetVisibleKnotCount: integer;
- procedure UpdateTreeGrid;
- function GetUpdateingState: boolean;
- procedure SetUpdateState(Updating: Boolean);
- procedure DeleteChildKnot(KnotItem: TKnotItem; KnotIndex: integer);
- function GetRootKnot: TKnotItem;
- protected
- function ComparePos(KnotItem1, KnotItem2: TKnotItem): integer;
- function GetItem(Index: integer): TKnotItem;
- procedure SetItem(Index: integer; const Value: TKnotItem);
- public
- constructor Create(AOwner: TDCCustomTreeGrid; AKnotItemClass: TKnotItemClass);
- destructor Destroy; override;
- function Add(Name: string; Position: integer = KNOT_END): TKnotItem;
- function AddChild(ParentKnot: TKnotItem; Name: string;
- Position: integer = KNOT_END): TKnotItem;
- function Delete(Knot: TKnotItem): boolean;
- procedure Move(KnotItem, DestKnot: TKnotItem; Position: integer = KNOT_END);
- procedure Exchange(KnotItem1, KnotItem2: TKnotItem);
- procedure Clear;
- function SelectKnot(KnotItem: TKnotItem; Offset: integer): TKnotItem;
- function GetFirstNode: TKnotItem;
- function GetFirstVisibleNode: TKnotItem;
- function GetKnot(KnotID: integer; var KnotItem: TKnotItem): boolean;
- procedure BeginUpdate(LockScreen: boolean = False);
- procedure EndUpdate;
- procedure SetState(Value: TKnotState);
- procedure RebuildIndexes(ParentKnot: TKnotItem; FirstIndex: integer);
- procedure LockRebuilds(KnotItem: TKnotItem; Lock: boolean);
- property Owner: TDCCustomTreeGrid read FOwner;
- property Grid: TDCCustomTreeGrid read FOwner;
- property Items[Index: integer]: TKnotItem read GetItem write SetItem;
- property Count:integer read GetCount;
- property LastKnotID: integer read FLastKnotID;
- property VisibleKnotCount: integer read GetVisibleKnotCount;
- property State: TKnotState read FState;
- property Updating: boolean read GetUpdateingState;
- property Root: TKnotItem read GetRootKnot;
- property First: TKnotItem read GetFirstNode;
- end;
-
- TKnotBookmarkList = class
- private
- FList: TList;
- FGrid: TDCCustomTreeGrid;
- FCache: integer;
- FCacheIndex: Integer;
- FCacheFind: boolean;
- FSortItems: boolean;
- function GetCount: integer;
- procedure ListChanged;
- function GetItem(Index: Integer): integer;
- function Compare(const KnotID1, KnotID2: integer): Integer;
- public
- constructor Create(AGrid: TDCCustomTreeGrid);
- destructor Destroy; override;
- procedure Clear;
- procedure Delete;
- procedure Sort;
- procedure Select(KnotItem: TKnotItem; Value: boolean);
- procedure SelectAll;
- function Find(const KnotID: integer; var Index: Integer): Boolean;
- function IndexOf(const KnotID: integer): Integer;
- function KnotSelected(const KnotID: integer): Boolean;
- property Count: Integer read GetCount;
- property Items[Index: Integer]: integer read GetItem; default;
- property SortItems: boolean read FSortItems write FSortItems;
- end;
-
- TTreeGridOption = (tgEditing, tgAlwaysShowEditor, tgTitles, tgIndicator,
- tgColumnResize, tgColLines, tgRowLines, tgColMoving, tgRowMoving, tgTabs,
- tgRowSelect, tgAlwaysShowSelection, tgConfirmDelete, tgCancelOnExit,
- tgMultiSelect, tgMarker, tgTreePath, tgTitleClicked, tgUserRowHeight,
- tgRowSizing, tgHighlightRow, tgFlatButtons, tgTreePathResize, tgFixedLines,
- tgCompleteLines, tgColumnSizing, tgGrouping, tgTreePathCompletion,
- tgDoubleBuffered, tgDrawFixedLine, tgAutoSize);
-
- TTreeGridOptionEx =(tgeInsertSelect, tgeMarkerMenu, tgeShadowSelection,
- tgeRightClickSelect, tgeTreeSelect, tgeShowLines, tgeShowButtons);
-
- TTreeGridMessageType = (mtLoadData, mtEmptyColumns);
-
- TTreeGridOptions = set of TTreeGridOption;
- TTreeGridOptionsEx = set of TTreeGridOptionEx;
-
- TTreeDrawCollumnCellEvent = procedure (Sender: TObject; const Rect: TRect;
- Canvas: TCanvas; DataCol: Integer; Column: TKnotColumn; KnotItem: TKnotItem;
- State: TGridDrawState) of object;
- TTreeCellTextEvent = procedure (Sender: TObject; KnotItem: TKnotItem; var
- Text: string; var DefaultDraw: boolean) of object;
- TTreeGridClickEvent = procedure (Column: TKnotColumn) of object;
- TTreeGridClipEvent = procedure (Sender: TObject; X, Y : LongInt;
- var Show: boolean) of object;
- TTreeGridKnotEvent = procedure (KnotItem: TKnotItem;
- var Apply: boolean) of object;
- TTreeGridEditEvent = procedure (KnotItem: TKnotItem;
- var Edit: TDCCustomChoiceEdit; Column: TKnotColumn; var CanCreate: boolean) of object;
- TTreeGridUpdateEvent = procedure (KnotItem: TKnotItem;
- var Edit: TDCCustomChoiceEdit; Column: TKnotColumn) of object;
- TTreeGridKnotDeleteEvent = procedure (KnotItem: TKnotItem;
- var Apply: boolean; ComponentState: TComponentState) of object;
- TTreeGridCommentEvent = procedure(Sender: TObject; Mode: integer;
- Column: TKnotColumn) of object;
- TTreeGridSelectKnot = procedure(Sender: TObject; KnotItem: TKnotItem) of object;
- TPaintMessageEvent = procedure(Sender: TObject; Canvas: TCanvas; ARect: TRect;
- MessageType: TTreeGridMessageType; UpdateMessage: string) of object;
- TTreeGridExpanded = procedure(Sender: TObject; KnotItem: TKnotItem) of object;
-
- TTreeGridHitTest = (htNowere, htOnButton, htOnIcon, htOnLabel);
- TFixedCell = (fcNone, fcIndicator, fcMarker, fcTreePath, fcColumn);
-
- TTreePathValue = (tpColor, tpFont);
- TTreePathValues = set of TTreePathValue;
-
- TTreePath = class(TPersistent)
- private
- FColor: TColor;
- FAssignedValues: TTreePathValues;
- FGrid: TDCCustomTreeGrid;
- FFont: TFont;
- function DefaultColor: TColor;
- function DefaultFont: TFont;
- function GetColor: TColor;
- function IsColorStored: Boolean;
- function IsFontStored: Boolean;
- procedure FontChanged(Sender: TObject);
- procedure SetColor(const Value: TColor);
- function GetFont: TFont;
- procedure SetFont(const Value: TFont);
- public
- procedure Assign(Source: TPersistent); override;
- constructor Create(AGrid: TDCCustomTreeGrid);
- property AssignedValues: TTreePathValues read FAssignedValues;
- published
- property Color: TColor read GetColor write SetColor stored
- IsColorStored;
- property Font: TFont read GetFont write SetFont stored IsFontStored;
- end;
-
- TDCCustomTreeGrid = class(TDCCustomGrid)
- private
- FActiveKnot: TKnotItem;
- FBookMarkSize: integer;
- FBookmarks: TKnotBookmarkList;
- FColumnFooter: TKnotColumnFooter;
- FClipDown: boolean;
- FClipPopup: TObject;
- FColumnCell: integer;
- FColumns: TKnotColumns;
- FCurrentCol: Integer;
- FCurrentPos: array[1..2] of TBookmark;
- FDefaultDrawing: boolean;
- FEditorMode: boolean;
- FEditTimerID: integer;
- FFirstGridCell: integer;
- FFirstIndex: integer;
- FFirstVisible: TKnotItem;
- FHintRow: integer;
- FHintWindow: TDCMessageWindow;
- FImageChangeLink: TChangeLink;
- FImages: TImageList;
- FIndent: integer;
- FInplaceCol: longint;
- FInplaceEdit: TDCCustomChoiceEdit;
- FInplaceRow: longint;
- FIsModified: boolean;
- FIsESCKey: boolean;
- FKnots: TKnotItems;
- FKnotCount: integer;
- FLayoutLock: Byte;
- FLockScreen: boolean;
- FLockScroll: boolean;
- FLockWindow: boolean;
- FMouseDownRow: integer;
- FMousePoint: TPoint;
- FOnCellClick: TTreeGridClickEvent;
- FOnCellDblClick: TTreeGridClickEvent;
- FOnClipButtonClick: TNotifyEvent;
- FOnClipClick: TTreeGridClipEvent;
- FOnCollapsed: TTreeGridExpanded;
- FOnColumnComment: TTreeGridCommentEvent;
- FOnColumnMoved: TMovedEvent;
- FOnCreateCellEdit: TTreeGridEditEvent;
- FOnDelete: TTreeGridKnotDeleteEvent;
- FOnDestroyCellEdit: TNotifyEvent;
- FOnDrawColumnCell: TTreeDrawCollumnCellEvent;
- FOnExpanded: TTreeGridExpanded;
- FOnInsert: TTreeGridKnotEvent;
- FOnPaintMessage: TPaintMessageEvent;
- FOnRowMoved: TMovedEvent;
- FOnSelectCell: TSelectCellEvent;
- FOnSelectKnot: TTreeGridSelectKnot;
- FOnTitleClick:TTreeGridClickEvent;
- FOnTopLeftChanged: TNotifyEvent;
- FOnTreeCellText: TTreeCellTextEvent;
- FOnUpdate: TTreeGridUpdateEvent;
- FOptions: TTreeGridOptions;
- FOptionsEx: TTreeGridOptionsEx;
- FPopupTitle: TPopupMenu;
- FRowUpdated: boolean;
- FSelectedKnot: TKnotItem;
- FSelecting: boolean;
- FSelectionKnot: TKnotItem;
- FSelfChangingTitleFont: Boolean;
- FSizingIndex: integer;
- FSizingOff: integer;
- FTitleFont: TFont;
- FTitleOffset, FIndicatorOffset: Byte;
- FTreeImages: TImageList;
- FTreePathWidth: integer;
- FTreePathSizing: boolean;
- FTreePath: TTreePath;
- FUpdateLock: Byte;
- function AlwaysShowSelection: boolean;
- procedure SetColumns(const Value: TKnotColumns);
- procedure InternalLayout;
- procedure MoveCol(RawCol, Direction: Integer);
- procedure SetOptions(Value: TTreeGridOptions);
- procedure TitleFontChanged(Sender: TObject);
- procedure DoSelection(Select: Boolean; Shift: TShiftState; Direction: Integer);
- procedure UpdateRowCount;
- procedure UpdateActive;
- function AcquireFocus: Boolean;
- procedure DataChanged;
- procedure UpdateEditData;
- procedure SetTitleFont(const Value: TFont);
- procedure SetTreePathWidth(const Value: integer);
- procedure SetTitleHeight;
- procedure SetClipDown(const Value: boolean);
- function GetSelectedIndex: Integer;
- procedure SetSelectedIndex(Value: Integer);
- function GetTreePathWidth: integer;
- function HideEditor: boolean;
- function Modified: boolean;
- procedure SetImages(const Value: TImageList);
- function GetHintTreeOffset(KnotItem: TKnotItem; Hint: TTreeGridHitTest): integer;
- procedure SetPopupTitle(const Value: TPopupMenu);
- procedure InsertKnot(ParentKnot: TKnotItem; lChild: boolean; Shift: TShiftState);
- procedure MarkKnot;
- procedure NextRow(Select: Boolean; Insert: boolean; Shift: TShiftState;
- AOffset: integer = 1);
- procedure PrevRow(Select: Boolean; Shift: TShiftState; AOffset: integer = 1);
- procedure ClearSelection;
- function Eof: boolean;
- function BoxRectEx(ALeft, ATop, ARight, ABottom: Longint): TRect;
- procedure ImageListChange(Sender: TObject);
- procedure SetSelectedKnot(KnotItem: TKnotItem);
- procedure SetSelected(const Value: TKnotItem);
- function GetPosition: TBookMark;
- procedure SetPosition(const Value: TBookMark);
- function GetTreeLableOffset(KnotItem: TKnotItem): integer;
- procedure FreeEditTimer;
- function CalcMaxTopLeft(const Coord: TGridCoord;
- const DrawInfo: TGridDrawInfo): TGridCoord;
- function CanModifyHScrollBar(ScrollBar, ScrollCode, Pos: Cardinal;
- UseRightToLeft: Boolean; var NewLeft: integer): boolean;
- procedure SetOptionsEx(const Value: TTreeGridOptionsEx);
- procedure SetIndent(const Value: integer);
- procedure InitGridPos;
- procedure SetColumnFooter(const Value: TKnotColumnFooter);
- procedure SetTreePath(const Value: TTreePath);
- protected
- function AcquireLayoutLock: Boolean;
- procedure BeginLayout; override;
- procedure BeginUpdate;
- function BookmarksEqual(Bookmark1, Bookmark2: TBookmark): boolean; virtual;
- procedure CalcSizingState(X, Y: Integer; var State: TGridState;
- var Index: Longint; var SizingPos, SizingOfs: Integer;
- var FixedInfo: TGridDrawInfo); override;
- function CanColResize(ACol: integer): boolean; override;
- function CanEditModify: Boolean; override;
- procedure CellClick(Column: TKnotColumn); dynamic;
- procedure CellDblClick(Column: TKnotColumn); dynamic;
- procedure ClipButtonClick(Sender: TObject); virtual;
- procedure ClipClick(ACellType: TFixedCell); dynamic;
- procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
- procedure CMExit(var Message: TMessage); message CM_EXIT;
- procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
- procedure CMInvalidValue(var Message: TMessage); message CM_INVALIDVALUE;
- procedure CMKnotChanged(var Message: TMessage); message CM_KNOTCHANGED;
- procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
- procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
- procedure CMPopupHintInfo(var Message: TMessage); message CM_POPUPHINTINFO;
- procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
- procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
- procedure ColWidthsChanged; override;
- function CreateColumns: TKnotColumns; virtual;
- function CreateKnots: TKnotItems; virtual;
- procedure CreateParams(var Params: TCreateParams); override;
- procedure CreateWnd; override;
- function DataToRawColumn(ACol: Integer): Integer;
- function DataVisible: boolean; virtual;
- procedure DblClick; override;
- function DeletePrompt: boolean; virtual;
- procedure DeleteRecords(AtOnce: boolean);
- procedure DoCollapse(KnotItem: TKnotItem); dynamic;
- procedure DoColumnClick(Shift: TShiftState; ColIndex: integer); override;
- procedure DoColumnComment(Mode: integer; Column: TKnotColumn); virtual;
- procedure DoCreateCellEdit(Column: TKnotColumn;
- var Edit: TDCCustomChoiceEdit; var CanCreate: boolean); virtual;
- procedure DoDelete(KnotItem: TKnotItem; var Apply: boolean;
- ComponentState: TComponentState); virtual;
- procedure DoDestroyCellEdit; virtual;
- procedure DoDrawColumnCell(Canvas: TCanvas; ARect: TRect; ACol: integer;
- AColumn: TKnotColumn; AKnot: TKnotItem; AState: TGridDrawState); virtual;
- procedure DoExpand(KnotItem: TKnotItem); dynamic;
- procedure DoInsert(KnotItem: TKnotItem; var Apply: boolean); virtual;
- function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
- function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
- procedure DoSelectCell(Sender: TObject; ACol, ARow: Longint;
- var CanSelect: Boolean); virtual;
- procedure DoUpdate(KnotItem: TKnotItem; var Edit: TDCCustomChoiceEdit;
- Column: TKnotColumn); virtual;
- procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
- function DrawTitleCell(ACanvas: TCanvas; ACol, ARow: Integer; ARect: TRect;
- BorderState: TDrawBorerState; AFillRect, ADraw: boolean): TPoint; override;
- procedure EndLayout; override;
- procedure EndUpdate;
- function FlatButtons: boolean; override;
- function GetBookmark(KnotItem: TKnotItem): TBookmark;
- procedure GetBookmarkData(KnotItem: TKnotItem; Data:Pointer); virtual;
- function GetBorderStyle: TEdgeBorderStyle; override;
- function GetClientRect: TRect; override;
- function GetCellByType(ACellType: TFixedCell): integer;
- function GetFixedCellType(ACol, AOffset: integer): TFixedCell;
- function GetKnots: TKnotItems;
- function GetPopupMenu: TPopupMenu; override;
- function GetRealColWidth(ColIndex: integer): integer; override;
- function GetTopLeft: TGridCoord;
- function GetTreePathCaption(KnotItem: TKnotItem; var Text: string): boolean; virtual;
- procedure GotoBookmark(Bookmark: TBookmark); virtual;
- procedure GroupBoxChanged; override;
- procedure HideHintWindow;
- function HighlightCell(DataCol, DataRow: Integer;
- AState: TGridDrawState; KnotItem: TKnotItem): Boolean; virtual;
- procedure InvalidateTitles;
- procedure InvalidateSelected;
- procedure LayoutChanged; virtual;
- procedure Loaded; override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer); override;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer); override;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- function RawToDataColumn(ACol: Integer): Integer; override;
- procedure ResizeColWidth(ACol, AWidth: integer); override;
- procedure RowMoved(FromIndex, ToIndex: Longint); override;
- function SelectCell(ACol, ARow: Longint): Boolean; override;
- procedure SetColumnAttributes; virtual;
- procedure SetKnots(const Value: TKnotItems);
- procedure ShowHintWindow(X, Y, ALeft, ATop, AOff: integer; Text: string);
- function ShowEditorChar(Ch: Char): boolean;
- procedure TitleClick(Column: TKnotColumn); dynamic;
- procedure TopLeftChanged; override;
- procedure WMChar(var Msg: TWMChar); message WM_CHAR;
- procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
- procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
- procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
- procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
- procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
- procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
- procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
- procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
- procedure WMSetFocus(var Message: TWMSetFocus); message WM_SetFOCUS;
- procedure WMSize(var Message: TWMSize); message WM_SIZE;
- procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
- procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;
- property BookmarkSize: integer read FBookmarkSize write FBookmarkSize;
- property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
- property IndicatorOffset: Byte read FIndicatorOffset;
- property Indent: integer read FIndent write SetIndent;
- property Knots: TKnotItems read GetKnots write SetKnots;
- property Options: TTreeGridOptions read FOptions write SetOptions
- default [tgEditing, tgTitles, tgIndicator, tgColumnResize, tgColLines,
- tgRowLines, tgTabs, tgConfirmDelete, tgCancelOnExit, tgTreePathResize,
- tgFixedLines, tgColMoving];
- property OptionsEx: TTreeGridOptionsEx read FOptionsEx write SetOptionsEx
- default [tgeInsertSelect, tgeMarkerMenu, tgeShadowSelection, tgeShowButtons];
- property TitleFont: TFont read FTitleFont write SetTitleFont;
- property UpdateLock: Byte read FUpdateLock;
- property TreePathWidth: integer read GetTreePathWidth write SetTreepathWidth;
- property LayoutLock: Byte read FLayoutLock;
- property SelectedRows: TKnotBookmarkList read FBookmarks;
- property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
- property OnCellClick: TTreeGridClickEvent read FOnCellClick write FOnCellClick;
- property OnCellDblClick: TTreeGridClickEvent read FOnCellDblClick write FOnCellDblClick;
- property OnTitleClick: TTreeGridClickEvent read FOnTitleClick write FOnTitleClick;
- property OnClipClick: TTreeGridClipEvent read FOnClipClick write FOnClipClick;
- property OnDelete: TTreeGridKnotDeleteEvent read FOnDelete write FOnDelete;
- property OnInsert: TTreeGridKnotEvent read FOnInsert write FOnInsert;
- property OnUpdate: TTreeGridUpdateEvent read FOnUpdate write FOnUpdate;
- property SelectedKnot: TKnotItem read FSelectedKnot write SetSelected;
- property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
- property OnDrawColumnCell: TTreeDrawCollumnCellEvent read FOnDrawColumnCell write FOnDrawColumnCell;
- property OnTreeCellText: TTreeCellTextEvent read FOnTreeCellText write FOnTreeCellText;
- property OnRowMoved: TMovedEvent read FOnRowMoved write FOnRowMoved;
- property OnSelectCell: TSelectCellEvent read FOnSelectCell write FOnSelectCell;
- property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
- property OnCreateCellEdit: TTreeGridEditEvent read FOnCreateCellEdit write FOnCreateCellEdit;
- property OnDestroyCellEdit: TNotifyEvent read FOnDestroyCellEdit write FOnDestroyCellEdit;
- property OnClipButtonClick: TNotifyEvent read FOnClipButtonClick write FOnClipButtonClick;
- property OnColumnComment: TTreeGridCommentEvent read FOnColumnComment write FOnColumnComment;
- property PopupTitle: TPopupMenu read FPopupTitle write SetPopupTitle;
- property RowModified: boolean read Modified;
- property OnSelectKnot: TTreeGridSelectKnot read FOnSelectKnot write FOnSelectKnot;
- property OnPaintMessage: TPaintMessageEvent read FOnPaintMessage write FOnPaintMessage;
- property OnExpanded: TTreeGridExpanded read FOnExpanded write FOnExpanded;
- property OnCollapsed: TTreeGridExpanded read FOnCollapsed write FOnCollapsed;
- property Footer: TKnotColumnFooter read FColumnFooter write SetColumnFooter;
- property TreePath: TTreePath read FTreePath write SetTreePath;
- public
- procedure SetModified(Value: boolean);
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure RowHeightsChanged; override;
- function GetHitTestInfoAt(KnotItem: TKnotItem; X,Y: integer): TTreeGridHitTest;
- property ClipDown: boolean read FClipDown write SetClipDown;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure ShowClipPopup(ACellType: TFixedCell; AClipPopup: TObject); virtual;
- procedure HideClipPopup;
- procedure Paint; override;
- procedure ShowEditor;
- procedure ShowTreePathEditor;
- procedure SavePosition;
- procedure RestPosition;
- procedure Update; override;
- procedure SelectItems(Mode: TSelectMode);
- procedure Sort(Level: integer; Compare: TGridSortCompare; Data: integer);
- function GroupingEnabled: boolean; override;
- property ColumnFooter: TKnotColumnFooter read FColumnFooter;
- property Columns: TKnotColumns read FColumns write SetColumns;
- property Font;
- property Images: TImageList read FImages write SetImages;
- property InEditorMode: boolean read FEditorMode;
- property Position: TBookMark read GetPosition write SetPosition;
- end;
-
- TDCTreeGrid = class(TDCCustomTreeGrid)
- public
- property Canvas;
- property Knots;
- property ScrollBars;
- property SelectedRows;
- property SelectedKnot;
- property SelectedIndex;
- property Col;
- property Row;
- property RowCount;
- property ColCount;
- property RowModified;
- property GroupBox;
- published
- property Align;
- property Anchors;
- property BiDiMode;
- property BorderStyle;
- property Color;
- property Columns;
- property Constraints;
- property Ctl3D;
- property DefaultDrawing;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property FixedColor;
- property Font;
- property Indent;
- property Options;
- property OptionsEx;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
- property OnColumnMoved;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnStartDock;
- property OnStartDrag;
- property Images;
- property DefaultRowHeight;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnCellClick;
- property OnCellDblClick;
- property OnTitleClick;
- property OnClipClick;
- property OnDelete;
- property OnInsert;
- property OnUpdate;
- property OnDrawColumnCell;
- property OnTreeCellText;
- property TreePathWidth;
- property OnRowMoved;
- property OnSelectCell;
- property OnTopLeftChanged;
- property OnCreateCellEdit;
- property OnDestroyCellEdit;
- property OnClipButtonClick;
- property OnColumnComment;
- property PopupTitle;
- property OnSelectKnot;
- property OnPaintMessage;
- property OnExpanded;
- property OnCollapsed;
- property OnGroupBoxInsert;
- property OnGroupBoxRemove;
- property OnGroupBoxMove;
- property Footer;
- property TreePath;
- end;
-
- {Inplace Editors}
- TSelection = record
- StartPos, EndPos: Integer;
- end;
-
- TDCInplaceChoiceEdit = class(TDCChoiceEdit)
- private
- FGrid: TDCCustomTreeGrid;
- procedure SetGrid(Value: TDCCustomTreeGrid);
- protected
- procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
- procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
- function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
- MousePos: TPoint): Boolean; override;
- procedure KeyUp(var Key: Word; Shift: TShiftState); override;
- public
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure ChoiceClick(Sender:TObject); override;
- property Grid: TDCCustomTreeGrid read FGrid write SetGrid;
- end;
-
- TDCInplaceDateEdit = class(TDCDateEdit)
- private
- FGrid: TDCCustomTreeGrid;
- procedure SetGrid(Value: TDCCustomTreeGrid);
- protected
- procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
- procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
- function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
- MousePos: TPoint): Boolean; override;
- procedure KeyUp(var Key: Word; Shift: TShiftState); override;
- public
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure ChoiceClick(Sender:TObject); override;
- property Grid: TDCCustomTreeGrid read FGrid write SetGrid;
- end;
-
- TDCInplaceFloatEdit = class(TDCFloatEdit)
- private
- FGrid: TDCCustomTreeGrid;
- procedure SetGrid(Value: TDCCustomTreeGrid);
- protected
- procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
- procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
- function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
- MousePos: TPoint): Boolean; override;
- procedure KeyUp(var Key: Word; Shift: TShiftState); override;
- public
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure ChoiceClick(Sender:TObject); override;
- property Grid: TDCCustomTreeGrid read FGrid write SetGrid;
- end;
-
- TDCInplaceGridEdit = class(TDCGridEdit)
- private
- FGrid: TDCCustomTreeGrid;
- procedure SetGrid(Value: TDCCustomTreeGrid);
- protected
- procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
- procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
- function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
- MousePos: TPoint): Boolean; override;
- procedure KeyUp(var Key: Word; Shift: TShiftState); override;
- public
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure ChoiceClick(Sender:TObject); override;
- property Grid: TDCCustomTreeGrid read FGrid write SetGrid;
- end;
-
- TDCInplaceTreeEdit = class(TDCTreeEdit)
- private
- FGrid: TDCCustomTreeGrid;
- procedure SetGrid(Value: TDCCustomTreeGrid);
- protected
- procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
- procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
- function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
- MousePos: TPoint): Boolean; override;
- procedure KeyUp(var Key: Word; Shift: TShiftState); override;
- public
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure ChoiceClick(Sender:TObject); override;
- property Grid: TDCCustomTreeGrid read FGrid write SetGrid;
- end;
-
- TDCInplaceComboBox = class(TDCComboBox)
- private
- FGrid: TDCCustomTreeGrid;
- procedure SetGrid(Value: TDCCustomTreeGrid);
- protected
- procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
- procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
- function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
- MousePos: TPoint): Boolean; override;
- procedure KeyUp(var Key: Word; Shift: TShiftState); override;
- public
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure ChoiceClick(Sender:TObject); override;
- property Grid: TDCCustomTreeGrid read FGrid write SetGrid;
- end;
-
- {$IFDEF DELPHI_V5UP}
- TDCInplaceADOGridEdit = class(TDCADOGridEdit)
- private
- FGrid: TDCCustomTreeGrid;
- procedure SetGrid(Value: TDCCustomTreeGrid);
- protected
- procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
- procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
- function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
- MousePos: TPoint): Boolean; override;
- procedure KeyUp(var Key: Word; Shift: TShiftState); override;
- public
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure ChoiceClick(Sender:TObject); override;
- property Grid: TDCCustomTreeGrid read FGrid write SetGrid;
- end;
- {$ENDIF}
-
- implementation
- uses
- DCEditButton;
-
- {$R *.RES}
- type
-
- TKnotClipPopup = class(TDBClipPopup)
- private
- FCellType: TFixedCell;
- protected
- procedure ButtonClick(Sender: TObject); override;
- public
- procedure AddButtons; override;
- property CellType: TFixedCell read FCellType write FCellType;
- end;
-
- const
- NE_EMPTY_KNOT = '$Empty Knot';
- NE_ROOT_KNOT = '$DC.sp_ROOT';
- TreeIconWidth = 20;
-
- const
- bmExpand = 'DC_TGEXPAND' ; nbmExpand = 0;
- bmCollapse = 'DC_TGCOLLAPSE' ; nbmCollapse = 1;
- bmExpandR = 'DC_TGEXPANDR' ; nbmExpandR = 2;
- bmCollapseR = 'DC_TGCOLLAPSER' ; nbmCollapseR = 3;
-
- pmSelectAll = 0;
- pmDeselectAll = 1;
-
- var
- DrawBitmap, TempBitmap: TBitmap;
- UserCount: Integer;
-
- function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; stdcall;
- external 'kernel32.dll' name 'MulDiv';
-
- procedure UsesBitmap;
- begin
- if UserCount = 0 then
- begin
- DrawBitmap := TBitmap.Create;
- TempBitmap := TBitmap.Create;
- end;
- Inc(UserCount);
- end;
-
- procedure ReleaseBitmap;
- begin
- Dec(UserCount);
- if UserCount = 0 then begin
- DrawBitmap.Free;
- TempBitmap.Free;
- end;
- end;
-
- procedure KillMessage(Wnd: HWnd; Msg: Integer);
- // Delete the requested message from the queue, but throw back
- // any WM_QUIT msgs that PeekMessage may also return
- var
- M: TMsg;
- begin
- M.Message := 0;
- if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
- PostQuitMessage(M.wparam);
- end;
-
- procedure InplaceUpdateLoc(Sender: TDCCustomChoiceEdit; R: TRect; Canvas: TCanvas);
- begin
- if Sender.DrawStyle <> fsNone then
- begin
- InflateRect(R, 1, 1);
- Dec(R.Left, 3);
- end;
- Sender.SetBounds(R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top);
- Canvas.Brush.Color := Sender.Color;
- R.Right := R.Right - Sender.ButtonWidth;
- Canvas.FillRect(R);
- Sender.Show;
- Sender.SetFocus;
- Sender.Repaint;
- end;
-
- procedure InplaceKeyDown(Sender: TDCCustomChoiceEdit; Grid: TDCCustomTreeGrid;
- var Key: Word; Shift: TShiftState);
-
- procedure SendToParent;
- begin
- Grid.KeyDown(Key, Shift);
- end;
-
- procedure ParentEvent;
- var
- GridKeyDown: TKeyEvent;
- begin
- if Assigned(Grid) then
- begin
- GridKeyDown := Grid.OnKeyDown;
- if Assigned(GridKeyDown) then GridKeyDown(Grid, Key, Shift);
- end;
- end;
-
- function ForwardMovement: Boolean;
- begin
- Result := tgAlwaysShowEditor in Grid.Options;
- end;
-
- function Ctrl: Boolean;
- begin
- Result := ssCtrl in Shift;
- end;
-
- function Selection: TSelection;
- begin
- SendMessage(Sender.Handle, EM_GETSEL, Longint(@Result.StartPos), Longint(@Result.EndPos));
- end;
-
- function RightSide: Boolean;
- begin
- with Selection do
- Result := ((StartPos = 0) or (EndPos = StartPos)) and
- (EndPos = Sender.GetTextLen);
- end;
-
- function LeftSide: Boolean;
- begin
- with Selection do
- Result := (StartPos = 0) and ((EndPos = 0) or (EndPos = Sender.GetTextLen));
- end;
- begin
- case Key of
- VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT:
- begin
- if not(ssAlt in Shift) then
- begin
- SendToParent;
- Key := 0;
- end;
- end;
- VK_ESCAPE:
- begin
- SendToParent;
- Key := 0;
- end;
- VK_INSERT:
- if Shift = [] then SendToParent
- else if (Shift = [ssShift]) and not Grid.CanEditModify then Key := 0;
- VK_LEFT : if ForwardMovement and (Ctrl or LeftSide ) then SendToParent;
- VK_RIGHT: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
- VK_HOME : if ForwardMovement and (Ctrl or LeftSide ) then SendToParent;
- VK_END : if ForwardMovement and (Ctrl or RightSide) then SendToParent;
- VK_F2:
- begin
- ParentEvent;
- if Key = VK_F2 then
- begin
- Sender.Deselect;
- Exit;
- end;
- end;
- VK_TAB:
- if not (ssAlt in Shift) then
- begin
- SendToParent;
- Key := 0;
- end;
- end;
- if (Key = VK_DELETE) and not Grid.CanEditModify then Key := 0;
- if Key <> 0 then ParentEvent;
- end;
-
- { TKnotColumn }
- procedure TKnotColumn.Assign(Source: TPersistent);
- begin
- if Source is TKnotColumn then
- begin
- try
- RestoreDefaults;
- Name := TKnotColumn(Source).Name;
- if cvColor in TKnotColumn(Source).AssignedValues then
- Color := TKnotColumn(Source).Color;
- if cvWidth in TKnotColumn(Source).AssignedValues then
- begin
- FWidth := TKnotColumn(Source).FWidth;
- FAssignedValues := FAssignedValues + [cvWidth];
- end;
- if cvFont in TKnotColumn(Source).AssignedValues then
- Font := TKnotColumn(Source).Font;
- if cvAlignment in TKnotColumn(Source).AssignedValues then
- Alignment := TKnotColumn(Source).Alignment;
- Title := TKnotColumn(Source).Title;
- Options := TKnotColumn(Source).Options;
- ItemIndex:= TKnotColumn(Source).ItemIndex;
- DisplayFormat := TKnotColumn(Source).DisplayFormat;
- FooterPanel.Visible := TKnotColumn(Source).FooterPanel.Visible;
- FooterPanel.Text := TKnotColumn(Source).FooterPanel.Text;
- finally
- end;
- end
- else
- inherited Assign(Source);
- end;
-
- constructor TKnotColumn.Create(Collection: TCollection);
- var
- Grid: TDCCustomTreeGrid;
- begin
- Grid := nil;
- if Assigned(Collection) and (Collection is TKnotColumns) then
- Grid := TKnotColumns(Collection).Grid;
- if Assigned(Grid) then Grid.BeginLayout;
- try
- inherited Create(Collection);
- FWidth := 50;
- FAlignment := taLeftJustify;
- FItemIndex := -1;
- FFont := TFont.Create;
- FFont.Assign(DefaultFont);
- FFont.OnChange := FontChanged;
- FTitle := TKnotColumnTitle.Create(Self);
- FOptions := [kcVisible, kcShowEdit, kcSizing];
- FFooterPanel := TKnotColumnFooterPanel.Create(Grid.ColumnFooter.Panels);
- FFooterPanel.SetInternalColIndex(Self.Index);
- finally
- if Assigned(Grid) then Grid.EndLayout;
- end;
- end;
-
- function TKnotColumn.DefaultAlignment: TAlignment;
- begin
- Result := taLeftJustify;
- end;
-
- function TKnotColumn.DefaultColor: TColor;
- begin
- if Assigned(Grid) then
- Result := Grid.Color
- else
- Result := clWindow;
- end;
-
- function TKnotColumn.DefaultFont: TFont;
- begin
- if Assigned(Grid) then
- Result := Grid.Font
- else
- Result := FFont;
- end;
-
- function TKnotColumn.DefaultWidth: Integer;
- var
- RestoreCanvas: Boolean;
- R: TRect;
- P: TPoint;
- W: integer;
- begin
- if Assigned(Grid) then with Grid do
- begin
- Result := Grid.DefaultColWidth;
- RestoreCanvas := not HandleAllocated;
- if RestoreCanvas then Canvas.Handle := GetDC(0);
- try
- if tgTitles in Options then
- begin
- Canvas.Font := Title.Font;
- R := Rect(0, 0, ClientWidth, ClientHeight);
- P := DrawTitleCell(Canvas, Index, 0, R, dsUp, False, False);
- W := P.X;
- if Result < W then Result := W;
- end;
- finally
- if RestoreCanvas then
- begin
- ReleaseDC(0, Canvas.Handle);
- Canvas.Handle := 0;
- end;
- end;
- end
- else
- Result := 64;
- end;
-
- destructor TKnotColumn.Destroy;
- begin
- FTitle.Free;
- FFont.Free;
- inherited Destroy;
- end;
-
- procedure TKnotColumn.FontChanged(Sender: TObject);
- begin
- Include(FAssignedValues, cvFont);
- Title.RefreshDefaultFont;
- Changed(False);
- end;
-
- function TKnotColumn.GetAlignment: TAlignment;
- begin
- if cvAlignment in FAssignedValues then
- Result := FAlignment
- else
- Result := DefaultAlignment;
- end;
-
- function TKnotColumn.GetColor: TColor;
- begin
- if cvColor in FAssignedValues then
- Result := FColor
- else
- Result := DefaultColor;
- end;
-
- function TKnotColumn.GetDisplayName: string;
- begin
- Result := FTitle.Caption;
- if Result = '' then Result := ClassName;
- end;
-
- function TKnotColumn.GetFont: TFont;
- var
- Save: TNotifyEvent;
- begin
- if not (cvFont in FAssignedValues) and (FFont.Handle <> DefaultFont.Handle) then
- begin
- Save := FFont.OnChange;
- FFont.OnChange := nil;
- FFont.Assign(DefaultFont);
- FFont.OnChange := Save;
- end;
- Result := FFont;
- end;
-
- function TKnotColumn.GetGrid: TDCCustomTreeGrid;
- begin
- if Assigned(Collection) and (Collection is TKnotColumns) then
- Result := TKnotColumns(Collection).Grid
- else
- Result := nil;
- end;
-
- function TKnotColumn.GetWidth: TWidth;
- begin
- if not( (kcVisible in Options) or
- ((Grid <> nil) and (csWriting in Grid.ComponentState) )) then
- begin
- if (Grid <> nil) and not (tgColLines in Grid.Options) then
- Result := 0
- else
- Result := -1
- end
- else if cvWidth in FAssignedValues then
- Result := FWidth
- else
- Result := DefaultWidth;
- end;
-
- function TKnotColumn.IsAlignmentStored: Boolean;
- begin
- Result := (cvAlignment in FAssignedValues) and (FAlignment <> DefaultAlignment);
- end;
-
- function TKnotColumn.IsColorStored: Boolean;
- begin
- Result := (cvColor in FAssignedValues) and (FColor <> DefaultColor);
- end;
-
- function TKnotColumn.IsFontStored: Boolean;
- begin
- Result := (cvFont in FAssignedValues) and (Font <> DefaultFont);
- end;
-
- function TKnotColumn.IsWidthStored: Boolean;
- begin
- Result := (cvWidth in FAssignedValues) and (FWidth <> DefaultWidth);
- end;
-
- procedure TKnotColumn.RefreshDefaultFont;
- var
- Save: TNotifyEvent;
- begin
- if cvFont in FAssignedValues then Exit;
- Save := FFont.OnChange;
- FFont.OnChange := nil;
- try
- FFont.Assign(DefaultFont);
- finally
- FFont.OnChange := Save;
- end;
- end;
-
- procedure TKnotColumn.RestoreDefaults;
- var
- FontAssigned: Boolean;
- begin
- FontAssigned := cvFont in FAssignedValues;
- FTitle.RestoreDefaults;
- FAssignedValues := [];
- RefreshDefaultFont;
- Changed(FontAssigned);
- end;
-
- procedure TKnotColumn.SetAlignment(const Value: TAlignment);
- begin
- if (cvAlignment in FAssignedValues) and (Value = FAlignment) then Exit;
- FAlignment := Value;
- Include(FAssignedValues, cvAlignment);
- Changed(False);
- end;
-
- procedure TKnotColumn.SetColor(const Value: TColor);
- begin
- if (cvColor in FAssignedValues) and (Value = FColor) then Exit;
- FColor := Value;
- Include(FAssignedValues, cvColor);
- Changed(False);
- end;
-
- procedure TKnotColumn.SetName(const Value: string);
- begin
- FName := Value;
- Changed(False);
- end;
-
- procedure TKnotColumn.SetFont(const Value: TFont);
- begin
- FFont.Assign(Value);
- Include(FAssignedValues, cvFont);
- Changed(False);
- end;
-
- procedure TKnotColumn.SetIndexStyle(const Value: TColumnIndexStyle);
- begin
- if Value <> FIndexStyle then
- begin
- FIndexStyle := Value;
- Changed(False);
- end;
- end;
-
- procedure TKnotColumn.SetItemIndex(const Value: integer);
- begin
- if Value <> FItemIndex then
- begin
- FItemIndex := Value;
- Changed(False);
- end;
- end;
-
- procedure TKnotColumn.SetOptions(const Value: TKnotOptions);
- var
- ChangedOptions: TKnotOptions;
- begin
- ChangedOptions := (FOptions + Value) - (FOptions * Value);
- if FOptions <> Value then
- begin
- FOptions := Value;
- Changed(True);
- end;
- end;
-
- procedure TKnotColumn.SetTitle(const Value: TKnotColumnTitle);
- begin
- FTitle.Assign(Value);
- end;
-
- procedure TKnotColumn.SetWidth(const Value: TWidth);
- begin
- if ((cvWidth in FAssignedValues) or (Value <> DefaultWidth))
- and (Value <> -1) and (Value <> 0)then
- begin
- FWidth := Value;
- Include(FAssignedValues, cvWidth);
- end;
- Changed(True);
- end;
-
- procedure TKnotColumn.SetComment(const Value: string);
- begin
- FComment := Value;
- Include(FAssignedValues, cvComment);
- end;
-
- function TKnotColumn.IsCommentStored: Boolean;
- begin
- Result := (cvComment in FAssignedValues);
- end;
-
- function TKnotColumn.DefaultComment: string;
- begin
- Result := FName;
- end;
-
- function TKnotColumn.GetComment: string;
- begin
- if cvComment in FAssignedValues then
- Result := FComment
- else
- Result := DefaultComment;
- end;
-
- procedure TKnotColumn.SetDisplayFormat(const Value: string);
- begin
- if Value <> FDisplayFormat then
- begin
- FDisplayFormat := Value;
- Changed(False);
- end;
- end;
-
- procedure TKnotColumn.Changed(AllItems: Boolean);
- begin
- inherited;
- end;
-
- function TKnotColumn.GetActualWidth: TWidth;
- begin
- if cvWidth in FAssignedValues then
- Result := FWidth
- else
- Result := DefaultWidth;
- end;
-
- procedure TKnotColumn.SetIndex(Value: Integer);
- begin
- inherited;
- end;
-
- procedure TKnotColumn.SetFooterPanel(const Value: TKnotColumnFooterPanel);
- begin
- FFooterPanel.Assign(Value);
- end;
-
- { TKnotColumns }
-
- function TKnotColumns.Add: TKnotColumn;
- begin
- Result := TKnotColumn(inherited Add);
- end;
-
- constructor TKnotColumns.Create(AGrid: TDCCustomTreeGrid;
- AKnotColumnClass: TKnotColumnClass);
- begin
- inherited Create(AKnotColumnClass);
- FGrid := AGrid;
- end;
-
- function TKnotColumns.GetItem(Index: Integer): TKnotColumn;
- begin
- Result := TKnotColumn(inherited GetItem(Index));
- end;
-
- function TKnotColumns.GetOwner: TPersistent;
- begin
- Result := TPersistent(FGrid);
- end;
-
- procedure TKnotColumns.SetItem(Index: Integer; Value: TKnotColumn);
- begin
- inherited SetItem(Index, Value);
- end;
-
- procedure TKnotColumns.Update(Item: TCollectionItem);
- var
- Raw: Integer;
- begin
- if (Grid = nil) or (csLoading in Grid.ComponentState) then Exit;
- if Item = nil then
- begin
- Grid.LayoutChanged;
- Grid.UpdateColWidths(-1, True)
- end
- else begin
- Raw := Grid.DataToRawColumn(Item.Index);
- Grid.InvalidateCol(Raw);
- if kcSizing in TKnotColumn(Item).Options then
- Grid.FSizingIndex := Raw
- else
- Grid.FSizingIndex := -1;
- Grid.ColWidths[Raw] := TKnotColumn(Item).Width;
- end;
- if Grid.GroupBox.Count > 0 then Grid.GroupBox.Invalidate;
- end;
-
- { TKnotItem }
-
- procedure TKnotItem.Clear;
- var
- i, iCount: integer;
- begin
- {╙Σαδ σ∞ Γ±σ⌡ ∩ε≥ε∞ΩεΓ}
- iCount := ChildCount;
- for i := iCount-1 downto 0 do TKnotItem(FChildKnots.Items[i]).Free;
- end;
-
- procedure TKnotItem.Collapse(Recurse: boolean);
- var
- i: integer;
- begin
- if Expanded and HasChildren then
- begin
- Owner.BeginUpdate;
- Expanded := False;
- if Recurse then
- begin
- for i := 0 to ChildCount-1 do
- TKnotItem(FChildKnots.Items[i]).Collapse(Recurse);
- end;
-
- if Grid <> nil then Grid.DoCollapse(Self);
- Owner.EndUpdate;
- end;
- end;
-
- constructor TKnotItem.Create(AOwner: TKnotItems; AParent: TKnotItem; AName: string);
- begin
- inherited Create;
- FOwner := AOwner;
- FParent := AParent;
- FName := AName;
-
- FNormalImage := -1;
- FSelectImage := -1;
- FState := ksCreate;
-
- {
- Expanded := False;
- Visible := True;
- Enabled := True;
- HasChildren := False;
- LockItems := False;
- Changed := False;
- }
- FFlag := 6;
- end;
-
- destructor TKnotItem.Destroy;
- var
- Apply: boolean;
- AIndex: integer;
- begin
- if (Grid <> nil) and (KnotID <> 0) and (FState <> ksCreate)
- then begin
- Apply := True;
- Grid.DoDelete(Self, Apply, [csDestroying]);
- if Grid.SelectedRows.Find(KnotID, AIndex) then
- Grid.SelectedRows.FList.Delete(AIndex)
- end;
- Data := nil;
- {╙Σαδ σ∞ ∩ε≥ε∞ΩεΓ}
- Clear;
-
- if (FState <> ksCreate) and Assigned(FParent) then Owner.DeleteChildKnot(FParent, FIndex);
-
- if FChildKnots <> nil then FChildKnots.Free;
- FChildKnots := nil;
- inherited Destroy;
- end;
-
- procedure TKnotItem.Expand(Recurse: boolean);
- var
- i: integer;
- begin
- if not Expanded and HasChildren then
- begin
- Owner.BeginUpdate;
- Expanded := True;
- if Recurse then
- for i := 0 to ChildCount-1 do
- TKnotItem(FChildKnots.Items[i]).Expand(Recurse);
-
- if Grid <> nil then Grid.DoExpand(Self);
- Owner.EndUpdate;
- end;
- end;
-
- function TKnotItem.GetChild(Index: integer): TKnotItem;
- begin
- Result := TKnotItem(FChildKnots.Items[Index])
- end;
-
- function TKnotItem.GetChildCount: integer;
- begin
- if FChildKnots <> nil then
- Result := FChildKnots.Count
- else
- Result := 0;
- end;
-
- procedure TKnotItem.SetChild(Index: integer; const Value: TKnotItem);
- begin
- if Index < ChildCount then FChildKnots.Items[Index] := Value;
- end;
-
- procedure TKnotItem.SetData(const Value: Pointer);
- begin
- FData := Value;
- end;
-
- function TKnotItem.GetNext: TKnotItem;
- var
- ParentKnot: TKnotItem;
- begin
- if (ChildCount > 0) then
- Result := Childs[0]
- else begin
- Result := GetNextSibling;
- if Result = nil then
- begin
- ParentKnot := Parent;
- Result := ParentKnot.GetNextSibling;
- while (Result = nil) and (ParentKnot.Level > 0) do
- begin
- ParentKnot := ParentKnot.Parent;
- Result := ParentKnot.GetNextSibling
- end;
- end;
- end;
- end;
-
- function TKnotItem.GetNextVisible: TKnotItem;
- var
- i: integer;
- ParentKnot: TKnotItem;
- begin
- if Expanded and (ChildCount > 0) then
- begin
- i := 0;
- repeat
- Result := Childs[i];
- inc(i);
- until (i = ChildCount) or Result.Visible;
- if Result.Visible then Exit;
- end;
-
- Result := Self;
- repeat
- ParentKnot := Result.Parent;
- repeat
- if Result = nil then
- begin
- Result := ParentKnot;
- ParentKnot := Result.Parent;
- end;
- if Result = Owner.Root then
- begin
- Result := nil;
- Exit;
- end;
- Result := Result.GetNextSiblingVisible;
- until (Result <> nil) and Result.Visible;
-
- until Result.Visible;
- end;
-
- function TKnotItem.GetNextSibling: TKnotItem;
- begin
- if (FIndex >= 0) and (Parent <> nil) and (FIndex < (Parent.ChildCount-1)) then
- Result := Parent.Childs[FIndex+1]
- else
- Result := nil;
- end;
-
- function TKnotItem.GetPrev: TKnotItem;
- begin
- Result := GetPrevSibling;
- if Result = nil then
- Result := Parent
- else begin
- if Result <> nil then
- while Result.ChildCount > 0 do
- Result := Result.Childs[Result.ChildCount-1]
- end;
- end;
-
- function TKnotItem.GetPrevSibling: TKnotItem;
- begin
- if (FIndex > 0) and (FIndex < Parent.ChildCount) then
- Result := Parent.Childs[FIndex-1]
- else
- Result := nil
- end;
-
- function TKnotItem.GetPrevVisible: TKnotItem;
- var
- ParentKnot: TKnotItem;
- begin
- Result := Self;
-
- repeat
- ParentKnot := Result.Parent;
- Result := Result.GetPrevSiblingVisible;
-
- if Result = nil then
- Result := ParentKnot
- else
- while Result.Expanded and (Result.ChildCount > 0) do
- Result := Result.Childs[Result.ChildCount-1];
-
- if Result = Owner.Root then
- begin
- Result := nil;
- Exit;
- end;
-
- until Result.Visible;
- end;
-
- procedure TKnotItem.SetName(const Value: string);
- begin
- if FName <> Value then
- begin
- FName := Value;
- FOwner.UpdateTreeGrid;
- end;
- end;
-
- function TKnotItem.GetGrid: TDCCustomTreeGrid;
- begin
- Result := FOwner.Grid;
- end;
-
- procedure TKnotItem.SetState(const Value: TKnotState);
- begin
- FState := Value;
- end;
-
- function TKnotItem.GetFlagValue(const Index: Integer): boolean; assembler;
- asm
- mov eax, dword([eax].FFlag)
- bt eax, Index
- sbb eax, eax
- and eax, 1
- end;
-
- procedure TKnotItem.SetFlagValue(const Index: Integer; const Value: boolean); assembler;
- asm
- or Value, Value
- jz @@1
- bts [eax].FFlag, Index
- ret
- @@1:
- btr [eax].FFlag, Index
- end;
-
- procedure TKnotItem.SetValueEx(const Index: Integer;
- const Value: boolean);
- begin
- if GetFlagvalue(Index) <> Value then
- begin
- SetFlagValue(Index, Value);
- Owner.UpdateTreeGrid;
- end;
- end;
-
- function TKnotItem.GetVisibleChildCount: integer;
- var
- i, iCount: integer;
- begin
- Result := 0;
- iCount := ChildCount;
- for i := 0 to iCount-1 do if Childs[i].Visible then Inc(Result);
- end;
-
- function TKnotItem.GetVisibleKnotCount: integer;
- var
- i, iCount: integer;
- begin
- Result := 0;
- if Visible then
- begin
- Result := 1;
- if Expanded then
- begin
- iCount := ChildCount;
- for i := 0 to iCount-1 do Result := Result + Childs[i].GetVisibleKnotCount;
- end
- end;
- end;
-
- procedure TKnotItem.SetNormalImage(const Value: shortint);
- begin
- if FNormalImage <> Value then
- begin
- FNormalImage := Value;
- FOwner.UpdateTreeGrid;
- end;
- end;
-
- procedure TKnotItem.SetSelectImage(const Value: shortint);
- begin
- if FSelectImage <> Value then
- begin
- FSelectImage := Value;
- FOwner.UpdateTreeGrid;
- end;
- end;
-
- function TKnotItem.GetLevel: integer;
- var
- KnotItem: TKnotItem;
- begin
- Result := -1;
- KnotItem := Self;
- if Owner <> nil then
- begin
- while (KnotItem <> Owner.Root) and (KnotItem <> nil) do
- begin
- KnotItem := KnotItem.Parent;
- Inc(Result);
- end;
- end;
- end;
-
- procedure TKnotItem.SetVisible(const Value: boolean);
- var
- lHasChildren: boolean;
- begin
- if GetFlagvalue(1) <> Value then
- begin
- SetFlagValue(1, Value);
- lHasChildren := (Parent.VisibleChilds <> 0);
-
- if lHasChildren <> Parent.HasChildren then
- Parent.HasChildren := lHasChildren
- else
- Owner.UpdateTreeGrid;
- end;
- end;
-
- function TKnotItem.GetVisible: boolean;
- begin
- Result := GetFlagValue(1);
- end;
-
- function TKnotItem.DisplayRect(TextOnly: boolean): TRect;
- var
- KnotItem1, KnotItem2: TKnotItem;
- ItemVisible: boolean;
- Grid: TDCCustomTreeGrid;
- i: integer;
- begin
- {Chack Item Visible}
- SetRectEmpty(Result);
- Grid := GetGrid;
- if Grid <> nil then
- begin
- {Check Item Visible}
- KnotItem1 := Self;
- ItemVisible := KnotItem1.Visible;
- while ItemVisible and (KnotItem1 <> Owner.Root) do
- begin
- KnotItem1 := KnotItem1.Parent;
- ItemVisible := KnotItem1.Visible and KnotItem1.Enabled;
- end;
-
- KnotItem1 := Self;
- KnotItem2 := Grid.FFirstVisible;
- with Grid do Result := CellRect(FIndicatorOffset - 1, TopRow + FTitleOffset);
- i := Owner.ComparePos(KnotItem1, KnotItem2);
- if i > 0 then
- begin
- while KnotItem1 <> KnotItem2 do
- begin
- KnotItem1 := KnotItem1.GetNextVisible;
- OffsetRect(Result, 0, -Grid.DefaultRowHeight)
- end;
- end
- else begin
- while KnotItem1 <> KnotItem2 do
- begin
- KnotItem1 := KnotItem1.GetPrevVisible;
- OffsetRect(Result, 0, Grid.DefaultRowHeight)
- end;
- end;
- if TextOnly then Result.Left := Result.Left + Grid.GetTreeLableOffset(Self)
- end;
- end;
-
- procedure TKnotItem.EditText;
- begin
- {}
- end;
-
- procedure TKnotItem.EndEdit(Cancel: boolean);
- begin
- {}
- end;
-
- function TKnotItem.GetNextSiblingVisible: TKnotItem;
- begin
- Result := Self;
- repeat
- Result := Result.GetNextSibling;
- until (Result = nil) or Result.Visible;
- end;
-
- function TKnotItem.GetPrevSiblingVisible: TKnotItem;
- begin
- Result := Self;
- repeat
- Result := Result.GetPrevSibling;
- until (Result = nil) or Result.Visible;
- end;
-
- function TKnotItem.GetOwner: TKnotItems;
- begin
- Result := FOwner;
- end;
-
- function TKnotItem.GetParent: TKnotItem;
- begin
- Result := FParent;
- end;
-
- procedure TKnotItem.SetParent(const Value: TKnotItem);
- begin
- FParent := Value;
- end;
-
- { TKnotItems }
-
- function TKnotItems.Add(Name: string; Position: integer = KNOT_END): TKnotItem;
- begin
- Result := AddChild(FRootKnot, Name, Position)
- end;
-
- function TKnotItems.AddChild(ParentKnot: TKnotItem; Name: string;
- Position: integer = KNOT_END): TKnotItem;
- var
- KnotItem: TKnotItem;
- Apply: boolean;
- begin
- KnotItem := FKnotItemClass.Create(Self, ParentKnot, Name);
- Inc(FLastKnotID);
- KnotItem.FKnotID := FLastKnotID;
-
- Apply := True;
- if (Grid <> nil) then Grid.DoInsert(KnotItem, Apply);
-
- if Apply then
- begin
- BeginUpdate;
- if ParentKnot.FChildKnots = nil then ParentKnot.FChildKnots := TList.Create;
- case Position of
- KNOT_BEGIN:
- begin
- ParentKnot.FChildKnots.Insert(0, KnotItem);
- RebuildIndexes(ParentKnot, 0);
- end;
- KNOT_END:
- KnotItem.FIndex := ParentKnot.FChildKnots.Add(KnotItem);
- else begin
- ParentKnot.FChildKnots.Insert(Position, KnotItem);
- RebuildIndexes(ParentKnot, Position);
- end;
- end;
- Result := KnotItem;
- KnotItem.State := ksBrowse;
- ParentKnot.HasChildren := True;
- EndUpdate;
- end
- else begin
- Result := nil;
- KnotItem.Free;
- end;
-
- end;
-
- procedure TKnotItems.Clear;
- begin
- SetState(ksUpdate);
- FRootKnot.Clear;
- if FOwner <> nil then with FOwner do
- begin
- InitGridPos;
- TopRow := FTitleOffset;
- Row := FTitleOffset;
- end;
- SetState(ksBrowse);
- UpdateTreeGrid;
- end;
-
- constructor TKnotItems.Create(AOwner: TDCCustomTreeGrid;
- AKnotItemClass: TKnotItemClass);
- begin
- inherited Create;
- FOwner := AOwner;
-
- FKnotItemClass := AKnotItemClass;
- FRootKnot := TKnotItem.Create(Self, nil, NE_ROOT_KNOT);
- FRootKnot.Expanded := True;
-
- FLastKnotID := 0;
- FUpdateCount := 0;
-
- SetState(ksBrowse);
- end;
-
- function TKnotItems.Delete(Knot: TKnotItem): boolean;
- var
- Apply: boolean;
- begin
- if Knot <> nil then
- begin
- Apply := True;
- if (Grid <> nil) then Grid.DoDelete(Knot, Apply, []);
- if Apply then
- begin
- if Knot = Owner.FFirstVisible then
- begin
- Knot.Free;
- FOwner.InitGridPos;
- end
- else
- Knot.Free;
- SetState(ksBrowse);
- UpdateTreeGrid;
- end;
- Result := Apply;
- end
- else
- Result := False;
- end;
-
- destructor TKnotItems.Destroy;
- begin
- FState := ksUpdate;
- FRootKnot.Free;
- inherited;
- end;
-
- function TKnotItems.GetCount: integer;
- begin
- Result := FRootKnot.ChildCount;
- end;
-
- function TKnotItems.GetItem(Index: integer): TKnotItem;
- begin
- Result := FRootKnot.Childs[Index];
- end;
-
- procedure TKnotItems.SetItem(Index: integer; const Value: TKnotItem);
- begin
- FRootKnot.Childs[Index] := Value;
- end;
-
- procedure TKnotItems.Move(KnotItem, DestKnot: TKnotItem;
- Position: integer);
- var
- ParentKnot: TKnotItem;
- begin
- if DestKnot = nil then DestKnot := FRootKnot;
- ParentKnot := KnotItem.Parent;
-
- if ParentKnot.LockItems then Exit;
-
- DeleteChildKnot(ParentKnot, KnotItem.FIndex);
-
- if DestKnot.FChildKnots = nil then DestKnot.FChildKnots := TList.Create;
- case Position of
- KNOT_BEGIN :
- begin
- DestKnot.FChildKnots.Insert(0, KnotItem);
- RebuildIndexes(DestKnot, 0);
- end;
- KNOT_END :
- KnotItem.FIndex := DestKnot.FChildKnots.Add(KnotItem);
- else begin
- DestKnot.FChildKnots.Insert(Position, KnotItem);
- if Position > 0 then
- RebuildIndexes(DestKnot, Position-1)
- else
- RebuildIndexes(DestKnot, 0);
- end;
- end;
- KnotItem.Parent := DestKnot;
- UpdateTreeGrid;
- end;
-
- function TKnotItems.GetVisibleKnotCount: integer;
- var
- i: integer;
- begin
- Result := 0;
- for i := 0 to Count-1 do
- begin
- Result := Result + Items[i].VisibleKnotCount;
- end;
- end;
-
- procedure TKnotItems.BeginUpdate(LockScreen: boolean = False);
- begin
- if FUpdateCount = 0 then
- begin
- SetUpdateState(True);
- end;
- Inc(FUpdateCount);
- if LockScreen then
- begin
- FOwner.FLockScreen := LockScreen;
- FOwner.Refresh;
- ShowScrollBar(FOwner.Handle, SB_BOTH, False);
- ProcessPaintMessages;
- end;
- end;
-
- procedure TKnotItems.EndUpdate;
- var
- ScrollInfo: TScrollInfo;
- begin
- if FUpdateCount > 0 then begin
- Dec(FUpdateCount);
- if FUpdateCount = 0 then
- begin
- SetUpdateState(False);
- if FOwner.FLockScreen then
- begin
- with FOwner do
- begin
- FLockScreen := False;
- with ScrollInfo do
- begin
- cbSize := SizeOf(ScrollInfo);
- fMask := SIF_ALL;
- nMin := 0;
- nMax := 0;
- nPage := 0;
- nPos := 0;
- nTrackPos := 0;
- end;
- SetScrollInfo(Handle, SB_HORZ, ScrollInfo, True);
- SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
- ColWidthsChanged;
- RowHeightsChanged;
- Refresh;
- end;
- ProcessPaintMessages;
- end;
- UpdateTreeGrid;
- end;
- end;
- end;
-
- procedure TKnotItems.UpdateTreeGrid;
- begin
- if (FUpdateCount = 0) and (FOwner <> nil) then
- FOwner.Perform(CM_KNOTCHANGED, 0, 0);
- end;
-
- function TKnotItems.SelectKnot(KnotItem: TKnotItem; Offset: integer): TKnotItem;
- var
- AKnotItem: TKnotItem;
- AIndex: integer;
- begin
- Result := KnotItem;
- AIndex := Offset;
- AKnotItem := GetFirstVisibleNode;
- if AIndex >= 0 then
- begin
- while (Result <> nil) and (AIndex > 0) do
- begin
- AKnotItem := Result;
- Result := Result.GetNextVisible;
- Dec(AIndex);
- end;
- end
- else begin
- while (Result <> nil) and (AIndex < 0) do
- begin
- AKnotItem := Result;
- Result := Result.GetPrevVisible;
- Inc(AIndex);
- end;
- end;
- if Result = nil then Result := AKnotItem;
- end;
-
- procedure TKnotItems.RebuildIndexes(ParentKnot: TKnotItem; FirstIndex: integer);
- var
- i: integer;
- begin
- with ParentKnot do
- begin
- if LockItems then
- begin
- Changed := True;
- FLastIndex := _intMin(FLastIndex, FirstIndex);
- end
- else
- for i := FirstIndex to ChildCount-1 do Childs[i].FIndex := i;
- end;
- end;
-
- procedure TKnotItems.SetState(Value: TKnotState);
- begin
- if Value <> FState then
- begin
- FState := Value;
- with Grid do
- if tgIndicator in Options then InvalidateCell(0,Row)
- end;
- end;
-
- function TKnotItems.GetFirstNode: TKnotItem;
- begin
- if FRootKnot.ChildCount > 0 then
- Result := FRootKnot.GetNext
- else
- Result := nil;
- end;
-
- procedure TKnotItems.Exchange(KnotItem1, KnotItem2: TKnotItem);
- var
- ParentKnot1, ParentKnot2: TKnotItem;
- begin
- ParentKnot1 := KnotItem1.Parent;
- ParentKnot2 := KnotItem2.Parent;
-
- if ParentKnot1.LockItems or ParentKnot2.LockItems then Exit;
-
- ParentKnot1.Childs[KnotItem1.Index] := KnotItem2;
- ParentKnot2.Childs[KnotItem2.Index] := KnotItem1;
-
- if ParentKnot1 = ParentKnot2 then
- RebuildIndexes(ParentKnot1, _intMin(KnotItem1.Index, KnotItem2.Index))
- else begin
- RebuildIndexes(ParentKnot1, KnotItem1.Index);
- RebuildIndexes(ParentKnot2, KnotItem2.Index);
- end;
-
- UpdateTreeGrid;
- end;
-
- function TKnotItems.GetUpdateingState: boolean;
- begin
- Result := FUpdateCount <> 0;
- end;
-
- procedure TKnotItems.SetUpdateState(Updating: Boolean);
- begin
- {}
- end;
-
- procedure TKnotItems.LockRebuilds(KnotItem: TKnotItem; Lock: boolean);
- begin
- with KnotItem do
- begin
- LockItems := Lock;
- if Lock then
- begin
- Changed := False;
- FLastIndex := MaxInt;
- end
- else begin
- if Changed then Owner.RebuildIndexes(KnotItem, FLastIndex)
- end;
- end;
- end;
-
- procedure TKnotItems.DeleteChildKnot(KnotItem: TKnotItem; KnotIndex: integer);
- begin
- {╙ΣαδσφΦσ εΣφεπε Φτ child}
- with KnotItem do
- begin
- if KnotIndex < ChildCount then
- begin
- FChildKnots.Delete(KnotIndex);
- FOwner.RebuildIndexes(KnotItem, KnotIndex);
- if ChildCount = 0 then HasChildren := False;
- end;
- end;
- end;
-
- function TKnotItems.GetKnot(KnotID: integer; var KnotItem: TKnotItem): boolean;
- begin
- KnotItem := GetFirstNode;
- while (KnotItem <> nil) and (KnotItem.KnotID <> KnotID) do
- KnotItem := KnotItem.GetNext;
- Result := KnotItem <> nil;
- end;
-
- function TKnotItems.ComparePos(KnotItem1, KnotItem2: TKnotItem): integer;
- var
- KnotItemA, KnotItemB: TKnotItem;
-
- begin
- if (KnotItem1 = KnotItem2) or (KnotItem2 = nil) or (KnotItem1 = nil) then
- begin
- Result := 0;
- Exit;
- end;
-
- KnotItemA := KnotItem1;
- KnotItemB := KnotItem2;
- while KnotItemA.Level <> KnotItemB.Level do
- begin
- if KnotItemA.Level > KnotItemB.Level then
- KnotItemA := KnotItemA.Parent
- else
- KnotItemB := KnotItemB.Parent
- end;
- while KnotItemA.Parent <> KnotItemB.Parent do
- begin
- KnotItemA := KnotItemA.Parent;
- KnotItemB := KnotItemB.Parent;
- end;
-
- if (KnotItemA.Index > KnotItemB.Index) or
- ((KnotItemA.Index = KnotItemB.Index) and (KnotItem1.Level > KnotItem2.Level))then
- Result := -1
- else
- Result := 1
- end;
-
- function TKnotItems.GetFirstVisibleNode: TKnotItem;
- begin
- if FRootKnot.ChildCount > 0 then
- Result := FRootKnot.GetNextVisible
- else
- Result := nil;
- end;
-
- function TKnotItems.GetRootKnot: TKnotItem;
- begin
- Result := FRootKnot;
- end;
-
- { TKnotColumnTitle }
-
- procedure TKnotColumnTitle.Assign(Source: TPersistent);
- begin
- if Source is TKnotColumnTitle then
- begin
- if cvTitleAlignment in TKnotColumnTitle(Source).FColumn.FAssignedValues then
- Alignment := TKnotColumnTitle(Source).Alignment;
- if cvTitleColor in TKnotColumnTitle(Source).FColumn.FAssignedValues then
- Color := TKnotColumnTitle(Source).Color;
- if cvTitleCaption in TKnotColumnTitle(Source).FColumn.FAssignedValues then
- Caption := TKnotColumnTitle(Source).Caption;
- if cvTitleFont in TKnotColumnTitle(Source).FColumn.FAssignedValues then
- Font := TKnotColumnTitle(Source).Font;
- end
- else
- inherited Assign(Source);
- end;
-
- constructor TKnotColumnTitle.Create(Column: TKnotColumn);
- begin
- inherited Create;
-
- FColumn := Column;
- FCaption := 'DefaultCaption';
- FFont := TFont.Create;
- FFont.Assign(DefaultFont);
- FFont.OnChange := FontChanged;
- end;
-
- function TKnotColumnTitle.DefaultAlignment: TAlignment;
- begin
- Result := taLeftJustify;
- end;
-
- function TKnotColumnTitle.DefaultCaption: string;
- begin
- Result := FColumn.FName;
- end;
-
- function TKnotColumnTitle.DefaultColor: TColor;
- var
- TreeGrid: TDCCustomTreeGrid;
- begin
- TreeGrid := FColumn.GetGrid;
- if Assigned(TreeGrid) then
- Result := TreeGrid.FixedColor
- else
- Result := clBtnFace;
- end;
-
- function TKnotColumnTitle.DefaultFont: TFont;
- var
- TreeGrid: TDCCustomTreeGrid;
- begin
- TreeGrid := FColumn.GetGrid;
- if Assigned(TreeGrid) then
- Result := TreeGrid.Font
- else
- Result := FColumn.Font;
- end;
-
- destructor TKnotColumnTitle.Destroy;
- begin
- FFont.Free;
- inherited Destroy;
- end;
-
- procedure TKnotColumnTitle.FontChanged(Sender: TObject);
- begin
- Include(FColumn.FAssignedValues, cvTitleFont);
- FColumn.Changed(True);
- end;
-
- function TKnotColumnTitle.GetAlignment: TAlignment;
- begin
- if cvTitleAlignment in FColumn.FAssignedValues then
- Result := FAlignment
- else
- Result := DefaultAlignment;
- end;
-
- function TKnotColumnTitle.GetCaption: string;
- begin
- if cvTitleCaption in FColumn.FAssignedValues then
- Result := FCaption
- else
- Result := DefaultCaption;
- end;
-
- function TKnotColumnTitle.GetColor: TColor;
- begin
- if cvTitleColor in FColumn.FAssignedValues then
- Result := FColor
- else
- Result := DefaultColor;
- end;
-
- function TKnotColumnTitle.GetFont: TFont;
- var
- Save: TNotifyEvent;
- Def: TFont;
- begin
- if not (cvTitleFont in FColumn.FAssignedValues) then
- begin
- Def := DefaultFont;
- if (FFont.Handle <> Def.Handle) or (FFont.Color <> Def.Color) then
- begin
- Save := FFont.OnChange;
- FFont.OnChange := nil;
- FFont.Assign(DefaultFont);
- FFont.OnChange := Save;
- end;
- end;
- Result := FFont;
- end;
-
- function TKnotColumnTitle.IsAlignmentStored: Boolean;
- begin
- Result := (cvTitleAlignment in FColumn.FAssignedValues) and
- (FAlignment <> DefaultAlignment);
- end;
-
- function TKnotColumnTitle.IsCaptionStored: Boolean;
- begin
- Result := (cvTitleCaption in FColumn.FAssignedValues) and
- (FCaption <> DefaultCaption);
- end;
-
- function TKnotColumnTitle.IsColorStored: Boolean;
- begin
- Result := (cvTitleColor in FColumn.FAssignedValues) and (FColor <> DefaultColor);
- end;
-
- function TKnotColumnTitle.IsFontStored: Boolean;
- begin
- Result := (cvTitleFont in FColumn.FAssignedValues);
- end;
-
- procedure TKnotColumnTitle.RefreshDefaultFont;
- var
- Save: TNotifyEvent;
- begin
- if (cvTitleFont in FColumn.FAssignedValues) then Exit;
- Save := FFont.OnChange;
- FFont.OnChange := nil;
- try
- FFont.Assign(DefaultFont);
- finally
- FFont.OnChange := Save;
- end;
- end;
-
- procedure TKnotColumnTitle.RestoreDefaults;
- var
- FontAssigned: Boolean;
- begin
- FontAssigned := cvTitleFont in FColumn.FAssignedValues;
- FColumn.FAssignedValues := FColumn.FAssignedValues - ColumnTitleValues;
- FCaption := '';
- RefreshDefaultFont;
- FColumn.Changed(FontAssigned);
- end;
-
- procedure TKnotColumnTitle.SetAlignment(Value: TAlignment);
- begin
- if (cvTitleAlignment in FColumn.FAssignedValues) and (Value = FAlignment) then Exit;
- FAlignment := Value;
- Include(FColumn.FAssignedValues, cvTitleAlignment);
- FColumn.Changed(False);
- end;
-
- procedure TKnotColumnTitle.SetCaption(const Value: string);
- var
- Grid: TDCCustomTreeGrid;
- begin
- if not(cvTitleCaption in FColumn.FAssignedValues) or (Value <> FCaption) then
- begin
- Grid := Column.GetGrid;
- FCaption := Value;
- Include(Column.FAssignedValues, cvTitleCaption);
- Column.Changed(False);
- if Assigned(Grid) then with Grid do
- begin
- if LayoutLock = 0 then Grid.InternalLayout;
- if GroupingEnabled then GroupBox.UpdateItemSize(GroupBox.Find(DataToRawColumn(FColumn.Index)));
- end;
- end;
- end;
-
- procedure TKnotColumnTitle.SetColor(Value: TColor);
- begin
- if (cvTitleColor in FColumn.FAssignedValues) and (Value = FColor) then Exit;
- FColor := Value;
- Include(FColumn.FAssignedValues, cvTitleColor);
- FColumn.Changed(False);
- end;
-
- procedure TKnotColumnTitle.SetFont(Value: TFont);
- begin
- FFont.Assign(Value);
- Include(FColumn.FAssignedValues, cvTitleFont);
- FColumn.Changed(False);
- end;
-
- { TDCCustomTreeGrid }
-
- function TDCCustomTreeGrid.AcquireFocus: Boolean;
- begin
- Result := True;
- if CanFocus and not (csDesigning in ComponentState) then
- begin
- SetFocus;
- Result := Focused;
- end;
- end;
-
- function TDCCustomTreeGrid.AcquireLayoutLock: Boolean;
- begin
- Result := (FUpdateLock = 0) and (FLayoutLock = 0);
- if Result then BeginLayout;
- end;
-
- procedure TDCCustomTreeGrid.BeginLayout;
- begin
- BeginUpdate;
- if FLayoutLock = 0 then Columns.BeginUpdate;
- Inc(FLayoutLock);
- end;
-
- procedure TDCCustomTreeGrid.BeginUpdate;
- begin
- Inc(FUpdateLock);
- end;
-
- procedure TDCCustomTreeGrid.CellClick(Column: TKnotColumn);
- begin
- if Assigned(FOnCellClick) then FOnCellClick(Column);
- end;
-
- procedure TDCCustomTreeGrid.CellDblClick(Column: TKnotColumn);
- begin
- if Assigned(FOnCellDblClick) then FOnCellDblClick(Column);
- end;
-
- procedure TDCCustomTreeGrid.ClipClick(ACellType: TFixedCell);
- var
- CellType: TFixedCell;
- begin
- CellType := TKnotClipPopup(FClipPopup).CellType;
- HideClipPopup;
- if CellType <> ACellType then ShowClipPopup(ACellType, FClipPopup);
- end;
-
- procedure TDCCustomTreeGrid.CMCancelMode(var Message: TCMCancelMode);
- begin
- inherited;
- with Message do
- if (Sender <> Self) and (Sender <> FClipPopup) then HideClipPopup;
- end;
-
- procedure TDCCustomTreeGrid.CMExit(var Message: TMessage);
- begin
- try
- if (tgCancelOnExit in Options) then
- begin
- with FKnots do
- begin
- if (State = ksInsert) and not Modified then Delete(FSelectedKnot);
- if not HideEditor then
- begin
- SetFocus;
- Exit;
- end;
- SetState(ksBrowse);
- end;
- end;
- HideClipPopup;
- HideHintWindow;
- DoColumnComment(MODE_HIDEWINDOW, nil);
- except
- SetFocus;
- raise;
- end;
- inherited;
- end;
-
- procedure TDCCustomTreeGrid.CMKnotChanged(var Message: TMessage);
- begin
- DataChanged;
- end;
-
- procedure TDCCustomTreeGrid.CMParentFontChanged(var Message: TMessage);
- begin
- inherited;
- if ParentFont then
- begin
- FSelfChangingTitleFont := True;
- try
- TitleFont := Font;
- finally
- FSelfChangingTitleFont := False;
- end;
- LayoutChanged;
- end;
- end;
-
- procedure TDCCustomTreeGrid.ColumnMoved(FromIndex, ToIndex: Integer);
- begin
- inherited;
- FromIndex := RawToDataColumn(FromIndex);
- ToIndex := RawToDataColumn(ToIndex);
- Columns[FromIndex].Index := ToIndex;
- if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
- end;
-
- procedure TDCCustomTreeGrid.ColWidthsChanged;
- var
- I: Integer;
- begin
- if UpdateLocked then Exit;
- if AcquireLayoutLock then
- try
- inherited ColWidthsChanged;
- if FColumns.Count > 0 then
- for I := FIndicatorOffset to ColCount - 1 do
- FColumns[I - FIndicatorOffset].Width := ColWidths[I];
- if FEditorMode then
- InplaceUpdateLoc(FInplaceEdit, CellRect(FInplaceCol, FInplaceRow), Canvas);
- finally
- EndLayout;
- end;
- end;
-
- constructor TDCCustomTreeGrid.Create(AOwner: TComponent);
- var
- Bmp: TBitmap;
- begin
- inherited Create(AOwner);
- inherited DefaultDrawing := False;
- Bmp := TBitmap.Create;
- try
- Bmp.LoadFromResourceName(HInstance, bmExpand);
- FTreeImages := TImageList.CreateSize(Bmp.Width, Bmp.Height);
- FTreeImages.AddMasked(Bmp, Bmp.Canvas.Pixels[0,0]);
- Bmp.LoadFromResourceName(HInstance, bmCollapse);
- FTreeImages.AddMasked(Bmp, Bmp.Canvas.Pixels[0,0]);
- Bmp.LoadFromResourceName(HInstance, bmExpandR);
- FTreeImages.AddMasked(Bmp, Bmp.Canvas.Pixels[0,0]);
- Bmp.LoadFromResourceName(HInstance, bmCollapseR);
- FTreeImages.AddMasked(Bmp, Bmp.Canvas.Pixels[0,0]);
-
- FTreeImages.DrawingStyle := dsTransparent;
- finally
- Bmp.Free;
- end;
-
- FDefaultDrawing := True;
- FTitleOffset := 1;
- FIndicatorOffset := 1;
- FOptions := [tgEditing, tgTitles, tgIndicator, tgColumnResize,
- tgColLines, tgRowLines, tgTabs, tgConfirmDelete, tgCancelOnExit,
- tgTreePathResize, tgFixedLines, tgColMoving];
-
- FOptionsEx := [tgeInsertSelect, tgeMarkerMenu, tgeShadowSelection, tgeShowButtons];
-
- DesignOptionsBoost := [goColSizing];
- VirtualView := True;
- UsesBitmap;
-
- inherited Options := [goFixedHorzLine, goFixedVertLine, goHorzLine,
- goVertLine, goColSizing, goTabs];
-
- FKnots := CreateKnots;
- FColumns := CreateColumns;
-
- inherited RowCount := 2;
- inherited ColCount := 2;
-
- Color := clWindow;
- ParentColor := False;
- FTitleFont := TFont.Create;
- FTitleFont.OnChange := TitleFontChanged;
- FSaveCellExtents := False;
-
- FBookmarks := TKnotBookmarkList.Create(Self);
-
- FCurrentCol := -1;
- FMousePoint := Point(-1,-1);
- FClipDown := False;
- FFirstGridCell := 0;
- FTreepathWidth := 0;
-
- InitGridPos;
-
- FInplaceEdit := nil;
- FEditorMode := False;
- FInplaceCol := -1;
- FInplaceRow := -1;
- FIsESCKey := False;
- FIsModified := False;
- FRowUpdated := False;
-
- FHintRow := -1;
-
- FImageChangeLink := TChangeLink.Create;
- FImageChangeLink.OnChange := ImageListChange;
- FBookmarkSize := 20;
- FMouseDownRow := -1;
- FEditTimerID := -1;
- FColumnCell := -1;
- FLockScroll := False;
- FLockWindow := False;
-
- FSizingIndex := -1;
- FIndent := FTreeImages.Width + 2;
- FColumnFooter := TKnotColumnFooter.Create(Footers);
- FTreePath := TTreePath.Create(Self);
- end;
-
- procedure TDCCustomTreeGrid.CreateWnd;
- begin
- BeginUpdate; { prevent updates in WMSize message that follows WMCreate }
- try
- inherited CreateWnd;
- finally
- EndUpdate;
- end;
- UpdateRowCount;
-
- FClipPopup := TKnotClipPopup.Create(Self);
- TKnotClipPopup(FClipPopup).CellType := fcNone;
- end;
-
- procedure TDCCustomTreeGrid.DataChanged;
- begin
- if not HandleAllocated then Exit;
- UpdateRowCount;
- end;
-
- function TDCCustomTreeGrid.DataToRawColumn(ACol: Integer): Integer;
- begin
- Result := ACol + FIndicatorOffset;
- end;
-
- procedure TDCCustomTreeGrid.DblClick;
- var
- Cell: TGridCoord;
- P: TPoint;
- R: TRect;
- ARow: integer;
- begin
- if not AcquireFocus or FKnots.Updating then Exit;
-
- GetCursorPos(P);
- P := ScreenToClient(P);
- Cell := MouseCoord(P.X, P.Y);
- R := CellRect(Cell.X, Cell.Y);
-
- if (FKnots.Count > 0) and (Cell.Y >= FTitleOffset) then
- with Cell do
- begin
- BeginUpdate;
- try
- if (Y >= FTitleOffset) and (Y - Row <> 0) then
- begin
- ARow := Row;
- Row := Cell.Y;
- if (ARow<>Cell.Y) and (Row<>Cell.Y) and (ARow=Row) then Exit;
- end;
- if Cell.X < FIndicatorOffset then
- with FSelectedKnot do
- begin
- case GetFixedCellType(Cell.X, 0) of
- fcTreePath:
- if tgEditing in Options then
- begin
- case GetHitTestInfoAt(FSelectedKnot, P.X-R.Left, P.Y-R.Top) of
- htOnButton,
- htOnIcon ,
- htOnLabel :
- if HasChildren then
- begin
- if Expanded then
- Collapse(False)
- else
- Expand(False);
- end;
- end
- end
- else
- if HasChildren then
- begin
- if Expanded then
- Collapse(False)
- else
- Expand(False);
- end;
- end
- end
- else begin
- if tgTreePathCompletion in Options then with FSelectedKnot do
- begin
- if HasChildren then
- begin
- if Expanded then
- Collapse(False)
- else
- Expand(False);
- end;
- end;
- ShowEditor;
- end;
- finally
- EndUpdate;
- end;
- end
- else
- if (Cell.X >= FIndicatorOffset) and (FKnots.Count = 0) and
- (Cell.Y >= FTitleOffset)
- then begin
- ShowEditor;
- end;
-
- inherited;
- end;
-
- destructor TDCCustomTreeGrid.Destroy;
- begin
-
- if Assigned(FCurrentPos[1]) then FreeMem(FCurrentPos[1]);
- if Assigned(FCurrentPos[2]) then FreeMem(FCurrentPos[2]);
-
- if Assigned(FClipPopup) then TKnotClipPopup(FClipPopup).Free;
-
- FColumns.Free;
- FTreeImages.Free;
- FTitleFont.Free;
- FKnots.Free;
- FBookmarks.Free;
- ReleaseBitmap;
- FImageChangeLink.Free;
- FTreePath.Free;
- inherited;
- end;
-
- function TDCCustomTreeGrid.DrawTitleCell(ACanvas: TCanvas; ACol,
- ARow: Integer; ARect: TRect; BorderState: TDrawBorerState; AFillRect, ADraw: boolean): TPoint;
- const
- ColumnIndexStyle : array [TColumnIndexStyle] of Integer =
- (nbmIndexNone,nbmIndexAsc,nbmIndexDesc);
- AlignFlags : array [TAlignment] of Integer =
- ( DT_LEFT or DT_NOPREFIX or DT_END_ELLIPSIS,
- DT_RIGHT or DT_NOPREFIX or DT_END_ELLIPSIS,
- DT_CENTER or DT_NOPREFIX or DT_END_ELLIPSIS);
-
- var
- TitleRect, TextRect, DrawRect: TRect;
- Column: TKnotColumn;
- Indicators: TImageList;
-
- function DoPaint(Canvas: TCanvas; DrawRect: TRect): TPoint;
- var
- P: TPoint;
- W: integer;
- begin
- TextRect := DrawRect;
-
- Canvas.Font := Column.Title.Font;
- Canvas.Brush.Color := Column.Title.Color;
-
- if AFillRect then FillRect(Canvas.Handle, TextRect, Canvas.Brush.Handle);
-
- W := 0;
- if BorderState = dsDown then
- begin
- TextRect.Top := TextRect.Top + 1;
- OffsetRect(TextRect, 3, 0);
- end
- else
- TextRect.Left := TextRect.Left + 2;
-
- if (Column.Grid.Images <> nil) and (Column.ItemIndex <> -1) and
- ((TextRect.Right - TextRect.Left) > 0)
- then begin
- if ADraw then Column.Grid.Images.Draw(Canvas, TextRect.Left, TextRect.Top, Column.ItemIndex);
- TextRect.Left := TextRect.Left + Column.Grid.Images.Width + 2;
- W := Column.Grid.Images.Height - 1;
- end;
-
- if TextRect.Left < TextRect.Right then
- begin
- SetTextColor(Canvas.Handle, Canvas.Font.Color);
- case Column.Title.Alignment of
- taLeftJustify:
- if ADraw then
- P := DrawHighLightText(Canvas, PChar(Column.Title.Caption),
- TextRect, 1, DT_NOPREFIX)
- else
- P := DrawHighLightText(Canvas, PChar(Column.Title.Caption),
- TextRect, 0, DT_NOPREFIX);
- taCenter, taRightJustify:
- begin
- if (kcIndexed in Column.Options) and (Column.IndexStyle <> idxNone) then
- Dec(TextRect.Right, IndexTitleWidth + 2);
- P := DrawTitleRect(Canvas, TextRect, Column.Title.Caption,
- Column.Title.Alignment, ADraw)
- end;
- end;
- Result.Y := _intMax(P.Y, W);
- Result.X := P.X + 2;
- if (kcIndexed in Column.Options) and ((Column.IndexStyle <> idxNone) and
- ((IndexTitleWidth + 4) <= (TextRect.Right - TextRect.Left)) or not ADraw)
- then begin
- if ADraw then
- begin
- if Column.Title.Alignment = taCenter then
- P.X := (TextRect.Right + TextRect.Left - P.X) div 2 + P.X - 1;
- Indicators.Draw(Canvas, P.X + 2, TextRect.Top, ColumnIndexStyle[Column.IndexStyle]);
- end;
- Inc(Result.X, IndexTitleWidth + 4);
- end
- else
- Inc(Result.X, 2);
- end;
-
- end;
-
- begin
- if ACol < 0 then Exit;
-
- Column := Columns[ACol];
- TitleRect := ARect;
- Indicators := GDGetImages;
-
- with TitleRect do if Right - Left <= 0 then Exit;
-
- if AFillRect then
- begin
- DrawBitmap.Width := TitleRect.Right - TitleRect.Left;
- DrawBitmap.Height := TitleRect.Bottom - TitleRect.Top;
-
- with DrawBitmap do
- begin
- DrawRect := Rect(0,0, Width, Height);
- Result := DoPaint(Canvas, DrawRect);
- end;
- if ADraw then ACanvas.Draw(ARect.Left, ARect.Top, DrawBitmap);
- end
- else
- Result := DoPaint(ACanvas, ARect);
- end;
-
- procedure TDCCustomTreeGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
- AState: TGridDrawState);
- var
- FrameOffs: Byte;
- BorderState: TDrawBorerState;
- BorderStyle: TEdgeBorderStyle;
- DrawKnot: TKnotItem;
- DrawColumn: TKnotColumn;
- Highlight, KnotFound, CellBorder: boolean;
- ALeft, ATop, KnotIndex, Indicator, LineColor: integer;
- CellType: TFixedCell;
- DrawRect: TRect;
- Indicators: TImageList;
-
- procedure GetDrawState(Canvas: TCanvas; AColumn: TKnotColumn);
- begin
- Highlight := HighlightCell(ACol, ARow, AState, DrawKnot);
- with Canvas do
- begin
- if (gdFixed in AState) and CellBorder then
- begin
- if AColumn <> nil then
- begin
- Font := AColumn.Title.Font;
- Brush.Color := AColumn.Title.Color;
- end
- else begin
- Font := TreePath.Font;
- Brush.Color := TreePath.Color;
- end;
- end
- else begin
- if AColumn <> nil then
- begin
- Font := AColumn.Font;
- Brush.Color := AColumn.Color;
- end
- else begin
- Font := Self.Font;
- if CellBorder then
- Brush.Color := FixedColor
- else
- Brush.Color := Self.Color
- end;
- end;
-
- if (tgHighlightRow in Options) and (AlwaysShowSelection or
- Focused or (Row = FInplaceRow)) then
- begin
- if ARow = Row - FTitleOffset then
- begin
- if not Focused and (tgeShadowSelection in OptionsEx) then
- Brush.Color := clShadowed
- else begin
- if Highlight or not (tgMultiSelect in Options) then
- begin
- Brush.Color := clHighlight;
- Font.Color := clHighlightText;
- end;
- end;
- AState := AState + [gdFocused];
- end;
- if Highlight then
- begin
- if not Focused and (tgeShadowSelection in OptionsEx) then
- Brush.Color := clShadowed
- else begin
- if not (tgMultiSelect in Options) then
- begin
- Brush.Color := clRowHighlight;
- Font.Color := clTextHighlight;
- end
- else begin
- Brush.Color := clHighlight;
- Font.Color := clHighlightText;
- end;
- end;
- AState := AState + [gdSelected];
- end;
- end
- else
- if Highlight or (not (tgMultiSelect in Options) or (Knots.Count = 0)) and
- ((tgTitles in Options) and
- (ARow = (Row-FTitleOffset)) or ([tgTitles]*Options=[]) and (ARow=Row)) and
- ((tgRowSelect in Options) or
- (tgTreePathCompletion in Options) and (DrawKnot <> nil) and DrawKnot.HasChildren)
- then begin
- if AlwaysShowSelection or Focused then
- begin
- if not Focused and (tgeShadowSelection in OptionsEx) then
- Brush.Color := clShadowed
- else begin
- Brush.Color := clHighlight;
- Font.Color := clHighlightText;
- end;
- end;
- AState := AState + [gdFocused];
- end;
- end;
- end;
-
- procedure DrawTreePathCell(ARect, PieRect: TRect; var AState: TGridDrawState;
- KnotFound: boolean; DrawKnot: TKnotItem);
- var
- DrawRect, TextRect: TRect;
- ATop, ITop, nVisible: integer;
- Text: string;
- P: TPoint;
- PrevKnot, NextKnot: TKnotItem;
-
- {╞σδα≥σδⁿφε Γ√φσ±≥Φ Γ protected Φ ΣεßαΓΦ≥ⁿ Event CustomDrawItem}
- procedure DoDraw(Canvas: TCanvas);
- var
- j, ButtonSize, cx, cy, wx, hy: integer;
- FastDraw: boolean;
- LineColor: TColor;
- LRect: TRect;
- KnotItem: TKnotItem;
-
- procedure DrawLineX(Canvas: TCanvas; AColor: TColor; APos: TPoint;
- ALength: integer);
- var
- i: integer;
- begin
- for i := 0 to ALength do
- if i mod 2 = 1 then Canvas.Pixels[APos.X + i, APos.Y] := AColor;
- end;
- procedure DrawLineY(Canvas: TCanvas; AColor: TColor; APos: TPoint;
- ALength: integer);
- var
- i: integer;
- begin
- for i := 0 to ALength do
- if i mod 2 = 1 then Canvas.Pixels[APos.X, APos.Y + i] := AColor;
- end;
-
- begin
- if not((tgTreePathCompletion in Options) and
- (AState*[gdSelected, gdFocused] <> []) and KnotFound and DrawKnot.HasChildren) then
- begin
- if CellBorder then
- Canvas.Brush.Color := TreePath.Color
- else
- Canvas.Brush.Color := Self.Color;
- Canvas.Font := TreePath.Font;
- end;
- if tgeTreeSelect in OptionsEx then GetDrawState(Canvas, nil);
-
- LineColor := clBtnFace;
-
- if [tgColLines, tgRowLines] * Options = [tgRowLines] then
- begin
- if tgTreePathCompletion in Options then InflateRect(TextRect, 0, -1)
- end;
-
- FillRect(Canvas.Handle, TextRect, Canvas.Brush.Handle);
- ATop := (DrawRect.Top + DrawRect.Bottom - FTreeImages.Height) shr 1;
-
- if BorderState = dsDown then
- begin
- TextRect.Left := TextRect.Left + 3;
- TextRect.Top := TextRect.Top + 1;
- Inc(ATop);
- end
- else
- TextRect.Left := TextRect.Left + 2;
-
- {╨Φ±σ≤∞ δΦφφΦΦ}
-
- if tgTreePathCompletion in Options then
- begin
- if (tgFlatButtons in Options) and (tgRowLines in Options) then
- begin
- if KnotFound and (DrawKnot.Level > 0) then
- begin
- for j := 1 to DrawKnot.Level do
- begin
- Inc(TextRect.Left, Indent);
- Canvas.Pen.Color := LineColor;
- Canvas.PenPos := Point(TextRect.Left - 4, TextRect.Top - 1);
- Canvas.LineTo(TextRect.Left - 4, TextRect.Bottom + 1);
-
- Canvas.Pen.Color := Self.Color;
- Canvas.PenPos := Point(TextRect.Left - 3, TextRect.Top);
- Canvas.LineTo(TextRect.Left - 3, TextRect.Bottom + 1);
- end;
- end
- else;
- Canvas.Pen.Color := Self.Color;
- Canvas.PenPos := Point(TextRect.Left-3, TextRect.Top);
- Canvas.LineTo(TextRect.Right, TextRect.Top);
-
- Canvas.Pen.Color := LineColor;
- if tgColLines in Options then
- begin
- Canvas.PenPos := Point(TextRect.Left - 2, TextRect.Top - 1);
- Canvas.LineTo(TextRect.Right, TextRect.Top - 1);
- end;
- if tgDrawFixedLine in Options then
- begin
- Canvas.PenPos := Point(TextRect.Left - 2, TextRect.Bottom);
- Canvas.LineTo(TextRect.Right, TextRect.Bottom);
- Canvas.PenPos := Point(TextRect.Right, TextRect.Top);
- Canvas.LineTo(TextRect.Right, TextRect.Bottom + 1);
- end;
- InflateRect(TextRect, 0, -1);
- end
- else begin
- Canvas.Pen.Color := LineColor;
- Canvas.PenPos := Point(TextRect.Left - 2, TextRect.Bottom);
- Canvas.LineTo(TextRect.Right, TextRect.Bottom);
- if tgDrawFixedLine in Options then
- begin
- Canvas.PenPos := Point(TextRect.Right, TextRect.Top);
- Canvas.LineTo(TextRect.Right, TextRect.Bottom + 1);
- end;
- if KnotFound then Inc(TextRect.Left, DrawKnot.Level*Indent);
- end;
- end
- else
- if KnotFound then Inc(TextRect.Left, DrawKnot.Level*Indent);
-
- if not KnotFound then Exit;
-
- with DrawKnot do
- begin
- nVisible := VisibleChilds;
- if ((nVisible > 0) or HasChildren) and (tgeShowButtons in OptionsEx) then
- begin
- if DrawKnot.Expanded then
- begin
- if tgTreePathCompletion in Options then
- FTreeImages.Draw(Canvas, TextRect.Left, ATop + 1, nbmExpandR)
- else
- FTreeImages.Draw(Canvas, TextRect.Left, ATop + 1, nbmExpand)
- end
- else
- begin
- if tgTreePathCompletion in Options then
- FTreeImages.Draw(Canvas, TextRect.Left, ATop + 1, nbmCollapseR)
- else
- FTreeImages.Draw(Canvas, TextRect.Left, ATop + 1, nbmCollapse);
- end;
- end;
-
- if [tgeShowLines, tgeShowButtons] * OptionsEx <> [] then
- TextRect.Left := TextRect.Left + Indent + 1
- else
- Inc(TextRect.Left, 1);
-
- if (tgeShowLines in OptionsEx) and
- not(tgTreePathCompletion in Options) then
- begin
- ButtonSize := 5;
- LRect := TextRect;
- InflateRect(LRect, 0, 2);
- wx := LRect.Left - 2;
- hy := LRect.Bottom;
- cx := LRect.Left - Indent - 1 + ButtonSize;
- cy := LRect.Top + (LRect.Bottom - LRect.Top) div 2;
- if cy mod 2 = 0 then dec(cy);
-
- PrevKnot := DrawKnot.GetPrevVisible;
- NextKnot := DrawKnot.GetNextSiblingVisible;
-
- Canvas.Pen.Style := psSolid;
-
- if DrawKnot.HasChildren and (tgeShowButtons in OptionsEx) then
- DrawLineX(Canvas, clAppWorkSpace,
- Point(cx + ButtonSize, cy), wx - (cx + ButtonSize) + 1)
- else
- DrawLineX(Canvas, clAppWorkSpace, Point(cx - 1, cy), wx - cx + 1);
-
- if tgeShowButtons in OptionsEx then
- begin
- if PrevKnot <> nil then
- DrawLineY(Canvas, clAppWorkSpace, Point(cx, LRect.Top), hy - cy - ButtonSize);
-
- if NextKnot <> nil then
- DrawLineY(Canvas, clAppWorkSpace, Point(cx, cy + ButtonSize), hy - cy - ButtonSize);
-
- if (nVisible = 0) or not HasChildren then
- begin
- if PrevKnot <> nil then
- DrawLineY(Canvas, clAppWorkSpace, Point(cx, cy - ButtonSize), (ButtonSize + 2) div 2);
- if NextKnot <> nil then
- DrawLineY(Canvas, clAppWorkSpace, Point(cx, cy + 1), (ButtonSize + 2) div 2)
- end;
- end
- else begin
- if PrevKnot <> nil then
- DrawLineY(Canvas, clAppWorkSpace, Point(cx, LRect.Top), hy - cy);
-
- if NextKnot <> nil then
- DrawLineY(Canvas, clAppWorkSpace, Point(cx, cy - 1), hy - cy);
- end;
-
- KnotItem := DrawKnot.Parent;
- while KnotItem.Level <> -1 do
- begin
- cx := cx - Indent;
- if KnotItem.GetNextSiblingVisible <> nil then
- DrawLineY(Canvas, clAppWorkSpace, Point(cx, LRect.Top), hy - LRect.Top);
- KnotItem := KnotItem.Parent;
- end;
- end;
-
- if (Images <> nil) then
- begin
- if FImages.Height < TextRect.Bottom - TextRect.Top then
- ITop := (TextRect.Top + TextRect.Bottom - FImages.Height) shr 1
- else
- ITop := TextRect.Top;
- if (ARow = (Row-FTitleOffset)) then
- begin
- if(SelectImage <> -1) then
- begin
- FImages.Draw(Canvas, TextRect.Left, ITop, SelectImage);
- TextRect.Left := TextRect.Left + FImages.Width + 5
- end
- end
- else begin
- if(NormalImage <> -1) then
- begin
- FImages.Draw(Canvas, TextRect.Left, ITop, NormalImage);
- TextRect.Left := TextRect.Left + FImages.Width + 5
- end;
- end;
- end;
- FastDraw := GetTreePathCaption(DrawKnot, Text);
-
- if not(tgTreePathCompletion in Options) and not FastDraw then
- begin
- P := DrawHighLightText(Canvas, PChar(Text), TextRect, 0, 0, FImages);
- if P.Y < TextRect.Bottom - TextRect.Top then
- TextRect.Top := (TextRect.Top + TextRect.Bottom - P.Y) shr 1;
- DrawHighLightText(Canvas, PChar(Text), TextRect, 1, 0, FImages);
- end
- else
- DrawText(Canvas.Handle, PChar(Text), Length(Text), TextRect, DT_LEFT or DT_VCENTER or DT_SINGLELINE);
- end;
- end;
-
- begin
- if KnotFound then
- begin
- if not(DoubleBuffered or DefaultDrawing) then with DrawBitmap do
- begin
- Width := ARect.Right - ARect.Left;
- Height := ARect.Bottom - ARect.Top;
- DrawRect := Rect(0,0, Width, Height);
- end
- else
- DrawRect := ARect;
- TextRect := DrawRect;
-
- if not(DoubleBuffered or DefaultDrawing) then
- begin
- DoDraw(DrawBitmap.Canvas);
- with PieRect do
- BitBlt(Self.Canvas.Handle, Left, Top, Right- Left, Bottom - Top,
- DrawBitmap.Canvas.Handle, Left - ARect.Left, Top - ARect.Top, SRCCOPY);
- end
- else
- DoDraw(Canvas);
- end
- else begin
- if tgeTreeSelect in OptionsEx then GetDrawState(Canvas, nil);
- Canvas.FillRect(PieRect);
- end;
- end;
-
- function GetTreePathRect(ARow: integer; ARect: TRect): TRect;
- var
- R1, R2: TRect;
- TreeCol: integer;
-
- begin
- TreeCol := 0;
-
- if tgIndicator in Options then Inc(TreeCol);
- if tgMarker in Options then Inc(TreeCol);
-
- Inc(ARow, FTitleOffset);
- R1 := CellRect(TreeCol, ARow);
- R2 := CellRect(LeftCol + VisibleColCount, ARow);
- Result := Rect(R1.Left, ARect.Top, R2.Right, ARect.Bottom);
- end;
-
- procedure PaintLine(Canvas: TCanvas; ARect: TRect);
- begin
- Canvas.Pen.Color := Self.Color;
- Canvas.PenPos := Point(ARect.Left, ARect.Top);
- Canvas.LineTo(ARect.Right, ARect.Top);
- end;
-
- function DoDrawCell(Canvas: TCanvas): boolean;
- begin
- Result := False;
- with Canvas do
- begin
- GetDrawState(Canvas, DrawColumn);
- if not Enabled or
- ((DrawKnot <> nil) and not DrawKnot.Enabled) then Font.Color := clGrayText;
-
- if not (tgTreePathCompletion in Options) then
- begin
- FillRect(DrawRect);
- if KnotFound then
- DoDrawColumnCell(Canvas, DrawRect, ACol, DrawColumn, DrawKnot, AState);
- end
- else begin
- if KnotFound {and (DrawKnot.Data <> nil)} then
- begin
- if DrawKnot.HasChildren and not(kcDrawTreeCell in DrawColumn.Options) then
- begin
- if not(DoubleBuffered or DefaultDrawing) then
- DrawTreePathCell(GetTreePathRect(ARow, ARect), ARect, AState, KnotFound, DrawKnot)
- else begin
- if TreePathWidth = 0 then
- begin
- FillRect(DrawRect);
- DoDrawColumnCell(Canvas, DrawRect, ACol, DrawColumn, DrawKnot, AState);
- PaintLine(Canvas, DrawRect);
- end;
- end;
- Exit;
- end
- else begin
- FillRect(DrawRect);
- DoDrawColumnCell(Canvas, DrawRect, ACol, DrawColumn, DrawKnot, AState);
- PaintLine(Canvas, DrawRect);
- end;
- end
- else begin
- FillRect(DrawRect);
- PaintLine(Canvas, DrawRect);
- end;
- end
- end;
- Result := True;
- end;
-
- procedure DrawFixedBorder(ARect: TRect; Frame: boolean);
- begin
- if Frame then FrameRect(Canvas.Handle, ARect, Canvas.Brush.Handle);
- if tgDrawFixedLine in Options then
- begin
- LineColor := clSilver;
- if ColorToRGB(Color) = clSilver then LineColor := clGray;
- with Canvas do
- begin
- Pen.Color := Pen.Color -1;
- Pen.Color := LineColor;
- PenPos := Point(ARect.Right, ARect.Top);
- LineTo(ARect.Right, ARect.Bottom);
-
- PenPos := Point(ARect.Left, ARect.Bottom);
- LineTo(ARect.Right + 1, ARect.Bottom);
- end;
- end;
- end;
-
- procedure DrawBorderEx(ARect: TRect; ABorderState: TDrawBorerState);
- begin
- if (tgRowLines in Options) or (BorderStyle <> ebsNone) then
- begin
- if (BorderStyle = ebsNone) then
- begin
- if [tgColLines, tgRowLines, tgTreePathCompletion] * Options <> [tgRowLines] then
- InflateRect(ARect, 1, 1);
- DrawFixedBorder(ARect, True)
- end
- else begin
- InflateRect(ARect, 1, 1);
- DrawGridFrameBorder(Canvas, ARect, BorderStyle, ABorderState, FixedColor);
- end;
- end
- else
- if (BorderStyle = ebsNone) and (tgDrawFixedLine in Options) then
- DrawFixedBorder(ARect, False)
- end;
-
- procedure DrawFixedCellFrame(ACellType: TFixedCell; ImageIndex: integer);
- begin
- if FClipDown and (TKnotClipPopup(FClipPopup).CellType = ACellType) then
- begin
- if tgFixedLines in Options then
- Indicators.Draw(Canvas, ALeft, ATop+1, ImageIndex)
- else
- Indicators.Draw(Canvas, ALeft-1, ATop, ImageIndex);
- DrawBorderEx(ARect, dsDown);
- end
- else begin
- Indicators.Draw(Canvas, ALeft-1, ATop, ImageIndex);
- DrawBorderEx(ARect, dsUp);
- end;
- end;
-
- begin
- if (csLoading in ComponentState) then
- begin
- Canvas.Brush.Color := Color;
- Canvas.FillRect(ARect);
- Exit;
- end;
- BorderStyle := GetBorderStyle;
- Indicators := GDGetImages;
-
- if (ClickedCol <> -1) and (ACol= ClickedCol) then
- BorderState := dsDown
- else
- BorderState := dsUp;
-
- Dec(ARow, FTitleOffset);
- Dec(ACol, FIndicatorOffset);
-
- if (GetFixedCellType(ACol, FIndicatorOffset) = fcTreePath) and
- (tgeTreeSelect in OptionsEx) and not(tgTreePathCompletion in Options) and
- (ARow >= 0) then
- CellBorder := False
- else
- CellBorder := True;
-
- if CellBorder and (gdFixed in AState) and
- ([tgRowLines, tgColLines] * Options = [tgRowLines, tgColLines])
- then begin
- InflateRect(ARect, -1, -1);
- FrameOffs := 1;
- end
- else
- FrameOffs := 2;
-
- DrawKnot := FActiveKnot;
- if ARow >= 0 then
- begin
- KnotIndex := FFirstIndex;
- DrawKnot := FFirstVisible;
-
- while (KnotIndex <> ARow) and (DrawKnot <> nil) do
- begin
- DrawKnot := DrawKnot.GetNextVisible;
- Inc(KnotIndex);
- end;
- FActiveKnot := DrawKnot;
-
- if (DrawKnot <> nil) and (DrawKnot <> FKnots.Root) then
- KnotFound := True
- else
- KnotFound := False;
- end
- else
- KnotFound := False;
-
- if (gdFixed in AState) and (ACol < 0)
- then begin
- CellType := GetFixedCellType(ACol, FIndicatorOffset);
- if CellBorder then
- Canvas.Brush.Color := FixedColor
- else
- Canvas.Brush.Color := Self.Color;
- if (CellType <> fcTreePath) or (ARow<0) or not KnotFound then Canvas.FillRect(ARect);
- case CellType of
- fcIndicator:
- begin
- ALeft := (ARect.Right + ARect.Left - Indicators.Width - FrameOffs) shr 1 + 1;
- ATop := (ARect.Top + ARect.Bottom - Indicators.Height) shr 1;
- if ARow = (Row-FTitleOffset) then
- begin
- case FKnots.State of
- ksInsert: Indicator := nbmInsert;
- ksEdit : Indicator := nbmEdit;
- ksBrowse: Indicator := nbmArrow;
- else
- Indicator := nbmArrow;
- end;
- Indicators.Draw(Canvas, ALeft, ATop, Indicator, True);
- end;
- if ARow < 0 then
- begin
- if (tgeMarkerMenu in OptionsEx) then
- DrawFixedCellFrame(fcIndicator, nbmMain)
- else begin
- if not( not(tgRowLines in Options) and (BorderStyle = ebsNone) ) then
- begin
- InflateRect(ARect, 1, 1);
- if BorderStyle <> ebsNone then
- DrawGridFrameBorder(Canvas, ARect, BorderStyle, dsUp, FixedColor)
- else
- DrawFixedBorder(ARect, True);
- end;
- end;
- Exit;
- end;
- end;
- fcMarker:
- begin
- ALeft := (ARect.Right + ARect.Left - Indicators.Width - FrameOffs) shr 1 + 1;
- ATop := (ARect.Top + ARect.Bottom - Indicators.Height) shr 1 - 1;
- if (ARow >= 0) and KnotFound and
- FBookmarks.KnotSelected(DrawKnot.KnotID)
- then begin
- Inc(ALeft, 2);
- Indicators.Draw(Canvas, ALeft-1, ATop, nbmCheck);
- end;
- if ARow < 0 then
- begin
- DrawFixedCellFrame(fcMarker, nbmCheckHrd);
- Exit;
- end;
- end;
- fcTreePath :
- if ARow >= 0 then
- begin
- if tgTreePathCompletion in Options then
- begin
- if (tgRowLines in Options) then InflateRect(ARect, 0, 1);
- if (tgColLines in Options) then InflateRect(ARect, 1, 0);
- if (DrawKnot <> nil) and DrawKnot.HasChildren then
- begin
- GetDrawState(Canvas, nil);
- DrawTreePathCell(GetTreePathRect(ARow, ARect), ARect, AState, KnotFound, DrawKnot);
- end
- else begin
- DrawTreePathCell(ARect, ARect, AState, KnotFound, DrawKnot);
- end;
- Exit;
- end
- else
- DrawTreePathCell(ARect, ARect, AState, KnotFound, DrawKnot);
- end;
- end;
- end
- else with Canvas do
- begin
- if FColumns.Count > ACol then
- begin
- DrawColumn := Columns[ACol];
- if (ARow < 0) then
- begin
- if not(kcVisible in DrawColumn.Options) then Exit;
- DrawTitleCell(Canvas, ACol, ARow, ARect, BorderState, True, True);
- end
- else begin
- if not(kcVisible in DrawColumn.Options) or
- ((ARow=(FInplaceRow-FTitleOffset)) and
- (ACol=(FInplaceCol-FIndicatorOffset)))
- then Exit;
-
- if not(DoubleBuffered or DefaultDrawing) then
- begin
- DrawBitmap.Width := ARect.Right - ARect.Left;
- DrawBitmap.Height := ARect.Bottom - ARect.Top;
- with DrawBitmap, DrawBitmap.Canvas do
- begin
- DrawRect := Rect(0,0, Width, Height);
- if DoDrawCell(Canvas) then
- Self.Canvas.Draw(ARect.Left, ARect.Top, DrawBitmap);
- end;
- end
- else begin
- DrawRect := ARect;
- DoDrawCell(Canvas);
- end;
- end;
- end
- else begin
- if not (gdFixed in AState) then
- Brush.Color := Color
- else
- Brush.Color := FixedColor;
- Canvas.FillRect(ARect);
- end;
- end;
- if CellBorder and (gdFixed in AState) then DrawBorderEx(ARect, BorderState)
- end;
-
- procedure TDCCustomTreeGrid.EndLayout;
- begin
- if FLayoutLock > 0 then
- begin
- try
- try
- if FLayoutLock = 1 then
- begin
- InternalLayout;
- end;
- finally
- if FLayoutLock = 1 then
- FColumns.EndUpdate;
- end;
- finally
- Dec(FLayoutLock);
- EndUpdate;
- end;
- end;
- end;
-
- procedure TDCCustomTreeGrid.EndUpdate;
- begin
- if FUpdateLock > 0 then
- Dec(FUpdateLock);
- end;
-
- function TDCCustomTreeGrid.GetFixedCellType(ACol, AOffset: integer): TFixedCell;
- var
- i: integer;
- begin
- Result := fcColumn;
- ACol := ACol + AOffset;
- i := 0;
- if tgIndicator in Options then Inc(i,4);
- if tgMarker in Options then Inc(i,2);
- if tgTreePath in Options then Inc(i,1);
-
- if (ACol = 0) and ( (i=7) or (i=6) or (i=5) or (i=4) ) then
- Result := fcIndicator
- else
- if (ACol = 0) and ((i=2) or (i=3)) or
- (ACol = 1) and ((i=7) or (i=6)) then
- Result := fcMarker
- else
- if (ACol = 0) and (i=1) or
- (ACol = 1) and ((i=3) or (i=5)) or
- (ACol = 2) and (i=7) then
- Result := fcTreePath
- end;
-
- function TDCCustomTreeGrid.GetHitTestInfoAt(KnotItem: TKnotItem;
- X, Y: integer): TTreeGridHitTest;
- var
- BP: TPoint;
- ALevel: integer;
- begin
- Result := htNowere;
-
- with KnotItem do
- begin
- if [tgeShowLines, tgeShowButtons] * OptionsEx <> [] then
- ALevel := Level
- else
- ALevel := Level - 1;
-
- if HasChildren then
- begin
- BP.X := ALevel * Indent;
- BP.Y := (ALevel+1) * Indent + 1;
-
- if (X >= BP.X) and (X <= BP.Y) and (tgeShowButtons in OptionsEx) then
- begin
- Result := htOnButton;
- Exit;
- end;
-
- end
- else begin
- BP.X := (ALevel+1) * Indent;
- BP.Y := BP.X;
- end;
-
- if (X < BP.X) then
- Exit;
-
- if (Images<>nil) and
- ((KnotItem.KnotID = SelectedKnot.KnotID) and (SelectImage>-1) or
- (KnotItem.KnotID <> SelectedKnot.KnotID) and (NormalImage>-1))
- then begin
- BP.X := BP.Y + 1;
- BP.Y := BP.Y + Images.Width + 5;
-
- if (X >= BP.X) and (X <= BP.Y) then begin
- Result := htOnIcon;
- Exit;
- end;
-
- end;
-
- Result := htOnLabel;
- end;
- end;
-
- function TDCCustomTreeGrid.GetSelectedIndex: Integer;
- begin
- Result := RawToDataColumn(Col);
- end;
-
- function TDCCustomTreeGrid.GetTreePathWidth: integer;
- begin
- if not(tgTreePath in Options) then
- Result := 0
- else begin
- if GroupingEnabled and (GroupBox.Count > 0) then
- begin
- if tgTreePathCompletion in Options then
- Result := GroupBox.Count * Indent - 1
- else
- Result := GroupBox.Count * Indent + 3
- end
- else
- if FTreePathWidth <> 0
- then
- Result := FTreePathWidth
- else
- Result := TreeIconWidth;
- end;
- end;
-
- procedure TDCCustomTreeGrid.HideClipPopup;
- begin
- if FClipDown then
- begin
- TDCClipPopup(FClipPopup).Hide;
- ClickedCol := -1;
- SetClipDown(False);
- TKnotClipPopup(FClipPopup).CellType := fcNone;
- end;
- end;
-
- function TDCCustomTreeGrid.HighlightCell(DataCol, DataRow: Integer;
- AState: TGridDrawState; KnotItem: TKnotItem): Boolean;
- begin
- Result := False;
- if (tgMultiSelect in Options) and (FKnots.Count>0) then
- Result := FBookmarks.KnotSelected(KnotItem.KnotID);
- if Options * [tgMultiSelect, tgRowSelect] <> [tgMultiSelect, tgRowSelect] then
- begin
- if not Result then
- Result := (gdSelected in AState)
- and ((tgAlwaysShowSelection in Options) or Focused)
- and ((UpdateLock = 0) or (tgRowSelect in Options));
- end;
- end;
-
- procedure TDCCustomTreeGrid.InternalLayout;
- var
- AColCount, I, ATitleOffset: integer;
-
- procedure MeasureTitleHeights;
- var
- K: Integer;
- RestoreCanvas: Boolean;
- begin
- RestoreCanvas := not HandleAllocated;
- if RestoreCanvas then Canvas.Handle := GetDC(0);
- try
- Canvas.Font := Font;
- K := Canvas.TextHeight('Wg') + 3;
- if tgRowLines in Options then
- Inc(K, GridLineWidth);
- if not(tgUserRowHeight in Options) then
- DefaultRowHeight := K;
- SetTitleHeight;
- finally
- if RestoreCanvas then
- begin
- ReleaseDC(0, Canvas.Handle);
- Canvas.Handle := 0;
- end;
- end;
- end;
-
- begin
- FIndicatorOffset := 0;
- if tgIndicator in Options then Inc(FIndicatorOffset);
- if tgMarker in Options then Inc(FIndicatorOffset);
- if tgTreePath in Options then Inc(FIndicatorOffset);
- if (csLoading in ComponentState) then Exit;
-
- if HandleAllocated then KillMessage(Handle, CM_DEFERLAYOUT);
-
- DoubleBuffered := [tgTreePathCompletion, tgDrawFixedLine, tgDoubleBuffered]*Options <>[];
-
- if GroupingEnabled then GroupBox.FixedCols := FIndicatorOffset;
-
- AColCount := FIndicatorOffset;
- if FColumns.Count = 0 then Inc(AColCount) else Inc(AColCount, FColumns.Count);
- ColCount := AColCount;
-
- if inherited FixedCols <> FIndicatorOffset then
- begin
- inherited FixedCols := FIndicatorOffset;
- InitGridPos;
- end;
-
- ATitleOffset := FTitleOffset;
- if tgTitles in Options then
- FTitleOffset := 1
- else
- FTitleOffset := 0;
-
- MeasureTitleHeights;
- SetColumnAttributes;
- if ATitleOffset <> FTitleOffset then UpdateRowCount;
-
- Invalidate;
-
- if tgAutoSize in Options then
- begin
- if (FSizingIndex > -1) or FTreePathSizing then
- begin
- if FTreePathSizing then FSizingIndex := FIndicatorOffset - 1;
- I := FSizingIndex;
- FSizingIndex := -1;
- UpdateColWidths(I, i <> ColCount - 1);
- end
- else
- UpdateColWidths(-1, True);
-
- if FColumns.Count > 0 then
- for I := FIndicatorOffset to ColCount - 1 do
- FColumns[I - FIndicatorOffset].Width := ColWidths[I];
- end;
- end;
-
- procedure TDCCustomTreeGrid.InvalidateTitles;
- var
- R, R1: TRect;
- DrawInfo: TGridDrawInfo;
- begin
- if HandleAllocated and (tgTitles in Options) then
- begin
- CalcDrawInfo(DrawInfo);
- with DrawInfo.Horz do
- begin
- R1 := CellRect(LeftCol + VisibleColCount, 0);
- if not IsRectEmpty(R1) and (FFirstGridCell > FirstGridCell) then
- begin
- R := Rect(R1.Left, 0, R1.Right, DrawInfo.Vert.FixedBoundary);
- InvalidateRect(Handle, @R, False);
- end;
- FFirstGridCell := FirstGridCell;
- end;
- end;
- end;
-
- procedure TDCCustomTreeGrid.KeyDown(var Key: Word; Shift: TShiftState);
- var
- KeyDownEvent: TKeyEvent;
- DrawInfo: TGridDrawInfo;
- PageWidth, PageHeight: Integer;
-
- procedure CalcPageExtents;
- begin
- CalcDrawInfo(DrawInfo);
- PageWidth := DrawInfo.Horz.LastFullVisibleCell - LeftCol;
- if PageWidth < 1 then PageWidth := 1;
- PageHeight := DrawInfo.Vert.LastFullVisibleCell - TopRow;
- if PageHeight < 1 then PageHeight := 1;
- end;
-
- procedure Tab(GoForward: Boolean);
- var
- ACol, Original: Integer;
- begin
- ACol := Col;
- Original := ACol;
- BeginUpdate;
- try
- while True do
- begin
- if GoForward then
- Inc(ACol) else
- Dec(ACol);
- if ACol >= ColCount then
- begin
- NextRow(False, True, Shift);
- ACol := FIndicatorOffset;
- end
- else if ACol < FIndicatorOffset then
- begin
- PrevRow(False, Shift);
- ACol := ColCount - FIndicatorOffset;
- end;
- if (ACol = Original) or
- (Assigned(FInplaceEdit) and TDCCustomEdit(FInplaceEdit).ShowError) then Exit;
- if TabStops[ACol] then
- begin
- MoveCol(ACol, 0);
- Exit;
- end;
- end;
- finally
- EndUpdate;
- end;
- end;
-
- const
- RowMovementKeys = [VK_UP, VK_PRIOR, VK_DOWN, VK_NEXT, VK_HOME, VK_END];
- begin
- if not DataVisible then Exit;
- if (DragState <> dsNone) then
- begin
- inherited;
- Exit;
- end;
-
- if FClipDown then
- begin
- if Key = VK_ESCAPE then
- HideClipPopup
- else
- TKnotClipPopup(FClipPopup).KeyDown(Key, Shift);
- Key := 0;
- Exit;
- end;
-
- KeyDownEvent := OnKeyDown;
- if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
- if not CanGridAcceptKey(Key, Shift) or FKnots.Updating then Exit;
-
- with FKnots do
- if ssCtrl in Shift then
- begin
- if (Key in RowMovementKeys) then ClearSelection;
- case Key of
- VK_DELETE:
- DeleteRecords(not(tgConfirmDelete in Options) or False);
- VK_INSERT:
- begin
- if tgEditing in Options then
- begin
- ClearSelection;
- InsertKnot(FSelectedKnot, True, Shift);
- end;
- end;
- VK_LEFT: MoveCol(FIndicatorOffset, 1);
- VK_RIGHT: MoveCol(ColCount - 1, -1);
- VK_HOME:
- begin
- Row := FTitleOffset;
- MoveCol(FIndicatorOffset, 1);
- ClearSelection;
- end;
- VK_END:
- begin
- ClearSelection;
- Row := RowCount-1;
- MoveCol(ColCount - 1, -1);
- end;
- VK_NEXT, VK_PRIOR:
- begin
- ClearSelection;
- inherited;
- end;
- VK_UP, VK_DOWN: inherited;
- 65:{A} SelectItems(smSelect);
- end
- end
- else
- if not(ssAlt in Shift) then
- begin
- case Key of
- VK_DOWN:
- begin
- if (ssShift in Shift) and not (tgMultiSelect in Options) then
- begin
- MarkKnot;
- NextRow(False, False, Shift);
- end
- else
- NextRow(True, True, Shift);
- Key := 0;
- end;
- VK_UP:
- begin
- PrevRow(True, Shift);
- if ssShift in Shift then MarkKnot;
- Key := 0;
- end;
- VK_LEFT:
- begin
- if tgRowSelect in Options then
- PrevRow(False, Shift)
- else
- MoveCol(Col - 1, -1);
- end;
- VK_RIGHT:
- begin
- if tgRowSelect in Options then
- NextRow(False, False, Shift)
- else
- MoveCol(Col + 1, 1);
- end;
- VK_INSERT:
- begin
- if (tgeInsertSelect in OptionsEx) then
- begin
- ClearSelection;
- MarkKnot;
- NextRow(True, True, Shift);
- end
- else
- if tgEditing in Options then
- begin
- ClearSelection;
- InsertKnot(FSelectedKnot, False, Shift)
- end;
- end;
- VK_TAB:
- begin
- if not (ssAlt in Shift) then Tab(not (ssShift in Shift));
- Key := 0;
- end;
- VK_ESCAPE:
- begin
- inherited;
- if Key = VK_ESCAPE then
- begin
- FIsESCKey := True;
- ClearSelection;
- if not (tgAlwaysShowEditor in Options) and FEditorMode then
- begin
- FIsModified := False;
- HideEditor;
- end
- else
- if (State = ksInsert) then
- begin
- FRowUpdated := False;
- PrevRow(True, Shift);
- end;
- end;
- end;
- VK_HOME:
- if (ColCount = FIndicatorOffset+1) or (tgRowSelect in Options) then
- begin
- Row := FTitleOffset;
- MoveCol(FIndicatorOffset, 1);
- end
- else
- MoveCol(FIndicatorOffset, 1);
- VK_END:
- if (ColCount = FIndicatorOffset+1) or (tgRowSelect in Options) then
- begin
- Row := RowCount-1;
- MoveCol(ColCount - 1, -1);
- end
- else
- MoveCol(ColCount - 1, -1);
- VK_NEXT:
- begin
- CalcPageExtents;
- NextRow(False, False, Shift, PageHeight);
- end;
- VK_PRIOR:
- begin
- CalcPageExtents;
- PrevRow(False, Shift, PageHeight);
- end;
- VK_F2: ShowEditor;
- VK_DELETE:
- DeleteRecords(True);
- end;
- end;
- end;
-
- procedure TDCCustomTreeGrid.KeyPress(var Key: Char);
- var
- KeyPressEvent: TKeyPressEvent;
- begin
- if not DataVisible then Exit;
- KeyPressEvent := OnKeyPress;
- FIsESCKey := False;
- if (FKnots.Count > 0) and not(FEditorMode or FKnots.Updating) and (DragState = dsNone) then
- with FSelectedKnot do
- begin
- if HasChildren then
- begin
- case Key of
- '-':
- begin
- Collapse(False);
- Key := #0;
- end;
- '+':
- begin
- Expand(False);
- Key := #0;
- end;
- '*':
- begin
- Expand(True);
- Key := #0;
- end;
- end;
- end;
- end;
- if not (tgAlwaysShowEditor in Options) and (Key = Chr(VK_RETURN)) then
- begin
- if FEditorMode then
- begin
- if not FInplaceEdit.DropDownVisible then
- begin
- HideEditor;
- Key := #0;
- end
- end
- else begin
- ShowEditor;
- Key := #0;
- end;
- end;
- if Key = Chr(VK_TAB) then Key := #0;
-
- if Assigned(KeyPressEvent) then KeyPressEvent(Self, Key);
- end;
-
- procedure TDCCustomTreeGrid.LayoutChanged;
- begin
- if AcquireLayoutLock then
- EndLayout;
- end;
-
- procedure TDCCustomTreeGrid.Loaded;
- begin
- inherited Loaded;
- if FColumns.Count > 0 then
- ColCount := FColumns.Count;
- GroupBoxChanged;
- LayoutChanged;
- end;
-
- procedure TDCCustomTreeGrid.MouseDown(Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- var
- Cell, ACell: TGridCoord;
- GridOptions: TGridOptions;
- R: TRect;
- ARow: integer;
- CellType: TFixedCell;
- Selected: boolean;
- begin
- FMouseDownRow := -1;
- FreeEditTimer;
- if not AcquireFocus or FKnots.Updating or not DataVisible then Exit;
-
- if Y > 0 then
- begin
- Cell := MouseCoord(X, Y);
- R := CellRect(Cell.X, Cell.Y);
- CellType := GetFixedCellType(Cell.X, 0);
- if IsRectEmpty(R) then Exit;
-
- if (ssDouble in Shift) and (Button = mbLeft) then
- begin
- if (Cell.Y >= FTitleOffset) and
- ((Cell.X >= FIndicatorOffset) or (CellType = fcTreePath))
- then begin
- DblClick;
- if Cell.Y >= FTitleOffset then CellDblClick(Columns[SelectedIndex]);
- Exit;
- end;
- Shift := Shift - [ssDouble];
- end;
-
- FMousePoint := Point(X,Y);
-
- if (Button = mbLeft) and (Cell.Y = 0) then
- begin
- if (CellType = fcIndicator) and (tgeMarkerMenu in OptionsEx) or (CellType = fcMarker) then
- ClipClick(CellType)
- else
- HideClipPopup;
- end
- else
- HideClipPopup;
-
- if (tgTitleClicked in Options) and (tgTitles in Options) and
- (Button = mbLeft) and not Sizing(X, Y) and (Cell.Y=0) and (CellType = fcColumn)
- then begin
- ClickedCol := Cell.X;
- if not(tgColMoving in Options) then InvalidateCell(Cell.X, 0);
- end;
-
- if CellType = fcTreePath then
- begin
- FMouseDownRow := Row;
- end;
-
- if Sizing(X, Y) then
- begin
- HideEditor;
- if not FEditorMode then
- inherited MouseDown(Button, Shift, X, Y);
- Exit;
- end
- else
- FSizingIndex := -1;
-
- if (DragKind = dkDock) and (Cell.X < FIndicatorOffset) and
- (Cell.Y < FTitleOffset) and (not (csDesigning in ComponentState)) then
- begin
- BeginDrag(false);
- Exit;
- end;
-
- if ((csDesigning in ComponentState) or (tgColumnResize in Options)) and
- (Cell.Y < FTitleOffset) then
- begin
- if (tgTitleClicked in Options) and (Button = mbLeft) and (CellType = fcColumn) then
- begin
- HideEditor;
- if tgColMoving in Options then
- begin
- GridOptions := inherited Options;
- inherited Options := inherited Options - [goColMoving];
- inherited MouseDown(Button, Shift, X, Y);
- inherited Options := GridOptions;
- end
- else
- inherited MouseDown(Button, Shift, X, Y);
- end
- else inherited MouseDown(Button, Shift, X, Y);
- Exit;
- end;
-
- with Cell do
- begin
- BeginUpdate;
- try
- ARow := 0; ACell.X := 0; ACell.Y := 0;
- if (Y >= FTitleOffset) and (Y - Row <> 0) then
- begin
- ARow := Row;
- with FKnots do
- if (State = ksInsert) and not Modified then Delete(FSelectedKnot);
- ACell.Y := Y;
- end;
- if (X >= FixedCols) then ACell.X := X;
-
- if (ACell.X <> 0) and (ACell.Y <> 0) then
- MoveColRow(ACell.X, ACell.Y, True, True)
- else begin
- if (ACell.Y <> 0) or not (tgTitles in Options) then Row := Y;
- if ACell.X <> 0 then MoveCol(X, 0);
- end;
-
- if (ACell.Y <> 0) and (ARow <> Y) and (Row <> Y) and (ARow=Row) then Exit;
-
- if FKnots.Count > 0 then with FSelectedKnot do
- begin
- if FEditorMode then HideEditor;
- if not FEditorMode then
- begin
- if tgMultiSelect in Options then
- with FBookmarks do
- begin
- FSelecting := False;
- Selected := KnotSelected(KnotID);
- if Selected then
- begin
- {Check Drag&Drop !!}
- if ssCtrl in Shift then
- Select(FSelectedKnot, not Selected)
- else
- begin
- Clear;
- Select(FSelectedKnot, True);
- end;
- end
- else begin
- if ssCtrl in Shift then
- Select(FSelectedKnot, not Selected)
- else
- begin
- Clear;
- Select(FSelectedKnot, True);
- end;
- end;
- end;
- case CellType of
- fcMarker:
- with FBookmarks do
- begin
- Select(FSelectedKnot, not KnotSelected(KnotID));
- InvalidateCell(Cell.X, Cell.Y);
- end;
- fcTreePath:
- if HasChildren and
- (GetHitTestInfoAt(FSelectedKnot,
- FMousePoint.X-R.Left, FMousePoint.Y-R.Top) = htOnButton) then
- begin
- if Expanded then
- Collapse(False)
- else
- Expand(False);
- end
- end;
- end;
- end;
- finally
- EndUpdate;
- end;
- end;
- end
- else inherited;
- end;
-
- procedure TDCCustomTreeGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
- var
- Cell: TGridCoord;
- OldCurrentCol, LabelOffset: integer;
- R: TRect;
- KnotItem: TKnotItem;
- P: TPoint;
- Text: string;
- CellX, CellY: integer;
- begin
- if FKnots.Updating or not DataVisible then Exit;
- Cell := MouseCoord(X,Y);
- OldCurrentCol := FCurrentCol;
- if Cell.Y = 0
- then FCurrentCol := Cell.X
- else FCurrentCol := -1;
-
- if (DragState = dsNone) and
- (Cell.X >= FixedCols) and (ClickedCol=FCurrentCol) and (ClickedCol <> -1) and
- (FGridState <> gsColMoving) and (tgColMoving in Options) and
- ((Abs(FMousePoint.X - X) > 5) or (Abs(FMousePoint.Y - Y) > 5) ) then
- begin
- FGridState := gsColMoving;
- inherited MouseDown(mbLeft, Shift, FMousePoint.X, FMousePoint.Y);
- if (FGridState = gsColMoving) or (DragState = dsColMoving) then Exit;
- end;
-
- inherited MouseMove(Shift, X, Y);
-
- if (ClickedCol <> -1) and (FCurrentCol <> OldCurrentCol) and
- (FGridState <> gsColMoving) and (DragState = dsNone)and
- (GetFixedCellType(ClickedCol, 0) = fcColumn)
- then begin
- InvalidateCell(ClickedCol, 0);
- end;
-
- if not FKnots.Updating then
- begin
- if (GetFixedCellType(Cell.X, 0) = fcTreePath) and (Cell.Y >= FTitleOffset)
- then begin
- R := CellRect(Cell.X, Cell.Y);
- KnotItem := FKnots.SelectKnot(FFirstVisible, Cell.Y-FTitleOffset-FFirstIndex);
- if Assigned(KnotItem) and (KnotItem.Level > -1) then
- case GetHitTestInfoAt(KnotItem, X-R.Left, Y-R.Top) of
- htOnIcon ,
- htOnLabel :
- if not(tgTreePathCompletion in Options) then
- begin
- LabelOffset := GetHintTreeOffset(KnotItem, htOnLabel);
- GetTreePathCaption(KnotItem, Text);
- P := DrawHighLightText(Canvas, PChar(Text), Rect(0, 0, 0, 0), 0);
- Canvas.Font := Self.Font;
- if ((R.Left + LabelOffset + P.X + 2) > R.Right) and (X < R.Right)
- then begin
- if (FHintRow <> -1) and (FHintRow = Cell.Y) then Exit;
- CellX := Cell.X;
- CellY := Cell.Y;
- if (tgeTreeSelect in OptionsEx) and
- (tgRowLines in Options) then R.Left := R.Left - 1;
- ShowHintWindow(CellX, CellY, R.Left - 1, R.Top + 1, LabelOffset, Text);
- end
- else
- HideHintWindow;
- end;
- else
- HideHintWindow;
- end;
- end
- else begin
- HideHintWindow;
- if (Cell.Y < FTitleOffset) and (RawToDataColumn(Cell.X)>=0) and (Columns.Count > 0) then
- begin
- if RawToDataColumn(Cell.X) <> FColumnCell then
- begin
- FColumnCell := RawToDataColumn(Cell.X);
- DoColumnComment(MODE_SHOWWINDOW, Columns[FColumnCell]);
- end;
- end
- else begin
- DoColumnComment(MODE_HIDEWINDOW, nil);
- {Γ±≥αΓΦ≥ⁿ ∩≡εΓσ≡Ω≤ φα ∩εΣ±Γσ≥Ω≤ hinta σ±δΦ ≥σΩ±≥ φσ ∩ε∞σ∙ασ≥± Γ ≈σΘΩσ}
- end;
- end;
- end;
-
- end;
-
- procedure TDCCustomTreeGrid.MouseUp(Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- var
- Cell: TGridCoord;
- SaveState: TGridState;
- SaveDragState: TDragGridState;
- MouseClick: boolean;
- OldClickedCol: integer;
- R: TRect;
- begin
- SaveState := FGridState;
- SaveDragState := DragState;
-
- MouseClick := (ClickedCol <> -1) and (ClickedCol=FCurrentCol);
-
- inherited MouseUp(Button, Shift, X, Y);
- Cell := MouseCoord(X,Y);
-
- if FTreePathSizing and (SaveState = gsColSizing) then
- begin
- R := CellRect(FIndicatorOffset-1, Cell.Y);
- if (X-R.Left + FSizingOff) < TreeIconWidth then
- TreePathWidth := TreeIconWidth
- else
- TreePathWidth := X-R.Left+FSizingOff;
- end;
-
- if (Button = mbLeft) and (ClickedCol <> -1) then
- begin
- OldClickedCol := ClickedCol;
- ClickedCol := -1;
- InvalidateCell(OldClickedCol, 0);
- end;
-
- if (SaveState = gsRowSizing) or (SaveState = gsColSizing) or
- ((InplaceEditor <> nil) and (InplaceEditor.Visible) and
- (PtInRect(InplaceEditor.BoundsRect, Point(X,Y))))
- then
- Exit;
-
- if (Button = mbLeft) and (Cell.X >= FIndicatorOffset) and(Cell.Y >= 0) and
- (SaveState <> gsColMoving) and (RawToDataColumn(Cell.X) < Columns.Count) and
- (SaveDragState <> dsColMoving) and (SaveDragState <>dsHeaderMoving)
- then begin
- if (Cell.Y < FTitleOffset) and MouseClick then
- DoColumnClick(Shift, Cell.X)
- else
- CellClick(Columns[SelectedIndex]);
- end;
-
- if (GetFixedCellType(Cell.X, 0) = fcTreePath) and (FKnots.Count > 0) and
- (FMouseDownRow <> -1) and (FMouseDownRow = Cell.Y)
- then begin
- R := CellRect(Cell.X, Cell.Y);
- if GetHitTestInfoAt(FSelectedKnot, X-R.Left, Y-R.Top) = htOnLabel then
- begin
- if FEditTimerID = -1 then
- FEditTimerID := SetTimer(Handle, 101, GetDoubleClickTime, nil);
- end;
- FMouseDownRow := 1;
- end;
- end;
-
- procedure TDCCustomTreeGrid.MoveCol(RawCol, Direction: Integer);
- var
- OldCol: Integer;
- begin
- if RawCol >= ColCount then
- RawCol := ColCount - 1;
- if RawCol < FixedCols then RawCol := FixedCols;
- if Direction <> 0 then
- begin
- while (RawCol < ColCount) and (RawCol >= FIndicatorOffset) and
- (ColWidths[RawCol] <= 0) do
- Inc(RawCol, Direction);
- if (RawCol >= ColCount) or (RawCol < FIndicatorOffset) then Exit;
- end;
- OldCol := Col;
- if RawCol <> OldCol then
- begin
- FLockWindow := True;
- try
- Col := RawCol;
- finally
- FLockWindow := False;
- FLockScroll := False;
- end;
- end;
- end;
-
- function TDCCustomTreeGrid.RawToDataColumn(ACol: Integer): Integer;
- begin
- Result := ACol - FIndicatorOffset;
- end;
-
- procedure TDCCustomTreeGrid.RowHeightsChanged;
- var
- i,ThisHasChanged,Def : Integer;
- begin
- ThisHasChanged:=-1;
- Def:=DefaultRowHeight;
- for i:=Ord(tgTitles in Options) to RowCount do
- if RowHeights[i] <> Def then begin
- ThisHasChanged:=i;
- Break;
- end;
- if ThisHasChanged<>-1 then begin
- DefaultRowHeight:=RowHeights[i];
- if FLayoutLock = 0 then InternalLayout;
- end;
- inherited;
- SetTitleHeight;
- end;
-
- function TDCCustomTreeGrid.SelectCell(ACol, ARow: Integer): Boolean;
- var
- OldRect, NewRect: TRect;
- DrawInfo: TGridDrawInfo;
- begin
- Result := inherited SelectCell(ACol, ARow);
- DoSelectCell(Self, ACol, ARow, Result);
- if FEditorMode and Result then
- begin
- SendMessage(FInplaceEdit.Handle, CM_EXIT, 0, 0);
- if FInplaceEdit.ShowError then Result := False;
- end;
-
- if Result and ((ARow<>Row)or(ACol<>Col)) then
- if not (tgAlwaysShowEditor in Options) and FEditorMode then HideEditor;
-
- if Result and (ARow <> Row) then
- begin
- CalcDrawInfo(DrawInfo);
- FRowUpdated := False;
- SetSelectedKnot(FKnots.SelectKnot(FSelectedKnot, ARow - Row));
- OldRect := BoxRectEx(0 , Row , ColCount-1, Row );
- if ARow <= DrawInfo.Vert.LastFullVisibleCell then
- NewRect := BoxRectEx(0 , ARow, ColCount-1, ARow)
- else begin
- with DrawInfo.Vert do
- NewRect := BoxRectEx(0 , LastFullVisibleCell+1, ColCount-1, LastFullVisibleCell+1);
- end;
- ValidateRect(Handle, @OldRect);
- InvalidateRect(Handle, @OldRect, False);
- InvalidateRect(Handle, @NewRect, False);
- FKnots.SetState(ksBrowse);
- end;
- end;
-
- procedure TDCCustomTreeGrid.SetClipDown(const Value: boolean);
- begin
- if FClipDown <> Value then
- begin
- FClipDown := Value;
- if (tgIndicator in Options) then
- InvalidateCell(GetCellByType(TKnotClipPopup(FClipPopup).CellType), 0);
- end;
- end;
-
- procedure TDCCustomTreeGrid.SetColumnAttributes;
- var
- I, J: Integer;
-
- begin
- for I := 0 to FColumns.Count-1 do
- with FColumns[I] do
- begin
- TabStops[I + FIndicatorOffset] := ([kcVisible,kcReadOnly]*Options=[kcVisible]);
- ColWidths[I + FIndicatorOffset] := Width;
- end;
-
- J := 0;
- if (tgIndicator in Options) then
- begin
- ColWidths[J] := IndicatorWidth;
- Inc(J);
- end;
- if (tgMarker in Options) then
- begin
- ColWidths[J] := MarkerWidth;
- Inc(J);
- end;
- if (tgTreePath in Options) then
- ColWidths[J] := TreePathWidth;
-
- if FColumns.Count = 0 then ColWidths[FIndicatorOffset] := DefaultColWidth;
- end;
-
- procedure TDCCustomTreeGrid.SetColumns(const Value: TKnotColumns);
- begin
- Columns.Assign(Value);
- end;
-
- procedure TDCCustomTreeGrid.SetKnots(const Value: TKnotItems);
- begin
- FKnots.Assign(Value);
- DataChanged;
- end;
-
- procedure TDCCustomTreeGrid.SetOptions(Value: TTreeGridOptions);
- const
- LayoutOptions = [tgEditing, tgAlwaysShowEditor, tgTitles, tgIndicator,
- tgColLines, tgRowLines, tgRowSelect, tgAlwaysShowSelection, tgMarker,
- tgTitleClicked, tgHighlightRow, tgTreePath, tgCompleteLines,
- tgTreePathCompletion, tgDrawFixedLine, tgFixedLines, tgDoubleBuffered];
- var
- NewGridOptions: TGridOptions;
- ChangedOptions: TTreeGridOptions;
- begin
- if FOptions <> Value then
- begin
- NewGridOptions := [];
- if tgColLines in Value then
- NewGridOptions := NewGridOptions + [goFixedVertLine, goVertLine];
- if tgRowLines in Value then
- NewGridOptions := NewGridOptions + [goFixedHorzLine, goHorzLine];
- if tgColumnResize in Value then
- NewGridOptions := NewGridOptions + [goColSizing];
- if tgColMoving in Value then
- NewGridOptions := NewGridOptions + [goColMoving];
- if tgRowMoving in Value then
- NewGridOptions := NewGridOptions + [goRowMoving];
- if tgTabs in Value then Include(NewGridOptions, goTabs);
- if tgRowSelect in Value then
- begin
- Include(NewGridOptions, goRowSelect);
- Exclude(Value, tgAlwaysShowEditor);
- Exclude(Value, tgEditing);
- end;
-
- if tgHighlightRow in Value then
- begin
- Exclude(Value, tgRowSelect);
- end;
-
- if tgMultiSelect in (FOptions - Value) then ;
-
- if tgMultiSelect in Value then Value := Value - [tgMarker];
-
- if tgRowSizing in Value then
- begin
- NewGridOptions := NewGridOptions + [goRowSizing];
- Value := Value +[tgUserRowHeight];
- end;
-
- if tgFlatButtons in Value then
- NewGridOptions := NewGridOptions - [goFixedHorzLine, goFixedVertLine];
-
- inherited Options := NewGridOptions;
-
- ChangedOptions := (FOptions + Value) - (FOptions * Value);
- FOptions := Value;
-
- GridOptions := [];
- if tgAutoSize in Value then GridOptions := GridOptions + [goAutoSize];
-
- if ChangedOptions * LayoutOptions <> [] then LayoutChanged;
- if [tgFlatButtons, tgAutoSize] * ChangedOptions <> [] then
- begin
- LockUpdate;
- if tgAutoSize in ChangedOptions then ScrollBars := ScrollBars;
- RecreateWnd;
- UnlockUpdate;
- if tgAutoSize in ChangedOptions then LayoutChanged;
- end;
- end;
- end;
-
- procedure TDCCustomTreeGrid.SetSelectedIndex(Value: Integer);
- begin
- MoveCol(DataToRawColumn(Value), 0);
- end;
-
- procedure TDCCustomTreeGrid.SetTitleFont(const Value: TFont);
- begin
- FTitleFont.Assign(Value);
- if tgTitles in Options then LayoutChanged;
- end;
-
- procedure TDCCustomTreeGrid.SetTitleHeight;
- var
- I: Integer;
- Heights: array of Integer;
- P: TPoint;
- begin
- Canvas.Font := Font;
- if tgTitles in Options then
- begin
- SetLength(Heights, FTitleOffset);
- for I := 0 to FColumns.Count-1 do
- begin
- Canvas.Font := FColumns[I].Title.Font;
- P := DrawHighLightText(Canvas, PChar(FColumns[I].Title.Caption), Rect(0,0,0,0), 0);
- if P.Y > 0 then Inc(P.Y, 4);
- if (Images <> nil) and (FColumns[I].ItemIndex <> -1) then
- if P.Y < (Images.Height + 3) then P.Y := Images.Height+3;
- Heights[0] := _intMax(P.Y, Heights[0]);
- end;
- if Heights[0] = 0 then
- begin
- Canvas.Font := FTitleFont;
- Heights[0] := Canvas.TextHeight('Wg') + 4;
- end;
- RowHeights[0] := Heights[0];
- end;
- end;
-
- procedure TDCCustomTreeGrid.SetTreePathWidth(const Value: integer);
- var
- J: integer;
- begin
- if Value > 0 then
- begin
- FTreePathWidth := Value;
- J := 0;
- if (tgIndicator in Options) then Inc(J);
- if (tgMarker in Options) then Inc(J);
- if (tgTreePath in Options) and (J < ColCount) then
- begin
- FSizingIndex := J;
- ColWidths[J] := TreePathWidth;
- end;
- if csDesigning in ComponentState then UpdateDesigner;
- end;
- end;
-
- procedure TDCCustomTreeGrid.ShowClipPopup(ACellType: TFixedCell; AClipPopup: TObject);
- var
- lShow: boolean;
- R: TRect;
-
- begin
- if not HideEditor then Exit;
- lShow := True;
- R := CellRect(GetCellByType(ACellType), 0);
- with TDCClipPopup(AClipPopup), TKnotClipPopup(AClipPopup) do
- begin
- Hide;
- CellType := ACellType;
- AddButtons;
- SetBoundsEx(R.Left, R.Bottom, Width, Height);
-
- if Assigned(FOnClipClick) then FOnClipClick(AClipPopup, Left, Top, lShow);
-
- if lShow then
- begin
- ClipDown := not ClipDown;
- OnButtonClick := ClipButtonClick;
- Show;
- end
- else
- HideClipPopup;
- end;
- end;
-
- procedure TDCCustomTreeGrid.TitleClick(Column: TKnotColumn);
- begin
- if Assigned(FOnTitleClick) then FOnTitleClick(Column);
- end;
-
- procedure TDCCustomTreeGrid.TitleFontChanged(Sender: TObject);
- begin
- if (not FSelfChangingTitleFont) and not (csLoading in ComponentState) then
- ParentFont := False;
- if tgTitles in Options then LayoutChanged;
- end;
-
- procedure TDCCustomTreeGrid.TopLeftChanged;
- begin
- if tgTreePathCompletion in Options then InvalidateRect(Handle, nil, False);
- if not FKnots.Updating then
- begin
- FFirstVisible := FKnots.SelectKnot(FFirstVisible, TopRow - FFirstIndex - FTitleOffset);
- FFirstIndex := TopRow - FTitleOffset;
- if FEditorMode and (FInplaceEdit <> nil) then
- InplaceUpdateLoc(FInplaceEdit, CellRect(FInplaceCol, FInplaceRow), Canvas);
- end;
- HideHintWindow;
- inherited;
- if Assigned(FOnTopLeftChanged) then FOnTopLeftChanged(Self);
- end;
-
- procedure TDCCustomTreeGrid.UpdateActive;
- begin
- if FKnots.Count > 0 then
- begin
- FFirstVisible := FKnots.SelectKnot(FKnots.GetFirstVisibleNode, FFirstIndex);
- if FFirstIndex <> TopRow - FTitleOffset then
- begin
- FFirstVisible := FKnots.SelectKnot(FFirstVisible, TopRow - FFirstIndex - FTitleOffset);
- FFirstIndex := TopRow - FTitleOffset;
- end;
- SetSelectedKnot(FKnots.SelectKnot(FFirstVisible, Row - TopRow));
- end
- else
- InitGridPos;
- end;
-
- procedure TDCCustomTreeGrid.UpdateRowCount;
- var
- NewFixedRows: integer;
- begin
- NewFixedRows := FTitleOffset;
-
- if RowCount <= NewFixedRows then RowCount := NewFixedRows + 1;
-
- if FixedRows <> NewFixedRows then
- begin
- FixedRows := NewFixedRows;
- InitGridPos;
- end;
- FKnotCount := FKnots.VisibleKnotCount;
- if FKnotCount = 0 then
- RowCount := 1 + NewFixedRows
- else
- RowCount := FKnotCount + NewFixedRows;
- UpdateActive;
- Invalidate;
- end;
-
- procedure TDCCustomTreeGrid.WMKillFocus(var Message: TMessage);
- begin
- inherited;
- HideClipPopup;
- InvalidateSelected;
- end;
-
- procedure TDCCustomTreeGrid.WMSetFocus(var Message: TWMSetFocus);
- begin
- inherited;
- HideClipPopup;
- MoveCol(Col, 1);
- InvalidateSelected;
- end;
-
- procedure TDCCustomTreeGrid.WMSize(var Message: TWMSize);
- begin
- UpdateColWidths(-1, True);
- inherited;
- InvalidateTitles;
- if FLockScreen or not DataVisible or (Footers.Height > 0) then Invalidate;
- end;
-
- function TDCCustomTreeGrid.HideEditor: boolean;
- var
- UpdateRect: TRect;
- begin
- if Assigned(FInplaceEdit) and FEditorMode then
- begin
- if FIsModified then
- begin
- Result := FInplaceEdit.ValueCorrect;
- if not Result then
- begin
- FInplaceEdit.ShowErrorMessage;
- Exit;
- end;
- if FInplaceEdit.ErrorCode = ERR_EDIT_NONE then UpdateEditData;
- end;
- if GetFocus = FInplaceEdit.Handle then Windows.SetFocus(Handle);
-
- FEditorMode := False;
- FInplaceEdit.Free;
- FInplaceEdit := nil;
-
- UpdateRect := BoxRectEx(0, FInplaceRow , ColCount - 1, FInplaceRow );
- ValidateRect(Handle, @UpdateRect);
- InvalidateRect(Handle, @UpdateRect, False);
- FInplaceCol := -1;
- FInplaceRow := -1;
- FIsESCKey := False;
- FRowUpdated := FRowUpdated or FIsModified;
-
- DoDestroyCellEdit;
- FSelectedKnot.State := ksBrowse;
-
- end
- else begin
- if Assigned(FInplaceEdit) then Windows.SetFocus(Handle);
- end;
-
- FIsModified := False;
- Result := True;
- end;
-
- procedure TDCCustomTreeGrid.ShowEditor;
-
- procedure UpdateEditor;
- begin
- FInplaceCol := Col;
- FInplaceRow := Row;
- FInplaceEdit.SelectAll;
- end;
-
- var
- Column: TKnotColumn;
- Key: Word;
- CanCreate: boolean;
- AState: TKnotState;
- begin
- if not(tgEditing in Options) or (Columns.Count=0) then Exit;
- Column := Columns[Col-FIndicatorOffset];
-
- if not(kcShowEdit in Column.Options) or
- (FSelectedKnot <> nil) and not FSelectedKnot.Enabled or
- (tgTreePathCompletion in Options) and (FSelectedKnot <> nil) and FSelectedKnot.HasChildren then Exit;
-
- with FKnots do
- if Count = 0 then begin
- Key := VK_DOWN;
- KeyDown(Key, []);
- if FSelectedKnot = nil then Exit;
- end;
-
- if FEditorMode then HideEditor;
-
- if Assigned(FSelectedKnot) then
- begin
- AState := FSelectedKnot.State;
- FSelectedKnot.State := ksEdit;
- end
- else
- AState := ksBrowse;
-
- DoCreateCellEdit(Column, FInplaceEdit, CanCreate);
-
- if Assigned(FInplaceEdit) then
- begin
- FEditorMode := True;
- FIsModified := False;
- with FInplaceEdit do
- begin
- Visible := False;
- ReadOnly := kcReadOnly in Column.Options ;
- if Options * [tgColLines, tgRowLines] = [tgColLines, tgRowLines] then
- DrawStyle := fsNone
- else
- DrawStyle := fsSingle;
- end;
- UpdateEditor;
- InplaceUpdateLoc(FInplaceEdit, CellRect(Col, Row), Canvas);
- end
- else
- if Assigned(FSelectedKnot) then FSelectedKnot.State := AState;
- end;
-
- procedure TDCCustomTreeGrid.DoCreateCellEdit(Column: TKnotColumn;
- var Edit: TDCCustomChoiceEdit; var CanCreate: boolean);
- begin
- CanCreate := True;
- if Assigned(FOnCreateCellEdit) then
- FOnCreateCellEdit(SelectedKnot, Edit, Column, CanCreate)
- else
- Edit := nil;
- end;
-
- procedure TDCCustomTreeGrid.CMInvalidValue(var Message: TMessage);
- begin
- if FIsESCKey then
- Message.Result := Integer(True)
- else
- Message.Result := Integer(False);
- end;
-
- function TDCCustomTreeGrid.Modified: boolean;
- begin
- Result := FIsModified or FRowUpdated;
- end;
-
- procedure TDCCustomTreeGrid.SetModified(Value: boolean);
- begin
- if FIsModified <> Value then
- begin
- FIsModified := Value;
- if FKnots.State <> ksInsert then
- FKnots.SetState(ksEdit);
- end;
- end;
-
- procedure TDCCustomTreeGrid.UpdateEditData;
- begin
- if SelectedKnot <> nil then
- begin
- if (FInplaceCol >= FIndicatorOffset) then
- DoUpdate(SelectedKnot, FInplaceEdit, FColumns[FInplaceCol-FIndicatorOffset])
- else
- DoUpdate(SelectedKnot, FInplaceEdit, nil);
- end;
- end;
-
- procedure TDCCustomTreeGrid.WMChar(var Msg: TWMChar);
- begin
- if not DataVisible then Exit;
- if (tgEditing in Options) and (Char(Msg.CharCode) in [^H, #32..#255]) then
- if not FEditorMode and (Char(Msg.CharCode) in ['+', '-', '*']) then
- inherited
- else begin
- if not ShowEditorChar(Char(Msg.CharCode)) then inherited
- end
- else
- inherited;
- end;
-
- function TDCCustomTreeGrid.ShowEditorChar(Ch: Char): boolean;
- begin
- Result := True;
- if not FEditorMode then
- begin
- ShowEditor;
- if FInplaceEdit <> nil then
- PostMessage(FInplaceEdit.Handle, WM_CHAR, Word(Ch), 0)
- else
- Result := False;
- end;
- end;
-
- procedure TDCCustomTreeGrid.CalcSizingState(X, Y: Integer;
- var State: TGridState; var Index, SizingPos, SizingOfs: Integer;
- var FixedInfo: TGridDrawInfo);
- var
- EffectiveOptions: TGridOptions;
- ACol, AWidth: integer;
-
- procedure CalcAxisState(const AxisInfo: TGridAxisDrawInfo; Pos: Integer;
- NewState: TGridState);
- var
- I, Line, Back, Range, J: Integer;
- begin
- if UseRightToLeftAlignment then
- Pos := ClientWidth - Pos;
- with AxisInfo do
- begin
- Range := EffectiveLineWidth;
- Back := 0;
- if Range < 7 then
- begin
- Range := 7;
- Back := (Range - EffectiveLineWidth) shr 1;
- end;
-
- if tgTreePath in Options then
- begin
- Line := FixedBoundary;
- if not(Line > GridBoundary) and
- (Pos >= Line - Back) and (Pos <= Line - Back + Range) then
- begin
- State := NewState;
- SizingPos := Line;
- SizingOfs := Line - Pos;
- Index := -1;
- Exit;
- end;
- end;
-
- Line := FixedBoundary;
- J := FirstGridCell;
- for I := J to GridCellCount - 1 do
- begin
- Inc(Line, GetExtent(I));
- if Line > GridBoundary then Break;
- if (Pos >= Line - Back) and (Pos <= Line - Back + Range) then
- begin
- State := NewState;
- SizingPos := Line;
- SizingOfs := Line - Pos;
- Index := I;
- Exit;
- end;
- Inc(Line, EffectiveLineWidth);
- end;
- if (GridBoundary = GridExtent) and (Pos >= GridExtent - Back)
- and (Pos <= GridExtent) then
- begin
- State := NewState;
- SizingPos := GridExtent;
- SizingOfs := GridExtent - Pos;
- Index := I;
- // Index := LastFullVisibleCell + 1;
- end;
- end;
- end;
-
- function XOutsideHorzFixedBoundary: Boolean;
- begin
- with FixedInfo do
- if not UseRightToLeftAlignment then
- Result := X > (Horz.FixedBoundary-AWidth)
- else
- Result := X < ClientWidth - (Horz.FixedBoundary-AWidth);
- end;
-
- function XOutsideOrEqualHorzFixedBoundary: Boolean;
- begin
- with FixedInfo do
- if not UseRightToLeftAlignment then
- Result := X >= (Horz.FixedBoundary-AWidth)
- else
- Result := X <= ClientWidth - (Horz.FixedBoundary-AWidth);
- end;
-
- begin
- if not(tgTitles in Options) and not(tgColumnSizing in Options)then Y := -1;
-
- ACol := 0; AWidth := 0;
-
- FTreePathSizing := False;
- if tgTreePath in Options then
- begin
- AWidth := TreePathWidth;
- with FixedInfo do
- begin
- if not(tgTreePathResize in Options) or GroupingEnabled then
- FTreePathSizing := False
- else
- if not UseRightToLeftAlignment then
- FTreePathSizing := (X > (Horz.FixedBoundary-AWidth)) and
- (X < Horz.FixedBoundary)
- else
- FTreePathSizing := (X < ClientWidth - (Horz.FixedBoundary-AWidth)) and
- (X < ClientWidth - Horz.FixedBoundary);
- if (tgAutoSize in Options) and (Horz.FixedBoundary = Horz.GridBoundary) then
- FTreePathSizing := False;
- end;
- end;
-
- State := gsNormal;
- Index := -1;
- EffectiveOptions := inherited Options;
- if csDesigning in ComponentState then
- EffectiveOptions := EffectiveOptions + DesignOptionsBoost;
- if [goColSizing, goRowSizing] * EffectiveOptions <> [] then
- with FixedInfo do
- begin
- Vert.GridExtent := ClientHeight;
- Horz.GridExtent := ClientWidth;
- if (Y > 0) and (XOutsideHorzFixedBoundary) and (goColSizing in EffectiveOptions) then
- begin
- if (Y >= Vert.FixedBoundary) and not(tgColumnSizing in Options) then Exit;
- CalcAxisState(Horz, X, gsColSizing);
- end
- else if (Y > Vert.FixedBoundary) and (goRowSizing in EffectiveOptions) then
- begin
- if XOutsideOrEqualHorzFixedBoundary then Exit;
- CalcAxisState(Vert, Y, gsRowSizing);
- end;
- end;
-
- if (State = gsColSizing)then
- begin
- ACol := RawToDataColumn(Index);
- if (ACol >= 0) and (ACol < Columns.Count) and
- not( (Columns[ACol].Options * [kcSizing, kcVisible] = [kcSizing, kcVisible]) or
- (csDesigning in ComponentState) ) or
- (ACol < 0) and not FTreePathSizing
- then
- State := gsNormal
- else
- FSizingIndex := Index;
- end;
-
- if (tgTreePath in Options) and (State = gsColSizing) and FTreePathSizing
- then
- if SizingPos < FixedInfo.Horz.FixedBoundary then
- FTreePathSizing := GetFixedCellType(ACol, FIndicatorOffset-1) = fcTreePath
- else
- FTreePathSizing := ((ACol+FIndicatorOffset)= -1);
- FSizingOff := SizingOfs;
- end;
-
- procedure TDCCustomTreeGrid.SetImages(const Value: TImageList);
- begin
- if Images <> nil then
- Images.UnRegisterChanges(FImageChangeLink);
- FImages := Value;
- if Images <> nil then
- begin
- Images.RegisterChanges(FImageChangeLink);
- Images.FreeNotification(Self);
- end;
- LayoutChanged;
- end;
-
- function TDCCustomTreeGrid.GetHintTreeOffset(KnotItem: TKnotItem;
- Hint: TTreeGridHitTest): integer;
- var
- ALevel: integer;
- begin
- with KnotItem do
- case Hint of
- htNowere :
- Result := 1;
- htOnButton:
- begin
- if [tgeShowLines, tgeShowButtons] * OptionsEx <> [] then
- ALevel := Level
- else
- ALevel := Level - 1;
- Result := GetHintTreeOffset(KnotItem, htNowere);
- Result := Result + ALevel* Indent + 1;
- end;
- htOnIcon :
- begin
- Result := GetHintTreeOffset(KnotItem, htOnButton);
- Result := Result + Indent;
- end;
- htOnLabel :
- begin
- Result := GetHintTreeOffset(KnotItem, htOnIcon);
- if (Images<>nil) and
- ((KnotID = SelectedKnot.KnotID)and(SelectImage>-1) or
- (KnotID <> SelectedKnot.KnotID)and(NormalImage>-1))
- then
- Result := Result+Images.Width + 5;
- end;
- else
- Result := 0;
- end;
- end;
-
- procedure TDCCustomTreeGrid.HideHintWindow;
- var
- pHintWindow: PHintWindowParam_tag;
- begin
- if (FHintRow <> -1) and HandleAllocated then
- begin
- GetMem(pHintWindow, SizeOf(THintWindowParam));
- with pHintWindow^ do
- begin
- HMode := 0;
- PHint := nil;
- end;
- SendMessage(Handle, CM_POPUPHINTINFO, Integer(pHintWindow), 0);
- end;
- end;
-
- procedure TDCCustomTreeGrid.CMMouseLeave(var Message: TMessage);
- begin
- inherited;
- DoColumnComment(MODE_HIDEWINDOW, nil);
- HideHintWindow;
- end;
-
- procedure TDCCustomTreeGrid.ShowHintWindow(X, Y, ALeft, ATop, AOff: integer;
- Text: string);
- var
- pHintWindow: PHintWindowParam_tag;
- begin
- if not ShowHint and (DragState = dsNone) then
- begin
-
- if [goHorzLine, goVertLine] * inherited Options <> [goHorzLine, goVertLine] then
- ALeft := ALeft - GridLineWidth;
-
- GetMem(pHintWindow, SizeOf(THintWindowParam));
- with pHintWindow^ do
- begin
- HMode := 1;
- HLeft := ALeft;
- HTop := ATop;
- HOff := AOff;
- HPosX := X;
- HPosY := Y;
- GetMem(PHint, (Length(Text)+1)*SizeOf(Char));
- StrPCopy(PHint, Text);
- end;
- SendMessage(Handle, CM_POPUPHINTINFO, Integer(pHintWindow), 1);
- end;
- end;
-
- procedure TDCCustomTreeGrid.InvalidateSelected;
- var
- Rect: TRect;
- begin
- if not HandleAllocated then Exit;
- if (tgMultiSelect in Options) and (FBookmarks.Count > 0) then
- InvalidateRect(Handle, nil, False)
- else begin
- Rect := BoxRectEx(0, Row , ColCount-1, Row );
- InvalidateRect(Handle, @Rect, False);
- end;
- end;
-
- function TDCCustomTreeGrid.GetTreePathCaption(KnotItem: TKnotItem;
- var Text: string): boolean;
- begin
- Result := True;
- Text := KnotItem.Name;
- if Assigned(FOnTreeCellText) then FOnTreeCellText(Self, KnotItem, Text, Result);
- end;
-
- procedure TDCCustomTreeGrid.RowMoved(FromIndex, ToIndex: Integer);
- begin
- inherited;
- if Assigned(FOnRowMoved) then FOnRowMoved(Self, FromIndex, ToIndex);
- end;
-
- procedure TDCCustomTreeGrid.ShowTreePathEditor;
- var
- R: TRect;
- CanCreate: boolean;
-
- procedure UpdateEditor;
- begin
- FInplaceCol := FIndicatorOffset-1;
- FInplaceRow := Row;
- FInplaceEdit.SelectAll;
- end;
-
- begin
- if not(tgEditing in Options) or (Columns.Count=0) or
- (FKnots.Count=0) then Exit;
-
- if FEditorMode then HideEditor;
-
- DoCreateCellEdit(nil, FInplaceEdit, CanCreate);
-
- if Assigned(FInplaceEdit) then
- begin
- FEditorMode := True;
- FIsModified := False;
- with FInplaceEdit do
- begin
- Text := FSelectedKnot.Name;
- Visible := False;
- Parent := Self;
- DrawStyle := fsSingle;
- end;
-
- UpdateEditor;
-
- R := CellRect(FIndicatorOffset-1, Row);
- R.Left := R.Left + GetTreeLableOffset(FSelectedKnot);
- InplaceUpdateLoc(FInplaceEdit, R, Canvas);
- end;
- end;
-
- procedure TDCCustomTreeGrid.ClipButtonClick(Sender: TObject);
- var
- ACellType: TFixedCell;
- begin
- ACellType := TKnotClipPopup(FClipPopup).CellType;
- HideClipPopup;
- if Assigned(FOnClipButtonClick) then FOnClipButtonClick(Sender);
- if ACellType = fcMarker then
- begin
- case TDCAssistButton(Sender).Pos of
- pmSelectAll: SelectItems(smSelect);
- pmDeselectAll: SelectItems(smDeselect);
- end;
- end;
- end;
-
- procedure TDCCustomTreeGrid.WMNCLButtonDown(var Message: TWMNCLButtonDown);
- begin
- inherited;
- HideClipPopup;
- end;
-
- procedure TDCCustomTreeGrid.WMHScroll(var Message: TWMHScroll);
- var
- NewLeft: integer;
- begin
- if (DragState = dsColMoving) or
- (not(FEditorMode or FKnots.Updating or FLockScreen) and DataVisible) then
- begin
- if CanModifyHScrollBar(SB_HORZ, Message.ScrollCode, Message.Pos, True, NewLeft) then
- begin
- FLockScroll := True;
- try
- if NewLeft <> -1 then
- LeftCol := NewLeft
- else
- inherited;
- finally
- FLockScroll := False;
- end;
- end;
- end;
- end;
-
- procedure TDCCustomTreeGrid.WMVScroll(var Message: TWMVScroll);
- begin
- if (DragState = dsColMoving) or
- (not(FEditorMode or FKnots.Updating or FLockScreen) and DataVisible) then
- begin
- inherited;
- end;
- end;
-
- procedure TDCCustomTreeGrid.SetPopupTitle(const Value: TPopupMenu);
- begin
- FPopupTitle := Value;
- end;
-
- function TDCCustomTreeGrid.GetPopupMenu: TPopupMenu;
- var
- P: TPoint;
- Cell: TGridCoord;
- begin
- GetCursorPos(P);
- P := ScreenToClient(P);
- Cell := MouseCoord(P.X, P.Y);
- with Cell do
- if (Y < FTitleOffset) and (X > 0) and (X >= FIndicatorOffset) and
- Assigned(FPopupTitle)
- then
- Result := FPopupTitle
- else
- Result := inherited GetPopupMenu;
- end;
-
- procedure TDCCustomTreeGrid.DoDelete(KnotItem: TKnotItem; var Apply: boolean;
- ComponentState: TComponentState);
- begin
- if KnotItem.Owner.State <> ksInsert then
- begin
- if Assigned(FOnDelete) then FOnDelete(KnotItem, Apply, ComponentState);
- end
- else
- Apply := True;
- end;
-
- procedure TDCCustomTreeGrid.DoInsert(KnotItem: TKnotItem; var Apply: boolean);
- begin
- if Assigned(FOnInsert) then FOnInsert(KnotItem, Apply);
- end;
-
- procedure TDCCustomTreeGrid.DoUpdate(KnotItem: TKnotItem; var Edit: TDCCustomChoiceEdit;
- Column: TKnotColumn);
- begin
- if Assigned(FOnUpdate) then FOnUpdate(KnotItem, Edit, Column);
- end;
-
- function TDCCustomTreeGrid.DeletePrompt: boolean;
- var
- Msg: string;
- nCount: integer;
- begin
- nCount := FBookmarks.Count;
- if (nCount > 1) then
- Msg := Format(LoadStr(RES_GRID_STR_MSEL),[nCount, RecordCount2Str(nCount)])
- else
- Msg := LoadStr(RES_GRID_STR_SSEL);
- Result := (MessageDlg(Msg, mtConfirmation, mbOKCancel, 0) <> idCancel);
- end;
-
- procedure TDCCustomTreeGrid.DeleteRecords(AtOnce: boolean);
- begin
- if (tgEditing in FOptions) and (AtOnce or DeletePrompt) and
- Assigned(FSelectedKnot)
- then begin
- if FBookmarks.Count = 0 then SelectedRows.Select(FSelectedKnot, True);
- SavePosition;
- BeginUpdate;
- try
- FBookmarks.Delete;
- if FCurrentPos[1] = nil
- then
- SelectedKnot := FKnots.GetFirstVisibleNode
- else
- GotoBookmark(FCurrentPos[1])
- finally
- EndUpdate;
- end;
- end;
- end;
-
- procedure TDCCustomTreeGrid.DoSelectCell(Sender: TObject; ACol,
- ARow: Integer; var CanSelect: Boolean);
- begin
- if Assigned(FOnSelectCell) then FOnSelectCell(Sender, ACol, ARow+1, CanSelect);
- end;
-
- procedure TDCCustomTreeGrid.DoDrawColumnCell(Canvas: TCanvas; ARect: TRect;
- ACol: integer; AColumn: TKnotColumn; AKnot: TKnotItem; AState: TGridDrawState);
- begin
- if Assigned(FOnDrawColumnCell) then
- FOnDrawColumnCell(Self, ARect, Canvas, ACol, AColumn, AKnot, AState);
- end;
-
- procedure TDCCustomTreeGrid.DoDestroyCellEdit;
- begin
- if Assigned(FOnDestroyCellEdit) then FOnDestroyCellEdit(Self);
- end;
-
- procedure TDCCustomTreeGrid.DoColumnComment(Mode: integer; Column: TKnotColumn);
- begin
- if (FColumnCell <> -1) and (Mode = MODE_HIDEWINDOW) then
- begin
- if Assigned(FOnColumnComment) then FOnColumnComment(Self, Mode, Column);
- FColumnCell := -1;
- end
- else
- if Assigned(FOnColumnComment) then FOnColumnComment(Self, Mode, Column);
- end;
-
- procedure TDCCustomTreeGrid.CMPopupHintInfo(var Message: TMessage);
- var
- pHintWindow: PHintWindowParam_tag;
- begin
- pHintWindow := PHintWindowParam_tag(Message.WParam);
- with pHintWindow^ do
- begin
- case HMode of
- 0:
- if (FHintRow <> - 1) and (FHintWindow <> nil) then
- begin
- FHintRow := -1;
- FHintWindow.Free;
- FHintWindow := nil;
- end;
- 1:
- begin
- if not Assigned(FHintWindow) then
- begin
- FHintWindow := TDCMessageWindow.Create(Self);
- with FHintWindow do
- begin
- Parent := Self;
- DialogStyle := dsSimple;
- PopupAlignment := wpOffset;
- Centered := True;
- end;
- end
- else
- FHintWindow.Hide;
-
- with FHintWindow do
- begin
- FHintRow := HPosY;
- Font := Self.Font;
- Caption := Format('/oh{-1}/ow{-2}%s',[PHint]);
- Left := HLeft + HOff + 1;
- Top := HTop - 2;
- Height := RowHeights[HPosY] + 2;
- Show;
- end;
- end;
- end;
- end;
- if Assigned(pHintWindow^.PHint) then FreeMem(pHintWindow^.PHint);
- FreeMem(pHintWindow);
- end;
-
- function TDCCustomTreeGrid.DoMouseWheelDown(Shift: TShiftState;
- MousePos: TPoint): Boolean;
- var
- MouseWheelDownEvent: TMouseWheelUpDownEvent;
- begin
- Result := False;
- MouseWheelDownEvent := OnMouseWheelDown;
- if Assigned(MouseWheelDownEvent) then
- MouseWheelDownEvent(Self, Shift, MousePos, Result);
-
- if not Result and (DragState = dsNone) and
- PtInRect(ClientRect, ScreenToClient(MousePos)) and not FKnots.Updating then
- begin
- if ssShift in Shift then
- NextRow(True, False, Shift)
- else begin
- if TopRow < RowCount - VisibleRowCount then TopRow := TopRow + 1;
- end;
- Result := True;
- end;
- end;
-
- function TDCCustomTreeGrid.DoMouseWheelUp(Shift: TShiftState;
- MousePos: TPoint): Boolean;
- var
- MouseWheelUpEvent: TMouseWheelUpDownEvent;
-
- begin
- Result := False;
- MouseWheelUpEvent := OnMouseWheelDown;
- if Assigned(MouseWheelUpEvent) then
- MouseWheelUpEvent(Self, Shift, MousePos, Result);
-
- if not Result and (DragState =dsNone) and
- PtInRect(ClientRect, ScreenToClient(MousePos)) and not FKnots.Updating then
- begin
- if ssShift in Shift then
- PrevRow(True, Shift)
- else
- if (TopRow > FixedRows) and (RowCount > VisibleRowCount) then TopRow := TopRow - 1;
- Result := True;
- end;
- end;
-
- procedure TDCCustomTreeGrid.InsertKnot(ParentKnot: TKnotItem;
- lChild: boolean; Shift: TShiftState);
- var
- NewKnot, NextKnot: TKnotItem;
- Delta: integer;
- CanSelect: boolean;
- begin
- with FKnots do
- begin
- if State = ksInsert then begin
- CanSelect := True and Modified;
- DoSelectCell(Self, Col, Row+1, CanSelect);
- if CanSelect then
- SetState(ksBrowse)
- else
- Exit;
- end;
- BeginUpdate;
- if ParentKnot = nil then
- begin
- NewKnot := FKnots.Add(NE_EMPTY_KNOT);
- if NewKnot <> nil then SetSelectedKnot(NewKnot);
- end
- else begin
- if lChild then
- begin
- NewKnot := FKnots.AddChild(ParentKnot, NE_EMPTY_KNOT);
- ParentKnot.Expand(False);
- end
- else
- if ssShift in Shift then
- begin
- NewKnot := FKnots.AddChild(ParentKnot.Parent, NE_EMPTY_KNOT,
- ParentKnot.FIndex);
- if NewKnot <> nil then SetSelectedKnot(NewKnot);
- end
- else
- NewKnot := FKnots.AddChild(ParentKnot.Parent, NE_EMPTY_KNOT,
- ParentKnot.FIndex+1)
- end;
- EndUpdate;
- if NewKnot = nil then Exit;
- Delta := 0;
- NextKnot := FSelectedKnot;
- while (NewKnot.KnotID<>NextKnot.KnotID) and (NextKnot<>nil) do
- begin
- Inc(Delta);
- NextKnot := NextKnot.GetNextVisible;
- end;
- if not Eof then Row := Row + Delta;
- FKnots.SetState(ksInsert);
- end;
- end;
-
- procedure TDCCustomTreeGrid.MarkKnot;
- begin
- if (tgMarker in Options) and (FKnots.Count>0) then
- begin
- try
- BeginUpdate;
- with FSelectedKnot, FBookmarks do
- Select(FSelectedKnot, not KnotSelected(KnotID));
- finally
- EndUpdate;
- end;
- end;
- end;
-
- procedure TDCCustomTreeGrid.NextRow(Select, Insert: boolean; Shift: TShiftState;
- AOffset: integer = 1);
- begin
- LockUpdate;
- try
- with FKnots do
- begin
- if (State = ksInsert) then
- begin
- if not Modified then
- begin
- if not Eof then
- begin
- if FEditorMode then HideEditor;
- if FInplaceEdit = nil then
- begin
- Delete(FSelectedKnot);
- SetState(ksBrowse);
- end;
- end;
- Exit;
- end
- end;
- if FEditorMode then HideEditor;
- if not Assigned(FInplaceEdit) then
- begin
- if Eof then
- begin
- if Focused and Insert and (tgEditing in Options) then
- InsertKnot(FSelectedKnot, False, Shift);
- end
- else begin
- DoSelection(Select, Shift, 1);
- if (Row + AOffset) < RowCount then
- Row := Row + AOffset
- else
- Row := RowCount - 1;
- end;
- end;
- end;
- finally
- UnlockUpdate;
- end;
- end;
-
- procedure TDCCustomTreeGrid.PrevRow(Select: Boolean; Shift: TShiftState;
- AOffset: integer = 1);
- var
- AEof: boolean;
- begin
- LockUpdate;
- try
- AEof := False;
- with FKnots do
- begin
- if FEditorMode then HideEditor;
- if (State = ksInsert) then
- begin
- AEof := Eof and not Modified;
- if (FInplaceEdit = nil) and not Modified then
- begin
- Delete(FSelectedKnot);
- SetState(ksBrowse);
- end;
- end;
- if (FInplaceEdit = nil) and (Row > FTitleOffset) and not(AEof) then
- begin
- DoSelection(Select, Shift, -1);
- if Row - AOffset < 0 then
- Row := FTitleOffset
- else
- Row := Row - AOffset;
- end;
- end;
- finally
- UnlockUpdate;
- end
- end;
-
- procedure TDCCustomTreeGrid.ClearSelection;
- begin
- if (tgMultiSelect in Options) then
- begin
- FBookmarks.Clear;
- FSelecting := False;
- end;
- end;
-
- function TDCCustomTreeGrid.Eof: boolean;
- begin
- Result := Row = (RowCount-1);
- end;
-
- function TDCCustomTreeGrid.BoxRectEx(ALeft, ATop, ARight,
- ABottom: Integer): TRect;
- begin
- Result := BoxRect(ALeft, ATop, ARight, ABottom);
- if tgCompleteLines in Options then Result.Right := Width;
- end;
-
- procedure TDCCustomTreeGrid.Paint;
- var
- DrawInfo: TGridDrawInfo;
- CurRow: integer;
- ARect, BRect: TRect;
- BorderStyle: TEdgeBorderStyle;
- LineColor: TColor;
- UpdateRect, FooterRect : TRect;
- SaveIndex: integer;
- begin
- if (tgCompleteLines in Options) and not(tgAutoSize in Options) then
- begin
- CalcDrawInfo(DrawInfo);
-
- SaveIndex := SaveDC(Canvas.Handle);
- UpdateRect := Canvas.ClipRect;
- FooterRect := Footers.BoundsRect;
- with UpdateRect do
- begin
- Bottom := FooterRect.Top;
- Left := DrawInfo.Horz.GridBoundary;
- Right := DrawInfo.Horz.GridExtent;
- ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);
- {
- ExcludeClipRect(Canvas.Handle, 0,
- DrawInfo.Vert.GridBoundary, DrawInfo.Horz.GridBoundary, DrawInfo.Vert.GridExtent);
- }
- end;
- inherited;
- RestoreDC(Canvas.Handle, SaveIndex);
-
- if not IsRectEmpty(FooterRect) then
- with FooterRect do
- ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);
-
- with DrawInfo do
- begin
- if Horz.GridBoundary < Horz.GridExtent then
- begin
- CurRow := 0;
-
- if ColorToRGB(Color) = clSilver then
- LineColor := clGray
- else
- LineColor := clSilver;
-
- BorderStyle := GetBorderStyle;
- if not(BorderStyle = ebsShadowFlat) and
- (ColorToRGB(Color) = ColorToRGB(FixedColor)) then BorderStyle := ebsNone;
-
- ARect := Rect(Horz.GridBoundary, 0, Horz.GridExtent, 0);
- if FTitleOffset > 0 then
- begin
- Canvas.Brush.Color := FixedColor;
- while CurRow < FTitleOffset do
- begin
- ARect.Bottom := ARect.Bottom + RowHeights[CurRow];
- BRect := ARect;
- InflateRect(BRect, 1, 1);
- if RectVisible(Canvas.Handle, BRect) then
- begin
- if RectVisible(Canvas.Handle, ARect) then
- begin
- Canvas.FillRect(ARect);
- if (tgFixedLines in Options) then
- begin
- if BorderStyle <> ebsNone then
- begin
- if BorderStyle = ebsShadowFlat then
- begin
- InflateRect(ARect, 1, 1);
- ARect.Right := ARect.Right + 1;
- ARect.Right := ARect.Right - 1;
- DrawGridFrameBorder(Canvas, ARect, BorderStyle, dsUp, FixedColor);
- InflateRect(ARect, -1, -1);
- end
- else begin
- ARect.Right := ARect.Right + 1;
- DrawGridFrameBorder(Canvas, ARect, BorderStyle, dsUp, FixedColor);
- end;
- end;
- end;
- end;
- Canvas.Pen.Color := Canvas.Pen.Color - 1;
- if (tgRowLines in FOptions) then
- begin
- case BorderStyle of
- ebsNone, ebsFlat:
- Canvas.Pen.Color := LineColor;
- else
- if not (tgColLines in FOptions) then
- Canvas.Pen.Color := FixedColor
- else
- Canvas.Pen.Color := clBlack;
- end;
- Canvas.MoveTo(ARect.Left, ARect.Bottom);
- Canvas.LineTo(ARect.Right, ARect.Bottom);
- end
- end;
- Inc(CurRow);
- ARect.Top := ARect.Bottom;
- end;
-
- end
- else begin
- if tgRowLines in FOptions then
- begin
- ARect.Top := ARect.Top - 1;
- ARect.Bottom := ARect.Bottom - 1;
- end;
- end;
-
- while (CurRow < Vert.GridCellCount) and
- (ARect.Top < UpdateRect.Bottom) do
- begin
- if tgRowLines in FOptions then
- begin
- ARect.Bottom := ARect.Bottom + RowHeights[CurRow] + 1;
- ARect.Top := ARect.Top + 1;
- end
- else begin
- ARect.Bottom := ARect.Bottom + RowHeights[CurRow];
- ARect.Top := ARect.Top;
- end;
-
- if RectVisible(Canvas.Handle, ARect) and
- ((tgRowSelect in Options) or (tgHighlightRow in Options)) and
- (AlwaysShowSelection or Focused)
- then begin
- if Row = (CurRow + Vert.FirstGridCell - FTitleOffset) then
- begin
- if FColumns.Count = 0 then
- Canvas.Brush.Color := Self.Color
- else begin
- if Focused or not (tgeShadowSelection in OptionsEx) then
- Canvas.Brush.Color := clHighlight
- else
- if AlwaysShowSelection then
- Canvas.Brush.Color := clShadowed;
- end;
- end
- else
- Canvas.Brush.Color := Self.Color;
- end
- else
- Canvas.Brush.Color := Self.Color;
-
- if tgTreePathCompletion in Options then
- begin
- Canvas.Pen.Color := Self.Color - 1;
- Canvas.Pen.Color := Self.Color;
- Canvas.PenPos := Point(ARect.Left, ARect.Top);
- Canvas.LineTo(ARect.Right, ARect.Top);
- Canvas.FillRect(Rect(ARect.Left, ARect.Top+1, ARect.Right, ARect.Bottom))
- end
- else
- Canvas.FillRect(ARect);
-
- ARect.Top := ARect.Top - 1;
- ARect.Bottom := ARect.Bottom;
-
- if (tgRowLines in FOptions) and RectVisible(Canvas.Handle, ARect) then
- begin
- Canvas.Pen.Color := 0;
- Canvas.Pen.Color := LineColor;
- Canvas.MoveTo(ARect.Left, ARect.Bottom);
- Canvas.LineTo(ARect.Right, ARect.Bottom);
- end;
-
- Inc(CurRow);
- ARect.Top := ARect.Bottom;
- end;
- if ARect.Top < UpdateRect.Bottom then
- begin
- BRect := ClientRect;
- if Vert.GridBoundary < Vert.GridExtent then
- begin
- ARect.Top := Vert.GridBoundary;
- ARect.Bottom := Vert.GridExtent;
- Canvas.Brush.Color := Self.Color;
- Canvas.FillRect(ARect);
- end;
- end;
- end;
- end;
- end
- else
- inherited;
- end;
-
- procedure TDCCustomTreeGrid.WMEraseBkgnd(var Message: TWmEraseBkgnd);
- begin
- { inherited; }
- end;
-
- procedure TDCCustomTreeGrid.ImageListChange(Sender: TObject);
- begin
- LayoutChanged;
- end;
-
- procedure TDCCustomTreeGrid.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if (Operation = opRemove) then
- begin
- if (AComponent = FImages) then
- begin
- FImages := nil;
- LayoutChanged;
- Exit;
- end;
- end;
- end;
-
- procedure TDCCustomTreeGrid.CMFontChanged(var Message: TMessage);
- begin
- inherited;
- LayoutChanged;
- end;
-
- procedure TDCCustomTreeGrid.SetSelectedKnot(KnotItem: TKnotItem);
- begin
- if FSelectedKnot <> KnotItem then
- begin
- FSelectedKnot := KnotItem;
- if Assigned(FOnSelectKnot) then FOnSelectKnot(Self, FSelectedKnot);
- end;
- end;
-
- procedure TDCCustomTreeGrid.SetSelected(const Value: TKnotItem);
- var
- KnotItem1, KnotItem2: TKnotItem;
- i, ARow: integer;
- begin
- if Value = nil then
- begin
- Row := FTitleOffset;
- Exit;
- end;
- KnotItem1 := Value;
- {check Visible}
- BeginUpdate;
- if not KnotItem1.Visible then KnotItem1.Visible := True;
- while KnotItem1 <> Knots.Root do
- begin
- KnotItem1 := KnotItem1.Parent;
- if not KnotItem1.Visible then KnotItem1.Visible := True;
- if not KnotItem1.Expanded then KnotItem1.Expand(False);
- end;
- EndUpdate;
- KnotItem1 := Value;
- KnotItem2 := FFirstVisible;
- ARow := _intMax(FFirstIndex + FTitleOffset, FTitleOffset);
- if KnotItem2 <> nil then
- begin
- i := Knots.ComparePos(KnotItem1, KnotItem2);
- while (KnotItem1 <> nil) and (KnotItem1 <> KnotItem2) do
- begin
- if i > 0 then
- KnotItem1 := KnotItem1.GetNextVisible
- else
- KnotItem1 := KnotItem1.GetPrevVisible;
- Inc(ARow, -i);
- end;
- end
- else begin
- KnotItem2 := Knots.GetFirstVisibleNode;
- while (KnotItem2 <> nil) and (KnotItem2 <> KnotItem1) do
- begin
- KnotItem2 := KnotItem2.GetNextVisible;
- Inc(ARow);
- end;
- end;
-
- if Row = ARow then
- begin
- if Row < TopRow then
- TopRow := Row
- else if Row > (TopRow + VisibleRowCount) then
- TopRow := Row - VisibleRowCount + 1;
- end
- else
- if (KnotItem1 <> nil) and (ARow <= RowCount) then Row := ARow;
- end;
-
- function TDCCustomTreeGrid.GetPosition: TBookMark;
- begin
- Result := FCurrentPos[2];
- end;
-
- procedure TDCCustomTreeGrid.RestPosition;
- begin
- if FCurrentPos[2] = nil
- then begin
- if Assigned(FCurrentPos[1]) then
- GotoBookmark(FCurrentPos[1])
- else
- SelectedKnot := FKnots.GetFirstVisibleNode;
- end
- else GotoBookmark(FCurrentPos[2])
- end;
-
- procedure TDCCustomTreeGrid.SavePosition;
- var
- KnotItem: TKnotItem;
-
- function KnotSelected(KnotItem: TKnotItem): boolean;
- begin
- if (KnotItem = nil) or (KnotItem.Level = -1) then
- begin
- Result := False;
- Exit;
- end;
-
- Result := SelectedRows.KnotSelected(KnotItem.KnotID);
-
- if not Result and (KnotItem.Parent.Level > -1) then
- Result := Result or KnotSelected(KnotItem.Parent)
- end;
-
- begin
- if FKnots.Count > 0 then
- begin
- with FKnots do
- begin
-
- if Assigned(FCurrentPos[1]) then FreeMem(FCurrentPos[1]);
- if Assigned(FCurrentPos[2]) then FreeMem(FCurrentPos[2]);
-
- KnotItem := SelectedKnot;
-
- if KnotItem <> nil then
- FCurrentPos[2] := GetBookmark(KnotItem)
- else begin
- FCurrentPos[2] := nil;
- FCurrentPos[1] := nil;
- Exit;
- end;
-
- while KnotSelected(KnotItem) do KnotItem := KnotItem.GetPrevVisible;
-
- if (KnotItem <> nil) and (KnotItem <> FKnots.Root) then
- FCurrentPos[1] := GetBookmark(KnotItem)
- else
- FCurrentPos[1] := nil;
-
- end;
- end;
- end;
-
- procedure TDCCustomTreeGrid.SetPosition(const Value: TBookMark);
- begin
- FCurrentPos[2] := Value;
- end;
-
- function TDCCustomTreeGrid.GetBookmark(KnotItem: TKnotItem): TBookmark;
- begin
- GetMem(Result, FBookMarkSize);
- GetBookmarkData(KnotItem, Result)
- end;
-
- procedure TDCCustomTreeGrid.GetBookmarkData(KnotItem: TKnotItem;
- Data: Pointer);
- begin
- StrPLCopy(PChar(Data), IntToStr(KnotItem.KnotID), FBookMarkSize-1);
- end;
-
- procedure TDCCustomTreeGrid.GotoBookMark(Bookmark: TBookmark);
- var
- KnotItem: TKnotItem;
- Bookmark1: Pointer;
- FindEqual: boolean;
- begin
- KnotItem := FKnots.GetFirstVisibleNode;
- FindEqual := False;
- while (KnotItem <> nil) and not FindEqual do
- begin
- Bookmark1 := GetBookmark(KnotItem);
- try
- FindEqual := BookmarksEqual(Bookmark1, Bookmark);
- finally
- FreeMem(Bookmark1);
- end;
- if not FindEqual then
- begin
- KnotItem := KnotItem.GetNext;
- end;
- end;
- SelectedKnot := KnotItem
- end;
-
- function TDCCustomTreeGrid.BookmarksEqual(Bookmark1,
- Bookmark2: TBookmark): boolean;
- begin
- Result := StrComp(PChar(Bookmark1), PChar(Bookmark2)) = 0;
- end;
-
- function TDCCustomTreeGrid.DataVisible: boolean;
- begin
- Result := (csDesigning in ComponentState) or (((FColumns.Count <> 0) or
- (TreePathWidth > 0)) {and (Knots.First <> nil)});
- end;
-
- procedure TDCCustomTreeGrid.WMSetCursor(var Msg: TWMSetCursor);
- begin
- if not DataVisible then
- Windows.SetCursor(LoadCursor(0, IDC_ARROW))
- else
- inherited;
- end;
-
- procedure TDCCustomTreeGrid.WMPaint(var Message: TWMPaint);
- var
- PS: TPaintStruct;
- UpdateMessage: string;
- R, R1: TRect;
- MessageType: TTreeGridMessageType;
- Flags: integer;
- MBitmap, OBitmap: HBITMAP;
- MDC, DC: HDC;
- begin
- if FLockScreen or not DataVisible then
- begin
- ShowScrollBar(Handle, SB_HORZ, False);
- ShowScrollBar(Handle, SB_VERT, False);
- GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top); R1 := R;
- DC := GetDC(0);
- MBitmap := CreateCompatibleBitmap(DC, R.Right, R.Bottom);
- ReleaseDC(0, DC);
- MDC := CreateCompatibleDC(0);
- OBitmap := SelectObject(MDC, MBitmap);
-
- try
- DC := BeginPaint(Handle, PS);
- Canvas.Handle := MDC;
- Canvas.Brush.Color := Self.Color;
- Canvas.Font := Self.Font;
-
- UpdateMessage := '';
- Flags := DT_END_ELLIPSIS or DT_CENTER;
- MessageType := mtEmptyColumns;
-
- if FLockScreen then
- begin
- UpdateMessage := LoadStr(RES_STRN_MSG_ONLOAD);
- MessageType := mtLoadData;
- end
- else begin
- if not DataVisible then
- begin
- UpdateMessage := LoadStr(RES_STRN_MSG_DBGCEM);
- MessageType := mtEmptyColumns;
- end;
- end;
-
- if Assigned(FOnPaintMessage) then
- FOnPaintMessage(Self, Canvas, R, MessageType, UpdateMessage)
- else begin
- Canvas.Lock;
- Canvas.FillRect(R);
- InflateRect(R, -5, -5);
- DrawHighLightText(Canvas, PChar(UpdateMessage), R, 1, Flags or DT_WORDBREAK);
- Canvas.UnLock;
- BitBlt(DC, 0, 0, R1.Right, R1.Bottom, MDC, 0, 0, SRCCOPY);
- end;
- EndPaint(Handle, PS);
- finally
- SelectObject(MDC, OBitmap);
- DeleteDC(MDC);
- DeleteObject(MBitmap);
- Canvas.Handle := 0;
- end;
- end
- else
- inherited;
- end;
-
- function TDCCustomTreeGrid.CanEditModify: Boolean;
- begin
- Result := True;
- end;
-
- function TDCCustomTreeGrid.GetTreeLableOffset(
- KnotItem: TKnotItem): integer;
- var
- X: integer;
- begin
- with KnotItem do
- begin
- if Indent > 0 then
- X := (Level+1)*Indent + 4
- else
- X := 0;
-
- if (Images<>nil) and
- ((KnotID = SelectedKnot.KnotID)and(SelectImage>-1) or
- (KnotID <> SelectedKnot.KnotID)and(NormalImage>-1))
- then
- X := X + Images.Width+2;
-
- Result := X;
-
- end;
- end;
-
- procedure TDCCustomTreeGrid.WMTimer(var Msg: TWMTimer);
- begin
- inherited;
- if (Msg.TimerId = FEditTimerID) then
- begin
- FreeEditTimer;
- if not FEditorMode then ShowTreePathEditor;
- end
- end;
-
- procedure TDCCustomTreeGrid.FreeEditTimer;
- begin
- if FEditTimerID <> -1 then
- begin
- KillTimer(Handle, 101);
- FEditTimerID := -1;
- end;
- end;
-
- procedure TDCCustomTreeGrid.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
- begin
- inherited;
- if (tgEditing in Options) and (Msg.CharCode = VK_RETURN) then Msg.Result := 1;
- end;
-
- procedure TDCCustomTreeGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
- begin
- inherited;
- if (BorderStyle = bsSingle) and (tgFlatButtons in Options) then
- InflateRect(Message.CalcSize_Params^.rgrc[0], -1, -1);
- end;
-
- procedure TDCCustomTreeGrid.WMNCPaint(var Message: TMessage);
- var
- R, R1: TRect;
- DC: HDC;
- ScrollW, ScrollH: integer;
- Brush: HBRUSH;
- ScrollInfo: TScrollInfo;
- IScroll, VScroll, HScroll: boolean;
- begin
- inherited;
- if (BorderStyle = bsSingle) and (tgFlatButtons in Options) then
- begin
- DC := GetWindowDC(Handle);
- Brush := CreateSolidBrush(ColorToRGB(clBtnFace));
- try
- GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top);
-
- ScrollInfo.cbSize := SizeOf(ScrollInfo);
- ScrollInfo.fMask := SIF_ALL;
- IScroll := GetScrollInfo(Self.Handle, SB_HORZ, ScrollInfo);
- HScroll := IScroll and (ScrollInfo.nMin <> ScrollInfo.nMax);
- IScroll := GetScrollInfo(Self.Handle, SB_VERT, ScrollInfo);
- VScroll := IScroll and (ScrollInfo.nMin <> ScrollInfo.nMax);
-
- if DataVisible and HScroll and VScroll then
- begin
- ScrollW := GetSystemMetrics(SM_CXVSCROLL);
- ScrollH := GetSystemMetrics(SM_CYVSCROLL);
- R1 := Rect(R.Right - ScrollW-1, R.Bottom - ScrollH-1, R.Right-1, R.Bottom-1);
- FrameRect(DC, R1, Brush);
- end;
-
- DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT);
- DrawEdge(DC, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
- finally
- DeleteObject(Brush);
- ReleaseDC(Handle, DC);
- end;
- end;
- end;
-
- procedure TDCCustomTreeGrid.CreateParams(var Params: TCreateParams);
- begin
- inherited;
- if (BorderStyle = bsSingle) and (tgFlatButtons in Options) then
- with Params do
- begin
- if NewStyleControls and Ctl3D then
- ExStyle := ExStyle and not WS_EX_CLIENTEDGE
- else
- Style := Style and not WS_BORDER;
- end;
- end;
-
- procedure TDCCustomTreeGrid.DoCollapse(KnotItem: TKnotItem);
- begin
- if Assigned(FOnCollapsed) then FOnCollapsed(Self, KnotItem);
- end;
-
- procedure TDCCustomTreeGrid.DoExpand(KnotItem: TKnotItem);
- begin
- if Assigned(FOnExpanded) then FOnExpanded(Self, KnotItem);
- end;
-
- function TDCCustomTreeGrid.GetBorderStyle: TEdgeBorderStyle;
- begin
- if not((tgColLines in Options) and (tgRowLines in Options)) or
- not(tgFixedLines in Options) then
- if (tgFlatButtons in Options) and (tgFixedLines in Options) then
- Result := ebsShadowFlat
- else
- Result := ebsNone
- else begin
- if (ColorToRGB(Color) = ColorToRGB(FixedColor)) then
- Result := ebsNone
- else
- begin
- if tgFlatButtons in Options then
- Result := ebsFlat
- else
- Result := ebsNormal;
- end;
- end;
- end;
-
- function TDCCustomTreeGrid.FlatButtons: boolean;
- begin
- Result := tgFlatButtons in Options;
- end;
-
- procedure TDCCustomTreeGrid.Update;
- begin
- if not UpdateLocked then inherited;
- if FLockWindow then FLockScroll := True;
- end;
-
- procedure TDCCustomTreeGrid.DoColumnClick(Shift: TShiftState;
- ColIndex: integer);
- var
- i: integer;
- begin
- inherited;
- if (RawToDataColumn(ColIndex) < Columns.Count) then
- begin
- if (kcIndexed in Columns[RawToDataColumn(ColIndex)].Options) then
- for i := 0 to Columns.Count-1 do
- begin
- if i = RawToDataColumn(ColIndex) then
- begin
- if Columns[i].IndexStyle < High(TColumnIndexStyle)
- then Columns[i].IndexStyle := Succ(Columns[i].IndexStyle)
- else Columns[i].IndexStyle := Pred(Columns[i].IndexStyle);
- InvalidateCell(DataToRawColumn(i),0);
- end
- else
- if not(ssShift in Shift) then
- begin
- if (kcIndexed in Columns[i].Options) and
- (Columns[i].IndexStyle <> Low(TColumnIndexStyle))
- then begin
- Columns[i].IndexStyle := Low(TColumnIndexStyle);
- InvalidateCell(DataToRawColumn(i),0);
- end;
- end;
- end;
- TitleClick(Columns[RawToDataColumn(ColIndex)])
- end;
- end;
-
- function TDCCustomTreeGrid.GroupingEnabled: boolean;
- begin
- Result := tgGrouping in Options;
- end;
-
- function TDCCustomTreeGrid.GetClientRect: TRect;
- begin
- if FLockScroll then
- begin
- if not DoubleBuffered and ((tgTreePathCompletion) in Options) then
- SetRectEmpty(Result)
- else
- Result := GetGridBounds;
- end
- else
- Result := inherited GetClientRect;
- end;
-
- procedure TDCCustomTreeGrid.GroupBoxChanged;
- begin
- inherited;
- if GroupingEnabled then
- begin
- if GroupBox.Count = 0 then
- Options := Options - [tgTreePath]
- else begin
- Options := Options + [tgTreePath];
- TreePathWidth := 1;
- end;
- end;
- end;
-
- function TDCCustomTreeGrid.GetRealColWidth(ColIndex: integer): integer;
- begin
- Result := Columns[RawToDataColumn(ColIndex)].ActualWidth;
- end;
-
- function TDCCustomTreeGrid.CalcMaxTopLeft(const Coord: TGridCoord;
- const DrawInfo: TGridDrawInfo): TGridCoord;
-
- function CalcMaxCell(const Axis: TGridAxisDrawInfo; Start: Integer): Integer;
- var
- Line: Integer;
- I, Extent: Longint;
- begin
- Result := Start;
- with Axis do
- begin
- Line := GridExtent + EffectiveLineWidth;
- for I := Start downto FixedCellCount do
- begin
- Extent := GetExtent(I);
- if Extent > 0 then
- begin
- Dec(Line, Extent);
- Dec(Line, EffectiveLineWidth);
- if Line < FixedBoundary then
- begin
- if (Result = Start) and (GetExtent(Start) <= 0) then
- Result := I;
- Break;
- end;
- Result := I;
- end;
- end;
- end;
- end;
-
- begin
- Result.X := CalcMaxCell(DrawInfo.Horz, Coord.X);
- Result.Y := CalcMaxCell(DrawInfo.Vert, Coord.Y);
- end;
-
- function TDCCustomTreeGrid.CanModifyHScrollBar(ScrollBar, ScrollCode,
- Pos: Cardinal; UseRightToLeft: Boolean; var NewLeft: integer): boolean;
- var
- NewTopLeft, MaxTopLeft: TGridCoord;
- DrawInfo: TGridDrawInfo;
- RTLFactor: Integer;
-
- function Min: Longint;
- begin
- if ScrollBar = SB_HORZ then Result := FixedCols
- else Result := FixedRows;
- end;
-
- function Max: Longint;
- begin
- if ScrollBar = SB_HORZ then Result := MaxTopLeft.X
- else Result := MaxTopLeft.Y;
- end;
-
- function PageUp: Longint;
- var
- MaxTopLeft: TGridCoord;
- begin
- MaxTopLeft := CalcMaxTopLeft(GetTopLeft, DrawInfo);
- if ScrollBar = SB_HORZ then
- Result := LeftCol - MaxTopLeft.X else
- Result := TopRow - MaxTopLeft.Y;
- if Result < 1 then Result := 1;
- end;
-
- function PageDown: Longint;
- var
- DrawInfo: TGridDrawInfo;
- begin
- CalcDrawInfo(DrawInfo);
- with DrawInfo do
- if ScrollBar = SB_HORZ then
- Result := Horz.LastFullVisibleCell - LeftCol else
- Result := Vert.LastFullVisibleCell - TopRow;
- if Result < 1 then Result := 1;
- end;
-
- function CalcScrollBar(Value, ARTLFactor: Longint): Longint;
- begin
- Result := Value;
- case ScrollCode of
- SB_LINEUP:
- Dec(Result, ARTLFactor);
- SB_LINEDOWN:
- Inc(Result, ARTLFactor);
- SB_PAGEUP:
- Dec(Result, PageUp * ARTLFactor);
- SB_PAGEDOWN:
- Inc(Result, PageDown * ARTLFactor);
- SB_THUMBPOSITION, SB_THUMBTRACK:
- if (goThumbTracking in inherited Options) or (ScrollCode = SB_THUMBPOSITION) then
- begin
- if (not UseRightToLeftAlignment) or (ARTLFactor = 1) then
- Result := Min + LongMulDiv(Pos, Max - Min, MaxShortInt)
- else
- Result := Max - LongMulDiv(Pos, Max - Min, MaxShortInt);
- end;
- SB_BOTTOM:
- Result := Max;
- SB_TOP:
- Result := Min;
- end;
- end;
-
- var
- Temp: Longint;
- begin
- Result := False;
- if (not UseRightToLeftAlignment) or (not UseRightToLeft) then
- RTLFactor := 1
- else
- RTLFactor := -1;
-
- CalcDrawInfo(DrawInfo);
- if ColCount = 1 then
- begin
- Result := True;
- NewLeft := -1;
- Exit;
- end;
-
- MaxTopLeft.X := ColCount - 1;
- MaxTopLeft.Y := RowCount - 1;
- MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
- NewTopLeft := GetTopLeft;
-
- repeat
- Temp := NewTopLeft.X;
- NewTopLeft.X := CalcScrollBar(NewTopLeft.X, RTLFactor);
- until (NewTopLeft.X <= FixedCols) or (NewTopLeft.X >= MaxTopLeft.X)
- or (ColWidths[NewTopLeft.X] > 0) or (Temp = NewTopLeft.X);
-
- NewTopLeft.X := _intMax(FixedCols, _intMin(MaxTopLeft.X, NewTopLeft.X));
- NewTopLeft.Y := _intMax(FixedRows, _intMin(MaxTopLeft.Y, NewTopLeft.Y));
-
- if (NewTopLeft.X <> LeftCol) or (NewTopLeft.Y <> TopRow) then
- begin
- Result := True;
- NewLeft := NewTopLeft.X;
- end;
-
- end;
-
- function TDCCustomTreeGrid.GetTopLeft: TGridCoord;
- begin
- Result.X := LeftCol;
- Result.Y := TopRow;
- end;
-
- procedure SortKnots(Sender: TObject; Knots: TKnotItems; KnotItem: TKnotItem; L, R: Integer;
- SortCompare: TGridSortCompare; Data: integer);
- var
- I, J, K: Integer;
- P: Pointer;
- AKnotItem: TKnotItem;
- begin
- repeat
- I := L;
- J := R;
- K := (L + R) shr 1;
- P := KnotItem.Childs[K];
- repeat
- while SortCompare(Sender, KnotItem.Childs[I], P, Data) < 0 do Inc(I);
- while SortCompare(Sender, KnotItem.Childs[J], P, Data) > 0 do Dec(J);
- if I <= J then
- begin
- if (I <> J) and
- (SortCompare(Sender, KnotItem.Childs[I], KnotItem.Childs[J], Data) <> 0) then
- begin
- AKnotItem := KnotItem.Childs[I];
- KnotItem.Childs[I] := KnotItem.Childs[J];
- KnotItem.Childs[J] := AKnotItem;
- Knots.RebuildIndexes(KnotItem, i);
- end;
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if L < J then SortKnots(Sender, Knots, KnotItem, L, J, SortCompare, Data);
- L := I;
- until I >= R;
- end;
-
- procedure TDCCustomTreeGrid.Sort(Level: integer; Compare: TGridSortCompare; Data: integer);
- var
- KnotItem: TKnotItem;
-
- procedure SortLevel(Parent: TKnotItem; Level: integer; Compare: TGridSortCompare);
- var
- KnotItem: TKnotItem;
- iCount: integer;
- begin
- if (Parent = nil) or (Parent.ChildCount = 0) then Exit;
- if Parent.Level = Level -1 then
- begin
- iCount := Parent.ChildCount - 1;
- if iCount > 0 then with Knots do
- begin
- LockRebuilds(Parent, True);
- SortKnots(Self, Knots, Parent, 0, iCount, Compare, Data);
- LockRebuilds(Parent, False);
- end;
- end
- else begin
- KnotItem := Parent.Childs[0];
- iCount := Parent.ChildCount;
- while KnotItem <> nil do
- begin
- SortLevel(KnotItem, Level, Compare);
- if KnotItem.Index < iCount - 1 then
- KnotItem := Parent.Childs[KnotItem.Index + 1]
- else
- KnotItem := nil;
- end;
- end;
- end;
-
- begin
- if (Knots <> nil) then
- begin
- KnotItem := SelectedKnot;
- Knots.BeginUpdate;
- SortLevel(Knots.Root, Level, Compare);
- InitGridPos;
- Knots.EndUpdate;
- SelectedKnot := KnotItem;
- end;
- end;
-
- function TDCCustomTreeGrid.CanColResize(ACol: integer): boolean;
- var
- i: integer;
- CellType: TFixedCell;
- begin
- CellType := GetFixedCellType(ACol, 0);
- case CellType of
- fcColumn:
- begin
- i := RawToDataColumn(ACol);
- if (i < Columns.Count) and (i > -1) then
- Result := (kcVisible in Columns[i].Options) and
- ((csDesigning in ComponentState) or (kcSizing in Columns[i].Options))
- else
- Result := True;
- end;
- fcTreePath:
- Result := ([tgTreePath, tgTreePathResize] * Options = [tgTreePath, tgTreePathResize]) and
- not(GroupingEnabled and (GroupBox.Count > 0));
- else
- Result := inherited CanColResize(ACol);
- end;
- end;
-
- procedure TDCCustomTreeGrid.ResizeColWidth(ACol, AWidth: integer);
- var
- CellType: TFixedCell;
- begin
- CellType := GetFixedCellType(ACol, 0);
- case CellType of
- fcColumn:
- inherited;
- fcTreePath:
- TreepathWidth := AWidth;
- end;
- end;
-
- procedure TDCCustomTreeGrid.SelectItems(Mode: TSelectMode);
- begin
- Knots.BeginUpdate;
- case Mode of
- smSelect: FBookmarks.SelectAll;
- smDeselect: FBookmarks.Clear;
- end;
- Knots.EndUpdate;
- end;
-
- procedure TDCCustomTreeGrid.SetOptionsEx(const Value: TTreeGridOptionsEx);
- var
- ChangedOptions: TTreeGridOptionsEx;
- begin
- if FOptionsEx <> Value then
- begin
- ChangedOptions := (FOptionsEx + Value) - (FOptionsEx * Value);
- FOptionsEx := Value;
- if [tgeMarkerMenu, tgeShadowSelection, tgeShowLines, tgeShowButtons,
- tgeTreeSelect] * ChangedOptions <> [] then
- begin
- invalidate;
- end;
-
- end;
- end;
-
- procedure TDCCustomTreeGrid.SetIndent(const Value: integer);
- begin
- if FIndent <> Value then
- begin
- FIndent := _intMax(FTreeImages.Width + 2, Value);
- invalidate;
- end;
- end;
-
- function TDCCustomTreeGrid.CreateColumns: TKnotColumns;
- begin
- Result := TKnotColumns.Create(Self, TKnotColumn);
- end;
-
- procedure TDCCustomTreeGrid.InitGridPos;
- begin
- FFirstIndex := 0;
- FFirstVisible := Knots.GetFirstVisibleNode;
- FSelectedKnot := FFirstVisible;
- end;
-
- procedure TDCCustomTreeGrid.SetColumnFooter(
- const Value: TKnotColumnFooter);
- begin
- FColumnFooter.Assign(Value);
- end;
-
- function TDCCustomTreeGrid.GetCellByType(ACellType: TFixedCell): integer;
- type
- AFixedCells = fcIndicator..fcTreePath;
- const
- ATypes: array[AFixedCells] of TTreeGridOption = (tgIndicator, tgMarker, tgTreePath);
- var
- j: TFixedCell;
- begin
- Result := -1;
- for j := Low(ATypes) to High(ATypes) do
- begin
- if ATypes[j] in Options then Inc(Result);
- if ACellType = j then Break;
- end;
- end;
-
- procedure TDCCustomTreeGrid.DoSelection(Select: Boolean; Shift: TShiftState;
- Direction: Integer);
- var
- AddAfter: Boolean;
- begin
- AddAfter := False;
- BeginUpdate;
- try
- if (tgMultiSelect in Options) and (FKnots.Count > 0) then
- if Select and (ssShift in Shift) then
- begin
- if not FSelecting then
- begin
- FSelectionKnot := FSelectedKnot;
- FBookmarks.Select(FSelectedKnot, True);
- FSelecting := True;
- AddAfter := True;
- end
- else
- with FBookmarks do
- begin
- AddAfter := Compare(FSelectedKnot.KnotID, FSelectionKnot.KnotID) <> -Direction;
- if not AddAfter then Select(FSelectedKnot, False);
- end
- end
- else
- ClearSelection;
- if AddAfter then FBookmarks.Select(FSelectedKnot, True);
- finally
- EndUpdate;
- end;
- end;
-
- function TDCCustomTreeGrid.AlwaysShowSelection: boolean;
- begin
- Result := (tgAlwaysShowSelection in Options) or
- ((tgMultiSelect in Options) and (FBookmarks.Count > 0));
- end;
-
- function TDCCustomTreeGrid.CreateKnots: TKnotItems;
- begin
- Result := TKnotItems.Create(Self, TKnotItem);
- end;
-
- function TDCCustomTreeGrid.GetKnots: TKnotItems;
- begin
- Result := FKnots;
- end;
-
- procedure TDCCustomTreeGrid.SetTreePath(const Value: TTreePath);
- begin
- FTreePath.Assign(Value);
- end;
-
- { TKnotBookmarkList }
-
- procedure TKnotBookmarkList.Clear;
- begin
- if FList.Count = 0 then Exit;
- FList.Clear;
- FGrid.Invalidate;
- end;
-
- function TKnotBookmarkList.Compare(const KnotID1,
- KnotID2: integer): Integer;
- begin
- if KnotID1 = KnotID2 then Result := 0
- else
- if KnotID1 > KnotID2 then Result := 1
- else
- Result := -1;
- end;
-
- constructor TKnotBookmarkList.Create(AGrid: TDCCustomTreeGrid);
- begin
- inherited Create;
- FList := TList.Create;
- FGrid := AGrid;
- FSortItems := True;
- ListChanged;
- end;
-
- procedure TKnotBookmarkList.Delete;
- var
- I: Integer;
- begin
- with FGrid.FKnots do
- begin
- BeginUpdate;
- try
- I := FList.Count - 1;
- while (I >= 0) and (FList.Count > 0) do
- begin
- Delete(TKnotItem(FList.Items[I]));
- Dec(I);
- end;
- finally
- EndUpdate;
- end;
- end;
- end;
-
- destructor TKnotBookmarkList.Destroy;
- begin
- Clear;
- FList.Free;
- inherited Destroy;
- end;
-
- function TKnotBookmarkList.Find(const KnotID: integer;
- var Index: Integer): Boolean;
- var
- L, H, I, C: Integer;
- begin
- if (KnotID = FCache) and (FCacheIndex >= 0) then
- begin
- Index := FCacheIndex;
- Result := FCacheFind;
- Exit;
- end;
- Result := False;
- L := 0;
- H := FList.Count - 1;
- while L <= H do
- begin
- I := (L + H) shr 1;
- C := Compare(TKnotItem(FList[I]).KnotID, KnotID);
- 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;
- FCache := KnotID;
- FCacheIndex := Index;
- FCacheFind := Result;
- end;
-
- function TKnotBookmarkList.GetCount: integer;
- begin
- Result := FList.Count;
- end;
-
- function TKnotBookmarkList.GetItem(Index: Integer): integer;
- begin
- Result := Integer(FList[Index]^);
- end;
-
- function TKnotBookmarkList.IndexOf(const KnotID: integer): Integer;
- begin
- if not Find(KnotID, Result) then Result := -1;
- end;
-
- function TKnotBookmarkList.KnotSelected(const KnotID: integer): Boolean;
- var
- Index: integer;
- begin
- Result := Find(KnotID, Index);
- end;
-
- procedure TKnotBookmarkList.ListChanged;
- begin
- FCache := -1;
- FCacheIndex := -1;
- end;
-
- function CompareKnotID(Item1, Item2: Pointer): Integer;
- begin
- if TknotItem(Item1).KnotID = TknotItem(Item2).KnotID then Result := 0
- else
- if TknotItem(Item1).KnotID > TknotItem(Item2).KnotID then Result := 1
- else
- Result := -1;
- end;
-
- procedure TKnotBookmarkList.Select(KnotItem: TKnotItem; Value: boolean);
- var
- Index: integer;
- begin
- if (Find(KnotItem.KnotID, Index) = Value) or (FGrid.FKnots.State = ksInsert) then Exit;
- if Value then
- begin
- FList.Add(KnotItem);
- if FSortItems then Sort;
- end
- else begin
- FList.Delete(Index);
- end;
- ListChanged;
- if not FGrid.Knots.Updating then FGrid.InvalidateRow(FGrid.Row);
- end;
-
- { TDCInplaceEdit }
-
- procedure TDCInplaceChoiceEdit.ChoiceClick(Sender: TObject);
- begin
- Grid.SetModified(True);
- inherited;
- end;
-
- procedure TDCInplaceChoiceEdit.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
- begin
- inherited;
- if Msg.CharCode = VK_RETURN then Msg.Result := 1;
- end;
-
- function TDCInplaceChoiceEdit.DoMouseWheel(Shift: TShiftState;
- WheelDelta: Integer; MousePos: TPoint): Boolean;
- begin
- Result := Grid.DoMouseWheel(Shift, WheelDelta, MousePos);
- end;
-
- procedure TDCInplaceChoiceEdit.KeyDown(var Key: Word; Shift: TShiftState);
- begin
- if Key > $20 then HideErrorMessage;
- if not DropDownVisible then InplaceKeyDown(Self, Grid, Key, Shift);
- if Key <> 0 then
- begin
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyDown(Key, Shift);
- end;
- end;
-
- procedure TDCInplaceChoiceEdit.KeyPress(var Key: Char);
- begin
- if not DropDownVisible then Grid.KeyPress(Key);
- if Key <> #0 then
- begin
- if not(Key in [#27, #8, #0]) then
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyPress(Key);
- end;
- end;
-
- procedure TDCInplaceChoiceEdit.KeyUp(var Key: Word; Shift: TShiftState);
- begin
- if not DropDownVisible then Grid.KeyUp(Key, Shift);
- if Key <> 0 then
- inherited KeyUp(Key, Shift);
- end;
-
- procedure TDCInplaceChoiceEdit.SetGrid(Value: TDCCustomTreeGrid);
- begin
- FGrid := Value;
- end;
-
- procedure TDCInplaceChoiceEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
- begin
- inherited;
- if tgTabs in Grid.Options then
- Message.Result := Message.Result or DLGC_WANTTAB;
- end;
-
- procedure TKnotBookmarkList.SelectAll;
- var
- KnotItem: TKnotItem;
- begin
- try
- FList.Clear;
- KnotItem := FGrid.Knots.GetFirstVisibleNode;
- while KnotItem <> nil do
- begin
- FList.Add(KnotItem);
- KnotItem := KnotItem.GetNextVisible;
- end;
- Sort;
- finally
- InvalidateRect(FGrid.Handle, nil, False);
- end;
- end;
-
- procedure TKnotBookmarkList.Sort;
- begin
- FList.Sort(CompareKnotID);
- end;
-
- { TDCInplaceDateEdit }
-
- procedure TDCInplaceDateEdit.ChoiceClick(Sender: TObject);
- begin
- Grid.SetModified(True);
- inherited;
- end;
-
- procedure TDCInplaceDateEdit.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
- begin
- inherited;
- if Msg.CharCode = VK_RETURN then Msg.Result := 1;
- end;
-
- function TDCInplaceDateEdit.DoMouseWheel(Shift: TShiftState;
- WheelDelta: Integer; MousePos: TPoint): Boolean;
- begin
- Result := Grid.DoMouseWheel(Shift, WheelDelta, MousePos);
- end;
-
- procedure TDCInplaceDateEdit.KeyDown(var Key: Word; Shift: TShiftState);
- begin
- if Key > $20 then HideErrorMessage;
- if not DropDownVisible then InplaceKeyDown(Self, Grid, Key, Shift);
- if Key <> 0 then
- begin
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyDown(Key, Shift);
- end;
- end;
-
- procedure TDCInplaceDateEdit.KeyPress(var Key: Char);
- begin
- if not DropDownVisible or (PerformCloseUp and (Key = Char(VK_RETURN))) then Grid.KeyPress(Key);
- if Key <> #0 then
- begin
- if not(Key in [#27, #8, #0]) then
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyPress(Key);
- end;
- end;
-
- procedure TDCInplaceDateEdit.KeyUp(var Key: Word; Shift: TShiftState);
- begin
- if not DropDownVisible then Grid.KeyUp(Key, Shift);
- if Key <> 0 then
- inherited KeyUp(Key, Shift);
- end;
-
- procedure TDCInplaceDateEdit.SetGrid(Value: TDCCustomTreeGrid);
- begin
- FGrid := Value;
- end;
-
- procedure TDCInplaceDateEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
- begin
- inherited;
- if tgTabs in Grid.Options then
- Message.Result := Message.Result or DLGC_WANTTAB;
- end;
-
- { TDCInplaceGridEdit }
-
- procedure TDCInplaceGridEdit.ChoiceClick(Sender: TObject);
- begin
- Grid.SetModified(True);
- inherited;
- end;
-
- procedure TDCInplaceGridEdit.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
- begin
- inherited;
- if Msg.CharCode = VK_RETURN then Msg.Result := 1;
- end;
-
- function TDCInplaceGridEdit.DoMouseWheel(Shift: TShiftState;
- WheelDelta: Integer; MousePos: TPoint): Boolean;
- begin
- Result := Grid.DoMouseWheel(Shift, WheelDelta, MousePos);
- end;
-
- procedure TDCInplaceGridEdit.KeyDown(var Key: Word; Shift: TShiftState);
- begin
- if Key > $20 then HideErrorMessage;
- if not DropDownVisible then InplaceKeyDown(Self, Grid, Key, Shift);
- if Key <> 0 then
- begin
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyDown(Key, Shift);
- end;
- end;
-
- procedure TDCInplaceGridEdit.KeyPress(var Key: Char);
- begin
- if not DropDownVisible or (PerformCloseUp and (Key = Char(VK_RETURN))) then Grid.KeyPress(Key);
- if Key <> #0 then
- begin
- if not(Key in [#27, #8, #0]) then
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyPress(Key);
- end;
- end;
-
- procedure TDCInplaceGridEdit.KeyUp(var Key: Word; Shift: TShiftState);
- begin
- if not DropDownVisible then Grid.KeyUp(Key, Shift);
- if Key <> 0 then
- inherited KeyUp(Key, Shift);
- end;
-
- procedure TDCInplaceGridEdit.SetGrid(Value: TDCCustomTreeGrid);
- begin
- FGrid := Value;
- end;
-
- procedure TDCInplaceGridEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
- begin
- inherited;
- if tgTabs in Grid.Options then
- Message.Result := Message.Result or DLGC_WANTTAB;
- end;
-
- { TDCInplaceTreeEdit }
-
- procedure TDCInplaceTreeEdit.ChoiceClick(Sender: TObject);
- begin
- Grid.SetModified(True);
- inherited;
- end;
-
- procedure TDCInplaceTreeEdit.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
- begin
- inherited;
- if Msg.CharCode = VK_RETURN then Msg.Result := 1;
- end;
-
- function TDCInplaceTreeEdit.DoMouseWheel(Shift: TShiftState;
- WheelDelta: Integer; MousePos: TPoint): Boolean;
- begin
- Result := Grid.DoMouseWheel(Shift, WheelDelta, MousePos);
- end;
-
- procedure TDCInplaceTreeEdit.KeyDown(var Key: Word; Shift: TShiftState);
- begin
- if Key > $20 then HideErrorMessage;
- if not DropDownVisible then InplaceKeyDown(Self, Grid, Key, Shift);
- if Key <> 0 then
- begin
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyDown(Key, Shift);
- end;
- end;
-
- procedure TDCInplaceTreeEdit.KeyPress(var Key: Char);
- begin
- if not DropDownVisible or (PerformCloseUp and (Key = Char(VK_RETURN))) then Grid.KeyPress(Key);
- if Key <> #0 then
- begin
- if not(Key in [#27, #8, #0]) then
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyPress(Key);
- end;
- end;
-
- procedure TDCInplaceTreeEdit.KeyUp(var Key: Word; Shift: TShiftState);
- begin
- if not DropDownVisible then Grid.KeyUp(Key, Shift);
- if Key <> 0 then
- inherited KeyUp(Key, Shift);
- end;
-
- procedure TDCInplaceTreeEdit.SetGrid(Value: TDCCustomTreeGrid);
- begin
- FGrid := Value;
- end;
-
- procedure TDCInplaceTreeEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
- begin
- inherited;
- if tgTabs in Grid.Options then
- Message.Result := Message.Result or DLGC_WANTTAB;
- end;
-
- { TDCInplaceComboBox }
-
- procedure TDCInplaceComboBox.ChoiceClick(Sender: TObject);
- begin
- Grid.SetModified(True);
- inherited;
- end;
-
- procedure TDCInplaceComboBox.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
- begin
- inherited;
- if Msg.CharCode = VK_RETURN then Msg.Result := 1;
- end;
-
- function TDCInplaceComboBox.DoMouseWheel(Shift: TShiftState;
- WheelDelta: Integer; MousePos: TPoint): Boolean;
- begin
- Result := Grid.DoMouseWheel(Shift, WheelDelta, MousePos);
- end;
-
- procedure TDCInplaceComboBox.KeyDown(var Key: Word; Shift: TShiftState);
- begin
- if Key > $20 then HideErrorMessage;
- if not DropDownVisible then InplaceKeyDown(Self, Grid, Key, Shift);
- if Key <> 0 then
- begin
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyDown(Key, Shift);
- end;
- end;
-
- procedure TDCInplaceComboBox.KeyPress(var Key: Char);
- begin
- if not DropDownVisible or (PerformCloseUp and (Key = Char(VK_RETURN))) then Grid.KeyPress(Key);
- if Key <> #0 then
- begin
- if not(Key in [#27, #8, #0]) then
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyPress(Key);
- end;
- end;
-
- procedure TDCInplaceComboBox.KeyUp(var Key: Word; Shift: TShiftState);
- begin
- if not DropDownVisible then Grid.KeyUp(Key, Shift);
- if Key <> 0 then
- inherited KeyUp(Key, Shift);
- end;
-
- procedure TDCInplaceComboBox.SetGrid(Value: TDCCustomTreeGrid);
- begin
- FGrid := Value;
- end;
-
- procedure TDCInplaceComboBox.WMGetDlgCode(var Message: TWMGetDlgCode);
- begin
- inherited;
- if tgTabs in Grid.Options then
- Message.Result := Message.Result or DLGC_WANTTAB;
- end;
-
- { TDCInplaceFloatEdit }
-
- procedure TDCInplaceFloatEdit.ChoiceClick(Sender: TObject);
- begin
- Grid.SetModified(True);
- inherited;
- end;
-
- procedure TDCInplaceFloatEdit.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
- begin
- inherited;
- if Msg.CharCode = VK_RETURN then Msg.Result := 1;
- end;
-
- function TDCInplaceFloatEdit.DoMouseWheel(Shift: TShiftState;
- WheelDelta: Integer; MousePos: TPoint): Boolean;
- begin
- Result := Grid.DoMouseWheel(Shift, WheelDelta, MousePos);
- end;
-
- procedure TDCInplaceFloatEdit.KeyDown(var Key: Word; Shift: TShiftState);
- begin
- if Key > $20 then HideErrorMessage;
- if not DropDownVisible then InplaceKeyDown(Self, Grid, Key, Shift);
- if Key <> 0 then
- begin
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyDown(Key, Shift);
- end;
- end;
-
- procedure TDCInplaceFloatEdit.KeyPress(var Key: Char);
- begin
- if not DropDownVisible or (PerformCloseUp and (Key = Char(VK_RETURN))) then Grid.KeyPress(Key);
- if Key <> #0 then
- begin
- if not(Key in [#27, #8, #0]) then
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyPress(Key);
- end;
- end;
-
- procedure TDCInplaceFloatEdit.KeyUp(var Key: Word; Shift: TShiftState);
- begin
- if not DropDownVisible then Grid.KeyUp(Key, Shift);
- if Key <> 0 then
- inherited KeyUp(Key, Shift);
- end;
-
- procedure TDCInplaceFloatEdit.SetGrid(Value: TDCCustomTreeGrid);
- begin
- FGrid := Value;
- end;
-
- procedure TDCInplaceFloatEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
- begin
- inherited;
- if tgTabs in Grid.Options then
- Message.Result := Message.Result or DLGC_WANTTAB;
- end;
-
- { TDCInplaceADOGridEdit }
-
- {$IFDEF DELPHI_V5UP}
-
- procedure TDCInplaceADOGridEdit.ChoiceClick(Sender: TObject);
- begin
- Grid.SetModified(True);
- inherited;
- end;
-
- procedure TDCInplaceADOGridEdit.CMWantSpecialKey(
- var Msg: TCMWantSpecialKey);
- begin
- inherited;
- if Msg.CharCode = VK_RETURN then Msg.Result := 1;
- end;
-
- function TDCInplaceADOGridEdit.DoMouseWheel(Shift: TShiftState;
- WheelDelta: Integer; MousePos: TPoint): Boolean;
- begin
- Result := Grid.DoMouseWheel(Shift, WheelDelta, MousePos);
- end;
-
- procedure TDCInplaceADOGridEdit.KeyDown(var Key: Word; Shift: TShiftState);
- begin
- if Key > $20 then HideErrorMessage;
- if not DropDownVisible then InplaceKeyDown(Self, Grid, Key, Shift);
- if Key <> 0 then
- begin
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyDown(Key, Shift);
- end;
- end;
-
- procedure TDCInplaceADOGridEdit.KeyPress(var Key: Char);
- begin
- if not DropDownVisible or (PerformCloseUp and (Key = Char(VK_RETURN))) then Grid.KeyPress(Key);
- if Key <> #0 then
- begin
- if not(Key in [#27, #8, #0]) then
- if not ReadOnly then Grid.SetModified(True);
- inherited KeyPress(Key);
- end;
- end;
-
- procedure TDCInplaceADOGridEdit.KeyUp(var Key: Word; Shift: TShiftState);
- begin
- if not DropDownVisible then Grid.KeyUp(Key, Shift);
- if Key <> 0 then
- inherited KeyUp(Key, Shift);
- end;
-
- procedure TDCInplaceADOGridEdit.SetGrid(Value: TDCCustomTreeGrid);
- begin
- FGrid := Value;
- end;
-
- procedure TDCInplaceADOGridEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
- begin
- inherited;
- if tgTabs in Grid.Options then
- Message.Result := Message.Result or DLGC_WANTTAB;
- end;
-
- {$ENDIF}
-
- { TKnotColumnFooterPanel }
-
- function TKnotColumnFooterPanel.GetColIndex: integer;
- begin
- Result := inherited GetColIndex;
- if Result >= 0 then Inc(Result, TDCCustomTreeGrid(Footer.Grid).FIndicatorOffset);
- end;
-
- procedure TKnotColumnFooterPanel.SetColIndex(const Value: integer);
- begin
- inherited SetColIndex(Value -TDCCustomTreeGrid(Footer.Grid).FIndicatorOffset);
- end;
-
- { TKnotClipPopup }
-
- procedure TKnotClipPopup.AddButtons;
- begin
- BeginUpdate;
- Clear;
- case CellType of
- fcIndicator:
- begin
- PopupStyle := cpPopupMenu;
- AddButton('#Property', 'DC_DBPROPERTY', LoadStr(RES_STRN_VAL_PROP) , 0, 0);
- AddButton('#Find' , 'DC_DBFIND' , LoadStr(RES_STRN_VAL_FIND) , 0, 1);
- AddButton('#Print' , 'DC_PRINT' , LoadStr(RES_STRN_VAL_PRINT), 0, 2);
- if (Parent is TDCCustomGrid) and TDCCustomGrid(Parent).GroupingEnabled then
- AddButton('#GroupBox' , 'DC_GROUPBOX', LoadStr(RES_STRN_VAL_GRPBOX), 0, 3)
- end;
- fcMarker:
- begin
- PopupStyle := cpPopupMenu;
- AddButton('#SelectAll', 'DC_PM_SELALL', LoadStr(RES_STRN_HNT_SELALL) ,
- 0, pmSelectAll);
- AddButton('#DeselectAll', 'DC_PM_DESALL', LoadStr(RES_STRN_HNT_DESALL) ,
- 0, pmDeselectAll);
- end;
- end;
- EndUpdate;
- end;
-
- procedure TKnotClipPopup.ButtonClick(Sender: TObject);
- begin
- inherited;
- if (Sender <> nil) and (Parent is TDCCustomGrid) then
- if TDCEditButton(Sender).Name = '#GroupBox' then
- TDCCustomGrid(Parent).Grouping := not TDCCustomGrid(Parent).Grouping;
- end;
-
- { TTreePath }
-
- procedure TTreePath.Assign(Source: TPersistent);
- begin
- if Source is TTreePath then
- begin
- FColor := TTreePath(Source).Color;
- Include(FAssignedValues, tpColor);
- end
- else
- inherited Assign(Source);
- end;
-
- constructor TTreePath.Create(AGrid: TDCCustomTreeGrid);
- begin
- inherited Create;
- FGrid := AGrid;
- FFont := TFont.Create;
- FFont.Assign(DefaultFont);
- FFont.OnChange := FontChanged;
- end;
-
- function TTreePath.DefaultFont: TFont;
- begin
- Result := FGrid.Font
- end;
-
- function TTreePath.DefaultColor: TColor;
- begin
- Result := FGrid.FixedColor
- end;
-
- procedure TTreePath.FontChanged(Sender: TObject);
- begin
- Include(FAssignedValues, tpFont);
- FGrid.Invalidate;
- end;
-
- function TTreePath.GetColor: TColor;
- begin
- if tpColor in FAssignedValues then
- Result := FColor
- else
- Result := DefaultColor;
- end;
-
- function TTreePath.GetFont: TFont;
- var
- Save: TNotifyEvent;
- begin
- if not (tpFont in FAssignedValues) and (FFont.Handle <> DefaultFont.Handle) then
- begin
- Save := FFont.OnChange;
- FFont.OnChange := nil;
- FFont.Assign(DefaultFont);
- FFont.OnChange := Save;
- end;
- Result := FFont;
- end;
-
- function TTreePath.IsColorStored: Boolean;
- begin
- Result := (tpColor in FAssignedValues) and (FColor <> DefaultColor);
- end;
-
- function TTreePath.IsFontStored: Boolean;
- begin
- Result := (tpFont in FAssignedValues) and (Font <> DefaultFont);
- end;
-
- procedure TTreePath.SetColor(const Value: TColor);
- begin
- if FColor <> Value then
- begin
- FColor := Value;
- FGrid.Invalidate;
- Include(FAssignedValues, tpColor);
- end;
- end;
-
- procedure TTreePath.SetFont(const Value: TFont);
- begin
-
- end;
-
- end.
-