{ $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 Types, Classes, SysUtils, TypInfo, Math, Maps, LCLStrConsts, LCLProc, LCLType, LCLIntf, LazFileUtils, FPCanvas, Controls, GraphType, Graphics, Forms, DynamicArray, LMessages, StdCtrls, LResources, MaskEdit, Buttons, Clipbrd, Themes, LazUTF8, LazUtf8Classes, Laz2_XMLCfg, LCSVUtils {$ifdef WINDOWS} ,messages {$endif} ; 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; DEFROWHEIGHT = 20; DEFBUTTONWIDTH = 25; type EGridException = class(Exception); type TGridOption = ( goFixedVertLine, // Ya goFixedHorzLine, // Ya goVertLine, // Ya goHorzLine, // Ya goRangeSelect, // Ya goDrawFocusSelected, // Ya goRowSizing, // Ya goColSizing, // Ya goRowMoving, // Ya goColMoving, // Ya goEditing, // Ya goAutoAddRows, // JuMa goTabs, // Ya goRowSelect, // Ya goAlwaysShowEditor, // Ya goThumbTracking, // ya // Additional Options goColSpanning, // Enable cellextent calcs goRelaxedRowSelect, // User can see focused cell on goRowSelect goDblClickAutoSize, // dblclicking columns borders (on hdrs) resize col. goSmoothScroll, // Switch scrolling mode (pixel scroll is by default) goFixedRowNumbering, // Ya 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 grid.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,//BB Also add a row (if AutoAddRows in Options) if last row is empty goRowHighlight // Highlight the current Row ); TGridOptions = set of TGridOption; 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, gfDefRowHeightChanged, gfColumnsLocked, gfEditingDone, gfSizingStarted, gfPainting, gfUpdatingSize, gfClientRectChange); 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. const soAll: TSaveOptions = [soDesign, soAttributes, soContent, soPosition]; constRubberSpace: byte = 2; constCellPadding: byte = 3; DefaultGridOptions = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goSmoothScroll ]; 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(TWinControl) 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 WndProc(var TheMessage : TLMessage); 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; 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; 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; FCells, FCols, FRows: TArray; 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; 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: Integer; FOldImageIndex: Integer; 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: Integer); 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; 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: Integer 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: Integer; 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; 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 default 1; property Tag: Integer read FTag write FTag default 0; property Title: TGridColumnTitle read FTitle write SetTitle; property Width: Integer read GetWidth write SetWidth stored IsWidthStored default DEFCOLWIDTH; property Visible: Boolean read GetVisible write SetVisible stored IsVisibleStored default true; 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 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 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: TList; // Accumulated width per column AccumHeight: TList; // Accumulated Height per row TLColOff,TLRowOff: Integer; // TopLeft Offset in pixels MaxTopLeft: TPoint; // Max Top left ( cell coorditates) 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; 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; FOnLoadColumn: TSaveColumnEvent; FOnSaveColumn: TSaveColumnEvent; FRangeSelectMode: TRangeSelectMode; FSelections: TGridRectArray; FOnUserCheckboxBitmap: TUserCheckboxBitmapEvent; FSortOrder: TSortOrder; FSortColumn: Integer; FTabAdvance: TAutoAdvance; FTitleImageList: TImageList; FTitleStyle: TTitleStyle; FAscImgInd: Integer; FDescImgInd: Integer; FOnCompareCells: TOnCompareCells; FGridLineStyle: TPenStyle; FGridLineWidth: Integer; FDefColWidth, FDefRowHeight: Integer; FCol,FRow, FFixedCols, FFixedRows: Integer; FOnEditButtonClick: TNotifyEvent; FOnButtonClick: TOnSelectEvent; FOnPickListSelect: TNotifyEvent; FOnCheckboxToggled: TToggledCheckboxEvent; FOnPrepareCanvas: TOnPrepareCanvasEvent; FOnSelectEditor: TSelectEditorEvent; FOnValidateEntry: TValidateEntryEvent; FGridLineColor: TColor; FFixedcolor, FFixedHotColor, FFocusColor, FSelectedColor: TColor; FFocusRectVisible: boolean; FCols,FRows: TList; FsaveOptions: TSaveOptions; FScrollBars: TScrollStyle; FSelectActive: Boolean; FTopLeft: TPoint; FPivot: TPoint; FRange: TRect; FDragDx: Integer; FMoveLast: TPoint; FUpdateCount: Integer; FGCache: TGridDataCache; FOptions: TGridOptions; FOnDrawCell: TOnDrawcell; FOnBeforeSelection: TOnSelectEvent; FOnSelection: TOnSelectEvent; FOnTopLeftChanged: TNotifyEvent; FUseXORFeatures: boolean; FVSbVisible, FHSbVisible: boolean; 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; FCheckedBitmap, FUnCheckedBitmap, FGrayedBitmap: TBitmap; FSavedCursor: TCursor; FSizing: TSizingRec; FRowAutoInserted: Boolean; FMouseWheelOption: TMouseWheelOption; FSavedHint: String; FCellHintPriority: TCellHintPriority; FOnGetCellHint: TGetCellHintEvent; 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 IsCellButtonColumn(ACell: TPoint): boolean; function GetSelectedColumn: TGridColumn; function IsDefRowHeightStored: boolean; function IsTitleImageListStored: boolean; 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 SetTitleImageList(const AValue: TImageList); 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 GetEditorBorderStyle: TBorderStyle; function GetBorderWidth: Integer; function GetRowCount: Integer; function GetRowHeights(Arow: Integer): Integer; function GetSelectedRange(AIndex: Integer): TGridRect; function GetSelectedRangeCount: Integer; function GetSelection: TGridRect; 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 SaveColumns(cfg: TXMLConfig; Version: integer); function ScrollToCell(const aCol,aRow: Integer; wResetOffs: boolean): Boolean; function ScrollGrid(Relative:Boolean; DCol,DRow: Integer): TPoint; procedure SetCol(AValue: Integer); procedure SetColWidths(Acol: Integer; Avalue: Integer); procedure SetColCount(AValue: Integer); procedure SetDefColWidth(AValue: Integer); procedure SetDefRowHeight(AValue: Integer); procedure SetDefaultDrawing(const AValue: Boolean); procedure SetEditor(AValue: TWinControl); procedure SetFixedRows(const AValue: Integer); procedure SetFocusColor(const AValue: TColor); procedure SetGridLineColor(const AValue: TColor); procedure SetGridLineStyle(const AValue: TPenStyle); procedure SetGridLineWidth(const AValue: Integer); procedure SetLeftCol(const AValue: Integer); procedure SetOptions(const AValue: TGridOptions); 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 SetTopRow(const AValue: Integer); function StartColSizing(const X, Y: Integer): boolean; procedure ChangeCursor(ACursor: Integer = MAXINT); procedure TryScrollTo(aCol,aRow: Integer); 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; class procedure WSRegisterClass; override; procedure AddSelectedRange; procedure AdjustClientRect(var ARect: TRect); override; procedure AdjustEditorBounds(NewCol,NewRow: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 CalcFocusRect(var ARect: TRect; adjust: boolean = true); function CalcMaxTopLeft: TPoint; 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 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; var 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; 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; aPath: string); virtual; procedure DoSaveColumn(sender: TCustomGrid; aColumn: TGridColumn; aColIndex: Integer; aCfg: TXMLConfig; aVersion: Integer; 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; 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 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; 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 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 EditorTextChanged(const aCol,aRow: Integer; const aText:string); 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; function GetImageForCheckBox(const aCol,aRow: Integer; CheckBoxView: TCheckBoxState): TBitmap; virtual; function GetScrollBarPosition(Which: integer): Integer; 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 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 GetIsCellTitle(aCol,aRow: Integer): boolean; virtual; function GetIsCellSelected(aCol, aRow: Integer): boolean; virtual; 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): Boolean; function MoveNextAuto(const Inverse: boolean): boolean; function MoveNextSelectable(Relative:Boolean; DCol, DRow: Integer): Boolean; procedure MoveSelection; virtual; function OffsetToColRow(IsCol,Fisical:Boolean; Offset:Integer; var 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 ResetOffset(chkCol, ChkRow: 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 SelectEditor; virtual; function SelectCell(ACol, ARow: Integer): Boolean; virtual; procedure SetCanvasFont(aFont: TFont); procedure SetColor(Value: TColor); override; procedure SetColRow(const ACol,ARow: Integer); 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 SetRawColWidths(ACol: Integer; AValue: Integer); procedure SetSelectedColor(const AValue: TColor); virtual; 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 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 chpTruncOnly; property Col: Integer read FCol write SetCol; property ColCount: Integer read GetColCount write SetColCount default 5; 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 FDefColWidth write SetDefColWidth default DEFCOLWIDTH; property DefaultRowHeight: Integer read FDefRowHeight write SetDefRowHeight stored IsDefRowHeightStored; property DefaultDrawing: Boolean read FDefaultDrawing write SetDefaultDrawing default True; property DefaultTextStyle: TTextStyle read FDefaultTextStyle write FDefaultTextStyle; 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 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; 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 TabAdvance: TAutoAdvance read FTabAdvance write FTabAdvance default aaRightDown; property TitleImageList: TImageList read FTitleImageList write SetTitleImageList; 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 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 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 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; 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 VisibleColCount: Integer read GetVisibleColCount stored false; property VisibleRowCount: Integer read GetVisibleRowCount stored false; 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 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; procedure BeginUpdate; function CellRect(ACol, ARow: Integer): TRect; function CellToGridZone(aCol,aRow: Integer): TGridZone; procedure CheckPosition; 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 EditorKeyUp(Sender: TObject; var key:Word; shift:TShiftState); procedure EndUpdate(aRefresh: boolean = true); procedure EraseBackground(DC: HDC); override; function Focused: Boolean; override; function HasMultiSelection: Boolean; 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(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; var ACol,ARow: Longint); overload; function MouseToLogcell(Mouse: TPoint): TPoint; function MouseToGridZone(X,Y: Integer): TGridZone; procedure SaveToFile(FileName: string); virtual; procedure SaveToStream(AStream: TStream); virtual; procedure SetFocus; override; 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; {$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 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); protected FGrid: TVirtualGrid; procedure CalcCellExtent(acol, aRow: Integer; var aRect: TRect); virtual; 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; 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); 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 Editor; property EditorBorderStyle; property EditorMode; property ExtendedColSizing; property AltColorStartNormal; property FastEditing; property FocusColor; property FocusRectVisible; property GridHeight; property GridLineColor; property GridLineStyle; 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 FixedColor; property FixedCols; property FixedHotColor; property FixedRows; property Flat; property Font; property GridLineWidth; property Options; //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 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; 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 Color; property ColCount; property ColumnClickSorts; property Columns; property Constraints; property DefaultColWidth; property DefaultDrawing; property DefaultRowHeight; property DragCursor; property DragKind; property DragMode; property Enabled; property ExtendedSelect; property FixedColor; property FixedCols; property FixedRows; property Flat; property Font; property GridLineWidth; property HeaderHotZones; property HeaderPushZones; property MouseWheelOption; property Options; //property ParentBiDiMode; property ParentColor default false; property ParentFont; property ParentShowHint; property PopupMenu; property RangeSelectMode; property RowCount; 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 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 OnPickListSelect; property OnPrepareCanvas; property OnSelectEditor; property OnSelection; property OnSelectCell; property OnSetCheckboxState; property OnSetEditText; property OnStartDock; property OnStartDrag; property OnTopleftChanged; property OnUserCheckboxBitmap; property OnUTF8KeyPress; 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; 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 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(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; 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); procedure LoadFromCSVFile(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(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; 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 ColumnClickSorts; property Columns; property Constraints; property DefaultColWidth; property DefaultDrawing; property DefaultRowHeight; property DragCursor; property DragKind; property DragMode; property Enabled; property ExtendedSelect; property FixedColor; property FixedCols; property FixedRows; property Flat; property Font; property GridLineWidth; property HeaderHotZones; property HeaderPushZones; property MouseWheelOption; property Options; property ParentBiDiMode; property ParentColor default false; property ParentFont; property ParentShowHint; property PopupMenu; property RangeSelectMode; property RowCount; 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 OnBeforeSelection; 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 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 OnUTF8KeyPress; property OnValidateEntry; end; procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor); function GetWorkingCanvas(const Canvas: TCanvas): TCanvas; procedure FreeWorkingCanvas(canvas: TCanvas); procedure Register; implementation {$R lcl_grid_images.res} {$R lcl_dbgrid_images.res} uses WSGrids; {$WARN SYMBOL_DEPRECATED OFF} {$IFDEF FPC_HAS_CPSTRING} {$WARN IMPLICIT_STRING_CAST OFF} {$WARN IMPLICIT_STRING_CAST_LOSS OFF} {$ENDIF} 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 PointIgual(const P1,P2: TPoint): Boolean; begin result:=(P1.X=P2.X)and(P1.Y=P2.Y); 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; procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor); procedure DrawVertLine(X1,Y1,Y2: integer); begin if Y2=0) then Result:=integer(PtrUInt(FRows[aRow])) else Result:=-1; if Result<0 then Result:=fDefRowHeight; end; function TCustomGrid.GetTopRow: Longint; begin Result:=fTopLeft.y; end; function TCustomGrid.GetVisibleColCount: Integer; begin with FGCache do begin Result := VisibleGrid.Right-VisibleGrid.Left; if GridWidth<=ClientWidth then inc(Result) end; end; function TCustomGrid.GetVisibleRowCount: Integer; begin with FGCache do begin Result:=VisibleGrid.bottom-VisibleGrid.top; if GridHeight<=ClientHeight then inc(Result); end; end; procedure TCustomGrid.HeadersMouseMove(const X, Y: Integer); var P: TPoint; Gz: TGridZone; ButtonColumn: boolean; begin with FGCache do begin Gz := MouseToGridZone(X,Y); ButtonColumn := IsMouseOverCellButton(X, Y); P := MouseToCell(Point(X, Y)); if (gz<>HotGridZone) 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; procedure SetColumnWidth(aCol,aWidth: Integer); begin if csLoading in ComponentState then SetRawColWidths(aCol, aWidth) else SetColWidths(aCol, aWidth); end; var I, ForcedIndex: Integer; Count: Integer; aPriority, aMin, aMax: Integer; AvailableSize: Integer; TotalWidth: Integer; // total grid's width FixedSizeWidth: Integer; // total width of Fixed Sized Columns 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. // Insert the algorithm that modify ColWidths accordingly // // For testing purposes, a simple algortihm is implemented: // if SizePriority=0, column size should be unmodified // if SizePriority<>0 means variable size column, its size // is the average avalilable size. Count := 0; FixedSizeWidth := 0; TotalWidth := 0; for i:=0 to ColCount-1 do begin GetAutoFillColumnInfo(i, aMin, aMax, aPriority); AvailableSize := GetColWidths(i); if aPriority>0 then Inc(Count) else Inc(FixedSizeWidth, AvailableSize); Inc(TotalWidth, AvailableSize); end; if Count=0 then begin //it's an autofillcolumns grid, so at least one // of the columns must fill completely the grid's // available width, let it be that column the last ForcedIndex := ColCount-1; if ForcedIndex>=FixedCols then Dec(FixedSizeWidth, GetColWidths(ForcedIndex)); Count := 1; end else ForcedIndex := -1; AvailableSize := ClientWidth - FixedSizeWidth - GetBorderWidth; if AvailableSize<0 then begin // There is no space available to fill with // Variable Size Columns, what to do? // Simply set all Variable Size Columns // to 0, decreasing the size beyond this // shouldn't be allowed. for i:=0 to ColCount-1 do begin GetAutoFillColumnInfo(i, aMin, aMax, aPriority); if aPriority>0 then SetColumnWidth(i, 0); end; end else begin // Simpler case: There is actually available space to // to be shared for variable size columns. FixedSizeWidth := AvailableSize mod Count; // space left after filling columns AvailableSize := AvailableSize div Count; for i:=0 to ColCount-1 do begin GetAutoFillColumnInfo(i, aMin, aMax, aPriority); if (APriority>0) or (i=ForcedIndex) then begin if i=ColCount-1 then // the last column gets all space left SetColumnWidth(i, AvailableSize + FixedSizeWidth) else SetColumnWidth(i, AvailableSize); end; 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 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 := FDefColWidth; end; OldSize := integer(PtrUInt(FCols[ACol])); if NewSize<>OldSize then begin if OldSize<0 then OldSize := fDefColWidth; 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: TPixmap; begin C := TPixmap.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.IsTitleImageListStored: boolean; begin Result := FTitleImageList <> nil; end; function TCustomGrid.GetLeftCol: Integer; begin result:=fTopLeft.x; end; function TCustomGrid.GetColCount: Integer; begin Result:=FCols.Count; end; function TCustomGrid.GetRowCount: Integer; begin Result:=FRows.Count; end; function TCustomGrid.GetColWidths(Acol: Integer): Integer; var C: TGridColumn; begin if not Columns.Enabled or (aCol=0) then Result:=integer(PtrUInt(FCols[aCol])) else Result:=-1; if result<0 then Result:=fDefColWidth; end else begin C := ColumnFromGridColumn(Acol); if C<>nil then Result := C.Width else result := FDefColWidth; end; 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.SetLeftCol(const AValue: Integer); begin TryScrollTo(AValue, FTopLeft.Y); end; procedure TCustomGrid.SetOptions(const AValue: TGridOptions); begin if FOptions=AValue then exit; FOptions:=AValue; UpdateSelectionRange; if goAlwaysShowEditor in Options then begin SelectEditor; EditorShow(true); end else begin EditorHide; end; if goAutoAddRowsSkipContentCheck in Options then FRowAutoInserted := False; 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); 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 (Cursor=crHSplit) 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: Integer = MAXINT); begin if ACursor=MAXINT then Cursor := FSavedCursor else begin FSavedCursor := Cursor; Cursor := TCursor(ACursor); end; 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 := FDefRowHeight; end; OldSize := integer(PtrUInt(FRows[ARow])); if AValue<>OldSize then begin if OldSize<0 then OldSize := FDefRowHeight; bigger := NewSize > OldSize; FRows[ARow]:=Pointer(PtrInt(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 FCols[ACol]:=Pointer(PtrInt(Avalue)); end; procedure TCustomGrid.AdjustCount(IsColumn: Boolean; OldValue, NewValue: Integer ); procedure AddDel(Lst: TList; 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>=1 then begin 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 Clear; end; end; procedure TCustomGrid.SetDefColWidth(AValue: Integer); var OldLeft,OldRight,NewLeft,NewRight: Integer; begin if AValue=fDefColwidth then Exit; FDefColWidth:=AValue; 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 include(FGridFlags, gfDefRowHeightChanged); FDefRowheight:=AValue; if EditorMode then ColRowToOffSet(False,True, FRow, OldTop, OldBottom); for i:=0 to RowCount-1 do FRows[i] := Pointer(-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); 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); 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.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} CalcScrollBarsRange; 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} if Which = SB_VERT then Vis := FVSbVisible else if Which = SB_HORZ then Vis := FHSbVisible else vis := false; 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 {$IFNDEF MSWINDOWS} Result:= getScrollbarVisible(handle, Which); {$ELSE} // Is up to the widgetset to implement GetScrollbarvisible // FVSbVisible, FHSbVisible are supposed to be update (if used ScrolLBarShow) // how can we know if GetScrollbarVisible is indeed implemented?.... if Which = SB_VERT then result := FVSbVisible else if Which = SB_HORZ then result := FHsbVisible else if Which = SB_BOTH then result := FHsbVisible and FVsbVisible; {$ENDIF} end; end; procedure TCustomGrid.ScrollBarPage(Which: Integer; aPage: Integer); var ScrollInfo: TScrollInfo; begin if HandleAllocated then begin {$Ifdef DbgScroll} DebugLn('ScrollbarPage: 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} ShowScrollBar(Handle,Which,aValue); if Which in [SB_BOTH, SB_VERT] then FVSbVisible := AValue else if Which in [SB_BOTH, SB_HORZ] then FHSbVisible := AValue; end; 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 reactagle corresponding to a fisical cell[aCol,aRow] } function TCustomGrid.CellRect(ACol, ARow: Integer): TRect; begin //Result:=ColRowToClientCellRect(aCol,aRow); ColRowToOffset(True, True, ACol, Result.Left, Result.Right); ColRowToOffSet(False,True, ARow, Result.Top, Result.Bottom); end; // The visible grid Depends on TopLeft and ClientWidht,ClientHeight, // Col/Row Count, So it Should be called inmediately after changing // those properties. function TCustomGrid.GetVisibleGrid: TRect; var w: 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 goSmoothScroll in Options then W := W - FGCache.TLColOff; while (Result.RightFixedRows then begin W:=GetRowheights(Result.Top) + FGCache.FixedHeight; if goSmoothScroll in Options then W := W - FGCache.TLRowOff; while (Result.Bottom=0) and (fTopLeft.x=0) and (fTopLeft.y