{ $Id$} { /*************************************************************************** Grids.pas --------- An interface to DB aware Controls Initial Revision : Sun Sep 14 2003 ***************************************************************************/ ***************************************************************************** This file is part of the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** } { TCustomGrid, TDrawGrid and TStringGrid for Lazarus Copyright (C) 2002 Jesus Reyes Aguilar. email: jesusrmx@yahoo.com.mx } unit Grids; {$mode objfpc}{$H+} {$modeswitch nestedprocvars} {$define NewCols} interface uses // RTL + FCL Classes, SysUtils, Types, TypInfo, Math, FPCanvas, HtmlDefs, StrUtils, // LCL LCLStrConsts, LCLType, LCLIntf, Controls, Graphics, Forms, LMessages, StdCtrls, LResources, MaskEdit, Buttons, Clipbrd, Themes, imglist, // LazUtils LazFileUtils, DynamicArray, Maps, LazUTF8, Laz2_XMLCfg, LazLoggerBase, LazUtilities, LCSVUtils, IntegerList {$ifdef WINDOWS} ,messages, imm {$endif} ,extctrls; const //GRIDFILEVERSION = 1; // Original //GRIDFILEVERSION = 2; // Introduced goSmoothScroll GRIDFILEVERSION = 3; // Introduced Col/Row FixedAttr and NormalAttr const GM_SETVALUE = LM_INTERFACELAST + 100; GM_GETVALUE = LM_INTERFACELAST + 101; GM_SETGRID = LM_INTERFACELAST + 102; GM_SETBOUNDS = LM_INTERFACELAST + 103; GM_SELECTALL = LM_INTERFACELAST + 104; GM_SETMASK = LM_INTERFACELAST + 105; GM_SETPOS = LM_INTERFACELAST + 106; GM_READY = LM_INTERFACELAST + 107; GM_GETGRID = LM_INTERFACELAST + 108; const EO_AUTOSIZE = $1; EO_HOOKKEYDOWN = $2; EO_HOOKKEYPRESS = $4; EO_HOOKKEYUP = $8; EO_SELECTALL = $10; EO_IMPLEMENTED = $20; const DEFCOLWIDTH = 64; DEFBUTTONWIDTH = 25; DEFIMAGEPADDING = 2; DEFMINSIZE = 0; DEFMAXSIZE = 0; DEFSIZEPRIORITY = 1; type EGridException = class(Exception); type TGridOption = ( goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing, goRowMoving, goColMoving, goEditing, goAutoAddRows, goTabs, goRowSelect, goAlwaysShowEditor, goThumbTracking, goColSpanning, // Enable CellExtent calculation goRelaxedRowSelect, // User can see focused cell on goRowSelect goDblClickAutoSize, // Double-clicking column borders (on headers) resizes column goSmoothScroll, // Switch scrolling mode (pixel scroll is by default) goFixedRowNumbering, goScrollKeepVisible, // Keeps focused cell visible while scrolling goHeaderHotTracking, // Header cells change look when mouse is over them goHeaderPushedLook, // Header cells looks pushed when clicked goSelectionActive, // Setting of Selection moves also cell cursor goFixedColSizing, // Allow to resize fixed columns goDontScrollPartCell, // Clicking partially visible cells will not scroll goCellHints, // Show individual cell hints goTruncCellHints, // Show cell hints if cell text is too long goCellEllipsis, // Show "..." if cell text is too long goAutoAddRowsSkipContentCheck, //Also add a row (if AutoAddRows in Options) if last row is empty goRowHighlight // Highlight the current row ); TGridOptions = set of TGridOption; TGridOption2 = ( goScrollToLastCol, // Allow scrolling to last column (so that last column can be LeftCol) goScrollToLastRow, // Allow scrolling to last row (so that last row can be TopRow) goEditorParentColor, // Set editor's ParentColor to True goEditorParentFont // Set editor's ParentFont to True ); TGridOptions2 = set of TGridOption2; TGridSaveOptions = ( soDesign, // Save grid structure (col/row count and Options) soAttributes, // Save grid attributes (Font,Brush,TextStyle) soContent, // Save Grid Content (Text in StringGrid) soPosition // Save Grid cursor and selection position ); TSaveOptions = set of TGridSaveOptions; TGridDrawState = set of (gdSelected, gdFocused, gdFixed, gdHot, gdPushed, gdRowHighlight); TGridState =(gsNormal, gsSelecting, gsRowSizing, gsColSizing, gsRowMoving, gsColMoving, gsHeaderClicking, gsButtonColumnClicking); TGridZone = (gzNormal, gzFixedCols, gzFixedRows, gzFixedCells, gzInvalid); TGridZoneSet = set of TGridZone; TAutoAdvance = (aaNone,aaDown,aaRight,aaLeft, aaRightDown, aaLeftDown, aaRightUp, aaLeftUp); { Option goRangeSelect: --> select a single range only, or multiple ranges } TRangeSelectMode = (rsmSingle, rsmMulti); TItemType = (itNormal,itCell,itColumn,itRow,itFixed,itFixedColumn,itFixedRow,itSelected); TColumnButtonStyle = ( cbsAuto, cbsEllipsis, cbsNone, cbsPickList, cbsCheckboxColumn, cbsButton, cbsButtonColumn ); TTitleStyle = (tsLazarus, tsStandard, tsNative); TGridFlagsOption = (gfEditorUpdateLock, gfNeedsSelectActive, gfEditorTab, gfRevEditorTab, gfVisualChange, gfColumnsLocked, gfEditingDone, gfSizingStarted, gfPainting, gfUpdatingSize, gfClientRectChange, gfAutoEditPending, gfUpdatingScrollbar); TGridFlags = set of TGridFlagsOption; TSortOrder = (soAscending, soDescending); TPrefixOption = (poNone, poHeaderClick); TMouseWheelOption = (mwCursor, mwGrid); TCellHintPriority = (chpAll, chpAllNoDefault, chpTruncOnly); // The grid can display three types of hint: the default hint (Hint property), // individual cell hints (OnCellHint event), and hints for truncated cells. // TCellHintPriority determines how the overall hint is combined when more // multiple hint texts are to be displayed. TCellProcessType = (cpCopy, cpPaste); const soAll: TSaveOptions = [soDesign, soAttributes, soContent, soPosition]; DefaultGridOptions = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goSmoothScroll ]; DefaultGridOptions2 = []; constRubberSpace: byte = 2; constCellPadding: byte = 3; constColRowBorderTolerance: byte = 3; var // Values to be used after HighDPI scaling varRubberSpace: byte; varCellpadding: byte; varColRowBorderTolerance: byte; type TCustomGrid = class; TGridColumn = class; PCellProps= ^TCellProps; TCellProps=record Attr: pointer; Data: TObject; Text: pchar; end; PColRowProps= ^TColRowProps; TColRowProps=record Size: Integer; FixedAttr: pointer; NormalAttr: pointer; end; PGridMessage=^TGridMessage; TGridMessage=record LclMsg: TLMessage; Grid: TCustomGrid; Col,Row: Integer; Value: string; CellRect: TRect; Options: Integer; end; type { Default cell editor for TStringGrid } { TStringCellEditor } TStringCellEditor=class(TCustomMaskEdit) private FGrid: TCustomGrid; FCol,FRow:Integer; protected procedure WndProc(var TheMessage : TLMessage); override; procedure Change; override; procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure msg_SetMask(var Msg: TGridMessage); message GM_SETMASK; procedure msg_SetValue(var Msg: TGridMessage); message GM_SETVALUE; procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE; procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID; procedure msg_SelectAll(var Msg: TGridMessage); message GM_SELECTALL; procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS; procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID; public constructor Create(Aowner : TComponent); override; procedure EditingDone; override; property EditText; property OnEditingDone; end; { TButtonCellEditor } TButtonCellEditor = class(TButton) private FGrid: TCustomGrid; FCol,FRow: Integer; protected procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID; procedure msg_SetBounds(var Msg: TGridMessage); message GM_SETBOUNDS; procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS; procedure msg_Ready(var Msg: TGridMessage); message GM_READY; procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID; public property Col: Integer read FCol; property Row: Integer read FRow; end; { TPickListCellEditor } TPickListCellEditor = class(TCustomComboBox) private FGrid: TCustomGrid; FCol,FRow: Integer; protected procedure WndProc(var TheMessage : TLMessage); override; procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure DropDown; override; procedure CloseUp; override; procedure Select; override; procedure Change; override; procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE; procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID; procedure msg_SetValue(var Msg: TGridMessage); message GM_SETVALUE; procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS; procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID; public procedure EditingDone; override; property BorderStyle; property OnEditingDone; end; { TCompositeCellEditor } TEditorItem = record Editor: TWinControl; Align: TAlign; ActiveControl: boolean; end; TCompositeCellEditor = class(TCustomControl) private FGrid: TCustomGrid; FCol,FRow: Integer; FEditors: array of TEditorItem; procedure DispatchMsg(msg: TGridMessage); function GetMaxLength: Integer; procedure SetMaxLength(AValue: Integer); protected function DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; override; procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE; procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID; procedure msg_SetValue(var Msg: TGridMessage); message GM_SETVALUE; procedure msg_SetBounds(var Msg: TGridMessage); message GM_SETBOUNDS; procedure msg_SetMask(var Msg: TGridMessage); message GM_SETMASK; procedure msg_SelectAll(var Msg: TGridMessage); message GM_SELECTALL; procedure CMControlChange(var Message: TLMEssage); message CM_CONTROLCHANGE; procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS; procedure msg_GetGrid(var Msg: TGridMessage); message GM_GETGRID; function GetActiveControl: TWinControl; procedure VisibleChanging; override; function SendChar(AChar: TUTF8Char): Integer; procedure SetColor(Value: TColor); override; procedure WndProc(var TheMessage : TLMessage); override; procedure CustomAlignPosition(AControl: TControl; var ANewLeft, ANewTop, ANewWidth, ANewHeight: Integer; var AlignRect: TRect; AlignInfo: TAlignInfo); override; public destructor Destroy; override; procedure AddEditor(aEditor: TWinControl; aAlign: TAlign; ActiveCtrl:boolean); procedure SetFocus; override; function Focused: Boolean; override; property MaxLength: Integer read GetMaxLength write SetMaxLength; property ActiveControl: TWinControl read GetActiveControl; end; TOnDrawCell = procedure(Sender: TObject; aCol, aRow: Integer; aRect: TRect; aState:TGridDrawState) of object; TOnSelectCellEvent = procedure(Sender: TObject; aCol, aRow: Integer; var CanSelect: Boolean) of object; TOnSelectEvent = procedure(Sender: TObject; aCol, aRow: Integer) of object; TGridOperationEvent = procedure (Sender: TObject; IsColumn:Boolean; sIndex, tIndex: Integer) of object; THdrEvent = procedure(Sender: TObject; IsColumn: Boolean; Index: Integer) of object; TOnCompareCells = procedure (Sender: TObject; ACol, ARow, BCol,BRow: Integer; var Result: integer) of object; TSelectEditorEvent = procedure(Sender: TObject; aCol, aRow: Integer; var Editor: TWinControl) of object; TOnPrepareCanvasEvent = procedure(Sender: TObject; aCol, aRow: Integer; aState: TGridDrawState) of object; TUserCheckBoxBitmapEvent = procedure(Sender: TObject; const aCol, aRow: Integer; const CheckedState: TCheckboxState; var ABitmap: TBitmap) of object; TUserCheckBoxImageEvent = procedure(Sender: TObject; const aCol, aRow: Integer; const CheckedState: TCheckBoxState; var ImageList: TCustomImageList; var ImageIndex: TImageIndex) of object; TValidateEntryEvent = procedure(Sender: TObject; aCol, aRow: Integer; const OldValue: string; var NewValue: String) of object; TToggledCheckboxEvent = procedure(Sender: TObject; aCol, aRow: Integer; aState: TCheckboxState) of object; THeaderSizingEvent = procedure(Sender: TObject; const IsColumn: boolean; const aIndex, aSize: Integer) of object; TCellProcessEvent = procedure(Sender: TObject; aCol, aRow: Integer; processType: TCellProcessType; var aValue: string) of object; TGetCellHintEvent = procedure (Sender: TObject; ACol, ARow: Integer; var HintText: String) of object; TSaveColumnEvent = procedure (Sender, aColumn: TObject; aColIndex: Integer; aCfg: TXMLConfig; const aVersion: integer; const aPath: string) of object; { TVirtualGrid } TVirtualGrid=class private FColCount: Integer; FRowCount: Integer; FCellArr, FColArr, FRowArr: TPointerPointerArray; function GetCells(Col, Row: Integer): PCellProps; function GetRows(Row: Integer): PColRowProps; function GetCols(Col: Integer): PColRowProps; procedure SetCells(Col, Row: Integer; const AValue: PCellProps); procedure SetRows(Row: Integer; const Avalue: PColRowProps); procedure SetColCount(const Avalue: Integer); procedure SetRowCount(const Avalue: Integer); procedure SetCols(Col: Integer; const Avalue: PColRowProps); protected procedure doDestroyItem(Sender: TObject; Col,Row: Integer; var Item: Pointer); procedure doNewItem(Sender: TObject; Col,Row: Integer; var Item: Pointer); procedure DeleteColRow(IsColumn: Boolean; index: Integer); procedure MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer); procedure ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer); procedure InsertColRow(IsColumn: Boolean; Index: Integer); procedure DisposeCell(var P: PCellProps); virtual; procedure DisposeColRow(var p: PColRowProps); virtual; function IsColumnIndexValid(AIndex: Integer): boolean; inline; function IsRowIndexValid(AIndex: Integer): boolean; inline; public constructor Create; destructor Destroy; override; procedure Clear; function GetDefaultCell: PcellProps; function GetDefaultColRow: PColRowProps; property ColCount: Integer read FColCount write SetColCount; property RowCount: Integer read FRowCount write SetRowCount; property Celda[Col,Row: Integer]: PCellProps read GetCells write SetCells; property Cols[Col: Integer]: PColRowProps read GetCols write SetCols; property Rows[Row: Integer]: PColRowProps read GetRows write SetRows; end; { TGridColumnTitle } TGridColumnTitle = class(TPersistent) private FColumn: TGridColumn; FCaption: PChar; FColor: ^TColor; FAlignment: ^TAlignment; FFont: TFont; FImageIndex: TImageIndex; FImageLayout: TButtonLayout; FIsDefaultTitleFont: boolean; FLayout: ^TTextLayout; FPrefixOption: TPrefixOption; FMultiline: Boolean; FIsDefaultCaption: boolean; procedure FontChanged(Sender: TObject); function GetAlignment: TAlignment; function GetColor: TColor; function GetFont: TFont; function GetLayout: TTextLayout; function IsAlignmentStored: boolean; function IsCaptionStored: boolean; function IsColorStored: boolean; function IsFontStored: boolean; function IsLayoutStored: boolean; procedure SetAlignment(const AValue: TAlignment); procedure SetColor(const AValue: TColor); procedure SetFont(const AValue: TFont); procedure SetImageIndex(const AValue: TImageIndex); procedure SetImageLayout(const AValue: TButtonLayout); procedure SetLayout(const AValue: TTextLayout); procedure SetMultiLine(const AValue: Boolean); procedure SetPrefixOption(const AValue: TPrefixOption); procedure WriteCaption(Writer: TWriter); property IsDefaultFont: boolean read FIsDefaultTitleFont; protected function GetDefaultCaption: string; virtual; function GetDefaultAlignment: TAlignment; function GetDefaultColor: TColor; function GetDefaultLayout: TTextLayout; function GetOwner: TPersistent; override; function GetCaption: TCaption; procedure SetCaption(const AValue: TCaption); virtual; procedure DefineProperties(Filer: TFiler); override; public constructor Create(TheColumn: TGridColumn); virtual; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure FillTitleDefaultFont; procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); virtual; procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); virtual; function IsDefault: boolean; property Column: TGridColumn read FColumn; published property Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored; property Caption: TCaption read GetCaption write SetCaption stored IsCaptionStored; property Color: TColor read GetColor write SetColor stored IsColorStored; property Font: TFont read GetFont write SetFont stored IsFontStored; property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; property ImageLayout: TButtonLayout read FImageLayout write SetImageLayout default blGlyphRight; property Layout: TTextLayout read GetLayout write SetLayout stored IsLayoutStored; property MultiLine: Boolean read FMultiLine write SetMultiLine default false; property PrefixOption: TPrefixOption read FPrefixOption write SetPrefixOption default poNone; end; { TGridColumn } TGridColumn = class(TCollectionItem) private FButtonStyle: TColumnButtonStyle; FDropDownRows: Longint; FTitle: TGridColumnTitle; FWidthChanged: boolean; FAlignment: ^TAlignment; FColor: ^TColor; FLayout: ^TTextLayout; FVisible: ^Boolean; FReadOnly: ^Boolean; FWidth: ^Integer; FFont: TFont; FisDefaultFont: Boolean; FPickList: TStrings; FMinSize, FMaxSize, FSizePriority: ^Integer; FValueChecked,FValueUnchecked: PChar; FTag: PtrInt; procedure FontChanged(Sender: TObject); function GetAlignment: TAlignment; function GetColor: TColor; function GetExpanded: Boolean; function GetFont: TFont; function GetGrid: TCustomGrid; function GetLayout: TTextLayout; function GetMaxSize: Integer; function GetMinSize: Integer; function GetSizePriority: Integer; function GetReadOnly: Boolean; function GetStoredWidth: Integer; function GetVisible: Boolean; function GetWidth: Integer; function IsAlignmentStored: boolean; function IsColorStored: boolean; function IsFontStored: boolean; function IsLayoutStored: boolean; function IsMinSizeStored: boolean; function IsMaxSizeStored: boolean; function IsReadOnlyStored: boolean; function IsSizePriorityStored: boolean; function IsValueCheckedStored: boolean; function IsValueUncheckedStored: boolean; function IsVisibleStored: boolean; function IsWidthStored: boolean; procedure SetAlignment(const AValue: TAlignment); procedure SetButtonStyle(const AValue: TColumnButtonStyle); procedure SetColor(const AValue: TColor); procedure SetExpanded(const AValue: Boolean); procedure SetFont(const AValue: TFont); procedure SetLayout(const AValue: TTextLayout); procedure SetMaxSize(const AValue: Integer); procedure SetMinSize(const Avalue: Integer); procedure SetPickList(const AValue: TStrings); procedure SetReadOnly(const AValue: Boolean); procedure SetSizePriority(const AValue: Integer); procedure SetTitle(const AValue: TGridColumnTitle); procedure SetValueChecked(const AValue: string); procedure SetValueUnchecked(const AValue: string); procedure SetVisible(const AValue: Boolean); procedure SetWidth(const AValue: Integer); protected function GetDisplayName: string; override; function GetDefaultAlignment: TAlignment; virtual; function GetDefaultColor: TColor; virtual; function GetDefaultLayout: TTextLayout; virtual; function GetDefaultMaxSize: Integer; virtual; function GetDefaultMinSize: Integer; virtual; function GetDefaultReadOnly: boolean; virtual; function GetDefaultSizePriority: Integer; function GetDefaultVisible: boolean; virtual; function GetDefaultValueChecked: string; virtual; function GetDefaultValueUnchecked: string; virtual; function GetDefaultWidth: Integer; virtual; function GetPickList: TStrings; virtual; function GetValueChecked: string; function GetValueUnchecked: string; procedure ColumnChanged; virtual; procedure AllColumnsChange; function CreateTitle: TGridColumnTitle; virtual; procedure SetIndex(Value: Integer); override; property IsDefaultFont: boolean read FIsDefaultFont; public constructor Create(ACollection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure FillDefaultFont; procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); virtual; procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); virtual; function IsDefault: boolean; virtual; property Grid: TCustomGrid read GetGrid; property DefaultWidth: Integer read GetDefaultWidth; property StoredWidth: Integer read GetStoredWidth; property WidthChanged: boolean read FWidthChanged; published property Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored; property ButtonStyle: TColumnButtonStyle read FButtonStyle write SetButtonStyle default cbsAuto; property Color: TColor read GetColor write SetColor stored IsColorStored; property DropDownRows: Longint read FDropDownRows write FDropDownRows default 7; property Expanded: Boolean read GetExpanded write SetExpanded default True; property Font: TFont read GetFont write SetFont stored IsFontStored; property Layout: TTextLayout read GetLayout write SetLayout stored IsLayoutStored; property MinSize: Integer read GetMinSize write SetMinSize stored IsMinSizeStored; property MaxSize: Integer read GetMaxSize write SetMaxSize stored isMaxSizeStored; property PickList: TStrings read GetPickList write SetPickList; property ReadOnly: Boolean read GetReadOnly write SetReadOnly stored IsReadOnlyStored; property SizePriority: Integer read GetSizePriority write SetSizePriority stored IsSizePriorityStored; property Tag: PtrInt read FTag write FTag default 0; property Title: TGridColumnTitle read FTitle write SetTitle; property Width: Integer read GetWidth write SetWidth stored IsWidthStored; property Visible: Boolean read GetVisible write SetVisible stored IsVisibleStored; property ValueChecked: string read GetValueChecked write SetValueChecked stored IsValueCheckedStored; property ValueUnchecked: string read GetValueUnchecked write SetValueUnchecked stored IsValueUncheckedStored; end; TGridPropertyBackup=record ValidData: boolean; FixedRowCount: Integer; FixedColCount: Integer; RowCount: Integer; ColCount: Integer; end; { TGridColumns } TGridColumns = class(TCollection) private FGrid: TCustomGrid; function GetColumn(Index: Integer): TGridColumn; function GetEnabled: Boolean; procedure SetColumn(Index: Integer; Value: TGridColumn); function GetVisibleCount: Integer; protected function GetOwner: TPersistent; override; procedure Update(Item: TCollectionItem); override; procedure TitleFontChanged; procedure FontChanged; procedure RemoveColumn(Index: Integer); procedure MoveColumn(FromIndex,ToIndex: Integer); virtual; procedure ExchangeColumn(Index,WithIndex: Integer); procedure InsertColumn(Index: Integer); public constructor Create(AGrid: TCustomGrid; aItemClass: TCollectionItemClass); function Add: TGridColumn; procedure Clear; function ColumnByTitle(const aTitle: string): TGridColumn; function RealIndex(Index: Integer): Integer; function IndexOf(Column: TGridColumn): Integer; function IsDefault: boolean; function HasIndex(Index: Integer): boolean; function VisibleIndex(Index: Integer): Integer; property Grid: TCustomGrid read FGrid; property Items[Index: Integer]: TGridColumn read GetColumn write SetColumn; default; property VisibleCount: Integer read GetVisibleCount; property Enabled: Boolean read GetEnabled; end; type TGridCoord = TPoint; TGridRect = TRect; TGridRectArray = array of TGridRect; TSizingRec = record Index: Integer; OffIni,OffEnd: Integer; DeltaOff: Integer; PrevLine: boolean; PrevOffset: Integer; end; TGridDataCache=record FixedWidth: Integer; // Sum( Fixed ColsWidths[i] ) FixedHeight: Integer; // Sum( Fixed RowsHeights[i] ) GridWidth: Integer; // Sum( ColWidths[i] ) GridHeight: Integer; // Sum( RowHeights[i] ) ClientWidth: Integer; // Width-VertScrollbar.Size ClientHeight: Integer; // Height-HorzScrollbar.Size ClientRect: TRect; // Cache for ClientRect - GetBorderWidth need for Bidi ScrollWidth: Integer; // ClientWidth-FixedWidth ScrollHeight: Integer; // ClientHeight-FixedHeight HScrollBarNetRange: Integer;//ScrollBar Range-Page VisibleGrid: TRect; // Visible non fixed rectangle of cellcoordinates MaxClientXY: Tpoint; // VisibleGrid.BottomRight (pixel) coordinates ValidRows: boolean; // true if there are not fixed columns to show ValidCols: boolean; // true if there are not fixed rows to show ValidGrid: boolean; // true if there are not fixed cells to show AccumWidth: TIntegerList; // Accumulated width per column AccumHeight: TIntegerList; // Accumulated Height per row TLColOff,TLRowOff: Integer; // TopLeft Offset in pixels MaxTopLeft: TPoint; // Max Top left ( cell coorditates) MaxTLOffset: TPoint; // Max Top left offset of the last cell HotCell: TPoint; // currently hot cell HotCellPainted: boolean; // HotCell was already painter? HotGridZone: TGridZone; // GridZone of last MouseMove ClickCell: TPoint; // Cell coords of the latest mouse click ClickMouse: TPoint; // mouse coords of the latest mouse click PushedCell: TPoint; // Cell coords of cell being pushed PushedMouse: TPoint; // mouse Coords of the cell being pushed ClickCellPushed: boolean; // Header Cell is currently pushed? FullVisibleGrid: TRect; // visible cells excluding partially visible cells MouseCell: TPoint; // Cell which contains the mouse OldMaxTopLeft: TPoint; // previous MaxTopleft (before col sizing) end; TGridCursorState = (gcsDefault, gcsColWidthChanging, gcsRowHeightChanging, gcsDragging); TGridScrollerDoScroll = procedure (Dir: TPoint) of object; { TGridScroller } TGridScroller = class private Dir: TPoint; Timer: TTimer; Callback: TGridScrollerDoScroll; procedure TimerTick(Sender: TObject); public constructor Create(DoScroll: TGridScrollerDoScroll); destructor Destroy; override; procedure Start(ADir: TPoint); end; type { TCustomGrid } TCustomGrid=class(TCustomControl) private FAlternateColor: TColor; FAutoAdvance: TAutoAdvance; FAutoEdit: boolean; FAutoFillColumns: boolean; FBorderColor: TColor; FDefaultDrawing: Boolean; FEditor: TWinControl; FEditorHidingCount: Integer; FEditorMode: Boolean; FEditorOldValue: string; FEditorShowing: Boolean; FEditorKey: Boolean; FEditorOptions: Integer; FExtendedSelect: boolean; FFastEditing: boolean; FAltColorStartNormal: boolean; FFlat: Boolean; FOnAfterSelection: TOnSelectEvent; FOnLoadColumn: TSaveColumnEvent; FOnSaveColumn: TSaveColumnEvent; FRangeSelectMode: TRangeSelectMode; FSelections: TGridRectArray; FOnUserCheckboxBitmap: TUserCheckboxBitmapEvent; FOnUserCheckboxImage: TUserCheckBoxImageEvent; FSortOrder: TSortOrder; FSortColumn: Integer; FSortLCLImages: TLCLGlyphs; FTabAdvance: TAutoAdvance; FTitleImageList: TImageList; FTitleImageListWidth: Integer; FTitleStyle: TTitleStyle; FAscImgInd: TImageIndex; FDescImgInd: TImageIndex; FOnCompareCells: TOnCompareCells; FGridLineStyle: TPenStyle; FGridLineWidth: Integer; FDefColWidth, FDefRowHeight: Integer; FRealizedDefColWidth, FRealizedDefRowHeight: Integer; FCol,FRow, FFixedCols, FFixedRows: Integer; FOnEditButtonClick: TNotifyEvent; FOnButtonClick: TOnSelectEvent; FOnPickListSelect: TNotifyEvent; FOnCheckboxToggled: TToggledCheckboxEvent; FOnPrepareCanvas: TOnPrepareCanvasEvent; FOnSelectEditor: TSelectEditorEvent; FOnValidateEntry: TValidateEntryEvent; FGridLineColor, FFixedGridLineColor: TColor; FFixedColor, FFixedHotColor, FFocusColor, FSelectedColor: TColor; FDisabledFontColor: TColor; FFadeUnfocusedSelection: boolean; FFocusRectVisible: boolean; FCols,FRows: TIntegerList; FsaveOptions: TSaveOptions; FScrollBars: TScrollStyle; FSelectActive: Boolean; FTopLeft: TPoint; FPivot: TPoint; FRange: TRect; FDragDx: Integer; FMoveLast: TPoint; FUpdateCount: Integer; FGCache: TGridDataCache; FOptions: TGridOptions; FOptions2: TGridOptions2; FOnDrawCell: TOnDrawcell; FOnBeforeSelection: TOnSelectEvent; FOnSelection: TOnSelectEvent; FOnTopLeftChanged: TNotifyEvent; FUseXORFeatures: boolean; FValidateOnSetSelection: boolean; FVSbVisible, FHSbVisible: ShortInt; // state: -1 not initialized, 0 hidden, 1 visible FDefaultTextStyle: TTextStyle; FLastWidth: Integer; FTitleFont, FLastFont: TFont; FTitleFontIsDefault: boolean; FColumns: TGridColumns; FButtonEditor: TButtonCellEditor; FStringEditor: TStringCellEditor; FButtonStringEditor: TCompositeCellEditor; FPickListEditor: TPickListCellEditor; FExtendedColSizing: boolean; FExtendedRowSizing: boolean; FUpdatingAutoFillCols: boolean; FGridBorderStyle: TBorderStyle; FGridFlags: TGridFlags; FGridPropBackup: TGridPropertyBackup; FStrictSort: boolean; FIgnoreClick: boolean; FAllowOutboundEvents: boolean; FColumnClickSorts: boolean; FHeaderHotZones: TGridZoneSet; FHeaderPushZones: TGridZoneSet; FCursorChangeLock: Integer; FCursorState: TGridCursorState; FColRowDragIndicatorColor: TColor; FSavedCursor: TCursor; FSpecialCursors: array[gcsColWidthChanging..gcsDragging] of TCursor; FSizing: TSizingRec; FRowAutoInserted: Boolean; FMouseWheelOption: TMouseWheelOption; FSavedHint: String; FCellHintPriority: TCellHintPriority; FOnGetCellHint: TGetCellHintEvent; FScroller: TGridScroller; procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer); procedure CacheVisibleGrid; procedure CancelSelection; procedure CheckFixedCount(aCol,aRow,aFCol,aFRow: Integer); procedure CheckCount(aNewColCount, aNewRowCount: Integer; FixEditor: boolean=true); procedure CheckIndex(IsColumn: Boolean; Index: Integer); function CheckTopLeft(aCol,aRow: Integer; CheckCols,CheckRows: boolean): boolean; function GetQuickColRow: TPoint; procedure SetQuickColRow(AValue: TPoint); function IsCellButtonColumn(ACell: TPoint): boolean; function GetSelectedColumn: TGridColumn; procedure SetAlternateColor(const AValue: TColor); procedure SetAutoFillColumns(const AValue: boolean); procedure SetBorderColor(const AValue: TColor); procedure SetColumnClickSorts(const AValue: boolean); procedure SetColumns(const AValue: TGridColumns); procedure SetEditorOptions(const AValue: Integer); procedure SetEditorBorderStyle(const AValue: TBorderStyle); procedure SetAltColorStartNormal(const AValue: boolean); procedure SetFlat(const AValue: Boolean); procedure SetFocusRectVisible(const AValue: Boolean); procedure ScrollerDoScroll(Dir: TPoint); procedure SetScroller(Dir: TPoint); procedure SetTitleImageList(const AValue: TImageList); procedure SetTitleImageListWidth(const aTitleImageListWidth: Integer); procedure SetTitleFont(const AValue: TFont); procedure SetTitleStyle(const AValue: TTitleStyle); procedure SetUseXorFeatures(const AValue: boolean); function doColSizing(X,Y: Integer): Boolean; function doRowSizing(X,Y: Integer): Boolean; procedure doColMoving(X,Y: Integer); procedure doPushCell; procedure doRowMoving(X,Y: Integer); procedure doTopleftChange(DimChg: Boolean); procedure DrawXORVertLine(X: Integer); procedure DrawXORHorzLine(Y: Integer); function EditorGetValue(validate:boolean=false): boolean; procedure EditorPos; procedure EditorShowChar(Ch: TUTF8Char); procedure EditorSetMode(const AValue: Boolean); procedure EditorSetValue; function EditorAlwaysShown: Boolean; procedure FixPosition(IsColumn: Boolean; aIndex: Integer); procedure FixScroll; function GetLeftCol: Integer; function GetColCount: Integer; function GetColWidths(Acol: Integer): Integer; function GetColumns: TGridColumns; function GetDefColWidth: Integer; function GetDefRowHeight: Integer; function GetEditorBorderStyle: TBorderStyle; function GetBorderWidth: Integer; procedure GetTitleImageInfo(aColumnIndex:Integer; out ImgIndex: Integer; out ImgLayout: TButtonLayout); procedure GetSortTitleImageInfo(aColumnIndex:Integer; out ImgList: TCustomImageList; out ImgIndex, ImgListWidth: Integer; out NativeSortGlyphs: Boolean); function GetRowCount: Integer; function GetRowHeights(Arow: Integer): Integer; function GetSelectedRange(AIndex: Integer): TGridRect; function GetSelectedRangeCount: Integer; function GetSelection: TGridRect; function GetSpecialCursor(ACursorState: TGridCursorState): TCursor; function GetTopRow: Longint; function GetVisibleColCount: Integer; function GetVisibleGrid: TRect; function GetVisibleRowCount: Integer; procedure HeadersMouseMove(const X,Y:Integer); procedure InternalAutoFillColumns; function InternalNeedBorder: boolean; procedure InternalSetColWidths(aCol,aValue: Integer); procedure InternalUpdateColumnWidths; procedure InvalidateMovement(DCol,DRow: Integer; OldRange: TRect); function IsAltColorStored: boolean; function IsColumnsStored: boolean; function IsPushCellActive: boolean; procedure LoadColumns(cfg: TXMLConfig; Version: integer); function LoadResBitmapImage(const ResName: string): TBitmap; procedure LoadSub(ACfg: TXMLConfig); procedure OnTitleFontChanged(Sender: TObject); procedure ReadColumns(Reader: TReader); procedure ReadColWidths(Reader: TReader); procedure ReadRowHeights(Reader: TReader); procedure ResetHotCell; procedure ResetPushedCell(ResetColRow: boolean=True); procedure RestoreCursor; procedure SaveColumns(cfg: TXMLConfig; Version: integer); function ScrollToCell(const aCol,aRow: Integer; const ForceFullyVisible: Boolean = True): Boolean; function ScrollGrid(Relative:Boolean; DCol,DRow: Integer): TPoint; procedure SetCol(AValue: Integer); procedure SetColWidths(Acol: Integer; Avalue: Integer); procedure SetColRowDragIndicatorColor(const AValue: TColor); procedure SetDefColWidth(AValue: Integer); procedure SetDefRowHeight(AValue: Integer); procedure SetDefaultDrawing(const AValue: Boolean); procedure SetEditor(AValue: TWinControl); procedure SetFocusColor(const AValue: TColor); procedure SetGridLineColor(const AValue: TColor); procedure SetFixedGridLineColor(const AValue: TColor); procedure SetGridLineStyle(const AValue: TPenStyle); procedure SetGridLineWidth(const AValue: Integer); procedure SetLeftCol(const AValue: Integer); procedure SetOptions(const AValue: TGridOptions); procedure SetOptions2(const AValue: TGridOptions2); procedure SetRangeSelectMode(const AValue: TRangeSelectMode); procedure SetRow(AValue: Integer); procedure SetRowCount(AValue: Integer); procedure SetRowHeights(Arow: Integer; Avalue: Integer); procedure SetScrollBars(const AValue: TScrollStyle); procedure SetSelectActive(const AValue: Boolean); procedure SetSelection(const AValue: TGridRect); procedure SetSpecialCursor(ACursorState: TGridCursorState; const AValue: TCursor); procedure SetTopRow(const AValue: Integer); function StartColSizing(const X, Y: Integer): boolean; procedure ChangeCursor(ACursor: TCursor; ASaveCurrentCursor: Boolean = true); function TitleFontIsStored: Boolean; function TrySmoothScrollBy(aColDelta, aRowDelta: Integer): Boolean; procedure TryScrollTo(aCol,aRow: Integer; ClearColOff, ClearRowOff: Boolean); procedure UpdateCachedSizes; procedure UpdateSBVisibility; procedure UpdateSizes; procedure WriteColumns(Writer: TWriter); procedure WriteColWidths(Writer: TWriter); procedure WriteRowHeights(Writer: TWriter); procedure WMEraseBkgnd(var message: TLMEraseBkgnd); message LM_ERASEBKGND; procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE; protected fGridState: TGridState; function RTLSign: Integer; class procedure WSRegisterClass; override; procedure AddSelectedRange; procedure AdjustClientRect(var ARect: TRect); override; procedure AdjustEditorBounds(NewCol,NewRow:Integer); virtual; procedure AfterMoveSelection(const prevCol,prevRow: Integer); virtual; procedure AssignTo(Dest: TPersistent); override; procedure AutoAdjustColumn(aCol: Integer); virtual; procedure BeforeMoveSelection(const DCol,DRow: Integer); virtual; procedure BeginAutoDrag; override; function BoxRect(ALeft,ATop,ARight,ABottom: Longint): TRect; procedure CacheMouseDown(const X,Y:Integer); procedure CalcAutoSizeColumn(const Index: Integer; var AMin,AMax,APriority: Integer); virtual; procedure CalcCellExtent(acol, aRow: Integer; var aRect: TRect); overload; virtual; deprecated 'old function'; procedure CalcFocusRect(var ARect: TRect; adjust: boolean = true); procedure CalcMaxTopLeft; procedure CalcScrollbarsRange; procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override; function CanEditShow: Boolean; virtual; function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; virtual; procedure CellClick(const aCol,aRow: Integer; const Button:TMouseButton); virtual; procedure CellExtent(const aCol,aRow: Integer; var R: TRect; out exCol:Integer); procedure CheckLimits(var aCol,aRow: Integer); procedure CheckLimitsWithError(const aCol, aRow: Integer); procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; procedure CMMouseEnter(var Message: TLMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var Message :TLMessage); message CM_MouseLeave; procedure ColRowDeleted(IsColumn: Boolean; index: Integer); virtual; procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); virtual; procedure ColRowInserted(IsColumn: boolean; index: integer); virtual; procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); virtual; function ColRowToOffset(IsCol, Relative: Boolean; Index:Integer; out StartPos, EndPos: Integer): Boolean; function ColumnIndexFromGridColumn(Column: Integer): Integer; function ColumnFromGridColumn(Column: Integer): TGridColumn; procedure ColumnsChanged(aColumn: TGridColumn); procedure ColWidthsChanged; virtual; function CreateColumns: TGridColumns; virtual; procedure CheckNewCachedSizes(var AGCache:TGridDataCache); virtual; procedure CreateWnd; override; procedure CreateParams(var Params: TCreateParams); override; procedure Click; override; procedure DblClick; override; function DefaultColWidthIsStored: Boolean; function DefaultRowHeightIsStored: Boolean; procedure DefineProperties(Filer: TFiler); override; procedure DestroyHandle; override; function DialogChar(var Message: TLMKey): boolean; override; function DoCompareCells(Acol,ARow,Bcol,BRow: Integer): Integer; virtual; procedure DoCopyToClipboard; virtual; procedure DoCutToClipboard; virtual; procedure DoEditButtonClick(const ACol,ARow: Integer); virtual; procedure DoEditorHide; virtual; procedure DoEditorShow; virtual; procedure DoExit; override; procedure DoEnter; override; procedure DoLoadColumn(Sender: TCustomGrid; aColumn: TGridColumn; aColIndex: Integer; aCfg: TXMLConfig; aVersion: Integer; const aPath: string); virtual; procedure DoSaveColumn(Sender: TCustomGrid; aColumn: TGridColumn; aColIndex: Integer; aCfg: TXMLConfig; aVersion: Integer; const aPath: string); virtual; function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelLeft(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelRight(Shift: TShiftState; MousePos: TPoint): Boolean; override; procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override; procedure DoOnChangeBounds; override; procedure DoOPDeleteColRow(IsColumn: Boolean; index: Integer); procedure DoOPExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer); procedure DoOPInsertColRow(IsColumn: boolean; index: integer); procedure DoOPMoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer); procedure DoPasteFromClipboard; virtual; procedure DoPrepareCanvas(aCol,aRow:Integer; aState: TGridDrawState); virtual; procedure DoOnResize; override; procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override; function DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; override; procedure DrawBorder; procedure DrawAllRows; virtual; procedure DrawFillRect(aCanvas:TCanvas; R:TRect);// Use FillRect after calc the new rect depened on Right To Left procedure DrawCell(aCol,aRow:Integer; aRect:TRect; aState:TGridDrawState); virtual; procedure DrawCellGrid(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); virtual; procedure DrawTextInCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); virtual; procedure DrawThemedCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); procedure DrawCellText(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState; const aText: String); virtual; procedure DrawGridCheckboxBitmaps(const aCol,aRow: Integer; const aRect: TRect; const aState: TCheckboxState); virtual; procedure DrawButtonCell(const aCol,aRow: Integer; aRect: TRect; const aState:TGridDrawState); procedure DrawColRowMoving; procedure DrawColumnText(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); virtual; procedure DrawColumnTitleImage(var ARect: TRect; AColumnIndex: Integer); procedure DrawEdges; procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); virtual; procedure DrawRow(aRow: Integer); virtual; procedure EditButtonClicked(Sender: TObject); procedure EditordoGetValue; virtual; procedure EditordoResetValue; virtual; procedure EditordoSetValue; virtual; function EditorCanAcceptKey(const ch: TUTF8Char): boolean; virtual; function EditorIsReadOnly: boolean; virtual; procedure EditorHide; virtual; function EditorLocked: boolean; Function EditingAllowed(ACol : Integer = -1) : Boolean; virtual; // Returns true if grid and current column allow editing procedure EditorSelectAll; procedure EditorShow(const SelAll: boolean); virtual; procedure EditorShowInCell(const aCol,aRow:Integer); virtual; procedure EditorWidthChanged(aCol,aWidth: Integer); virtual; function FirstGridColumn: integer; virtual; function FixedGrid: boolean; procedure FontChanged(Sender: TObject); override; procedure GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); virtual; function GetCellHintText(ACol, ARow: Integer): string; virtual; function GetCells(ACol, ARow: Integer): string; virtual; function GetColumnAlignment(Column: Integer; ForTitle: Boolean): TAlignment; function GetColumnColor(Column: Integer; ForTitle: Boolean): TColor; function GetColumnFont(Column: Integer; ForTitle: Boolean): TFont; function GetColumnLayout(Column: Integer; ForTitle: boolean): TTextLayout; function GetColumnReadonly(Column: Integer): boolean; function GetColumnTitle(Column: Integer): string; function GetColumnWidth(Column: Integer): Integer; function GetDeltaMoveNext(const Inverse: boolean; var ACol,ARow: Integer; const AAutoAdvance: TAutoAdvance): boolean; virtual; function GetDefaultColumnAlignment(Column: Integer): TAlignment; virtual; function GetDefaultColumnWidth(Column: Integer): Integer; virtual; function GetDefaultColumnLayout(Column: Integer): TTextLayout; virtual; function GetDefaultColumnReadOnly(Column: Integer): boolean; virtual; function GetDefaultColumnTitle(Column: Integer): string; virtual; function GetDefaultEditor(Column: Integer): TWinControl; virtual; function GetDefaultRowHeight: integer; virtual; function GetGridDrawState(ACol, ARow: Integer): TGridDrawState; procedure GetImageForCheckBox(const aCol,aRow: Integer; CheckBoxView: TCheckBoxState; var ImageList: TCustomImageList; var ImageIndex: TImageIndex; var Bitmap: TBitmap); virtual; function GetScrollBarPosition(Which: integer): Integer; function GetSmoothScroll(Which: Integer): Boolean; virtual; procedure GetSBVisibility(out HsbVisible,VsbVisible:boolean);virtual; procedure GetSBRanges(const HsbVisible,VsbVisible: boolean; out HsbRange,VsbRange,HsbPage,VsbPage,HsbPos,VsbPos:Integer); virtual; procedure GetSelectedState(AState: TGridDrawState; out IsSelected:boolean); virtual; function GetEditMask(ACol, ARow: Longint): string; virtual; function GetEditText(ACol, ARow: Longint): string; virtual; function GetFixedcolor: TColor; virtual; function GetFirstVisibleColumn: Integer; function GetFirstVisibleRow: Integer; function GetLastVisibleColumn: Integer; function GetLastVisibleRow: Integer; function GetSelectedColor: TColor; virtual; function GetTitleShowPrefix(Column: Integer): boolean; function GetPxTopLeft: TPoint; function GetTruncCellHintText(ACol, ARow: Integer): string; virtual; function GridColumnFromColumnIndex(ColumnIndex: Integer): Integer; procedure GridMouseWheel(Shift: TShiftState; Delta: Integer); virtual; procedure HeaderClick(IsColumn: Boolean; index: Integer); virtual; procedure HeaderSized(IsColumn: Boolean; index: Integer); virtual; procedure HeaderSizing(const IsColumn:boolean; const AIndex,ASize:Integer); virtual; procedure HideCellHintWindow; procedure InternalSetColCount(ACount: Integer); procedure InvalidateCell(aCol, aRow: Integer; Redraw: Boolean); overload; procedure InvalidateFromCol(ACol: Integer); procedure InvalidateGrid; procedure InvalidateFocused; function IsColumnIndexValid(AIndex: Integer): boolean; function IsRowIndexValid(AIndex: Integer): boolean; function IsColumnIndexVariable(AIndex: Integer): boolean; function IsRowIndexVariable(AIndex: Integer): boolean; function GetIsCellTitle(aCol,aRow: Integer): boolean; virtual; function GetIsCellSelected(aCol, aRow: Integer): boolean; virtual; function IsEmptyRow(ARow: Integer): Boolean; function IsMouseOverCellButton(X,Y: Integer): boolean; procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure KeyUp(var Key : Word; Shift : TShiftState); override; procedure KeyPress(var Key: char); override; procedure LoadContent(cfg: TXMLConfig; Version: Integer); virtual; procedure LoadGridOptions(cfg: TXMLConfig; Version: Integer); virtual; procedure Loaded; override; procedure LockEditor; function MouseButtonAllowed(Button: TMouseButton): boolean; virtual; 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; function MoveExtend(Relative: Boolean; DCol, DRow: Integer; ForceFullyVisible: Boolean = True): Boolean; function MoveNextAuto(const Inverse: boolean): boolean; function MoveNextSelectable(Relative:Boolean; DCol, DRow: Integer): Boolean; virtual; procedure MoveSelection; virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; function OffsetToColRow(IsCol, Physical: Boolean; Offset: Integer; out Index, Rest: Integer): Boolean; procedure Paint; override; procedure PickListItemSelected(Sender: TObject); procedure PrepareCanvas(aCol,aRow: Integer; aState:TGridDrawState); virtual; procedure PrepareCellHints(ACol, ARow: Integer); virtual; procedure ResetDefaultColWidths; virtual; procedure ResetEditor; procedure ResetLastMove; function ResetOffset(chkCol, ChkRow: Boolean): Boolean; procedure ResetSizes; virtual; procedure ResizeColumn(aCol, aWidth: Integer); procedure ResizeRow(aRow, aHeight: Integer); procedure RowHeightsChanged; virtual; procedure SaveContent(cfg: TXMLConfig); virtual; procedure SaveGridOptions(cfg: TXMLConfig); virtual; procedure ScrollBarRange(Which:Integer; aRange,aPage,aPos: Integer); procedure ScrollBarPosition(Which, Value: integer); function ScrollBarIsVisible(Which:Integer): Boolean; procedure ScrollBarPage(Which: Integer; aPage: Integer); procedure ScrollBarShow(Which: Integer; aValue: boolean); function ScrollBarAutomatic(Which: TScrollStyle): boolean; virtual; procedure ScrollBy(DeltaX, DeltaY: Integer); override; procedure SelectEditor; virtual; function SelectCell(ACol, ARow: Integer): Boolean; virtual; procedure SetCanvasFont(aFont: TFont); procedure SetColCount(AValue: Integer); virtual; procedure SetColor(Value: TColor); override; procedure SetColRow(const ACol,ARow: Integer; withEvents: boolean = false); procedure SetCursor(AValue: TCursor); override; procedure SetEditText(ACol, ARow: Longint; const Value: string); virtual; procedure SetBorderStyle(NewStyle: TBorderStyle); override; procedure SetFixedcolor(const AValue: TColor); virtual; procedure SetFixedCols(const AValue: Integer); virtual; procedure SetFixedRows(const AValue: Integer); virtual; procedure SetRawColWidths(ACol: Integer; AValue: Integer); procedure SetSelectedColor(const AValue: TColor); virtual; procedure SetFadeUnfocusedSelection(const AValue: boolean); procedure ShowCellHintWindow(APoint: TPoint); procedure SizeChanged(OldColCount, OldRowCount: Integer); virtual; procedure Sort(ColSorting: Boolean; index,IndxFrom,IndxTo:Integer); virtual; procedure StartPushCell; procedure TopLeftChanged; virtual; function TryMoveSelection(Relative: Boolean; var DCol, DRow: Integer): Boolean; procedure UnLockEditor; procedure UnprepareCellHints; virtual; procedure UpdateHorzScrollBar(const aVisible: boolean; const aRange,aPage,aPos: Integer); virtual; procedure UpdateSelectionRange; procedure UpdateVertScrollbar(const aVisible: boolean; const aRange,aPage,aPos: Integer); virtual; procedure UpdateBorderStyle; function ValidateEntry(const ACol,ARow:Integer; const OldValue:string; var NewValue:string): boolean; virtual; procedure VisualChange; virtual; procedure WMSize(var Message: TLMSize); message LM_SIZE; procedure WMHScroll(var message : TLMHScroll); message LM_HSCROLL; procedure WMVScroll(var message : TLMVScroll); message LM_VSCROLL; procedure WMKillFocus(var message: TLMKillFocus); message LM_KILLFOCUS; procedure WMSetFocus(var message: TLMSetFocus); message LM_SETFOCUS; procedure WndProc(var TheMessage : TLMessage); override; property AllowOutboundEvents: boolean read FAllowOutboundEvents write FAllowOutboundEvents default true; property AlternateColor: TColor read FAlternateColor write SetAlternateColor stored IsAltColorStored; property AutoAdvance: TAutoAdvance read FAutoAdvance write FAutoAdvance default aaRight; property AutoEdit: boolean read FAutoEdit write FAutoEdit default true; property AutoFillColumns: boolean read FAutoFillColumns write SetAutoFillColumns default false; property BorderStyle:TBorderStyle read FGridBorderStyle write SetBorderStyle default bsSingle; property BorderColor: TColor read FBorderColor write SetBorderColor default cl3DDKShadow; property CellHintPriority: TCellHintPriority read FCellHintPriority write FCellHintPriority default chpAllNoDefault; property Col: Integer read FCol write SetCol; property ColCount: Integer read GetColCount write SetColCount default 5; property ColRow: TPoint read GetQuickColRow write SetQuickColRow; property ColRowDraggingCursor: TCursor index gcsDragging read GetSpecialCursor write SetSpecialCursor default crMultiDrag; property ColRowDragIndicatorColor: TColor read FColRowDragIndicatorColor write SetColRowDragIndicatorColor default clRed; property ColSizingCursor: TCursor index gcsColWidthChanging read GetSpecialCursor write SetSpecialCursor default crHSplit; property ColumnClickSorts: boolean read FColumnClickSorts write SetColumnClickSorts default false; property Columns: TGridColumns read GetColumns write SetColumns stored IsColumnsStored; property ColWidths[aCol: Integer]: Integer read GetColWidths write SetColWidths; property DefaultColWidth: Integer read GetDefColWidth write SetDefColWidth stored DefaultColWidthIsStored; property DefaultRowHeight: Integer read GetDefRowHeight write SetDefRowHeight stored DefaultRowHeightIsStored; property DefaultDrawing: Boolean read FDefaultDrawing write SetDefaultDrawing default True; property DefaultTextStyle: TTextStyle read FDefaultTextStyle write FDefaultTextStyle; property DisabledFontColor: TColor read FDisabledFontColor write FDisabledFontColor default clGrayText; property DragDx: Integer read FDragDx write FDragDx; property Editor: TWinControl read FEditor write SetEditor; property EditorBorderStyle: TBorderStyle read GetEditorBorderStyle write SetEditorBorderStyle; property EditorMode: Boolean read FEditorMode write EditorSetMode; property EditorKey: boolean read FEditorKey write FEditorKey; property EditorOptions: Integer read FEditorOptions write SetEditorOptions; property EditorShowing: boolean read FEditorShowing write FEditorShowing; property ExtendedColSizing: boolean read FExtendedColSizing write FExtendedColSizing; property ExtendedRowSizing: boolean read FExtendedRowSizing write FExtendedRowSizing; property ExtendedSelect: boolean read FExtendedSelect write FExtendedSelect default true; property FastEditing: boolean read FFastEditing write FFastEditing; property AltColorStartNormal: boolean read FAltColorStartNormal write SetAltColorStartNormal; property FixedCols: Integer read FFixedCols write SetFixedCols default 1; property FixedRows: Integer read FFixedRows write SetFixedRows default 1; property FixedColor: TColor read GetFixedColor write SetFixedcolor default clBtnFace; property FixedGridLineColor: TColor read FFixedGridLineColor write SetFixedGridLineColor default cl3DDKShadow; property FixedHotColor: TColor read FFixedHotColor write FFixedHotColor default cl3DLight; property Flat: Boolean read FFlat write SetFlat default false; property FocusColor: TColor read FFocusColor write SetFocusColor; property FocusRectVisible: Boolean read FFocusRectVisible write SetFocusRectVisible; property GCache: TGridDataCache read FGCAChe; property GridFlags: TGridFlags read FGridFlags write FGridFlags; property GridHeight: Integer read FGCache.GridHeight; property GridLineColor: TColor read FGridLineColor write SetGridLineColor default clSilver; property GridLineStyle: TPenStyle read FGridLineStyle write SetGridLineStyle default psSolid; property GridLineWidth: Integer read FGridLineWidth write SetGridLineWidth default 1; property GridWidth: Integer read FGCache.GridWidth; property HeaderHotZones: TGridZoneSet read FHeaderHotZones write FHeaderHotZones default [gzFixedCols]; property HeaderPushZones: TGridZoneSet read FHeaderPushZones write FHeaderPushZones default [gzFixedCols]; property ImageIndexSortAsc: TImageIndex read FAscImgInd write FAscImgInd default -1; property ImageIndexSortDesc: TImageIndex read FDescImgInd write FDescImgInd default -1; property TabAdvance: TAutoAdvance read FTabAdvance write FTabAdvance default aaRightDown; property TitleImageList: TImageList read FTitleImageList write SetTitleImageList; property TitleImageListWidth: Integer read FTitleImageListWidth write SetTitleImageListWidth default 0; property InplaceEditor: TWinControl read FEditor; property IsCellSelected[aCol,aRow: Integer]: boolean read GetIsCellSelected; property LeftCol:Integer read GetLeftCol write SetLeftCol; property MouseWheelOption: TMouseWheelOption read FMouseWheelOption write FMouseWheelOption default mwCursor; property Options: TGridOptions read FOptions write SetOptions default DefaultGridOptions; property Options2: TGridOptions2 read FOptions2 write SetOptions2 default DefaultGridOptions2; property RangeSelectMode: TRangeSelectMode read FRangeSelectMode write SetRangeSelectMode default rsmSingle; property Row: Integer read FRow write SetRow; property RowCount: Integer read GetRowCount write SetRowCount default 5; property RowSizingCursor: TCursor index gcsRowHeightChanging read GetSpecialCursor write SetSpecialCursor default crVSplit; property RowHeights[aRow: Integer]: Integer read GetRowHeights write SetRowHeights; property SaveOptions: TSaveOptions read FsaveOptions write FSaveOptions; property SelectActive: Boolean read FSelectActive write SetSelectActive; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor; property FadeUnfocusedSelection: boolean read FFadeUnfocusedSelection write SetFadeUnfocusedSelection default false; property SelectedColumn: TGridColumn read GetSelectedColumn; property Selection: TGridRect read GetSelection write SetSelection; property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssAutoBoth; property StrictSort: boolean read FStrictSort write FStrictSort; property TitleFont: TFont read FTitleFont write SetTitleFont stored TitleFontIsStored; property TitleStyle: TTitleStyle read FTitleStyle write SetTitleStyle default tsLazarus; property TopRow: Integer read GetTopRow write SetTopRow; property UseXORFeatures: boolean read FUseXORFeatures write SetUseXorFeatures default false; property ValidateOnSetSelection: boolean read FValidateOnSetSelection write FValidateOnSetSelection; property VisibleColCount: Integer read GetVisibleColCount stored false; property VisibleRowCount: Integer read GetVisibleRowCount stored false; property OnAfterSelection: TOnSelectEvent read FOnAfterSelection write FOnAfterSelection; property OnBeforeSelection: TOnSelectEvent read FOnBeforeSelection write FOnBeforeSelection; property OnCheckboxToggled: TToggledCheckboxEvent read FOnCheckboxToggled write FOnCheckboxToggled; property OnCompareCells: TOnCompareCells read FOnCompareCells write FOnCompareCells; property OnPrepareCanvas: TOnPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas; property OnDrawCell: TOnDrawCell read FOnDrawCell write FOnDrawCell; // Deprecated in favor of OnButtonClick. property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick write FOnEditButtonClick; deprecated; property OnButtonClick: TOnSelectEvent read FOnButtonClick write FOnButtonClick; property OnPickListSelect: TNotifyEvent read FOnPickListSelect write FOnPickListSelect; property OnSelection: TOnSelectEvent read fOnSelection write fOnSelection; property OnSelectEditor: TSelectEditorEvent read FOnSelectEditor write FOnSelectEditor; property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged; property OnUserCheckboxBitmap: TUserCheckboxBitmapEvent read FOnUserCheckboxBitmap write FOnUserCheckboxBitmap; property OnUserCheckboxImage: TUserCheckBoxImageEvent read FOnUserCheckboxImage write FOnUserCheckboxImage; property OnValidateEntry: TValidateEntryEvent read FOnValidateEntry write FOnValidateEntry; // Bidi functions function FlipRect(ARect: TRect): TRect; function FlipPoint(P: TPoint): TPoint; function FlipX(X: Integer): Integer; // Hint-related property OnGetCellHint : TGetCellHintEvent read FOnGetCellHint write FOnGetCellHint; property OnSaveColumn: TSaveColumnEvent read FOnSaveColumn write FOnSaveColumn; property OnLoadColumn: TSaveColumnEvent read FOnLoadColumn write FOnLoadColumn; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Invalidate; override; procedure EditingDone; override; { Exposed procs } procedure AdjustInnerCellRect(var ARect: TRect); procedure AutoAdjustColumns; virtual; procedure BeginUpdate; function CellRect(ACol, ARow: Integer): TRect; function CellToGridZone(aCol,aRow: Integer): TGridZone; procedure CheckPosition; function ClearCols: Boolean; function ClearRows: Boolean; procedure Clear; procedure ClearSelections; function EditorByStyle(Style: TColumnButtonStyle): TWinControl; virtual; procedure EditorKeyDown(Sender: TObject; var Key:Word; Shift:TShiftState); procedure EditorKeyPress(Sender: TObject; var Key: Char); procedure EditorUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char); procedure EditorKeyUp(Sender: TObject; var key:Word; shift:TShiftState); procedure EditorTextChanged(const aCol,aRow: Integer; const aText:string); virtual; procedure EndUpdate(aRefresh: boolean = true); procedure EraseBackground(DC: HDC); override; procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override; function Focused: Boolean; override; function HasMultiSelection: Boolean; procedure HideSortArrow; procedure InvalidateCell(aCol, aRow: Integer); overload; procedure InvalidateCol(ACol: Integer); procedure InvalidateRange(const aRange: TRect); procedure InvalidateRow(ARow: Integer); function IsCellVisible(aCol, aRow: Integer): Boolean; function IsFixedCellVisible(aCol, aRow: Integer): boolean; procedure LoadFromFile(const FileName: string); virtual; procedure LoadFromStream(AStream: TStream); virtual; function MouseCoord(X,Y: Integer): TGridCoord; function MouseToCell(const Mouse: TPoint): TPoint; overload; procedure MouseToCell(X,Y: Integer; out ACol,ARow: Longint); overload; function MouseToLogcell(Mouse: TPoint): TPoint; function MouseToGridZone(X,Y: Integer): TGridZone; procedure SaveToFile(const FileName: string); virtual; procedure SaveToStream(AStream: TStream); virtual; procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override; procedure SetFocus; override; property CursorState: TGridCursorState read FCursorState; property SelectedRange[AIndex: Integer]: TGridRect read GetSelectedRange; property SelectedRangeCount: Integer read GetSelectedRangeCount; property SortOrder: TSortOrder read FSortOrder write FSortOrder; property SortColumn: Integer read FSortColumn; property TabStop default true; {$ifdef WINDOWS} protected procedure IMEStartComposition(var Msg:TMessage); message WM_IME_STARTCOMPOSITION; procedure IMEComposition(var Msg:TMessage); message WM_IME_COMPOSITION; procedure IMEEndComposition(var Msg:TMessage); message WM_IME_ENDCOMPOSITION; {$endif} end; TGetEditEvent = procedure (Sender: TObject; ACol, ARow: Integer; var Value: string) of object; TSetEditEvent = procedure (Sender: TObject; ACol, ARow: Integer; const Value: string) of object; TGetCheckboxStateEvent = procedure (Sender: TObject; ACol, ARow: Integer; var Value: TCheckboxState) of object; TSetCheckboxStateEvent = procedure (Sender: TObject; ACol, ARow: Integer; const Value: TCheckboxState) of object; { TCustomDrawGrid } TCustomDrawGrid=class(TCustomGrid) private FEditorRow, FEditorCol: Integer; FOnColRowDeleted: TgridOperationEvent; FOnColRowExchanged: TgridOperationEvent; FOnColRowInserted: TGridOperationEvent; FOnColRowMoved: TgridOperationEvent; FOnGetCheckboxState: TGetCheckboxStateEvent; FOnGetEditMask: TGetEditEvent; FOnGetEditText: TGetEditEvent; FOnHeaderClick, FOnHeaderSized: THdrEvent; FOnHeaderSizing: THeaderSizingEvent; FOnSelectCell: TOnSelectcellEvent; FOnSetCheckboxState: TSetCheckboxStateEvent; FOnSetEditText: TSetEditEvent; function CellNeedsCheckboxBitmaps(const aCol,aRow: Integer): boolean; procedure DrawCellCheckboxBitmaps(const aCol,aRow: Integer; const aRect: TRect); function GetEditorValue(ACol, ARow: Integer): String; protected FGrid: TVirtualGrid; procedure CellClick(const aCol,aRow: Integer; const Button:TMouseButton); override; procedure ColRowDeleted(IsColumn: Boolean; index: Integer); override; procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); override; procedure ColRowInserted(IsColumn: boolean; index: integer); override; procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); override; function CreateVirtualGrid: TVirtualGrid; virtual; procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override; procedure DrawCellAutonumbering(aCol,aRow: Integer; aRect: TRect; const aValue: string); virtual; procedure DrawFocusRect(aCol,aRow: Integer; ARect: TRect); override; function GetCells(ACol, ARow: Integer): string; override; procedure GetCheckBoxState(const aCol, aRow:Integer; var aState:TCheckboxState); virtual; function GetEditMask(aCol, aRow: Longint): string; override; function GetEditText(aCol, aRow: Longint): string; override; procedure GridMouseWheel(shift: TShiftState; Delta: Integer); override; procedure HeaderClick(IsColumn: Boolean; index: Integer); override; procedure HeaderSized(IsColumn: Boolean; index: Integer); override; procedure HeaderSizing(const IsColumn:boolean; const AIndex,ASize:Integer); override; procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure NotifyColRowChange(WasInsert,IsColumn:boolean; FromIndex,ToIndex:Integer); function SelectCell(aCol,aRow: Integer): boolean; override; procedure SetColor(Value: TColor); override; procedure SetCheckboxState(const aCol, aRow:Integer; const aState: TCheckboxState); virtual; procedure SetEditText(ACol, ARow: Longint; const Value: string); override; procedure SizeChanged(OldColCount, OldRowCount: Integer); override; procedure ToggleCheckbox; virtual; property OnGetCheckboxState: TGetCheckboxStateEvent read FOnGetCheckboxState write FOnGetCheckboxState; property OnSetCheckboxState: TSetCheckboxStateEvent read FOnSetCheckboxState write FOnSetCheckboxState; public // to easy user call constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure DeleteColRow(IsColumn: Boolean; index: Integer); procedure DeleteCol(Index: Integer); virtual; procedure DeleteRow(Index: Integer); virtual; procedure ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer); virtual; procedure InsertColRow(IsColumn: boolean; index: integer); procedure MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer); procedure SortColRow(IsColumn: Boolean; index:Integer); overload; procedure SortColRow(IsColumn: Boolean; Index,FromIndex,ToIndex: Integer); overload; procedure DefaultDrawCell(aCol,aRow: Integer; var aRect: TRect; aState:TGridDrawState); virtual; // properties property AllowOutboundEvents; property BorderColor; property Canvas; property Col; property ColWidths; property ColRow; property DisabledFontColor; property Editor; property EditorBorderStyle; property EditorMode; property ExtendedColSizing; property AltColorStartNormal; property FastEditing; property FixedGridLineColor; property FocusColor; property FocusRectVisible; property GridHeight; property GridWidth; property IsCellSelected; property LeftCol; property Row; property RowHeights; property SaveOptions; property SelectedColor; property SelectedColumn; property Selection; property StrictSort; //property TabStops; property TopRow; property UseXORFeatures; public property Align; property Anchors; property AutoAdvance; property AutoFillColumns; //property BiDiMode; property BorderSpacing; property BorderStyle; property Color default clWindow; property ColCount; property Columns; property Constraints; property DefaultColWidth; property DefaultDrawing; property DefaultRowHeight; //property DragCursor; //property DragKind; //property DragMode; property Enabled; property FadeUnfocusedSelection; property FixedColor; property FixedCols; property FixedHotColor; property FixedRows; property Flat; property Font; property GridLineColor; property GridLineStyle; property GridLineWidth; property Options; property Options2; //property ParentBiDiMode; //property ParentColor; //property ParentFont; property ParentShowHint; property PopupMenu; property RowCount; property ScrollBars; property ShowHint; property TabAdvance; property TabOrder; property TabStop; property Visible; property VisibleColCount; property VisibleRowCount; property OnAfterSelection; property OnBeforeSelection; property OnClick; property OnColRowDeleted: TgridOperationEvent read FOnColRowDeleted write FOnColRowDeleted; property OnColRowExchanged: TgridOperationEvent read FOnColRowExchanged write FOnColRowExchanged; property OnColRowInserted: TGridOperationEvent read FOnColRowInserted write FOnColRowInserted; property OnColRowMoved: TgridOperationEvent read FOnColRowMoved write FOnColRowMoved; property OnCompareCells; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDrawCell; property OnEditButtonClick; deprecated; property OnButtonClick; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnGetEditMask: TGetEditEvent read FOnGetEditMask write FOnGetEditMask; property OnGetEditText: TGetEditEvent read FOnGetEditText write FOnGetEditText; property OnHeaderClick: THdrEvent read FOnHeaderClick write FOnHeaderClick; property OnHeaderSized: THdrEvent read FOnHeaderSized write FOnHeaderSized; property OnHeaderSizing: THeaderSizingEvent read FOnHeaderSizing write FOnHeaderSizing; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnPickListSelect; property OnPrepareCanvas; property OnSelectEditor; property OnSelection; property OnSelectCell: TOnSelectCellEvent read FOnSelectCell write FOnSelectCell; property OnSetEditText: TSetEditEvent read FOnSetEditText write FOnSetEditText; property OnStartDock; property OnStartDrag; property OnTopleftChanged; property OnUTF8KeyPress; property OnValidateEntry; end; { TDrawGrid } TDrawGrid = class(TCustomDrawGrid) public property InplaceEditor; published property Align; property AlternateColor; property Anchors; property AutoAdvance; property AutoEdit; property AutoFillColumns; //property BiDiMode; property BorderSpacing; property BorderStyle; // property CellHintPriority; property Color; property ColCount; property ColRowDraggingCursor; property ColRowDragIndicatorColor; property ColSizingCursor; property ColumnClickSorts; property Columns; property Constraints; property DefaultColWidth; property DefaultDrawing; property DefaultRowHeight; property DoubleBuffered; property DragCursor; property DragKind; property DragMode; property Enabled; property ExtendedSelect; property FadeUnfocusedSelection; property FixedColor; property FixedCols; property FixedRows; property Flat; property Font; property GridLineColor; property GridLineStyle; property GridLineWidth; property HeaderHotZones; property HeaderPushZones; property ImageIndexSortAsc; property ImageIndexSortDesc; property MouseWheelOption; property Options; property Options2; //property ParentBiDiMode; property ParentColor default false; property ParentDoubleBuffered; property ParentFont; property ParentShowHint; property PopupMenu; property RangeSelectMode; property RowCount; property RowSizingCursor; property ScrollBars; property ShowHint; property TabAdvance; property TabOrder; property TabStop; property TitleFont; property TitleImageList; property TitleImageListWidth; property TitleStyle; property UseXORFeatures; property Visible; property VisibleColCount; property VisibleRowCount; property OnAfterSelection; property OnBeforeSelection; property OnCheckboxToggled; property OnClick; property OnColRowDeleted; property OnColRowExchanged; property OnColRowInserted; property OnColRowMoved; property OnCompareCells; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDrawCell; property OnEditButtonClick; deprecated; property OnButtonClick; property OnEditingDone; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnGetCellHint; property OnGetCheckboxState; property OnGetEditMask; property OnGetEditText; property OnHeaderClick; property OnHeaderSized; property OnHeaderSizing; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnMouseWheelHorz; property OnMouseWheelLeft; property OnMouseWheelRight; property OnPickListSelect; property OnPrepareCanvas; property OnSelectEditor; property OnSelection; property OnSelectCell; property OnSetCheckboxState; property OnSetEditText; property OnStartDock; property OnStartDrag; property OnTopleftChanged; property OnUserCheckboxBitmap; property OnUserCheckboxImage; property OnUTF8KeyPress; property OnValidateEntry; end; TCustomStringGrid = class; { TStringGridStrings } TStringGridStrings = class(TStrings) private FAddedCount: Integer; FGrid: TCustomStringGrid; FIsCol: Boolean; FIndex: Integer; FOwner: TMap; function ConvertIndexLineCol(Index: Integer; var Line, Col: Integer): boolean; protected function Get(Index: Integer): string; override; function GetCount: Integer; override; function GetObject(Index: Integer): TObject; override; procedure Put(Index: Integer; const S: string); override; procedure PutObject(Index: Integer; aObject: TObject); override; public constructor Create(aGrid: TCustomStringGrid; OwnerMap:TMap; aIsCol: Boolean; aIndex: Longint); destructor Destroy; override; function Add(const S: string): Integer; override; procedure Assign(Source: TPersistent); override; procedure Clear; override; procedure Delete(Index: Integer); override; procedure Insert(Index: Integer; const S: string); override; end; { TCustomStringGrid } TCustomStringGrid = class(TCustomDrawGrid) private FModified: boolean; FColsMap,FRowsMap: TMap; fOnCellProcess: TCellProcessEvent; function GetCols(index: Integer): TStrings; function GetObjects(ACol, ARow: Integer): TObject; function GetRows(index: Integer): TStrings; procedure MapFree(var aMap: TMap); function MapGetColsRows(IsCols: boolean; Index:Integer; var AMap:TMap):TStrings; procedure ReadCells(Reader: TReader); procedure SetCols(index: Integer; const AValue: TStrings); procedure SetObjects(ACol, ARow: Integer; AValue: TObject); procedure SetRows(index: Integer; const AValue: TStrings); procedure WriteCells(Writer: TWriter); procedure CopyCellRectToClipboard(const R:TRect); protected procedure AssignTo(Dest: TPersistent); override; procedure AutoAdjustColumn(aCol: Integer); override; procedure CalcCellExtent(acol, aRow: Integer; var aRect: TRect); override; procedure DefineProperties(Filer: TFiler); override; procedure DefineCellsProperty(Filer: TFiler); virtual; function DoCompareCells(Acol,ARow,Bcol,BRow: Integer): Integer; override; procedure DoCopyToClipboard; override; procedure DoCutToClipboard; override; procedure DoPasteFromClipboard; override; procedure DoCellProcess(aCol, aRow: Integer; processType: TCellProcessType; var aValue: string); virtual; procedure DrawColumnText(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); override; procedure DrawTextInCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); override; procedure DrawCellAutonumbering(aCol,aRow: Integer; aRect: TRect; const aValue: string); override; //procedure EditordoGetValue; override; //procedure EditordoSetValue; override; function GetCells(ACol, ARow: Integer): string; override; procedure GetCheckBoxState(const aCol, aRow:Integer; var aState:TCheckboxState); override; function GetEditText(aCol, aRow: Integer): string; override; procedure LoadContent(cfg: TXMLConfig; Version: Integer); override; procedure Loaded; override; procedure SaveContent(cfg: TXMLConfig); override; //procedure DrawInteriorCells; override; //procedure SelectEditor; override; procedure SelectionSetText(const TheText: String); procedure SelectionSetHTML(const TheHTML: String; TheText: String); procedure SetCells(ACol, ARow: Integer; const AValue: string); virtual; procedure SetCheckboxState(const aCol, aRow:Integer; const aState: TCheckboxState); override; procedure SetEditText(aCol, aRow: Longint; const aValue: string); override; property Modified: boolean read FModified write FModified; property OnCellProcess: TCellProcessEvent read fOnCellProcess write fOnCellProcess; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure AutoSizeColumn(aCol: Integer); procedure AutoSizeColumns; procedure Clean; overload; procedure Clean(CleanOptions: TGridZoneSet); overload; procedure Clean(aRect: TRect; CleanOptions: TGridZoneSet); overload; procedure Clean(StartCol,StartRow,EndCol,EndRow: integer; CleanOptions: TGridZoneSet); overload; procedure CopyToClipboard(AUseSelection: boolean = false); procedure InsertRowWithValues(Index: Integer; Values: array of String); procedure LoadFromCSVStream(AStream: TStream; ADelimiter: Char=','; UseTitles: boolean=true; FromLine: Integer=0; SkipEmptyLines: Boolean=true); virtual; procedure LoadFromCSVFile(const AFilename: string; ADelimiter: Char=','; UseTitles: boolean=true; FromLine: Integer=0; SkipEmptyLines: Boolean=true); procedure SaveToCSVStream(AStream: TStream; ADelimiter: Char=','; WriteTitles: boolean=true; VisibleColumnsOnly: boolean=false); procedure SaveToCSVFile(const AFileName: string; ADelimiter: Char=','; WriteTitles: boolean=true; VisibleColumnsOnly: boolean=false); property Cells[ACol, ARow: Integer]: string read GetCells write SetCells; property Cols[index: Integer]: TStrings read GetCols write SetCols; property DefaultTextStyle; property EditorMode; property ExtendedSelect; property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects; property Rows[index: Integer]: TStrings read GetRows write SetRows; property UseXORFeatures; property ValidateOnSetSelection; end; { TStringGrid } TStringGrid = class(TCustomStringGrid) protected class procedure WSRegisterClass; override; public property Modified; property InplaceEditor; published property Align; property AlternateColor; property Anchors; property AutoAdvance; property AutoEdit; property AutoFillColumns; property BiDiMode; property BorderSpacing; property BorderStyle; property CellHintPriority; property Color; property ColCount; property ColRowDraggingCursor; property ColRowDragIndicatorColor; property ColSizingCursor; property ColumnClickSorts; property Columns; property Constraints; property DefaultColWidth; property DefaultDrawing; property DefaultRowHeight; property DoubleBuffered; property DragCursor; property DragKind; property DragMode; property Enabled; property ExtendedSelect; property FadeUnfocusedSelection; property FixedColor; property FixedCols; property FixedRows; property Flat; property Font; property GridLineColor; property GridLineStyle; property GridLineWidth; property HeaderHotZones; property HeaderPushZones; property ImageIndexSortAsc; property ImageIndexSortDesc; property MouseWheelOption; property Options; property Options2; property ParentBiDiMode; property ParentColor default false; property ParentDoubleBuffered; property ParentFont; property ParentShowHint; property PopupMenu; property RangeSelectMode; property RowCount; property RowSizingCursor; property ScrollBars; property ShowHint; property TabAdvance; property TabOrder; property TabStop; property TitleFont; property TitleImageList; property TitleStyle; property UseXORFeatures; property Visible; property VisibleColCount; property VisibleRowCount; property OnAfterSelection; property OnBeforeSelection; property OnCellProcess; property OnChangeBounds; property OnCheckboxToggled; property OnClick; property OnColRowDeleted; property OnColRowExchanged; property OnColRowInserted; property OnColRowMoved; property OnCompareCells; property OnContextPopup; property OnDragDrop; property OnDragOver; property OnDblClick; property OnDrawCell; property OnEditButtonClick; deprecated; property OnButtonClick; property OnEditingDone; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnGetCellHint; property OnGetCheckboxState; property OnGetEditMask; property OnGetEditText; property OnHeaderClick; property OnHeaderSized; property OnHeaderSizing; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnMouseWheelHorz; property OnMouseWheelLeft; property OnMouseWheelRight; property OnPickListSelect; property OnPrepareCanvas; property OnResize; property OnSelectEditor; property OnSelection; property OnSelectCell; property OnSetCheckboxState; property OnSetEditText; property OnShowHint; property OnStartDock; property OnStartDrag; property OnTopLeftChanged; property OnUserCheckboxBitmap; property OnUserCheckboxImage; property OnUTF8KeyPress; property OnValidateEntry; end; procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor; DrawBits:Byte=BF_RECT); function GetWorkingCanvas(const Canvas: TCanvas): TCanvas; procedure FreeWorkingCanvas(canvas: TCanvas); procedure Register; implementation {$R lcl_grid_images.res} uses WSGrids, GraphMath; {$WARN SYMBOL_DEPRECATED OFF} {$IFDEF FPC_HAS_CPSTRING} {$WARN IMPLICIT_STRING_CAST OFF} {$WARN IMPLICIT_STRING_CAST_LOSS OFF} {$ENDIF} type TWinControlAccess = Class(TWinControl); //used in TCustomGrid.DoEditorShow const MULTISEL_MODIFIER = {$IFDEF Darwin}ssMeta{$ELSE}ssCtrl{$ENDIF}; function BidiFlipX(X: Integer; const Width: Integer; const Flip: Boolean): Integer; begin if Flip then //-1 because it zero based Result := Width - X - 1 else Result := X; end; function BidiFlipX(X: Integer; const ParentRect: TRect; const Flip: Boolean): Integer; begin Result := BidiFlipX(X, ParentRect.Right, Flip); end; function BidiFlipPoint(P: TPoint; const ParentRect: TRect; const Flip: Boolean): TPoint; begin Result := P; Result.Y := BidiFlipX(Result.Y, ParentRect, Flip); end; function NormalizarRect(const R:TRect): TRect; begin Result.Left:=Min(R.Left, R.Right); Result.Top:=Min(R.Top, R.Bottom); Result.Right:=Max(R.Left, R.Right); Result.Bottom:=Max(R.Top, R.Bottom); end; procedure SwapInt(var I1,I2: Integer); var Tmp: Integer; begin Tmp:=I1; I1:=I2; I2:=Tmp; end; {$ifdef GridTraceMsg} function TransMsg(const S: String; const TheMsg: TLMessage): String; begin case TheMsg.Msg of CM_BASE..CM_MOUSEWHEEL: case TheMsg.Msg of CM_MOUSEENTER: exit; //Result := 'CM_MOUSEENTER'; CM_MOUSELEAVE: exit; //Result := 'CM_MOUSELEAVE'; CM_TEXTCHANGED: Result := 'CM_TEXTCHANGED'; CM_UIACTIVATE: Result := 'CM_UIACTIVATE'; CM_CONTROLLISTCHANGE: Result := 'CM_CONTROLLISTCHANGE'; CM_PARENTCOLORCHANGED: Result := 'CM_PARENTCOLORCHANGED'; CM_PARENTSHOWHINTCHANGED: Result := 'CM_PARENTSHOWHINTCHANGED'; CM_PARENTBIDIMODECHANGED: Result := 'CM_PARENTBIDIMODECHANGED'; CM_CONTROLCHANGE: Result := 'CM_CONTROLCHANGE'; CM_SHOWINGCHANGED: Result := 'CM_SHOWINGCHANGED'; CM_VISIBLECHANGED: Result := 'CM_VISIBLECHANGED'; CM_HITTEST: exit;//Result := 'CM_HITTEST'; else Result := 'CM_BASE + '+ IntToStr(TheMsg.Msg - CM_BASE); end; else case TheMsg.Msg of //CN_BASE MESSAGES CN_COMMAND: Result := 'CN_COMMAND'; CN_KEYDOWN: Result := 'CN_KEYDOWN'; CN_KEYUP: Result := 'CN_KEYUP'; CN_CHAR: Result := 'CN_CHAR'; // NORMAL MESSAGES LM_SETFOCUS: Result := 'LM_SetFocus'; LM_LBUTTONDOWN: Result := 'LM_MOUSEDOWN'; LM_LBUTTONUP: Result := 'LM_LBUTTONUP'; LM_LBUTTONDBLCLK: Result := 'LM_LBUTTONDBLCLK'; LM_RBUTTONDOWN: Result := 'LM_RBUTTONDOWN'; LM_RBUTTONUP: Result := 'LM_RBUTTONUP'; LM_RBUTTONDBLCLK: Result := 'LM_RBUTTONDBLCLK'; LM_GETDLGCODE: Result := 'LM_GETDLGCODE'; LM_KEYDOWN: Result := 'LM_KEYDOWN'; LM_KEYUP: Result := 'LM_KEYUP'; LM_CAPTURECHANGED: Result := 'LM_CAPTURECHANGED'; LM_ERASEBKGND: Result := 'LM_ERASEBKGND'; LM_KILLFOCUS: Result := 'LM_KILLFOCUS'; LM_CHAR: Result := 'LM_CHAR'; LM_SHOWWINDOW: Result := 'LM_SHOWWINDOW'; LM_SIZE: Result := 'LM_SIZE'; LM_WINDOWPOSCHANGED: Result := 'LM_WINDOWPOSCHANGED'; LM_HSCROLL: Result := 'LM_HSCROLL'; LM_VSCROLL: Result := 'LM_VSCROLL'; LM_MOUSEMOVE: exit;//Result := 'LM_MOUSEMOVE'; LM_MOUSEWHEEL: Result := 'LM_MOUSEWHEEL'; 1105: exit;//Result := '?EM_SETWORDBREAKPROCEX?'; else Result := GetMessageName(TheMsg.Msg); end; end; Result:= S + '['+IntToHex(TheMsg.msg, 8)+'] W='+IntToHex(TheMsg.WParam,8)+ ' L='+IntToHex(TheMsg.LParam,8)+' '+Result; DebugLn(Result); end; {$Endif GridTraceMsg} function dbgs(zone: TGridZone):string; overload; begin case Zone of gzFixedCells: Result := 'gzFixedCells'; gzFixedCols: Result := 'gzFixedCols'; gzFixedRows: Result := 'gzFixedRows'; gzNormal: Result := 'gzNormal'; gzInvalid: Result := 'gzInvalid'; else result:= 'gz-error'; end; end; function dbgs(zones: TGridZoneSet):string; overload; procedure add(const s:string); begin if result<>'' then result := result + ',' + s else result := s; end; begin result:=''; if gzFixedCells in zones then add('gzFixedCells'); if gzFixedCols in zones then add('gzFixedCols'); if gzFixedRows in zones then add('gzFixedRows'); if gzNormal in zones then add('gzNormal'); if gzInvalid in zones then add('gzInvalid'); result := '['+result+']'; end; {$ifdef DbgScroll} function SbToStr(Which: Integer): string; begin case Which of SB_VERT: result := 'vert'; SB_HORZ: result := 'horz'; SB_BOTH: result := 'both'; else result := '????'; end; end; {$endif} procedure CfgSetFontValue(cfg: TXMLConfig; AKey: WideString; AFont: TFont); begin cfg.SetValue(AKey + '/name/value', AFont.Name); cfg.SetValue(AKey + '/size/value', AFont.Size); cfg.SetValue(AKey + '/color/value', ColorToString(AFont.Color)); cfg.SetValue(AKey + '/style/value', Integer(AFont.Style)); end; procedure CfgGetFontValue(cfg: TXMLConfig; AKey: WideString; AFont: TFont); begin AFont.Name := cfg.GetValue(AKey + '/name/value', 'default'); AFont.Size := cfg.GetValue(AKey + '/size/value', 0); AFont.Color:= StringToColor(cfg.GetValue(AKey + '/color/value', 'clWindowText')); AFont.Style:= TFontStyles(cfg.GetValue(AKey + '/style/value', 0)); end; // Draws a dotted rectangle by drawing each enabled side. By default all sides are // enabled. The DrawBits parameter set sides to drawn, it has this layout: xxxxBRTL procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor; DrawBits: Byte); procedure DrawVertLine(X1,Y1,Y2: integer); begin if Y2HotGridZone) or (P.x<>HotCell.x) or (P.y<>HotCell.y) then begin ResetHotCell; if (P.x>=0) and (P.y>=0) then begin if ButtonColumn or (goHeaderHotTracking in Options) then begin InvalidateCell(P.X, P.Y); HotCell := P; end; end; end; if ButtonColumn or (goHeaderPushedLook in Options) then begin if ClickCellPushed then begin if (P.X<>PushedCell.x) or (P.Y<>PushedCell.Y) then ResetPushedCell(False); end else if IsPushCellActive() then begin if (P.X=PushedCell.X) and (P.Y=PushedCell.Y) then begin ClickCellPushed:=True; InvalidateCell(P.X, P.Y); end; end; end; HotGridZone := Gz; end; end; procedure TCustomGrid.InternalAutoFillColumns; var i, availableSize, avgSize, rest: Integer; widths: array of record aIndex, aMin, aMax, aPriority, aWidth: Integer; end; done, isMax, isMin: boolean; procedure SetColumnWidth(aCol,aWidth: Integer); begin if csLoading in ComponentState then SetRawColWidths(aCol, aWidth) else SetColWidths(aCol, aWidth); end; procedure DeleteWidth(aIndex: Integer); begin if aIndex < Length(widths) - 1 then move(widths[aIndex+1], widths[aIndex], (Length(widths)-aIndex-1) * SizeOf(widths[0])); SetLength(widths, Length(widths) - 1); end; begin if not AutoFillColumns then exit; if FUpdatingAutoFillCols then exit; FUpdatingAutoFillCols:=True; try // if needed, last size can be obtained from FLastWidth // when InternalAutoFillColumns is called from DoChangeBounds // for example. // A simple algorithm is implemented: // if SizePriority=0, column size should be unmodified // if SizePriority<>0 means variable size column whose width // is the average available size respecting each column // MinSize and MaxSize constraints, such constraints // are valid only if they are bigger than 0. widths := nil; SetLength(widths, ColCount); availableSize := ClientWidth - GetBorderWidth; for i:=ColCount-1 downto 0 do with widths[i] do begin aIndex := i; GetAutoFillColumnInfo(i, aMin, aMax, aPriority); aWidth := GetColWidths(i); if aPriority=0 then begin Dec(availableSize, aWidth); DeleteWidth(i); end end; if Length(widths)=0 then begin // it's an autofillcolumns grid either WITHOUT custom colums and // fixedCols=ColCount or WITH custom columns where all columns // have PrioritySize=0, resize the last column (inherited behavior) i := ColCount-1; if (i>=FixedCols) then // aMax of last column ... SetColumnWidth(i, AvailableSize + GetColWidths(i)); exit; end; avgSize := availableSize div Length(widths); repeat done := true; for i:=Length(widths)-1 downto 0 do with widths[i] do begin isMax := ((aMax>0) and (avgSize>aMax)); isMin := ((aMin>0) and (avgSize0 then avgSize := availableSize div length(widths); done := false; break; end; end; until done; if length(widths)>0 then begin rest := availableSize mod length(widths); for i:=0 to length(widths)-1 do with widths[i] do begin aWidth := Max(avgSize, 0); if rest>0 then begin inc(aWidth); dec(rest); end; SetColumnWidth(aIndex, aWidth); end; end; finally FUpdatingAutoFillCols:=False; end; end; function TCustomGrid.InternalNeedBorder: boolean; begin result := FFlat and (FGridBorderStyle = bsSingle); end; procedure TCustomGrid.InternalSetColCount(ACount: Integer); var OldC: Integer; NewRowCount: Integer; begin OldC := FCols.Count; if ACount=OldC then Exit; if ACount<1 then Clear else begin if EditorMode and (ACount<=Col) then EditorMode:=False; NewRowCount := RowCount; if (OldC=0) and FGridPropBackup.ValidData then begin NewRowCount := FGridPropBackup.RowCount; FFixedRows := Min(FGridPropBackup.FixedRowCount, NewRowCount); FFixedCols := Min(FGridPropBackup.FixedColCount, ACount); end; CheckFixedCount(ACount, NewRowCount, FFixedCols, FFixedRows); CheckCount(ACount, NewRowCount); AdjustCount(True, OldC, ACount); FGridPropBackup.ValidData := false; end; end; procedure TCustomGrid.InternalSetColWidths(aCol, aValue: Integer); var OldSize,NewSize: Integer; R: TRect; Bigger: boolean; begin NewSize := AValue; if NewSize<0 then begin AValue:=-1; NewSize := DefaultColWidth; end; OldSize := FCols[ACol]; if NewSize<>OldSize then begin if OldSize<0 then OldSize := DefaultColWidth; Bigger := NewSize>OldSize; SetRawColWidths(ACol, AValue); if not (csLoading in ComponentState) and HandleAllocated then begin if FUpdateCount=0 then begin UpdateSizes; R := CellRect(aCol, 0); R.Bottom := FGCache.MaxClientXY.Y+GetBorderWidth+1; if UseRightToLeftAlignment then begin //Bigger or not bigger i will refresh R.Left := FGCache.ClientRect.Left; if aCol=FTopLeft.x then R.Right := FGCache.ClientRect.Right - FGCache.FixedWidth; end else begin if Bigger then R.Right := FGCache.MaxClientXY.X+GetBorderWidth+1 else R.Right := FGCache.ClientWidth; if aCol=FTopLeft.x then R.Left := FGCache.FixedWidth; end; InvalidateRect(handle, @R, False); end; if (FEditor<>nil)and(Feditor.Visible)and(ACol<=FCol) then EditorWidthChanged(aCol, aValue); ColWidthsChanged; end; end; end; procedure TCustomGrid.InternalUpdateColumnWidths; var i: Integer; C: TGridColumn; begin for i:= FixedCols to ColCount-1 do begin C := ColumnFromGridColumn(i); if C<>nil then SetRawColWidths(i, C.Width); end; end; procedure TCustomGrid.InvalidateMovement(DCol, DRow: Integer; OldRange: TRect); procedure doInvalidateRange(Col1,Row1,Col2,Row2: Integer); begin InvalidateRange(Rect(Col1,Row1,Col2,Row2)); end; begin if (goRowHighlight in Options) then OldRange := Rect(FFixedCols, OldRange.Top, Colcount-1, OldRange.Bottom); if SelectActive then begin if DCol>FCol then begin // expanded cols if not (goRowSelect in Options) then doInvalidateRange(FCol, OldRange.Top, DCol, Oldrange.Bottom) else if (goRelaxedRowSelect in Options) and (DRow=FRow) then InvalidateRow(DRow) end else if DColFRow then // expanded rows doInvalidateRange(OldRange.Left, FRow, OldRange.Right, DRow) else if DRowFCol)and(DRowFRow) then // (3: III Cuadrant) // Rect(FCol-1,FRow+1,DCol,DRow) normalized -v doInvalidateRange(DCol, FRow+1, FCol-1, DRow) else if (DCol>FCol)and(DRow>FRow) then // (4: IV Cuadrant) // normalization not needed doInvalidateRange(FCol+1,FRow+1,DCol,DRow); end; end else begin if (OldRange.Right-OldRange.Left>0) or (OldRange.Bottom-OldRange.Top>0) then // old selected range gone, invalidate old area InvalidateRange(OldRange) else // Single cell InvalidateCell(FCol, FRow); // and invalidate current selecion, cell or full row if ((goRowSelect in Options) or (goRowHighlight in Options)) then InvalidateRow(Drow) else InvalidateCell(DCol, DRow); end; end; function TCustomGrid.IsColumnsStored: boolean; begin result := Columns.Enabled; end; function TCustomGrid.IsPushCellActive: boolean; begin with FGCache do result := (PushedCell.X<>-1) and (PushedCell.Y<>-1); end; function TCustomGrid.LoadResBitmapImage(const ResName: string): TBitmap; var C: TPortableNetworkGraphic; begin C := TPortableNetworkGraphic.Create; try C.LoadFromResourceName(hInstance, ResName); Result := TBitmap.Create; Result.Assign(C); finally C.Free; end; end; function TCustomGrid.MouseButtonAllowed(Button: TMouseButton): boolean; begin result := (Button=mbLeft); end; function TCustomGrid.GetLeftCol: Integer; begin result:=fTopLeft.x; end; function TCustomGrid.GetPxTopLeft: TPoint; begin if (FTopLeft.x >= 0) and (FTopLeft.x < FGCache.AccumWidth.Count) then Result.x := FGCache.AccumWidth[FTopLeft.x]+FGCache.TLColOff-FGCache.FixedWidth else if FTopLeft.x > 0 then Result.x := FGCache.GridWidth+FGCache.TLColOff-FGCache.FixedWidth else Result.x := 0; if (FTopLeft.y >= 0) and (FTopLeft.y < FGCache.AccumHeight.Count) then Result.y := FGCache.AccumHeight[FTopLeft.y]+FGCache.TLRowOff-FGCache.FixedHeight else if FTopLeft.y > 0 then Result.y := FGCache.GridHeight+FGCache.TLRowOff-FGCache.FixedHeight else Result.y := 0; end; function TCustomGrid.GetColCount: Integer; begin Result:=FCols.Count; end; function TCustomGrid.GetRowCount: Integer; begin Result:=FRows.Count; end; function TCustomGrid.IsColumnIndexValid(AIndex: Integer): boolean; begin Result := (AIndex>=0) and (AIndex=0) and (AIndex=FFixedCols) and (AIndex=FFixedRows) and (AIndexnil then Result:=C.Width else Result:=-1; end; if Result<0 then Result:=DefaultColWidth; end; procedure TCustomGrid.SetEditor(AValue: TWinControl); var Msg: TGridMessage; begin if FEditor=AValue then exit; {$ifdef DbgGrid} DebugLnEnter('TCustomGrid.SetEditor %s oldEd=%s newEd=%s INIT',[dbgsName(self),dbgsName(FEditor),dbgsName(Avalue)]); {$endif} if (FEditor<>nil) and FEditor.Visible then EditorHide; FEditor:=AValue; if FEditor<>nil then begin if FEditor.Parent=nil then FEditor.Visible:=False; if FEditor.Parent<>Self then FEditor.Parent:=Self; Msg.LclMsg.msg:=GM_SETGRID; Msg.Grid:=Self; Msg.Options:=0; FEditor.Dispatch(Msg); FEditorOptions := Msg.Options + 1; // force new editor setup SetEditorOptions(Msg.Options); end; {$ifdef DbgGrid} DebugLnExit('TCustomGrid.SetEditor DONE'); {$endif} end; procedure TCustomGrid.SetFixedCols(const AValue: Integer); begin if FFixedCols=AValue then begin if FixedGrid and FGridPropBackup.ValidData then begin // user modified fixed properties in fixed grid // update stored values FGridPropBackup.FixedColCount := AValue; end; exit; end; CheckFixedCount(ColCount, RowCount, AValue, FFixedRows); if EditorMode then EditorMode:=False; FFixedCols:=AValue; FTopLeft.x:=AValue; if Columns.Enabled then begin FCol:=AValue; UpdateSelectionRange; if not (csLoading in componentState) then doTopleftChange(true); ColumnsChanged(nil) end else begin if not (csLoading in componentState) then doTopleftChange(true); MoveNextSelectable(False, FixedCols, FRow); UpdateSelectionRange; end; end; procedure TCustomGrid.SetFixedRows(const AValue: Integer); begin if FFixedRows=AValue then begin if FixedGrid and FGridPropBackup.ValidData then begin // user modified fixed properties in fixed grid // update stored values FGridPropBackup.FixedRowCount := AValue; end; exit; end; CheckFixedCount(ColCount, RowCount, FFixedCols, AValue); if EditorMode then EditorMode:=False; FFixedRows:=AValue; FTopLeft.y:=AValue; if not (csLoading in ComponentState) then doTopleftChange(true); MoveNextSelectable(False, FCol, FixedRows); UpdateSelectionRange; end; procedure TCustomGrid.SetGridLineColor(const AValue: TColor); begin if FGridLineColor=AValue then exit; FGridLineColor:=AValue; Invalidate; end; procedure TCustomGrid.SetFixedGridLineColor(const AValue: TColor); begin if FFixedGridLineColor=AValue then exit; FFixedGridLineColor:=AValue; Invalidate; end; procedure TCustomGrid.SetLeftCol(const AValue: Integer); begin TryScrollTo(AValue, FTopLeft.Y, True, False); end; procedure TCustomGrid.SetOptions(const AValue: TGridOptions); begin if FOptions=AValue then exit; FOptions:=AValue; UpdateSelectionRange; if goEditing in Options then SelectEditor; if goAlwaysShowEditor in Options then EditorShow(true) else EditorHide; if goAutoAddRowsSkipContentCheck in Options then FRowAutoInserted := False; VisualChange; end; procedure TCustomGrid.SetOptions2(const AValue: TGridOptions2); begin if FOptions2=AValue then exit; FOptions2:=AValue; VisualChange; end; procedure TCustomGrid.SetScrollBars(const AValue: TScrollStyle); begin if FScrollBars=AValue then exit; FScrollBars:=AValue; VisualChange; end; procedure TCustomGrid.SetTopRow(const AValue: Integer); begin TryScrollTo(FTopLeft.X, Avalue, False, True); end; function TCustomGrid.StartColSizing(const X, Y: Integer):boolean; var OrgIndex, TmpIndex: Integer; ACase: Integer; begin result := false; with FSizing do begin OrgIndex := FGCache.ClickCell.X; if OrgIndex<0 then begin // invalid starting cell if not AllowOutBoundEvents and (FCursorState=gcsColWidthChanging) then // resizing still allowed if mouse is within "resizeable region" OrgIndex := Index else exit; end; Index := OrgIndex; ColRowToOffset(true, true, Index, OffIni, OffEnd); if (Min(OffEnd, FGCache.ClientRect.Right)-FGCache.ClickMouse.X) < (FGCache.ClickMouse.X-OffIni) then begin if X>FGCache.ClickMouse.X then ACase := 4 // dragging right side to the right else ACase := 3; // dragging right side to the left end else begin if X>FGCache.ClickMouse.X then ACase := 2 // dragging left side to the right else ACase := 1; // dragging left side to the left end; if UseRightToLeftAlignment then begin case ACase of 1: ACase := 4; 2: ACase := 3; 3: ACase := 2; 4: ACase := 1; end; end; case ACase of 3: ; // current column is the right one to resize 4: // find following covered column (visible 0-width) at the right side begin TmpIndex := Index; while (TmpIndex0) or covered column begin Dec(Index); while (Index>FixedCols) do begin if not Columns.Enabled or ColumnFromGridColumn(Index).Visible then break; Dec(Index); end; end; 1: // find previous visible (width>0) column begin Dec(Index); while (Index>FixedCols) do begin if ColWidths[Index]>0 then break; Dec(Index); end; end; end; if OrgIndex<>Index then ColRowToOffset(True, True, Index, OffIni, OffEnd); // if precision on changing cursor from normal to split is expanded, there // will be a starting big jump on size, to fix it, uncomment next lines // TODO: check for RTL //DeltaOff := OffEnd - FGCache.ClickMouse.X; DeltaOff := 0; if goFixedColSizing in Options then result := (Index>=0) else result := (Index>=FixedCols); end; end; procedure TCustomGrid.ChangeCursor(ACursor: TCursor; ASaveCurrentCursor: Boolean = true); begin if FCursorChangeLock = 0 then begin if ASaveCurrentCursor then FSavedCursor := Cursor; inc(FCursorChangeLock); Cursor := ACursor; dec(FCursorChangeLock); end; end; procedure TCustomGrid.RestoreCursor; begin Cursor := FSavedCursor; FCursorState := gcsDefault; end; procedure TCustomGrid.SetRowHeights(Arow: Integer; Avalue: Integer); var OldSize,NewSize: Integer; R: TRect; Bigger: boolean; begin NewSize := AValue; if NewSize<0 then begin AValue:=-1; NewSize := DefaultRowHeight; end; OldSize := FRows[ARow]; if AValue<>OldSize then begin if OldSize<0 then OldSize := DefaultRowHeight; bigger := NewSize > OldSize; FRows[ARow]:=AValue; if not (csLoading in ComponentState) and HandleAllocated then begin if FUpdateCount=0 then begin UpdateSizes; R := CellRect(0, aRow); if UseRightToLeftAlignment then begin R.Left := FlipX(FGCache.MaxClientXY.X+GetBorderWidth); R.Right := R.Right + 1; end else R.Right := FGCache.MaxClientXY.X+GetBorderWidth+1; if bigger then R.Bottom := FGCache.MaxClientXY.Y+GetBorderWidth+1 else R.Bottom := FGCache.ClientHeight; if aRow=FTopLeft.y then R.Top := FGCache.FixedHeight; InvalidateRect(handle, @R, False); end; if (FEditor<>nil)and(Feditor.Visible)and(ARow<=FRow) then EditorPos; RowHeightsChanged; end; end; end; procedure TCustomGrid.SetColWidths(Acol: Integer; Avalue: Integer); var c: TGridColumn; OldWidth: Integer; begin if not Columns.Enabled or (aColnil then begin OldWidth := C.Width; C.Width := AValue; SetRawColWidths(ACol, AValue); if OldWidth<>C.Width then EditorWidthChanged(aCol, C.Width); end; end; end; procedure TCustomGrid.SetRawColWidths(ACol: Integer; AValue: Integer); begin if ACol < FCols.Count then // Prevent a range error in case of a bug. FCols[ACol]:=Avalue else DebugLn(['TCustomGrid.SetRawColWidths with Range Error: ACol=', ACol, ', Cols.Count=', FCols.Count]); end; procedure TCustomGrid.AdjustCount(IsColumn: Boolean; OldValue, NewValue: Integer); procedure AddDel(Lst: TIntegerList; aCount: Integer); begin while lst.Count=0) then begin FTopLeft.X:=FFixedCols; if RowCount=0 then begin if FGridPropBackup.ValidData then begin NewCount := FGridPropBackup.RowCount; FFixedRows := Min(FGridPropBackup.FixedRowCount, NewCount); end else NewCount := 1; FTopLeft.Y:=FFixedRows; AddDel(FRows, NewCount); FGCache.AccumHeight.Count:=NewCount; end; end; UpdateCachedSizes; SizeChanged(OldValue, OldCount); // if new count makes current col out of range, adjust position // if not, position should not change (fake changed col to be the last one) Dec(NewValue); if NewValue=0) then begin FTopleft.Y:=FFixedRows; //DebugLn('TCustomGrid.AdjustCount B ',DbgSName(Self),' FTopLeft=',dbgs(FTopLeft)); if FCols.Count=0 then begin if FGridPropBackup.ValidData then begin NewCount := FGridPropBackup.ColCount; FFixedCols := Min(FGridPropBackup.FixedColCount, NewCount); end else begin NewCount := 1; FFixedCols := 0; end; FTopLeft.X:=FFixedCols; AddDel(FCols, NewCount); FGCache.AccumWidth.Count:=NewCount; end; end; UpdateCachedSizes; SizeChanged(OldCount, OldValue); // if new count makes current row out of range, adjust position // if not, position should not change (fake changed row to be the last one) Dec(NewValue); if NewValueOldR then begin if AValue>=0 then begin if EditorMode and (AValue<=Row) then EditorMode:=False; NewColCount := ColCount; if (OldR=0) and FGridPropBackup.ValidData then begin NewColCount := FGridPropBackup.ColCount; FFixedCols := Min(FGridPropBackup.FixedColCount, NewColCount); FFixedRows := Min(FGridPropBackup.FixedRowCount, AValue); FTopLeft.X := FFixedCols; FTopLeft.Y := FFixedRows; // ignore backedup value of rowcount because // finally rowcount will be AValue FGridPropBackup.RowCount := AValue; end; if Columns.Enabled then begin // setup custom columns Self.ColumnsChanged(nil); FGridPropBackup.ValidData := false; // still need to adjust rowcount? if AValue=FRows.Count then exit; end; CheckFixedCount(NewColCount, AValue, FFixedCols, FFixedRows); CheckCount(NewColCount, AValue); AdjustCount(False, OldR, AValue); end else ClearRows; end; end; procedure TCustomGrid.SetDefColWidth(AValue: Integer); var OldLeft,OldRight,NewLeft,NewRight: Integer; begin if AValue=fDefColwidth then Exit; FDefColWidth:=AValue; FRealizedDefColWidth := 0; if EditorMode then ColRowToOffset(True, True, FCol, OldLeft, OldRight); ResetDefaultColWidths; if EditorMode then begin ColRowToOffset(True, True, FCol, NewLeft, NewRight); if (NewLeft<>OldLeft) or (NewRight<>OldRight) then EditorWidthChanged(FCol, GetColWidths(FCol)); end; end; procedure TCustomGrid.SetDefRowHeight(AValue: Integer); var i: Integer; OldTop,OldBottom,NewTop,NewBottom: Integer; begin if (AValue<>fDefRowHeight) or (csLoading in ComponentState) then begin FDefRowheight:=AValue; FRealizedDefRowHeight := 0; if EditorMode then ColRowToOffSet(False,True, FRow, OldTop, OldBottom); for i:=0 to RowCount-1 do FRows[i] := -1; VisualChange; if EditorMode then begin ColRowToOffSet(False,True, FRow, NewTop, NewBottom); if (NewTop<>OldTOp) or (NewBottom<>OldBottom) then EditorPos; end; end; end; procedure TCustomGrid.SetCol(AValue: Integer); begin if AValue=FCol then Exit; if not AllowOutboundEvents then CheckLimitsWithError(AValue, FRow); MoveExtend(False, AValue, FRow, True); Click; end; procedure TCustomGrid.SetRangeSelectMode(const AValue: TRangeSelectMode); begin if FRangeSelectMode=AValue then exit; FRangeSelectMode := AValue; ClearSelections; end; procedure TCustomGrid.SetRow(AValue: Integer); begin if AValue=FRow then Exit; if not AllowOutBoundEvents then CheckLimitsWithError(FCol, AValue); MoveExtend(False, FCol, AValue, True); Click; end; procedure TCustomGrid.Sort(ColSorting: Boolean; index, IndxFrom, IndxTo: Integer); procedure QuickSort(L,R: Integer); var I,J: Integer; P{,Q}: Integer; begin repeat I:=L; J:=R; P:=(L+R) div 2; repeat if ColSorting then begin while DoCompareCells(index, P, index, I)>0 do I:=I+1; while DoCompareCells(index, P, index, J)<0 do J:=J-1; end else begin while DoCompareCells(P, index, I, index)>0 do I:=I+1; while DoCompareCells(P, index, J, index)<0 do J:=J-1; end; if I<=J then begin if I<>J then if not FStrictSort or (ColSorting and (DoCompareCells(index, I, index, J)<>0)) or (not ColSorting and (DoCompareCells(I, index, J, index)<>0)) then DoOPExchangeColRow(not ColSorting, I,J); if P=I then P:=J else if P=J then P:=I; I:=I+1; J:=J-1; end; until I>J; if L=R; end; begin if RowCount>FixedRows then begin CheckIndex(ColSorting, Index); CheckIndex(not ColSorting, IndxFrom); CheckIndex(not ColSorting, IndxTo); BeginUpdate; QuickSort(IndxFrom, IndxTo); EndUpdate; end; end; procedure TCustomGrid.HideSortArrow; begin FSortColumn := -1; InvalidateGrid; end; procedure TCustomGrid.doTopleftChange(DimChg: Boolean); begin TopLeftChanged; VisualChange; end; procedure TCustomGrid.DrawXORVertLine(X: Integer); var OldPenMode: TPenMode; OldPenColor: TColor; begin OldPenMode := Canvas.Pen.Mode; OldPenColor := Canvas.Pen.Color; Canvas.Pen.Color := clWhite; Canvas.Pen.Mode := pmXOR; Canvas.MoveTo(X,0); Canvas.LineTo(X,FGCache.MaxClientXY.Y); Canvas.Pen.Mode := OldPenMode; Canvas.Pen.Color := OldPenColor; end; procedure TCustomGrid.DrawXORHorzLine(Y: Integer); var OldPenMode: TPenMode; OldPenColor: TColor; begin OldPenMode := Canvas.Pen.Mode; OldPenColor := Canvas.Pen.Color; Canvas.Pen.Color := clWhite; Canvas.Pen.Mode := pmXOR; if UseRightToLeftAlignment then begin Canvas.MoveTo(FlipX(FGCache.MaxClientXY.X)+1,Y); Canvas.LineTo(FGCache.ClientRect.Right,Y); end else begin Canvas.MoveTo(0,Y); Canvas.LineTo(FGCache.MaxClientXY.X,Y); end; Canvas.Pen.Mode := OldPenMode; Canvas.Pen.Color := OldPenColor; end; procedure TCustomGrid.VisualChange; begin if (FUpdateCount<>0) then exit; {$ifdef DbgVisualChange} DebugLn('TCustomGrid.VisualChange INIT ',DbgSName(Self)); {$endif} UpdateSizes; Invalidate; {$ifdef DbgVisualChange} DebugLn('TCustomGrid.VisualChange END ',DbgSName(Self)); {$endif} end; procedure TCustomGrid.ResetSizes; begin //DebugLn('TCustomGrid.VisualChange ',DbgSName(Self)); if (FCols=nil) or ([csLoading,csDestroying]*ComponentState<>[]) or (not HandleAllocated) then exit; // not yet initialized or already destroyed UpdateCachedSizes; CheckNewCachedSizes(FGCache); CacheVisibleGrid; {$Ifdef DbgVisualChange} DebugLn('TCustomGrid.ResetSizes %s Width=%d Height=%d',[DbgSName(Self),Width,Height]); DebugLn(' Cache: ClientWidth=%d ClientHeight=%d GWidth=%d GHeight=%d', [FGCAche.ClientWidth, FGCache.ClientHeight,FGCache.GridWidth, FGCache.GridHeight]); DebugLn(' Reald: ClientWidth=%d ClientHeight=%d',[ClientWidth, ClientHeight]); DebugLn(' MaxTopLeft',dbgs(FGCache.MaxTopLeft)); {$Endif} end; procedure TCustomGrid.CreateParams(var Params: TCreateParams); const ClassStylesOff = CS_VREDRAW or CS_HREDRAW; begin inherited CreateParams(Params); with Params do begin WindowClass.Style := WindowClass.Style and DWORD(not ClassStylesOff); Style := Style or WS_VSCROLL or WS_HSCROLL or WS_CLIPCHILDREN; end; end; procedure TCustomGrid.Click; begin {$IFDEF dbgGrid} DebugLn('FIgnoreClick=', dbgs(FIgnoreClick)); {$ENDIF} if not FIgnoreClick then inherited Click; end; procedure TCustomGrid.ScrollBarRange(Which: Integer; aRange,aPage,aPos: Integer); var ScrollInfo: TScrollInfo; begin if HandleAllocated then begin {$Ifdef DbgScroll} DebugLn('ScrollbarRange: Which=%s Range=%d Page=%d Pos=%d', [SbToStr(Which),aRange,aPage,aPos]); {$endif} FillChar(ScrollInfo, SizeOf(ScrollInfo), 0); ScrollInfo.cbSize := SizeOf(ScrollInfo); ScrollInfo.fMask := SIF_RANGE or SIF_PAGE or SIF_DISABLENOSCROLL; if not (gfPainting in FGridFlags) then ScrollInfo.fMask := ScrollInfo.fMask or SIF_POS; {$ifdef Unix} ScrollInfo.fMask := ScrollInfo.fMask or SIF_UPDATEPOLICY; if goThumbTracking in Options then ScrollInfo.ntrackPos := SB_POLICY_CONTINUOUS else ScrollInfo.ntrackPos := SB_POLICY_DISCONTINUOUS; {$endif} ScrollInfo.nMin := 0; ScrollInfo.nMax := aRange; ScrollInfo.nPos := aPos; if APage<0 then APage := 0; ScrollInfo.nPage := APage; if (Which=SB_HORZ) and UseRightToLeftAlignment then begin ScrollInfo.nPos := ScrollInfo.nMax-ScrollInfo.nPage-ScrollInfo.nPos; {$Ifdef DbgScroll} DebugLn('ScrollbarRange: RTL nPos=%d',[ScrollInfo.nPos]); {$endif} end; SetScrollInfo(Handle, Which, ScrollInfo, True); end; end; procedure TCustomGrid.ScrollBarPosition(Which, Value: integer); var ScrollInfo: TScrollInfo; Vis: Boolean; begin if HandleAllocated then begin {$Ifdef DbgScroll} DebugLn('ScrollbarPosition: Which=',SbToStr(Which), ' Value= ',IntToStr(Value)); {$endif} Vis := ScrollBarIsVisible(Which); FillChar(ScrollInfo, SizeOf(ScrollInfo), 0); ScrollInfo.cbSize := SizeOf(ScrollInfo); if (Which=SB_HORZ) and Vis and UseRightToLeftAlignment then begin ScrollInfo.fMask := SIF_PAGE or SIF_RANGE; GetScrollInfo(Handle, SB_HORZ, ScrollInfo); Value := (ScrollInfo.nMax-ScrollInfo.nPage)-Value; {$Ifdef DbgScroll} DebugLn('ScrollbarPosition: Which=',SbToStr(Which), ' RTL Value= ',IntToStr(Value)); {$endif} end; ScrollInfo.fMask := SIF_POS; ScrollInfo.nPos:= Value; SetScrollInfo(Handle, Which, ScrollInfo, Vis); end; end; function TCustomGrid.ScrollBarIsVisible(Which: Integer): Boolean; begin Result:=false; if HandleAllocated then begin // Don't use GetScrollbarvisible from the widgetset - it sends WM_PAINT message (Gtk2). Issue #30160 if Which = SB_VERT then result := (FVSbVisible=1) else if Which = SB_HORZ then result := (FHsbVisible=1) else if Which = SB_BOTH then result := (FVSbVisible=1) and (FHsbVisible=1); end; end; procedure TCustomGrid.ScrollBarPage(Which: Integer; aPage: Integer); var ScrollInfo: TScrollInfo; begin if HandleAllocated then begin {$Ifdef DbgScroll} DebugLn('Scrollbar Page: Which=',SbToStr(Which), ' Avalue=',dbgs(aPage)); {$endif} ScrollInfo.cbSize := SizeOf(ScrollInfo); ScrollInfo.fMask := SIF_PAGE; ScrollInfo.nPage:= aPage; SetScrollInfo(Handle, Which, ScrollInfo, True); end; end; procedure TCustomGrid.ScrollBarShow(Which: Integer; aValue: boolean); begin if HandleAllocated then begin {$Ifdef DbgScroll} DebugLn('ScrollbarShow: Which=',SbToStr(Which), ' Avalue=',dbgs(AValue)); {$endif} Include(FGridFlags, gfUpdatingScrollbar); try ShowScrollBar(Handle,Which,aValue); finally Exclude(FGridFlags, gfUpdatingScrollbar); end; if Which in [SB_BOTH, SB_VERT] then FVSbVisible := Ord(AValue); if Which in [SB_BOTH, SB_HORZ] then FHSbVisible := Ord(AValue); end; end; procedure TCustomGrid.ScrollBy(DeltaX, DeltaY: Integer); var ClipArea: TRect; ScrollFlags: Integer; begin if (DeltaX=0) and (DeltaY=0) then Exit; ScrollFlags := SW_INVALIDATE or SW_ERASE; if DeltaX<>0 then begin ClipArea := ClientRect; if Flat then InflateRect(ClipArea, -1, -1); if BiDiMode <> bdRightToLeft then Inc(ClipArea.Left, FGCache.FixedWidth) else Dec(ClipArea.Right, FGCache.FixedWidth); ScrollWindowEx(Handle, DeltaX, 0, @ClipArea, @ClipArea, 0, nil, ScrollFlags); end; if DeltaY<>0 then begin ClipArea := ClientRect; if Flat then InflateRect(ClipArea, -1, -1); Inc(ClipArea.Top, FGCache.FixedHeight); ScrollWindowEx(Handle, 0, DeltaY, @ClipArea, @ClipArea, 0, nil, ScrollFlags); end; CacheVisibleGrid; CalcScrollbarsRange; end; function TCustomGrid.ScrollBarAutomatic(Which: TScrollStyle): boolean; begin result:=false; if (Which=ssVertical)or(Which=ssHorizontal) then begin if Which=ssVertical then Which:=ssAutoVertical else Which:=ssAutoHorizontal; Result:= FScrollBars in [Which, ssAutoBoth]; end; end; // Returns a rectagle corresponding to a physical cell[aCol,aRow] function TCustomGrid.CellRect(ACol, ARow: Integer): TRect; var ok: Boolean; begin ok := ColRowToOffset(True, True, ACol, Result.Left, Result.Right); if ok then begin ok := ColRowToOffSet(False, True, ARow, Result.Top, Result.Bottom); if ok and (goColSpanning in Options) then CalcCellExtent(ACol, ARow, Result); end; if not ok then Result:=Rect(0,0,0,0); end; // The visible grid Depends on TopLeft and ClientWidth,ClientHeight, // Col/Row Count, So it Should be called inmediately after changing // those properties. function TCustomGrid.GetVisibleGrid: TRect; var W, H: Integer; begin if (FTopLeft.X<0)or(FTopLeft.y<0)or(csLoading in ComponentState) then begin Result := Rect(0,0,-1,-1); FGCache.MaxClientXY := point(0,0); Exit; end; // visible TopLeft Cell Result.TopLeft:=fTopLeft; Result.BottomRight:=Result.TopLeft; // Left Margin of next visible Column and Rightmost visible cell if ColCount>FixedCols then begin W:=GetColWidths(Result.Left) + FGCache.FixedWidth; if GetSmoothScroll(SB_Horz) then W := W - FGCache.TLColOff; while (Result.RightFixedRows then begin H:=GetRowheights(Result.Top) + FGCache.FixedHeight; if GetSmoothScroll(SB_Vert) then H := H - FGCache.TLRowOff; while (Result.Bottom