{ $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.LCL, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** } { TCustomGrid, TDrawGrid and TStringGrid for Lazarus Copyright (C) 2002 Jesus Reyes Aguilar. email: jesusrmx@yahoo.com.mx Cur version: 0.8.5 The log was moved to end of file, search for: The_Log } {$define UseClipRect} {$ifdef WIN32} {$define GoodClipping} {$endif} unit Grids; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FPCAdds, LCLStrConsts, LCLProc, LCLType, LCLIntf, Controls, GraphType, Graphics, Forms, DynamicArray, LMessages, XMLCfg, StdCtrls, LResources, MaskEdit, Buttons, Clipbrd; const //GRIDFILEVERSION = 1; // Original //GRIDFILEVERSION = 2; // Introduced goSmoothScroll GRIDFILEVERSION = 3; // Introduced Col/Row FixedAttr and NormalAttr const GM_SETVALUE = LM_USER + 100; GM_GETVALUE = LM_USER + 101; GM_SETGRID = LM_USER + 102; GM_SETPOS = LM_USER + 103; GM_SELECTALL = LM_USER + 104; GM_SETMASK = LM_USER + 105; const CA_LEFT = $1; CA_CENTER = $2; CA_RIGHT = $4; CL_TOP = $8; CL_CENTER = $10; CL_BOTTOM = $20; const EO_AUTOSIZE = $1; EO_HOOKKEYDOWN = $2; EO_HOOKKEYPRESS = $4; EO_HOOKKEYUP = $8; EO_HOOKEXIT = $10; EO_SELECTALL = $20; EO_WANTCHAR = $40; 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 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) ); 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); TGridState = (gsNormal, gsSelecting, gsRowSizing, gsColSizing,gsRowMoving,gsColMoving); TGridZone = (gzNormal, gzFixedCols, gzFixedRows, gzFixedCells); TUpdateOption = (uoNone, uoQuick, uoFull); TAutoAdvance = (aaNone,aaDown,aaRight,aaLeft); TItemType = (itNormal,itCell,itColumn,itRow,itFixed,itFixedColumn,itFixedRow,itSelected); TColumnButtonStyle = (cbsAuto, cbsEllipsis, cbsNone, cbsPickList, cbsCheckboxColumn); //SSY TCleanOptions = set of TGridZone; TTitleStyle = (tsLazarus, tsStandard, tsNative); const soAll: TSaveOptions = [soDesign, soAttributes, soContent, soPosition]; constRubberSpace: byte = 2; 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 MsgID: Cardinal; Grid: TCustomGrid; Col,Row: Integer; Value: string; CellRect: TRect; Options: Integer; end; type { Default cell editor for TStringGrid } TStringCellEditor=class(TCustomMaskEdit) private FGrid: TCustomGrid; 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; end; TButtonCellEditor = class(TButton) private FGrid: TCustomGrid; protected procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID; procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS; end; { TPickListCellEditor } TPickListCellEditor = class(TCustomComboBox) private FGrid: TCustomGrid; FMouseSelecting: boolean; protected procedure WndProc(var TheMessage : TLMessage); override; procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; procedure Change; override; procedure DropDown; override; procedure CloseUp; 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; public property BorderStyle; end; TOnDrawCell = procedure(Sender: TObject; Col, Row: Integer; aRect: TRect; aState:TGridDrawState) of object; TOnSelectCellEvent = procedure(Sender: TObject; Col, Row: Integer; var CanSelect: Boolean) of object; TOnSelectEvent = procedure(Sender: TObject; Col,Row: 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; Col,Row: Integer; var Editor: TWinControl) of object; TOnPrepareCanvasEvent = procedure(sender: TObject; Col,Row: Integer; aState:TGridDrawState) 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; { TColumnTitle } TGridColumnTitle = class(TPersistent) private FColumn: TGridColumn; FCaption: PChar; FColor: ^TColor; FAlignment: ^TAlignment; FFont: TFont; FIsDefaultTitleFont: boolean; FLayout: ^TTextLayout; procedure FontChanged(Sender: TObject); function GetAlignment: TAlignment; function GetCaption: string; 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 SetCaption(const AValue: string); procedure SetColor(const AValue: TColor); procedure SetFont(const AValue: TFont); procedure SetLayout(const AValue: TTextLayout); property IsDefaultFont: boolean read FIsDefaultTitleFont; protected function GetDefaultCaption: string; virtual; public constructor Create(TheColumn: TGridColumn); virtual; destructor Destroy; override; procedure FillTitleDefaultFont; function IsDefault: boolean; property Column: TGridColumn read FColumn; published property Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored; property Layout: TTextLayout read GetLayout write SetLayout stored IsLayoutStored; property Caption: string read GetCaption write SetCaption stored IsCaptionStored; property Color: TColor read GetColor write SetColor stored IsColorStored; property Font: TFont read GetFont write SetFont stored IsFontStored; end; { 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; 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 GetPickList: TStrings; function GetReadOnly: Boolean; 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 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 SetVisible(const AValue: Boolean); procedure SetWidth(const AValue: Integer); function GetDefaultSizePriority: Integer; protected {$ifdef ver1_0} // workaround to access protected procedure in base class procedure Changed(AllItems: Boolean); {$endif} function GetDisplayName: string; override; function GetDefaultAlignment: TAlignment; virtual; function InternalDefaultMaxSize: Integer; virtual; function InternalDefaultMinSize: Integer; virtual; function InternalDefaultReadOnly: boolean; virtual; function InternalDefaultWidth: Integer; virtual; function GetDefaultVisible: boolean; virtual; procedure ColumnChanged; procedure AllColumnsChange; function CreateTitle: TGridColumnTitle; virtual; property IsDefaultFont: boolean read FIsDefaultFont; public constructor Create(ACollection: TCollection); override; destructor Destroy; override; procedure FillDefaultFont; function IsDefault: boolean; virtual; property Grid: TCustomGrid read GetGrid; property WidthChanged: boolean read FWidthChanged; published property Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored; property ButtonStyle: TColumnButtonStyle read FButtonStyle write SetButtonStyle default cbsAuto; property Color: TColor read GetColor write SetColor stored IsColorStored; property DropDownRows: Longint read FDropDownRows write FDropDownRows default 7; property Expanded: Boolean read GetExpanded write SetExpanded default True; property Font: TFont read GetFont write SetFont stored IsFontStored; property Layout: TTextLayout read GetLayout write SetLayout stored IsLayoutStored; property MinSize: Integer read GetMinSize write SetMinSize stored IsMinSizeStored; property MaxSize: Integer read GetMaxSize write SetMaxSize stored isMaxSizeStored; property PickList: TStrings read GetPickList write SetPickList; property ReadOnly: Boolean read GetReadOnly write SetReadOnly stored IsReadOnlyStored; property SizePriority: Integer read GetSizePriority write SetSizePriority stored IsSizePriorityStored; property Title: TGridColumnTitle read FTitle write SetTitle; property Width: Integer read GetWidth write SetWidth stored IsWidthStored default 64; property Visible: Boolean read GetVisible write SetVisible stored IsVisibleStored default true; 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 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); constructor Create(AGrid: TCustomGrid; aItemClass: TCollectionItemClass); function Add: TGridColumn; function RealIndex(Index: Integer): Integer; function IndexOf(Column: TGridColumn): Integer; function IsDefault: boolean; function HasIndex(Index: Integer): boolean; 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; 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 ScrollWidth: Integer; // ClientWidth-FixedWidth ScrollHeight: Integer; // ClientHeight-FixedHeight VisibleGrid: TRect; // Visible non fixed rectagle of cells MaxClientXY: Tpoint; // VisibleGrid.BottomRight (pixel) coordinates ValidGrid: Boolean; // true if there is something 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) end; type { TCustomGrid } TCustomGrid=class(TCustomControl) private FAutoAdvance: TAutoAdvance; FAutoFillColumns: boolean; FDefaultDrawing: Boolean; FEditor: TWinControl; FEditorHidingCount: Integer; FEditorMode: Boolean; FEditorShowing: Boolean; FEditorKey: Boolean; FEditorOptions: Integer; FExtendedSelect: boolean; FFastEditing: boolean; FFlat: Boolean; FTitleStyle: TTitleStyle; FOnCompareCells: TOnCompareCells; FGridLineStyle: TPenStyle; FGridLineWidth: Integer; FDefColWidth, FDefRowHeight: Integer; FCol,FRow, FFixedCols, FFixedRows: Integer; FOnEditButtonClick: TNotifyEvent; FOnPrepareCanvas: TOnPrepareCanvasEvent; FOnSelectEditor: TSelectEditorEvent; FGridLineColor: TColor; FFixedcolor, FFocusColor, FSelectedColor: TColor; FFocusRectVisible: boolean; FCols,FRows: TList; FsaveOptions: TSaveOptions; FScrollBars: TScrollStyle; FSelectActive: Boolean; FTopLeft: TPoint; FSplitter, FPivot: TPoint; FRange: TRect; FDragDx: Integer; FMoveLast: TPoint; FUpdateCount: Integer; FUpdateScrollBarsCount: Integer; FGCache: TGridDataCache; FOptions: TGridOptions; FOnDrawCell: TOnDrawcell; FOnBeforeSelection: TOnSelectEvent; FOnSelection: TOnSelectEvent; FOnTopLeftChanged: TNotifyEvent; FGSMHBar, FGSMVBar: Integer; // Scrollbar's metrics FUseXORFeatures: boolean; FVSbVisible, FHSbVisible: boolean; FDefaultTextStyle: TTextStyle; FLastWidth: Integer; FTitleFont, FLastFont: TFont; FColumns: TGridColumns; FButtonEditor: TButtonCellEditor; FStringEditor: TStringCellEditor; FPickListEditor: TPickListCellEditor; FExtendedColSizing: boolean; FExtendedRowSizing: boolean; FUpdatingAutoFillCols: boolean; FPrevLine: boolean; FPrevValue: Integer; procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer); procedure CacheVisibleGrid; procedure CheckFixedCount(aCol,aRow,aFCol,aFRow: Integer); procedure CheckCount(aNewColCount, aNewRowCount: Integer); procedure CheckIndex(IsColumn: Boolean; Index: Integer); function CheckTopLeft(aCol,aRow: Integer; CheckCols,CheckRows: boolean): boolean; procedure SetAutoFillColumns(const AValue: boolean); procedure SetColumns(const AValue: TGridColumns); procedure SetEditorOptions(const AValue: Integer); procedure SetEditorBorderStyle(const AValue: TBorderStyle); procedure SetFlat(const AValue: Boolean); procedure SetFocusRectVisible(const AValue: Boolean); 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 doRowMoving(X,Y: Integer); procedure doTopleftChange(DimChg: Boolean); procedure DrawXORVertLine(X: Integer); procedure DrawXORHorzLine(Y: Integer); function EditorCanProcessKey(var Key: Char): boolean; procedure EditorGetValue; procedure EditorPos; procedure EditorShowChar(Ch: Char); procedure EditorSetMode(const AValue: Boolean); procedure EditorSetValue; function EditorAlwaysShown: Boolean; function GetLeftCol: Integer; function GetColCount: Integer; function GetColWidths(Acol: Integer): Integer; function GetColumns: TGridColumns; function GetEditorBorderStyle: TBorderStyle; function GetRowCount: Integer; function GetRowHeights(Arow: Integer): Integer; function GetSelection: TGridRect; function GetSystemMetricsGapSize(const Index: Integer): Integer; function GetTopRow: Longint; function GetVisibleColCount: Integer; function GetVisibleGrid: TRect; function GetVisibleRowCount: Integer; procedure InternalAutoFillColumns; procedure InternalSetColWidths(aCol,aValue: Integer); procedure InternalSetFixedCols(const AValue: Integer); procedure InternalUpdateColumnWidths; function IsColumnsStored: boolean; procedure MyTextRect(R: TRect; Offx,Offy:Integer; S:string; Clipping: boolean); procedure OnTitleFontChanged(Sender: TObject); procedure ReadColumns(Reader: TReader); procedure ReadColWidths(Reader: TReader); procedure ReadRowHeights(Reader: TReader); function ScrollToCell(const aCol,aRow: Integer): Boolean; function ScrollGrid(Relative:Boolean; DCol,DRow: Integer): TPoint; procedure SetCol(Valor: Integer); procedure SetColwidths(Acol: Integer; Avalue: Integer); procedure SetRawColWidths(ACol: Integer; AValue: Integer); procedure SetColCount(Valor: Integer); procedure SetDefColWidth(Valor: Integer); procedure SetDefRowHeight(Valor: Integer); procedure SetDefaultDrawing(const AValue: Boolean); procedure SetEditor(AValue: TWinControl); procedure SetFixedCols(const AValue: Integer); 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 SetRow(Valor: Integer); procedure SetRowCount(Valor: 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); procedure TryScrollTo(aCol,aRow: integer); procedure UpdateScrollBarPos(Which: TScrollStyle); procedure UpdateSelectionRange; 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; { procedure WMSize(var Msg: TLMSize); message LM_SIZE; } procedure WMChar(var message: TLMChar); message LM_CHAR; protected fGridState: TGridState; procedure AutoAdjustColumn(aCol: Integer); virtual; procedure BeforeMoveSelection(const DCol,DRow: Integer); virtual; procedure CalcAutoSizeColumn(const Index: Integer; var AMin,AMax,APriority: Integer); dynamic; procedure CalcFocusRect(var ARect: TRect); procedure CellClick(const aCol,aRow: Integer); virtual; procedure CheckLimits(var aCol,aRow: Integer); procedure ColRowDeleted(IsColumn: Boolean; index: Integer); dynamic; procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); dynamic; procedure ColRowInserted(IsColumn: boolean; index: integer); dynamic; procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); dynamic; function ColRowToOffset(IsCol,Fisical:Boolean; index: Integer; var Ini,Fin:Integer): Boolean; function ColumnIndexFromGridColumn(Column: Integer): Integer; function ColumnFromGridColumn(Column: Integer): TGridColumn; procedure ColumnsChanged(aColumn: TGridColumn); procedure ColWidthsChanged; dynamic; function CreateColumns: TGridColumns; virtual; procedure CreateWnd; override; procedure CreateParams(var Params: TCreateParams); override; procedure DblClick; override; procedure DefineProperties(Filer: TFiler); override; procedure DestroyHandle; override; function DoCompareCells(Acol,ARow,Bcol,BRow: Integer): Integer; dynamic; procedure DoCopyToClipboard; virtual; procedure DoCutToClipboard; virtual; procedure DoEditorHide; virtual; procedure DoEditorShow; virtual; procedure DoExit; override; procedure DoEnter; 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 DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override; procedure DrawBackGround; virtual; procedure DrawBorder; procedure DrawByRows; virtual; procedure DrawCell(aCol,aRow:Integer; aRect:TRect; aState:TGridDrawState); virtual; procedure DrawCellGrid(aCol,aRow: Integer; aRect: TRect; astate: TGridDrawState); virtual; procedure DrawColRowMoving; procedure DrawEdges; //procedure DrawFixedCells; virtual; //procedure DrawFocused; virtual; procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); virtual; //procedure DrawInteriorCells; virtual; procedure DrawRow(aRow: Integer); virtual; procedure EditButtonClicked(Sender: TObject); procedure EditordoGetValue; virtual; procedure EditordoSetValue; virtual; function EditorCanAcceptKey(const ch: Char): boolean; virtual; function EditorIsReadOnly: boolean; virtual; procedure EditorHide; virtual; function EditorLocked: boolean; procedure EditorSelectAll; procedure EditorShow(const SelAll: boolean); virtual; procedure EditorWidthChanged(aCol,aWidth: Integer); virtual; procedure GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); dynamic; function GetFixedcolor: TColor; virtual; function GetSelectedColor: TColor; virtual; function GetEditMask(ACol, ARow: Longint): string; dynamic; function GetEditText(ACol, ARow: Longint): string; dynamic; 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 GeTGridColumnTitle(Column: Integer): string; function GetColumnWidth(Column: Integer): Integer; function GetDefaultAlignment(Column: Integer): TAlignment; virtual; function GetDefaultEditor(Column: Integer): TWinControl; function GetDefaultColumnWidth(Column: Integer): Integer; virtual; function GetDefaultLayout(Column: Integer): TTextLayout; virtual; function GetDefaultReadOnly(Column: Integer): boolean; virtual; function GetDefaultTitle(Column: Integer): string; virtual; procedure SetEditText(ACol, ARow: Longint; const Value: string); dynamic; procedure HeaderClick(IsColumn: Boolean; index: Integer); dynamic; procedure HeaderSized(IsColumn: Boolean; index: Integer); dynamic; procedure InternalSetColCount(ACount: Integer); procedure InvalidateCell(aCol, aRow: Integer); overload; procedure InvalidateCell(aCol, aRow: Integer; Redraw: Boolean); overload; procedure InvalidateCol(ACol: Integer); procedure InvalidateFromCol(ACol: Integer); procedure InvalidateGrid; procedure InvalidateRow(ARow: Integer); procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure KeyUp(var Key : Word; Shift : TShiftState); override; procedure LoadContent(cfg: TXMLConfig; Version: Integer); virtual; procedure Loaded; override; procedure LockEditor; 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: boolean; function MoveNextSelectable(Relative:Boolean; DCol, DRow: Integer): Boolean; procedure MoveSelection; virtual; function OffsetToColRow(IsCol,Fisical:Boolean; Offset:Integer; var Rest:Integer): Integer; procedure Paint; override; procedure PrepareCanvas(aCol,aRow: Integer; aState:TGridDrawState); virtual; procedure ResetOffset(chkCol, ChkRow: Boolean); procedure ResizeColumn(aCol, aWidth: Integer); procedure ResizeRow(aRow, aHeight: Integer); procedure RowHeightsChanged; dynamic; procedure SaveContent(cfg: TXMLConfig); virtual; procedure ScrollBarRange(Which:Integer; aRange,aPage: 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 SetBorderStyle(NewStyle: TBorderStyle); override; procedure SetFixedcolor(const AValue: TColor); virtual; procedure SetSelectedColor(const AValue: TColor); virtual; procedure SizeChanged(OldColCount, OldRowCount: Integer); dynamic; procedure Sort(ColSorting: Boolean; index,IndxFrom,IndxTo:Integer); virtual; procedure TopLeftChanged; dynamic; function TryMoveSelection(Relative: Boolean; var DCol, DRow: Integer): Boolean; procedure UnLockEditor; procedure UpdateHorzScrollBar(const aVisible: boolean; const aRange,aPage: Integer); virtual; procedure UpdateVertScrollbar(const aVisible: boolean; const aRange,aPage: Integer); virtual; procedure VisualChange; virtual; //procedure ValidateCols(FromCol, ToCol: Integer); 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 AutoAdvance: TAutoAdvance read FAutoAdvance write FAutoAdvance default aaRight; property AutoFillColumns: boolean read FAutoFillColumns write SetAutoFillColumns; property BorderStyle default bsSingle; property Col: Integer read FCol write SetCol; property ColCount: Integer read GetColCount write SetColCount; 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 64; property DefaultRowHeight: Integer read FDefRowHeight write SetDefRowHeight default 20; 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; property FastEditing: boolean read FFastEditing write FFastEditing; 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; 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 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 LeftCol:Integer read GetLeftCol write SetLeftCol; property Options: TGridOptions read FOptions write SetOptions; property Row: Integer read FRow write SetRow; property RowCount: Integer read GetRowCount write SetRowCount; 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 Selection: TGridRect read GetSelection write SetSelection; property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars; property TitleFont: TFont read FTitleFont write SetTitleFont; property TitleStyle: TTitleStyle read FTitleStyle write SetTitleStyle; property TopRow: Integer read GetTopRow write SetTopRow; property UseXORFeatures: boolean read FUseXORFeatures write SetUseXorFeatures; property VisibleColCount: Integer read GetVisibleColCount; property VisibleRowCount: Integer read GetVisibleRowCount; property OnBeforeSelection: TOnSelectEvent read FOnBeforeSelection write FOnBeforeSelection; property OnCompareCells: TOnCompareCells read FOnCompareCells write FOnCompareCells; property OnPrepareCanvas: TOnPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas; property OnDrawCell: TOnDrawCell read FOnDrawCell write FOnDrawCell; property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick write FOnEditButtonClick; property OnSelection: TOnSelectEvent read fOnSelection write fOnSelection; property OnSelectEditor: TSelectEditorEvent read FOnSelectEditor write FOnSelectEditor; property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Invalidate; override; { Exposed procs } procedure AutoAdjustColumns; procedure BeginUpdate; function CellRect(ACol, ARow: Integer): TRect; procedure Clear; function EditorByStyle(Style: TColumnButtonStyle): TWinControl; virtual; procedure EditorExit(Sender: TObject); 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(UO: TUpdateOption); overload; procedure EndUpdate(FullUpdate: Boolean); overload; procedure EndUpdate; overload; procedure EraseBackground(DC: HDC); override; function IscellSelected(aCol,aRow: Integer): Boolean; function IscellVisible(aCol, aRow: Integer): Boolean; procedure LoadFromFile(FileName: string); function MouseToCell(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; function CellToGridZone(aCol,aRow: Integer): TGridZone; procedure SaveToFile(FileName: string); 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; { TCustomDrawGrid } TCustomDrawGrid=class(TCustomGrid) private FOnColRowDeleted: TgridOperationEvent; FOnColRowExchanged: TgridOperationEvent; FOnColRowInserted: TGridOperationEvent; FOnColRowMoved: TgridOperationEvent; FOnGetEditMask: TGetEditEvent; FOnGetEditText: TGetEditEvent; FOnHeaderClick, FOnHeaderSized: THdrEvent; FOnSelectCell: TOnSelectcellEvent; FOnSetEditText: TSetEditEvent; protected FGrid: TVirtualGrid; procedure CalcCellExtent(acol, aRow: Integer; var aRect: TRect); virtual; 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 DrawFocusRect(aCol,aRow: Integer; ARect: TRect); override; procedure HeaderClick(IsColumn: Boolean; index: Integer); override; procedure HeaderSized(IsColumn: Boolean; index: Integer); override; procedure GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); override; function GetEditMask(aCol, aRow: Longint): string; override; function GetEditText(aCol, aRow: Longint): string; override; function SelectCell(aCol,aRow: Integer): boolean; override; procedure SetColor(Value: TColor); override; procedure SetEditText(ACol, ARow: Longint; const Value: string); override; procedure SizeChanged(OldColCount, OldRowCount: Integer); override; public // to easy user call constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure DeleteColRow(IsColumn: Boolean; index: Integer); 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 Canvas; property Col; property ColWidths; property Editor; property EditorBorderStyle; property EditorMode; property ExtendedColSizing; property FocusColor; property FocusRectVisible; property GridHeight; property GridLineColor; property GridLineStyle; property GridWidth; property LeftCol; property Row; property RowHeights; property SaveOptions; property SelectedColor; property Selection; //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 Ctl3D; // Deprecated property DefaultColWidth; property DefaultDrawing; property DefaultRowHeight; //property DragCursor; //property DragKind; //property DragMode; property Enabled; property FixedColor; property FixedCols; property FixedRows; property Flat; property Font; property GridLineWidth; property Options; //property ParentBiDiMode; //property ParentColor; //property ParentCtl3D; // Deprecated //property ParentFont; property ParentShowHint; property PopupMenu; property RowCount; property ScrollBars; property ShowHint; 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 OnDblClick; property OnDrawCell; property OnEditButtonClick; 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 OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseWheelDown; property OnMouseWheelUp; property OnPrepareCanvas; property OnSelectEditor; property OnSelection; property OnSelectCell: TOnSelectCellEvent read FOnSelectCell write FOnSelectCell; property OnSetEditText: TSetEditEvent read FOnSetEditText write FOnSetEditText; property OnTopleftChanged; { property OnContextPopup; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnStartDock; property OnStartDrag; } end; { TDrawGrid } TDrawGrid = class(TCustomDrawGrid) published property Align; property Anchors; property AutoAdvance; property AutoFillColumns; //property BiDiMode; property BorderSpacing; property BorderStyle; property Color; property ColCount; property Columns; //property Constraints; //property Ctl3D; // Deprecated property DefaultColWidth; property DefaultDrawing; property DefaultRowHeight; //property DragCursor; //property DragKind; //property DragMode; property Enabled; property FixedColor; property FixedCols; property FixedRows; property Flat; property Font; property GridLineWidth; property Options; //property ParentBiDiMode; //property ParentColor; //property ParentCtl3D; // Deprecated //property ParentFont; property ParentShowHint; property PopupMenu; property RowCount; property ScrollBars; property ShowHint; property TabOrder; property TabStop; property TitleStyle; property Visible; property VisibleColCount; property VisibleRowCount; property OnBeforeSelection; property OnClick; property OnColRowDeleted; property OnColRowExchanged; property OnColRowInserted; property OnColRowMoved; property OnCompareCells; property OnDblClick; property OnDrawCell; property OnEditButtonClick; property OnEnter; property OnExit; property OnGetEditMask; property OnGetEditText; property OnHeaderClick; property OnHeaderSized; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseWheelDown; property OnMouseWheelUp; property OnPrepareCanvas; property OnSelectEditor; property OnSelection; property OnSelectCell; property OnSetEditText; property OnTopleftChanged; { property OnContextPopup; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnStartDock; property OnStartDrag; } end; { TCustomStringGrid } TCustomStringGrid = class(TCustomDrawGrid) private //FDefEditor: TStringCellEditor; function GetCells(ACol, ARow: Integer): string; function GetCols(index: Integer): TStrings; function GetObjects(ACol, ARow: Integer): TObject; function GetRows(index: Integer): TStrings; procedure ReadCells(Reader: TReader); procedure SetCells(ACol, ARow: Integer; const AValue: string); 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); protected procedure AutoAdjustColumn(aCol: Integer); override; procedure CalcCellExtent(acol, aRow: Integer; var aRect: TRect); override; procedure DefineProperties(Filer: TFiler); override; procedure DoCopyToClipboard; override; procedure DoCutToClipboard; override; procedure DoPasteFromClipboard; override; procedure DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); override; //procedure EditordoGetValue; override; //procedure EditordoSetValue; override; function GetEditText(aCol, aRow: Integer): string; override; procedure LoadContent(cfg: TXMLConfig; Version: Integer); override; procedure SaveContent(cfg: TXMLConfig); override; //procedure DrawInteriorCells; override; //procedure SelectEditor; override; procedure SelectionSetText(TheText: String); procedure SetEditText(aCol, aRow: Longint; const aValue: string); override; public constructor Create(AOwner: TComponent); override; //destructor Destroy; override; procedure AutoSizeColumn(aCol: Integer); procedure AutoSizeColumns; procedure Clean; overload; procedure Clean(CleanOptions: TCleanOptions); overload; procedure Clean(aRect: TRect; CleanOptions: TCleanOptions); overload; procedure Clean(StartCol,StartRow,EndCol,EndRow: integer; CleanOptions: TCleanOptions); overload; property Cells[ACol, ARow: Integer]: string read GetCells write SetCells; property Cols[index: Integer]: TStrings read GetCols write SetCols; 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) published property Align; property Anchors; property AutoAdvance; property AutoFillColumns; //property BiDiMode; property BorderSpacing; property BorderStyle; property Color; property ColCount; property Columns; //property Constraints; //property Ctl3D; // Deprecated property DefaultColWidth; property DefaultDrawing; property DefaultRowHeight; //property DragCursor; //property DragKind; //property DragMode; property Enabled; property FixedColor; property FixedCols; property FixedRows; property Flat; property Font; property GridLineWidth; property Options; //property ParentBiDiMode; //property ParentColor; //property ParentCtl3D; // Deprecated //property ParentFont; property ParentShowHint; property PopupMenu; property RowCount; property ScrollBars; property ShowHint; property TabOrder; property TabStop; property TitleStyle; property Visible; property VisibleColCount; property VisibleRowCount; property OnBeforeSelection; property OnChangeBounds; property OnClick; property OnColRowDeleted; property OnColRowExchanged; property OnColRowInserted; property OnColRowMoved; property OnCompareCells; property OnDblClick; property OnDrawCell; property OnEditButtonClick; property OnEnter; property OnExit; property OnGetEditMask; property OnGetEditText; property OnHeaderClick; property OnHeaderSized; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseWheelDown; property OnMouseWheelUp; property OnPrepareCanvas; property OnResize; property OnSelectEditor; property OnSelection; property OnSelectCell; property OnSetEditText; property OnTopleftChanged; { property OnContextPopup; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnStartDock; property OnStartDrag; } end; procedure DebugRect(S:string; R:TRect); procedure DebugPoint(S:string; P:TPoint); procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor); procedure Register; implementation function PointIgual(const P1,P2: TPoint): Boolean; begin result:=(P1.X=P2.X)and(P1.Y=P2.Y); end; {function RectIgual(const R1,R2: TRect): Boolean; begin Result:=CompareMem(@R1,@R2, SizeOf(R1)); end;} function Min(const I,J: Integer): Integer; begin if IJ then Result:=I else Result:=J; 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_PARENTCTL3DCHANGED: Result := 'CM_PARENTCTL3DCHANGED'; CM_UIACTIVATE: Result := 'CM_UIACTIVATE'; CM_CONTROLLISTCHANGE: Result := 'CM_CONTROLLISTCHANGE'; CM_PARENTCOLORCHANGED: Result := 'CM_PARENTCOLORCHANGED'; CM_PARENTFONTCHANGED: Result := 'CM_PARENTFONTCHANGED'; 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} procedure DrawRubberRect(Canvas: TCanvas; aRect: TRect; Color: TColor); procedure DrawVertLine(X1,Y1,Y2: integer); begin if Y2=0) then Result:=PtrInt(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; var R: TRect; begin R:=FGCache.VisibleGrid; Result:=R.Right-R.left+1; end; function TCustomGrid.GetVisibleRowCount: Integer; var R: TRect; begin R:=FGCache.VisibleGrid; Result:=r.bottom-r.top+1; 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 completly the grid's // available width, let it be that column the last ForcedIndex := ColCount-1; Count := 1; end else ForcedIndex := -1; AvailableSize := Width {ClientWidth} - FixedSizeWidth - Integer(BorderStyle); 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); //SetColWidths(i,0); //SetRawColWidths(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 if i=ColCount-1 then // the last column gets all space left //SetColWidths(i, AvailableSize + FixedSizeWidth) SetColumnWidth(i, AvailableSize + FixedSizeWidth) else //SetColWidths(i, AvailableSize) //SetRawColWidths(i, AvailableSize); SetColumnWidth(i, AvailableSize); end; end; finally FUpdatingAutoFillCols:=False; end; end; procedure TCustomGrid.InternalSetColCount(ACount: Integer); var OldC: Integer; begin if ACount=FCols.Count then Exit; if ACount<1 then Clear else begin OldC:=FCols.Count; CheckFixedCount(ACount, RowCount, FFixedCols, FFixedRows); CheckCount(ACount, RowCount); AdjustCount(True, OldC, ACount); end; end; procedure TCustomGrid.InternalSetColWidths(aCol, aValue: Integer); begin if AValue<0 then Avalue:=-1; if Avalue<>PtrInt(FCols[ACol]) then begin SetRawColWidths(ACol, Avalue); if not (csLoading in ComponentState) then begin VisualChange; if (FEditor<>nil)and(Feditor.Visible)and(ACol<=FCol) then EditorWidthChanged(aCol, aValue); ColWidthsChanged; end; end; end; procedure TCustomGrid.InternalSetFixedCols(const AValue: Integer); begin if FFixedCols=AValue then exit; CheckFixedCount(ColCount, RowCount, AValue, FFixedRows); FFixedCols:=AValue; fTopLeft.x:=AValue; fCol:=Avalue; UpdateSelectionRange; if not (csLoading in componentState) then doTopleftChange(true); 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; function TCustomGrid.IsColumnsStored: boolean; begin result := Columns.Enabled; 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:=PtrInt(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; FEditor:=AValue; if FEditor<>nil then begin if FEditor.Parent=nil then FEditor.Visible:=False; if FEditor.Parent<>Self then FEditor.Parent:=Self; FEditor.TabStop:=False; Msg.MsgID:=GM_SETGRID; Msg.Grid:=Self; Msg.Options:=0; FEditor.Dispatch(Msg); SetEditorOptions(Msg.Options); end; end; procedure TCustomGrid.SetFixedCols(const AValue: Integer); begin if Columns.Enabled then begin if FFixedCols=Avalue then Exit; CheckFixedCount(ColCount, RowCount, AValue, FFixedRows); FFixedCols:=AValue; fTopLeft.x:=AValue; fCol:=Avalue; UpdateSelectionRange; if not (csLoading in componentState) then TopLeftChanged; ColumnsChanged(nil); end else InternalSetFixedCols(AValue); end; procedure TCustomGrid.SetFixedRows(const AValue: Integer); begin if FFixedRows=AValue then exit; CheckFixedCount(ColCount, RowCount, FFixedCols, AValue); FFixedRows:=AValue; fTopLeft.y:=AValue; FRow:=AValue; UpdateSelectionRange; if not (csLoading in ComponentState) then doTopleftChange(true); 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; { if goRangeSelect in Options then FOptions:=FOptions - [goAlwaysShowEditor]; } UpdateSelectionRange; if goAlwaysShowEditor in Options then begin EditorShow(true); end else begin EditorHide; end; 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; procedure TCustomGrid.Setrowheights(Arow: Integer; Avalue: Integer); begin if AValue<0 then AValue:=-1; if AValue<>PtrInt(FRows[ARow]) then begin FRows[ARow]:=Pointer(PtrInt(AValue)); VisualChange; if (FEditor<>nil)and(Feditor.Visible)and(ARow<=FRow) then EditorPos; RowHeightsChanged; end; end; procedure TCustomGrid.Setcolwidths(Acol: Integer; Avalue: Integer); var c: TGridColumn; begin if not Columns.Enabled or (aColnil then C.Width := AValue; 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 FRows.Count - 1 then FRow := FRows.Count - 1; if FCol > FCols.Count - 1 then FCol := FCols.Count - 1; UpdateSelectionRange; end; procedure FixTopLeft; var oldTL: TPoint; begin OldTL:=FTopLeft; if IsColumn then begin if OldTL.X+VisibleColCount>FCols.Count then begin OldTL.X := FCols.Count - VisibleColCount; if OldTL.XFRows.Count then begin OldTL.Y := FRows.Count - VisiblerowCount; if OldTL.Y=0) then begin FTopLeft.X:=FFixedCols; if RowCount=0 then begin FFixedRows:=0; FTopLeft.Y:=0; AddDel(FRows, 1); FGCache.AccumHeight.Count:=1; end; end; SizeChanged(OldValue, OldCount); end else begin AddDel(FRows, NewValue); FGCache.AccumHeight.Count:=NewValue; OldCount:=ColCount; if (OldValue=0)and(NewValue>=0) then begin FTopleft.Y:=FFixedRows; if FCols.Count=0 then begin FFixedCols:=0; FTopLeft.X:=0; AddDel(FCols, 1); FGCache.AccumWidth.Count:=1; end; end; SizeChanged(OldCount, OldValue); end; FixTopleft; FixSelection; VisualChange; end; procedure TCustomGrid.SetColCount(Valor: Integer); begin if Columns.Enabled then raise EGridException.Create('Use Columns property to add/remove columns'); InternalSetColCount(Valor); end; procedure TCustomGrid.SetRowCount(Valor: Integer); var OldR: Integer; begin if Valor=FRows.Count then Exit; if Valor<1 then clear else begin OldR:=FRows.Count; CheckFixedCount(ColCount, Valor, FFixedCols, FFixedRows); CheckCount(ColCount, Valor); AdjustCount(False, OldR, Valor); end; end; procedure TCustomGrid.SetDefColWidth(Valor: Integer); var i: Integer; begin if Valor=fDefColwidth then Exit; FDefColWidth:=Valor; if not AutoFillColumns then begin for i:=0 to ColCount-1 do FCols[i] := Pointer(-1); VisualChange; end; end; procedure TCustomGrid.SetDefRowHeight(Valor: Integer); var i: Integer; begin if Valor=fDefRowHeight then Exit; FDefRowheight:=Valor; for i:=0 to RowCount-1 do FRows[i] := Pointer(-1); VisualChange; end; procedure TCustomGrid.SetCol(Valor: Integer); begin if Valor=FCol then Exit; MoveExtend(False, Valor, FRow); end; procedure TCustomGrid.SetRow(Valor: Integer); begin if Valor=FRow then Exit; MoveExtend(False, FCol, Valor); 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 DoOPExchangeColRow(not ColSorting, i,j); I:=I+1; J:=j-1; end; until I>J; if L=R; end; begin CheckIndex(ColSorting, Index); CheckIndex(not ColSorting, IndxFrom); CheckIndex(not ColSorting, IndxTo); BeginUpdate; QuickSort(IndxFrom, IndxTo); EndUpdate(True); end; procedure TCustomGrid.doTopleftChange(dimChg: Boolean); begin TopLeftChanged; if dimchg then begin VisualChange; end else begin CacheVisibleGrid; Invalidate; end; //UpdateScrollBarPos(nil); updateScrollBarPos(ssBoth); 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; Canvas.MoveTo(0,Y); Canvas.LineTo(FGCache.MaxClientXY.X,Y); Canvas.Pen.Mode := OldPenMode; Canvas.Pen.Color := OldPenColor; end; function TCustomGrid.EditorCanProcessKey(var Key: Char): boolean; begin result := EditorCanAcceptKey(Key) and not EditorIsReadOnly; if not Result then Key := #0; end; procedure TCustomGrid.VisualChange; var Tw,Th: Integer; Dh,DV: Integer; HsbVisible, VsbVisible: boolean; HsbRange, VsbRange: Integer; function CalcMaxTopLeft: TPoint; var i: Integer; W,H: Integer; begin Result:=Point(ColCount-1, RowCount-1); W:=0; for i:=ColCount-1 downto FFixedCols do begin W:=W+GetColWidths(i); if W=ColCount)) or // leftmost column can't be equal/higher than colcount ((Y+Yinc>=RowCount)) or // topmost column can't be equal/higher than rowcount ((XInc>0)and(X=aCol)and(GetColWidths(aCol)>FGCache.ClientWidth)) or ((YInc>0)and(Y=aRow)and(GetRowHeights(aRow)>FGCache.ClientHeight)) then Break; Inc(FTopLeft.x, XInc); Inc(FTopLeft.y, YInc); end; Result:=not PointIgual(OldTopleft,FTopLeft); if result then doTopleftChange(False) else ResetOffset(True, True); end; {Returns a valid TopLeft from a proposed TopLeft[DCol,DRow] which are relative or absolute coordinates } function TCustomGrid.ScrollGrid(Relative: Boolean; DCol, DRow: Integer): TPoint; begin Result:=FTopLeft; if not Relative then begin DCol:=DCol-Result.x; DRow:=DRow-Result.y; end; if DCol+Result.xColCount-1 then DCol:=ColCount-1-Result.x; if DRow+Result.yRowCount-1 then DRow:=RowCount-1-Result.y; Inc(Result.x, DCol); Inc(Result.y, DRow); end; procedure TCustomGrid.TopLeftChanged; begin if Assigned(OnTopLeftChanged) and not (csDesigning in ComponentState) then OnTopLeftChanged(Self); end; procedure TCustomGrid.HeaderClick(IsColumn: Boolean; index: Integer); begin end; procedure TCustomGrid.HeaderSized(IsColumn: Boolean; index: Integer); begin end; procedure TCustomGrid.ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); begin if IsColumn and Columns.Enabled then Columns.MoveColumn(ColumnIndexFromGridColumn(FromIndex), ColumnIndexFromGridColumn(ToIndex)); end; procedure TCustomGrid.ColRowExchanged(isColumn: Boolean; index, WithIndex: Integer); begin end; procedure TCustomGrid.ColRowInserted(IsColumn: boolean; index: integer); begin end; procedure TCustomGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect); begin end; procedure TCustomGrid.AutoAdjustColumn(aCol: Integer); begin end; procedure TCustomGrid.SizeChanged(OldColCount, OldRowCount: Integer); begin end; procedure TCustomGrid.ColRowDeleted(IsColumn: Boolean; index: Integer); begin end; procedure TCustomGrid.Paint; begin Inherited Paint; if FUpdateCount=0 then begin //DebugLn('Paint: FGCache.ValidGrid=',FGCache.ValidGrid ); //DebugRect('Paint.ClipRect=',Canvas.ClipRect); DrawBackGround; if FGCache.ValidGrid then begin { DrawFixedCells; DrawInteriorCells; DrawFocused; } DrawByRows; DrawColRowMoving; end; DrawEdges; DrawBorder; end; end; procedure TCustomGrid.PrepareCanvas(aCol, aRow: Integer; aState: TGridDrawState); begin if DefaultDrawing then begin //if gdSelected in aState then Canvas.Brush.color:= SelectedColor else //if gdFixed in aState then Canvas.Brush.color:= FixedColor //else Canvas.Brush.color:= Color; //if gdSelected in aState then Canvas.Font.Color := clWindow //else Canvas.Font.Color := Self.Font.Color; //clWindowText; Canvas.Pen.Mode := pmCopy; if gdSelected in aState then begin Canvas.Brush.Color := SelectedColor; SetCanvasFont(GetColumnFont(aCol, False)); Canvas.Font.Color := clWindow; FLastFont:=nil; end else begin Canvas.Brush.Color := GetColumnColor(aCol, gdFixed in AState); SetCanvasFont(GetColumnFont(aCol, gdFixed in aState)); end; Canvas.TextStyle := DefaultTextStyle; Canvas.TextStyle.Alignment := GetColumnAlignment(aCol, gdFixed in AState); Canvas.TextStyle.Layout := GetColumnLayout(aCol, gdFixed in AState); end else begin Canvas.TextStyle := DefaultTextStyle; Canvas.Brush.Color := clWindow; Canvas.Font.Color := clWindowText; end; if Assigned(OnPrepareCanvas) then OnPrepareCanvas(Self, aCol, aRow, aState); end; procedure TCustomGrid.ResetOffset(chkCol, ChkRow: Boolean); begin with FGCache do begin if ChkCol then ChkCol:=TLColOff<>0; if ChkCol then TlColOff:=0; if ChkRow then ChkRow:=TLRowOff<>0; if ChkRow then TlRowOff:=0; if ChkRow or ChkCol then begin CacheVisibleGrid; Invalidate; if ChkCol then updateScrollBarPos(ssHorizontal);//UpdateScrollBarPos(HorzScrollBar); if ChkRow then updateScrollBarPos(ssVertical);//UpdateScrolLBarPos(VertScrollBar); end; end; end; procedure TCustomGrid.ResizeColumn(aCol, aWidth: Integer); var R: TRect; bigger: boolean; begin BeginUpdate; if aWidth<0 then aWidth:=0; bigger := aWidth > ColWidths[aCol]; ColWidths[aCol]:=aWidth; EndUpdate(uoNone); R := CellRect(aCol, 0); {$IFDEF GoodClipping} R.Bottom := FGCache.MaxClientXY.Y; {$ELSE} R.Bottom := FGCache.ClientHeight; {$ENDIF} if bigger then R.Right := FGCache.MaxClientXY.X else R.Right := FGCache.ClientWidth; if aCol=FTopLeft.x then R.Left := FGCache.FixedWidth; InvalidateRect(handle, @R, True); end; procedure TCustomGrid.ResizeRow(aRow, aHeight: Integer); var R: TRect; bigger: boolean; begin BeginUpdate; if aHeight<0 then aHeight:=0; bigger := aHeight > RowHeights[aRow]; RowHeights[aRow] := aHeight; EndUpdate(uoNone); R := CellRect(0, aRow); {$IFDEF GoodClipping} R.Right := FGCache.MaxClientXY.X; {$ELSE} R.Right := FGCache.ClientWidth; {$ENDIF} if bigger then R.Bottom := FGCache.MaxClientXY.Y else R.Bottom := FGCache.ClientHeight; if aRow=FTopLeft.y then R.Top := FGCache.FixedHeight; InvalidateRect(handle, @R, True); end; function TCustomGrid.SelectCell(ACol, ARow: Integer): Boolean; begin Result:=true; //Result:=MoveExtend(False, aCol, aRow); end; procedure TCustomGrid.SetCanvasFont(aFont: TFont); begin if aFont<>FLastFont then begin Canvas.Font := aFont; FLastFont := AFont; end; end; procedure TCustomGrid.DrawBackGround; begin { The user can draw a something here :) Canvas.Brush.Color:=Color; Canvas.FillRect(Parent.ClientRect); } end; procedure TCustomGrid.DrawBorder; var R: TRect; begin if BorderStyle = bsSingle then begin R := Rect(0,0,FGCache.ClientWidth, FGCache.Clientheight); with R, Canvas do begin Pen.Color := cl3DDKShadow; MoveTo(0,0); LineTo(0,Bottom); LineTo(Right, Bottom); LineTo(Right, 0); LineTo(0,0); end; end; end; (* procedure TCustomGrid.DrawFixedCells; var Gds: TGridDrawState; i,j: Integer; begin Gds:=[gdFixed]; // Draw fixed fixed Cells For i:=0 to FFixedCols-1 do For j:=0 to fFixedRows-1 do DrawCell(i,j, CellRect(i,j), gds); with FGCache.VisibleGrid do begin // Draw fixed column headers For i:=left to Right do For j:=0 to fFixedRows-1 do DrawCell(i,j, CellRect(i,j), gds); // Draw fixed row headers For i:=0 to FFixedCols-1 do For j:=Top to Bottom do DrawCell(i,j, CellRect(i,j), gds); end; end; procedure TCustomGrid.DrawInteriorCells; var Gds: TGridDrawState; i,j: Integer; begin with FGCache.VisibleGrid do begin For i:=Left to Right do For j:=Top to Bottom do begin Gds:=[]; if (i=FCol)and(J=FRow) then Continue; if IsCellSelected(i,j) then Include(gds, gdSelected); DrawCell(i,j, CellRect(i,j), gds); end; end; end; *) procedure TCustomGrid.DrawColRowMoving; {$ifdef AlternativeMoveIndicator} var x, y, dx, dy: Integer; R: TRect; {$endif} begin if (FGridState=gsColMoving)and(fMoveLast.x>=0) then begin {$ifdef AlternativeMoveIndicator} dx := 4; dy := 4; Canvas.pen.Width := 1; Canvas.Pen.Color := clHighlight; Canvas.Brush.Color := clHighlight; R := CellRect(FMoveLast.X, 0); X := R.Left; Y := R.Bottom - dy; Canvas.Polygon([Point(x-dx,y),point(x+dx,y),point(x,y+dy), point(x-dx,y)]); Y := R.Top + dy; Canvas.Polygon([Point(x-dx,y),point(x+dx,y),point(x,y-dy), point(x-dx,y)]); {$else} Canvas.Pen.Width:=3; Canvas.Pen.Color:=clRed; Canvas.MoveTo(fMoveLast.y, 0); Canvas.Lineto(fMovelast.y, FGCache.MaxClientXY.Y); Canvas.Pen.Width:=1; {$endif} end else if (FGridState=gsRowMoving)and(FMoveLast.y>=0) then begin {$ifdef AlternativeMoveIndicator} dx := 4; dy := 4; Canvas.pen.Width := 1; Canvas.Pen.Color := clHighlight; Canvas.Brush.Color := clHighlight; R := CellRect(0, FMoveLast.Y); X := R.Right - dx; Y := R.Top; Canvas.Polygon([Point(x,y+dy),point(x,y-dy),point(x+dx,y), point(x,y+dy)]); X := R.Left + dx; Canvas.Polygon([Point(x,y+dy),point(x,y-dy),point(x-dx,y), point(x,y+dy)]); {$else} Canvas.Pen.Width:=3; Canvas.Pen.Color:=clRed; Canvas.MoveTo(0, FMoveLast.X); Canvas.LineTo(FGCache.MaxClientXY.X, FMoveLast.X); Canvas.Pen.Width:=1; {$endif} end; end; procedure TCustomGrid.DrawCell(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); begin PrepareCanvas(aCol, aRow, aState); Canvas.FillRect(aRect); DrawCellGrid(aCol,aRow,aRect,aState); end; procedure TCustomGrid.DrawByRows; var i: Integer; begin // Draw Rows with FGCache.VisibleGrid do For i:=Top To Bottom do DrawRow(i); // Draw Fixed Rows For i:=0 to FFixedRows-1 Do DrawRow(i); end; function VerticalIntersect(const aRect,bRect: TRect): boolean; begin result := (aRect.Top < bRect.Bottom) and (aRect.Bottom > bRect.Top); end; function HorizontalIntersect(const aRect,bRect: TRect): boolean; begin result := (aRect.Left < bRect.Right) and (aRect.Right > bRect.Left); end; procedure TCustomGrid.DrawRow(aRow: Integer); var Gds: TGridDrawState; i: Integer; Rs: Boolean; R: TRect; {$IFDEF UseClipRect} ClipArea: Trect; {$ENDIF} begin // Upper and Lower bounds for this row ColRowToOffSet(False, True, aRow, R.Top, R.Bottom); {$IFDEF UseClipRect} // is this row within the ClipRect? ClipArea := Canvas.ClipRect; if not VerticalIntersect( R, ClipArea) then begin {$IFDEF DbgVisualChange} DebugLn('Drawrow: Skipped row: ', IntToStr(aRow)); {$ENDIF} exit; end; {$ENDIF} // Draw columns in this row with FGCache.VisibleGrid do if ARow=Top) and (ARow<=Bottom)) or IsCellVisible(FCol,ARow)) then begin if EditorMode then begin //if EditorAlwaysShown and (FEditor<>nil) and FEditor.Visible then begin //DebugLn('No Draw Focus Rect'); end else begin ColRowToOffset(True, True, FCol, R.Left, R.Right); {$IFDEF UseClipRect} // is this column within the ClipRect? if HorizontalIntersect( R, ClipArea) then {$ENDIF} DrawFocusRect(FCol,FRow, R); end; end; end; // else begin // Draw Fixed Columns gds:=[gdFixed]; For i:=0 to FFixedCols-1 do begin ColRowToOffset(True, True, i, R.Left, R.Right); {$IFDEF UseClipRect} // is this column within the ClipRect? if HorizontalIntersect( R, ClipArea) then {$ENDIF} DrawCell(i,aRow, R,gds); end; end; procedure TCustomGrid.EditButtonClicked(Sender: TObject); begin if Assigned(OnEditButtonClick) then OnEditButtonClick(Self); end; procedure TCustomGrid.DrawEdges; var P: TPoint; Cr: TRect; begin P:=FGCache.MaxClientXY; Cr:=Bounds(0,0, FGCache.ClientWidth, FGCache.ClientHeight); if P.x=FGCache.VisibleGrid.Top) and (Frow<=FGCache.VisibleGrid.Bottom)) then begin R:=CellRect(fCol,fRow); DrawFocusRect(fcol,fRow, R, gds); end; end; } procedure DebugRect(S:string; R:TRect); begin DebugLn(S,dbgs(r)); end; procedure DebugPoint(S:string; P:TPoint); begin DebugLn(S,dbgs(p)); end; procedure TCustomGrid.DrawCellGrid(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); var dv,dh: Boolean; aR: TRect; begin // Draw Cell Grid or Maybe in the future Borders.. with Canvas, aRect do begin if (gdFixed in aState) then begin Dv := goFixedVertLine in Options; Dh := goFixedHorzLine in Options; Pen.Style := psSolid; if not FFlat then begin if FTitleStyle=tsNative then begin aR := aRect; DrawFrameControl(Handle, ar, DFC_BUTTON, DFCS_BUTTONPUSH); exit; end else begin Pen.Color := cl3DHilight; MoveTo(Right - 1, Top); LineTo(Left, Top); LineTo(Left, Bottom); if FTitleStyle=tsStandard then begin // more contrast Pen.Color := cl3DShadow; MoveTo(Left+1, Bottom-2); LineTo(Right-2, Bottom-2); LineTo(Right-2, Top); end; end; end; Pen.Color := cl3DDKShadow; end else begin Dv := goVertLine in Options; Dh := goHorzLine in Options; Pen.Style := fGridLineStyle; Pen.Color := fGridLineColor; end; if Dh then begin MoveTo(Left, Bottom - 1); LineTo(Right, Bottom - 1); end; if Dv then begin MoveTo(Right - 1, Top); LineTo(Right - 1, Bottom); end; end; end; procedure TCustomGrid.MyTextRect(R: TRect; Offx, Offy: Integer; S: string; Clipping: boolean); var Rorg: TRect; tmpRgn: HRGN; begin if Clipping then begin //IntersectClipRect(Canvas.handle, R.Left,R.Top,R.Right,R.Bottom); GetClipBox(Canvas.Handle, @ROrg); //DebugRect('Ini Rect = ', ROrg); tmpRGN:=CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom); SelectClipRgn(Canvas.Handle, tmpRGN); //GetClipBox(Canvas.Handle, @Rtmp); //DebugRect('Set Rect = ', Rtmp); DeleteObject(tmpRGN); end; //if Ts.Opaque then Canvas.FillRect(R); Canvas.TextOut(R.Left+Offx, R.Top+Offy, S); if Clipping then begin tmpRGN:=CreateRectRgn(Rorg.Left, Rorg.Top, Rorg.Right, Rorg.Bottom); SelectClipRgn(Canvas.Handle, tmpRGN); //GetClipBox(Canvas.Handle, @Rtmp); //DebugRect('end Rect = ', Rtmp); DeleteObject(tmpRGN); end; end; procedure TCustomGrid.OnTitleFontChanged(Sender: TObject); begin if FColumns.Enabled then FColumns.TitleFontChanged; ColumnsChanged(nil); //else // VisualChange; // LayoutChanged; end; procedure TCustomGrid.ReadColumns(Reader: TReader); begin Columns.Clear; Reader.ReadValue; Reader.ReadCollection(Columns); end; procedure TCustomGrid.ReadColWidths(Reader: TReader); var i: integer; begin with Reader do begin ReadListBegin; for i:=0 to ColCount-1 do ColWidths[I] := ReadInteger; ReadListEnd; end; end; procedure TCustomGrid.ReadRowHeights(Reader: TReader); var i: integer; begin with Reader do begin ReadListBegin; for i:=0 to RowCount-1 do RowHeights[I] := ReadInteger; ReadListEnd; end; end; procedure TCustomGrid.WMEraseBkgnd(var message: TLMEraseBkgnd); begin message.Result:=1; end; procedure TCustomGrid.WMGetDlgCode(var Msg: TLMNoParams); begin Msg.Result := DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_WANTALLKEYS; if goTabs in Options then Msg.Result:= Msg.Result or DLGC_WANTTAB; end; procedure TCustomGrid.WMHScroll(var message: TLMHScroll); var C,TL,CTL: Integer; {$ifdef GoodClipping} R: TRect; {$endif} begin {$IfDef dbgScroll} DebugLn('HSCROLL: Code=',IntToStr(message.ScrollCode),' Position=', IntToStr(message.Pos)); {$Endif} if not FGCache.ValidGrid then Exit; if FEditor<>nil then EditorGetValue; TL:= PtrInt(FGCache.AccumWidth[ FGCache.MaxTopLeft.X ]) - FGCAche.FixedWidth; CTL:= PtrInt(FGCache.AccumWidth[ FtopLeft.X ]) - FGCache.FixedWidth; case message.ScrollCode of // Scrolls to start / end of the text SB_TOP: C := 0; SB_BOTTOM: C := TL; // Scrolls one line up / down SB_LINEDOWN: C := CTL + GetColWidths( FTopLeft.X ); SB_LINEUP: C := CTL - GetColWidths( FTopLeft.X - 1); // Scrolls one page of lines up / down SB_PAGEDOWN: C := CTL + FGCache.ClientWidth; SB_PAGEUP: C := CTL - FGCache.ClientWidth; // Scrolls to the current scroll bar position SB_THUMBPOSITION: C := Message.Pos; SB_THUMBTRACK: if goThumbTracking in Options then C := message.Pos else Exit; // Ends scrolling SB_ENDSCROLL: Exit; end; if C > TL then C := TL else if C < 0 then C := 0; {$Ifdef dbgScroll} DebugLn('---- Position=',IntToStr(C), ' FixedWidth=',IntToStr(FGCache.FixedWidth)); {$Endif} ScrollBarPosition(SB_HORZ, C); C:= C + FGCache.FixedWidth + Integer(BorderStyle); {$Ifdef dbgScroll} DebugLn('---- Position=',IntToStr(C), ' FixedWidth=',IntToStr(FGCache.FixedWidth)); {$Endif} TL:=OffsetToColRow(True, False, C, FGCache.TLColOff); {$Ifdef dbgScroll} DebugLn('---- Offset=',IntToStr(C), ' TL=',IntToStr(TL),' TLColOFf=', IntToStr(FGCache.TLColOff)); {$Endif} if not (goSmoothScroll in Options) then FGCache.TLColOff:=0; if TL<>FTopLeft.X then begin Inc(FUpdateScrollBarsCount); TryScrollTo(Tl, FTopLeft.Y); Dec(FUpdateScrollBarsCount); end else if goSmoothScroll in Options then begin CacheVisibleGrid; {$IFDEF GoodClipping} R.Topleft:=Point(FGCache.FixedWidth, 0); R.BottomRight:= FGCache.MaxClientXY; InvalidateRect(Handle, @R, false); {$ELSE} Invalidate; {$ENDIF} end; end; procedure TCustomGrid.WMVScroll(var message: TLMVScroll); var C, TL, CTL: Integer; {$IFDEF GoodClipping} R: TRect; {$ENDIF} begin {$IfDef dbgScroll} DebugLn('VSCROLL: Code=',IntToStr(message.ScrollCode),' Position=', IntToStr(message.Pos)); {$Endif} if not FGCache.ValidGrid then Exit; if FEditor<>nil then EditorGetValue; TL:= PtrInt(FGCache.AccumHeight[ FGCache.MaxTopLeft.Y ]) - FGCache.FixedHeight; CTL:= PtrInt(FGCache.AccumHeight[ FtopLeft.Y ]) - FGCache.FixedHeight; case message.ScrollCode of // Scrolls to start / end of the text SB_TOP: C := 0; SB_BOTTOM: C := TL; // Scrolls one line up / down SB_LINEDOWN: C := CTL + GetRowHeights( FTopleft.Y ); SB_LINEUP: C := CTL - GetRowHeights( FTopleft.Y - 1 ); // Scrolls one page of lines up / down SB_PAGEDOWN: C := CTL + FGCache.ClientHeight; SB_PAGEUP: C := CTL - FGCache.ClientHeight; // Scrolls to the current scroll bar position SB_THUMBPOSITION: C := message.Pos; SB_THUMBTRACK: if goThumbTracking in Options then C := message.Pos else Exit; // Ends scrolling SB_ENDSCROLL: Exit; end; if C > Tl then C := TL else if C < 0 then C := 0; {$Ifdef dbgScroll} DebugLn('---- Position=',IntToStr(C), ' FixedHeight=',IntToStr(FGCache.FixedHeight)); {$Endif} ScrollBarPosition(SB_VERT, C); C:= C + FGCache.FixedHeight + Integer(BorderStyle); {$Ifdef dbgScroll} DebugLn('---- NewPosition=',IntToStr(C)); {$Endif} TL:=OffsetToColRow(False, False, C, FGCache.TLRowOff); {$Ifdef dbgScroll} DebugLn('---- Offset=',IntToStr(C), ' TL=',IntToStr(TL), ' TLRowOFf=', IntToStr(FGCache.TLRowOff)); {$Endif} if not (goSmoothScroll in Options) then FGCache.TLRowOff:=0; if TL<>FTopLeft.Y then begin Inc(FUpdateScrollBarsCount); TryScrollTo(FTopLeft.X, Tl); Dec(FUpdateScrollBarsCount); end else if goSmoothScroll in Options then begin CacheVisibleGrid; {$IFDEF GoodClipping} R.TopLeft:=Point(0, FGCache.FixedHeight); R.BottomRight:=FGCache.MaxClientXY; InvalidateRect(Handle, @R, false); {$ELSE} Invalidate; {$ENDIF} end; end; procedure TCustomGrid.WMKillFocus(var message: TLMKillFocus); begin {$ifdef dbgGrid} if csDestroying in ComponentState then exit; DbgOut('*** grid.WMKillFocus, FocusedWnd=', dbgs(Message.FocusedWnd),'[',dbgs(pointer(Message.FocusedWnd)),'] '); if EditorMode and (Message.FocusedWnd = FEditor.Handle) then DebugLn('Editor') else DebugLn('ExternalWindow'); {$endif} end; procedure TCustomGrid.WMSetFocus(var message: TLMSetFocus); begin {$ifdef dbgGrid} DbgOut('*** grid.WMSetFocus, FocusedWnd=', dbgs(Message.FocusedWnd),'[',dbgs(pointer(Message.FocusedWnd)),'] '); if EditorMode and (Message.FocusedWnd = FEditor.Handle) then DebugLn('Editor') else DebugLn('ExternalWindow'); {$endif} end; procedure TCustomGrid.WMChar(var message: TLMChar); var Ch: Char; begin inherited; Ch:=Char(message.CharCode); {$Ifdef GridTraceMsg} DebugLn(ClassName,'.WMchar CharCode= ', IntToStr(message.CharCode)); {$Endif} if (goEditing in Options) and (Ch in [^H, #32..#255]) then EditorShowChar(Ch); end; procedure TCustomGrid.WndProc(var TheMessage: TLMessage); begin {$ifdef GridTraceMsg} TransMsg('GRID: ', TheMessage); {$endif} case TheMessage.Msg of LM_HSCROLL, LM_VSCROLL: if csDesigning in ComponentState then exit; end; inherited WndProc(TheMessage); end; procedure TCustomGrid.CreateWnd; begin inherited CreateWnd; VisualChange; end; { Scroll grid to the given Topleft[aCol,aRow] as needed } procedure TCustomGrid.TryScrollTo(aCol, aRow: Integer); var TryTL: TPoint; begin TryTL:=ScrollGrid(False,aCol, aRow); if not PointIgual(TryTL, FTopLeft) then begin FTopLeft:=TryTL; doTopleftChange(False); end; end; procedure TCustomGrid.SetGridLineWidth(const AValue: Integer); begin // Todo if FGridLineWidth=AValue then exit; FGridLineWidth:=AValue; Invalidate; end; { Reposition the scrollbars according to the current TopLeft } procedure TCustomGrid.UpdateScrollbarPos(Which: TScrollStyle); begin // Adjust ScrollBar Positions // Special condition only When scrolling by draging // the scrollbars see: WMHScroll and WVHScroll if FUpdateScrollBarsCount=0 then begin if Which in [ssHorizontal, ssBoth] then begin if ScrollBarAutomatic(ssHorizontal) then begin with FGCache do ScrollBarPosition(SB_HORZ, PtrInt(AccumWidth[FTopLeft.x])-TLColOff-FixedWidth ); end; end; if Which in [ssVertical, ssBoth] then begin if ScrollBarAutomatic(ssVertical) then begin with FGCache do ScrollBarPosition(SB_VERT, PtrInt(AccumHeight[FTopLeft.y])-TLRowOff-FixedHeight); end; end; end; {if FUpd...} end; procedure TCustomGrid.UpdateSelectionRange; begin if goRowSelect in Options then begin FRange:=Rect(FFixedCols, FRow, ColCount-1, FRow); end else FRange:=Rect(FCol,FRow,FCol,FRow); end; procedure TCustomGrid.WriteColumns(Writer: TWriter); begin if Columns.IsDefault then Writer.WriteCollection(nil) else Writer.WriteCollection(Columns); end; procedure TCustomGrid.WriteColWidths(Writer: TWriter); var i: Integer; begin with writer do begin WriteListBegin; for i:=0 to ColCount-1 do WriteInteger(ColWidths[i]); WriteListEnd; end; end; procedure TCustomGrid.WriteRowHeights(Writer: TWriter); var i: integer; begin with writer do begin WriteListBegin; for i:=0 to RowCount-1 do WriteInteger(RowHeights[i]); WriteListEnd; end; end; procedure TCustomGrid.CheckFixedCount(aCol,aRow,aFCol,aFRow: Integer); begin if AFRow<0 then Raise EGridException.Create('FixedRows<0'); if AFCol<0 then Raise EGridException.Create('FixedCols<0'); if (aCol=0)And(aFCol=0) then // invalid grid, ok else if (aFCol>=aCol) and not (csLoading in componentState) then raise EGridException.Create(rsFixedColsTooBig); if (aRow=0)and(aFRow=0) then // Invalid grid, ok else if (aFRow>=aRow) and not (csLoading in ComponentState) then raise EGridException.Create(rsFixedRowsTooBig); end; procedure TCustomGrid.CheckCount(aNewColCount, aNewRowCount: Integer); var NewCol,NewRow: Integer; begin if HandleAllocated then begin if Col >= aNewColCount then NewCol := aNewColCount-1 else NewCol := Col; if Row >= aNewRowCount then NewRow := aNewRowCount-1 else NewRow := Row; if (NewCol>=0) and (NewRow>=0) and ((NewCol <> Col) or (NewRow <> Row)) then begin CheckTopleft(NewCol, NewRow , NewCol<>Col, NewRow<>Row); MoveNextSelectable(false, NewCol, NewRow); end; end; end; procedure TCustomGrid.CheckIndex(IsColumn: Boolean; Index: Integer); begin if (IsColumn and ((Index<0) or (Index>ColCount-1))) or (not IsColumn and ((Index<0) or (Index>RowCount-1))) then raise EGridException.Create('Index out of range'); end; function TCustomGrid.CheckTopLeft(aCol,aRow: Integer; CheckCols, CheckRows: boolean): boolean; var OldTopLeft: TPoint; W: Integer; begin OldTopLeft := FTopLeft; Result:= False; with FTopleft do if CheckCols and (X>FixedCols) then begin W := FGCache.ScrollWidth-ColWidths[aCol]-PtrInt(FGCache.AccumWidth[aCol]); while (x>FixedCols)and(W+PtrInt(FGCache.AccumWidth[x])>=ColWidths[x-1]) do begin Dec(x); end; end; with FTopleft do if CheckRows and (Y > FixedRows) then begin W := FGCache.ScrollHeight-RowHeights[aRow]-PtrInt(FGCache.AccumHeight[aRow]); while (y>FixedRows)and(W+PtrInt(FGCache.AccumHeight[y])>=RowHeights[y-1]) do begin Dec(y); end; end; Result := Not PointIgual(OldTopleft,FTopLeft); if Result then doTopleftChange(False) end; function TCustomGrid.GetEditorBorderStyle: TBorderStyle; begin result := bsSingle; if FEditor = FstringEditor then Result := FStringEditor.BorderStyle else if FEditor = FPickListEditor then Result := FStringEditor.BorderStyle; end; function TCustomGrid.GetColumns: TGridColumns; begin result := FColumns; end; function TCustomGrid.CreateColumns: TGridColumns; begin result := TGridColumns.Create(Self); end; procedure TCustomGrid.SetAutoFillColumns(const AValue: boolean); begin FAutoFillColumns := AValue; if FAutoFillColumns then VisualChange; end; procedure TCustomGrid.SetColumns(const AValue: TGridColumns); begin FColumns.Assign(Avalue); end; procedure TCustomGrid.SetEditorOptions(const AValue: Integer); begin if FEditorOptions<>AValue then begin if FEditor=nil then exit; FEditorOptions:=AValue; if FEditorOptions and EO_HOOKKEYDOWN = EO_HOOKKEYDOWN then begin FEditor.OnKeyDown:=@EditorKeyDown; end; if FEditorOptions and EO_HOOKKEYPRESS = EO_HOOKKEYPRESS then begin FEditor.OnKeyPress := @EditorKeyPress; end; if FEditorOptions and EO_HOOKKEYUP = EO_HOOKKEYUP then begin FEditor.OnKeyUp := @EditorKeyUp; end; if FEditorOptions and EO_HOOKEXIT = EO_HOOKEXIT then begin FEditor.OnExit:=@EditorExit; end; {$IfDef EditorDbg} DBGOut('SetEditor-> Editor=',FEditor.Name,' '); if FEditorOptions and EO_AUTOSIZE = EO_AUTOSIZE then DBGOut('EO_AUTOSIZE '); if FEditorOptions and EO_HOOKKEYDOWN = EO_HOOKKEYDOWN then DBGOut('EO_HOOKKEYDOWN '); if FEditorOptions and EO_HOOKKEYPRESS = EO_HOOKKEYPRESS then DBGOut('EO_HOOKKEYPRESS '); if FEditorOptions and EO_HOOKKEYUP = EO_HOOKKEYUP then DBGOut('EO_HOOKKEYUP '); if FEditorOptions and EO_HOOKEXIT = EO_HOOKEXIT then DBGOut('EO_HOOKEXIT '); if FEditorOptions and EO_SELECTALL= EO_SELECTALL then DBGOut('EO_SELECTALL '); if FEditorOptions and EO_WANTCHAR = EO_WANTCHAR then DBGOut('EO_WANTCHAR '); DebugLn; {$Endif} end; end; procedure TCustomGrid.SetEditorBorderStyle(const AValue: TBorderStyle); begin // supposedly instances cannot access protected properties // of parent classes, so why the next works? { if FEditor.BorderStyle <> AValue then begin FEditor.BorderStyle := AValue; if EditorMode then EditorPos; end; } if FStringEditor.BorderStyle<>AValue then begin FStringEditor.BorderStyle := AValue; if (FEditor = FStringEditor) and EditorMode then EditorPos; end; if FPicklistEditor.BorderStyle<>AValue then begin FPicklistEditor.BorderStyle := AValue; if (FEditor = FPicklistEditor) and EditorMode then EditorPos; end; end; procedure TCustomGrid.SetFlat(const AValue: Boolean); begin if FFlat=AValue then exit; FFlat:=AValue; Invalidate; end; procedure TCustomGrid.SetFocusRectVisible(const AValue: Boolean); begin if FFocusRectVisible<>AValue then begin FFocusRectVisible := AValue; Invalidate; end; end; procedure TCustomGrid.SetTitleFont(const AValue: TFont); begin FTitleFont.Assign(AValue); VisualChange; end; procedure TCustomGrid.SetTitleStyle(const AValue: TTitleStyle); begin if FTitleStyle=AValue then exit; FTitleStyle:=AValue; Invalidate; end; procedure TCustomGrid.SetUseXorFeatures(const AValue: boolean); begin if FUseXORFeatures=AValue then exit; FUseXORFeatures:=AValue; Invalidate; end; procedure TCustomGrid.SetBorderStyle(NewStyle: TBorderStyle); begin if BorderStyle<>NewStyle then begin inherited; if HandleAllocated and ([csDestroying,csLoading]*ComponentState=[]) then begin VisualChange; if CheckTopLeft(Col, Row, True, True) then VisualChange; end; end; end; { Save to the cache the current visible grid (excluding fixed cells) } procedure TCustomGrid.CacheVisibleGrid; var R: TRect; begin with FGCache do begin VisibleGrid:=GetVisibleGrid; with VisibleGrid do ValidGrid:= (Left>=0)and(Top>=0)and(Right>=Left)and(Bottom>=Top)and (ColCount>0)and(RowCount>0); if not ValidGrid then MaxClientXY:=Point(0,0) else begin R:=CellRect(VisibleGrid.Right, VisibleGrid.Bottom); MaxClientXY:=R.BottomRight; end; end; end; function TCustomGrid.GetSelection: TGridRect; begin Result:=FRange; end; function TCustomGrid.GetSystemMetricsGapSize(const Index: Integer): Integer; begin {$ifdef Win32} result := 0; {$else} result := 3; {$endif} end; procedure TCustomGrid.SetDefaultDrawing(const AValue: Boolean); begin if FDefaultDrawing=AValue then exit; FDefaultDrawing:=AValue; Invalidate; end; procedure TCustomGrid.SetFocusColor(const AValue: TColor); begin if FFocusColor=AValue then exit; FFocusColor:=AValue; InvalidateCell(FCol,FRow); end; procedure TCustomGrid.SetGridLineStyle(const AValue: TPenStyle); begin if FGridLineStyle=AValue then exit; FGridLineStyle:=AValue; Invalidate; end; procedure TCustomGrid.SetSelectActive(const AValue: Boolean); begin if FSelectActive=AValue then exit; FSelectActive:=AValue and (not(goEditing in Options) or (ExtendedSelect and not EditorAlwaysShown)); if FSelectActive then FPivot:=Point(FCol,FRow); end; procedure TCustomGrid.SetSelection(const AValue: TGridRect); begin if goRangeSelect in Options then begin fRange:=NormalizarRect(aValue); Invalidate; end; end; function TCustomGrid.doColSizing(X, Y: Integer): Boolean; var R: TRect; Loc: Integer; begin Result:=False; if gsColSizing = fGridState then begin {.$ifdef UseXOR} if FUseXORFeatures then begin if (x-FSplitter.Y)<=0 then x:= FSplitter.Y; if x<>FPrevValue then begin if FPrevLine then DrawXorVertLine(FPrevValue); DrawXorVertLine(X); FPrevLine:=True; FPrevValue:=X; end; end else {.$else} ResizeColumn(FSplitter.x, x-FSplitter.y); {.$endif} Result:=True; end else if (fGridState=gsNormal) and ((YFGCache.FixedWidth) then begin FSplitter.X:= OffsetToColRow(True, True, X, Loc); FSplitter.Y:=0; if FSplitter.X>=0 then begin R:=CellRect(FSplitter.x, FSplitter.y); FSplitter.y:=X; // Resizing X reference if (R.Right-X)<(X-R.Left) then Loc:=R.Right else begin Loc:=R.Left; Dec(FSplitter.x); // Resizing col is the previous end; IF (Abs(Loc-x)<=2)and(FSplitter.X>=FFixedCols) then begin // start resizing Cursor:=crHSplit; {.$ifdef UseXOR} FPrevLine := False; FPrevValue := -1; {.$endif} end else Cursor:=crDefault; Result:=True; end; end else if (cursor=crHSplit) then Cursor:=crDefault; end; function TCustomGrid.doRowSizing(X, Y: Integer): Boolean; var OffTop,OffBottom: Integer; begin Result:=False; if gsRowSizing = fGridState then begin {.$ifdef UseXOR} if FUseXORFeatures then begin if (y-FSplitter.x)<=0 then y:= FSplitter.x; if y<>FPrevValue then begin if FPrevLine then DrawXorHorzLine(FPrevValue); DrawXorHorzLine(Y); FPrevLine:=True; FPrevValue:=y; end; end else {.$else} ResizeRow(FSplitter.y, y-FSplitter.x); {.$endif} Result:=True; end else if (fGridState=gsNormal) and ((XFGCache.FixedHeight) then begin fSplitter.Y:=OffsetToColRow(False, True, Y, OffTop{dummy}); if Fsplitter.Y>=0 then begin ColRowToOffset(False, True, FSplitter.Y, OffTop, OffBottom); FSplitter.X:=Y; if (OffBottom-Y)<(Y-OffTop) then SwapInt(OffTop, OffBottom) else Dec(FSplitter.y); if (Abs(OffTop-y)<=2)and(FSplitter.Y>=FFixedRows) then begin // start resizing Cursor:=crVSplit; {.$ifdef UseXOR} FPrevLine := False; FPrevValue := -1; {.$endif} end else Cursor:=crDefault; Result:=True; end; end else if Cursor=crVSplit then Cursor:=crDefault; end; procedure TCustomGrid.doColMoving(X, Y: Integer); var P: TPoint; R: TRect; begin //debugLn('DoColMoving: FDragDX=',IntToStr(FDragDX), ' Sp.x= ', IntTOStr(FSplitter.X), 'Sp.y= ', IntToStr(FSplitter.y)); P:=MouseToCell(Point(X,Y)); if (Abs(FSplitter.Y-X)>fDragDx)and(Cursor<>crMultiDrag) then begin Cursor:=crMultiDrag; FMoveLast:=Point(-1,-1); ResetOffset(True, False); end; if (Cursor=crMultiDrag)and (P.x>=FFixedCols) and ((P.X<=FSplitter.X)or(P.X>FSplitter.X))and (P.X<>FMoveLast.X) then begin R:=CellRect(P.x, P.y); if P.x<=FSplitter.X then fMoveLast.Y:=R.left else FMoveLast.Y:=R.Right; fMoveLast.X:=P.X; {$ifdef AlternativeMoveIndicator} InvalidateRow(0); {$else} Invalidate; {$endif} end; end; procedure TCustomGrid.doRowMoving(X, Y: Integer); var P: TPoint; R: TRect; begin P:=MouseToCell(Point(X,Y)); if (Cursor<>crMultiDrag)and(Abs(FSplitter.X-Y)>fDragDx) then begin Cursor:=crMultiDrag; FMoveLast:=Point(-1,-1); ResetOffset(False, True); end; if (Cursor=crMultiDrag)and (P.y>=FFixedRows) and ((P.y<=FSplitter.Y)or(P.Y>FSplitter.Y))and (P.y<>FMoveLast.Y) then begin R:=CellRect(P.x, P.y); if P.y<=FSplitter.y then fMoveLast.X:=R.Top else FMoveLast.X:=R.Bottom; fMoveLast.Y:=P.Y; Invalidate; end; end; function TCustomGrid.OffsetToColRow(IsCol, Fisical: Boolean; Offset: Integer; var Rest: Integer): Integer; begin Result:=0; //Result:=-1; Rest:=0; Offset := Offset - Integer(BorderStyle); if Offset<0 then Exit; // Out of Range; with FGCache do if IsCol then begin // begin to count Cols from 0 but ... if Fisical and (Offset>FixedWidth-1) then begin Result:=FTopLeft.X; // In scrolled view, then begin from FtopLeft col Offset:=Offset-FixedWidth+PtrInt(AccumWidth[Result])+TLColOff; if Offset>GridWidth-1 then begin Result:=ColCount-1; Exit; end; end; while Offset>(PtrInt(AccumWidth[Result])+GetColWidths(Result)-1) do Inc(Result); Rest:=Offset; if Result<>0 then Rest:=Offset-PtrInt(AccumWidth[Result]); end else begin if Fisical and (Offset>FixedHeight-1) then begin Result:=FTopLeft.Y; Offset:=Offset-FixedHeight+PtrInt(AccumHeight[Result])+TLRowOff; if Offset>GridHeight-1 then begin Result:=RowCount-1; Exit; // Out of Range end; end; while Offset>(PtrInt(AccumHeight[Result])+GetRowHeights(Result)-1) do Inc(Result); Rest:=Offset; if Result<>0 then Rest:=Offset-PtrInt(AccumHeight[Result]); end; end; // ex: IsCol=true, Index:=100, TopLeft.x:=98, FixedCols:=1, all ColWidths:=20 // Fisical = Relative => Ini := WidthfixedCols+WidthCol98+WidthCol99 // Not Fisical = Absolute => Ini := WidthCols(0..99) function TCustomGrid.ColRowToOffset(IsCol,Fisical:Boolean; index:Integer; var Ini,Fin:Integer): Boolean; var Dim: Integer; begin with FGCache do begin if IsCol then begin Ini:=PtrInt(AccumWidth[index]); Dim:=GetColWidths(index); end else begin Ini:=PtrInt(AccumHeight[index]); Dim:= GetRowHeights(index); end; Ini := Ini + Integer(BorderStyle); if not Fisical then begin Fin:=Ini + Dim; Exit; end; if IsCol then begin if index>=FFixedCols then Ini:=Ini-PtrInt(AccumWidth[FTopLeft.X]) + FixedWidth - TLColOff; end else begin if index>=FFixedRows then Ini:=Ini-PtrInt(AccumHeight[FTopLeft.Y]) + FixedHeight - TLRowOff; end; Fin:=Ini + Dim; end; Result:=true; end; function TCustomGrid.ColumnIndexFromGridColumn(Column: Integer): Integer; begin Result := Columns.RealIndex( Column - FixedCols ); end; function TCustomGrid.ColumnFromGridColumn(Column: Integer): TGridColumn; var ColIndex: Integer; begin ColIndex := Columns.RealIndex( Column - FixedCols ); if ColIndex>=0 then result := Columns[ColIndex] else result := nil; end; procedure TCustomGrid.ColumnsChanged(aColumn: TGridColumn); var aCol: Integer; begin if csDestroying in ComponentState then exit; if AColumn=nil then if Columns.Enabled then begin InternalSetColCount( FixedCols + Columns.VisibleCount ) end else if not (csloading in ComponentState) then ColCount := FixedCols + 1 else begin aCol := Columns.IndexOf(AColumn); if ACol>=0 then begin if aColumn.WidthChanged then VisualChange else InvalidateCol(FixedCols + ACol); end; end; end; function TCustomGrid.MouseToGridZone(X, Y: Integer): TGridZone; begin if X<=FGCache.FixedWidth then if Y<=FGcache.FixedHeight then Result:=gzFixedCells else Result:=gzFixedRows else if Y<=FGCache.FixedHeight then if X<=FGCache.FixedWidth then Result:=gzFixedCells else Result:=gzFixedCols else result := gzNormal; end; function TCustomGrid.CellToGridZone(aCol, aRow: Integer): TGridZone; begin if (aColColCount-1 then Index := ColCount-1; if columns.Enabled then begin Columns.InsertColumn(ColumnIndexFromGridColumn(index)); ColRowInserted(true, index); exit; end else begin FCols.Insert(Index, pointer(-1)); FGCache.AccumWidth.Insert(Index, nil); end; end else begin Frows.Insert(Index, pointer(-1)); FGCache.AccumHeight.Insert(Index, nil); end; ColRowInserted(IsColumn, index); VisualChange; end; procedure TCustomGrid.doOPMoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer); begin CheckIndex(IsColumn, FromIndex); CheckIndex(IsColumn, ToIndex); if IsColumn and Columns.Enabled then ColRowMoved(True, FromIndex, ToIndex) else begin FRows.Move(FromIndex, ToIndex); ColRowMoved(IsColumn, FromIndex, ToIndex); VisualChange; end; end; procedure TCustomGrid.DoOPDeleteColRow(IsColumn: Boolean; index: Integer); procedure doDeleteColumn; begin CheckIndex(IsColumn,Index); CheckFixedCount(ColCount-1, RowCount, FFixedCols, FFixedRows); CheckCount(ColCount-1, RowCount); if Columns.Enabled then begin Columns.RemoveColumn(ColumnIndexFromGridColumn(Index)); ColRowDeleted(True, Index); end else begin if Index=0 then begin if FMoveLast.X=FSplitter.X then {$ifdef AlternativeMoveIndicator} InvalidateRow(0); {$else} Invalidate; {$endif} DoOPMoveColRow(True, Fsplitter.X, FMoveLast.X); Cursor:=crDefault; end else if Cur.X=FSplitter.X then HeaderClick(True, FSplitter.X); end; gsRowMoving: begin //DebugLn('Move Row From ',Fsplitter.Y,' to ', FMoveLast.Y); if FMoveLast.Y>=0 then begin DoOPMoveColRow(False, Fsplitter.Y, FMoveLast.Y); Cursor:=crDefault; end else if Cur.Y=FSplitter.Y then HeaderClick(False, FSplitter.Y); end; gsColSizing: begin {.$ifdef UseXOR} if FUseXORFeatures then begin if FPrevLine then DrawXorVertLine(FPrevValue); FPrevLine := False; FPrevValue := -1; ResizeColumn(FSplitter.x, x-FSplitter.y); end; {.$endif} HeaderSized( True, FSplitter.X); end; gsRowSizing: begin {.$ifdef UseXOR} if FUseXORFeatures then begin if FPrevLine then DrawXorHorzLine(FPrevValue); FPrevLine := False; FPrevValue := -1; ResizeRow(FSplitter.y, y-FSplitter.x); end; {.$endif} HeaderSized( False, FSplitter.Y); end; end; fGridState:=gsNormal; {$IfDef dbgGrid}DebugLn('MouseUP END RND=', FloatToStr(Random));{$Endif} end; procedure TCustomGrid.DblClick; begin if (goColSizing in Options) and (Cursor=crHSplit) then begin if (goDblClickAutoSize in Options) then begin AutoAdjustColumn( FSplitter.X ); end {else DebugLn('Got Doubleclick on Col Resizing: AutoAdjust?');} end else if (goDblClickAutoSize in Options) and (goRowSizing in Options) and (Cursor=crVSplit) then begin { DebugLn('Got DoubleClick on Row Resizing: AutoAdjust?'); } end else Inherited DblClick; end; procedure TCustomGrid.DefineProperties(Filer: TFiler); function SonRowsIguales(aGrid: TCustomGrid): boolean; var i: Integer; begin result := aGrid.RowCount = RowCount; if Result then for i:=0 to RowCount-1 do if aGrid.RowHeights[i]<>RowHeights[i] then begin result := false; break; end; end; function SonColsIguales(aGrid: TCustomGrid): boolean; var i: Integer; begin result := aGrid.ColCount = ColCount; if Result then for i:=0 to ColCount-1 do if aGrid.ColWidths[i]<>ColWidths[i] then begin result := false; break; end; end; function SonDefault(IsColumn: Boolean; L1: TList): boolean; var i: Integer; DefValue, Value: Integer; begin Result := True; if IsColumn then DefValue := DefaultColWidth else DefValue := DefaultRowHeight; for i:=0 to L1.Count-1 do begin Value := PtrInt(L1[i]); Result := (Value = DefValue) or (Value<0); if not Result then break; end; end; function NeedWidths: boolean; begin if Filer.Ancestor <> nil then Result := not SonColsIguales(TCustomGrid(Filer.Ancestor)) else Result := not SonDefault(True, FCols); result := Result and not AutoFillColumns; end; function NeedHeights: boolean; begin if Filer.Ancestor <> nil then Result := not SonRowsIguales(TCustomGrid(Filer.Ancestor)) else Result := not SonDefault(false, FRows); end; function HasColumns: boolean; var C: TGridColumns; begin if Filer.Ancestor <> nil then C := TCustomGrid(Filer.Ancestor).Columns else C := Columns; if C<>nil then result := not C.IsDefault else result := false; end; begin inherited DefineProperties(Filer); with Filer do begin //DefineProperty('Columns', @ReadColumns, @WriteColumns, HasColumns); DefineProperty('ColWidths', @ReadColWidths, @WriteColWidths, NeedWidths); DefineProperty('RowHeights', @ReadRowHeights, @WriteRowHeights, NeedHeights); end; end; procedure TCustomGrid.DestroyHandle; begin editorGetValue; inherited DestroyHandle; end; function TCustomGrid.DoCompareCells(Acol, ARow, Bcol, BRow: Integer): Integer; begin result := 0; if Assigned(OnCompareCells) then OnCompareCells(Self, ACol, ARow, BCol, BRow, Result); end; procedure TCustomGrid.DoCopyToClipboard; begin end; procedure TCustomGrid.DoCutToClipboard; begin end; procedure TCustomGrid.DoEditorHide; begin Editor.Visible:=False; //Editor.Parent:=nil; LCLIntf.SetFocus(Self.Handle); end; procedure TCustomGrid.DoEditorShow; begin {$ifdef dbgGrid}DebugLn('grid.DoEditorShow INIT');{$endif} ScrollToCell(FCol,FRow); Editor.parent := nil; EditorSetValue; Editor.Parent:=Self; Editor.Visible:=True; Editor.SetFocus; InvalidateCell(FCol,FRow,True); {$ifdef dbgGrid}DebugLn('grid.DoEditorShow FIN');{$endif} end; procedure TCustomGrid.DoOnChangeBounds; begin inherited DoOnChangeBounds; VisualChange; end; procedure TCustomGrid.DoPasteFromClipboard; begin // end; procedure TCustomGrid.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); begin FLastWidth := ClientWidth; inherited DoSetBounds(ALeft, ATop, AWidth, AHeight); end; procedure TCustomGrid.doExit; begin if FEditorShowing then begin {$IfDef dbgGrid}DebugLn('DoExit - EditorShowing');{$Endif} end else begin {$IfDef dbgGrid}DebugLn('DoExit - Ext');{$Endif} //Invalidate; end; inherited DoExit; end; procedure TCustomGrid.DoEnter; begin inherited DoEnter; if EditorLocked then begin {$IfDef dbgGrid}DebugLn('DoEnter - EditorLocked');{$Endif} end else begin {$IfDef dbgGrid}DebugLn('DoEnter - Ext');{$Endif} if EditorAlwaysShown then begin SelectEditor; if Feditor<>nil then EditorShow(true); end; end; end; function TCustomGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint ): Boolean; begin {$ifdef dbgGrid}DebugLn('doMouseWheelDown INIT');{$endif} Result:=inherited DoMouseWheelDown(Shift, MousePos); if not result then begin // event wasn't handled by the user if ssCtrl in Shift then MoveExtend(true, 1, 0) else MoveExtend(true, 0, 1); Result := true; end; {$ifdef dbgGrid}DebugLn('doMouseWheelDown FIN');{$endif} end; function TCustomGrid.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint ): Boolean; begin {$ifdef dbgGrid}DebugLn('doMouseWheelUP INIT');{$endif} Result:=inherited DoMouseWheelUp(Shift, MousePos); if not result then begin // event wasn't handled by the user if ssCtrl in Shift then MoveExtend(true, -1, 0) else MoveExtend(true, 0, -1); Result := True; end; {$ifdef dbgGrid}DebugLn('doMouseWheelUP FIN');{$endif} end; procedure TCustomGrid.KeyDown(var Key: Word; Shift: TShiftState); var Sh: Boolean; procedure MoveSel(Rel: Boolean; aCol,aRow: Integer); begin // Always reset Offset in keyboard Events FGCache.TLColOff:=0; FGCache.TLRowOff:=0; SelectActive:=Sh; MoveNextSelectable(Rel, aCol, aRow); Key:=0; end; var R: TRect; Relaxed: Boolean; //PF: TCustomForm; begin {$ifdef dbgGrid}DebugLn('Grid.KeyDown INIT Key=',IntToStr(Key));{$endif} inherited KeyDown(Key, Shift); if not FGCache.ValidGrid then Exit; Sh:=(ssShift in Shift); Relaxed:=not (goRowSelect in Options) or (goRelaxedRowSelect in Options); if (Key=Vk_TAB) then begin if (goTabs in Options) then begin case FAutoAdvance of aaRight: if Sh then Key:=VK_LEFT else Key:=VK_RIGHT; aaDown: if Sh then Key:=VK_UP else Key:=VK_DOWN; aaLeft: if sh then Key:=VK_RIGHT else Key:=VK_LEFT; aaNone: Key:=0; end; end else begin // TODO (* Pf:=GetParentForm(Self); if (Pf<>nil) then Pf.FocusControl(Self); PerformTab; *) end; end; case Key of VK_LEFT: begin if Relaxed then MoveSel(True,-1, 0) else MoveSel(true, 0,-1); end; VK_RIGHT: begin if Relaxed then MoveSel(True, 1, 0) else MoveSel(True, 0, 1); end; VK_UP: begin MoveSel(True, 0, -1); end; VK_DOWN: begin MoveSel(True, 0, 1); end; VK_PRIOR: begin R:=FGCache.Visiblegrid; MoveSel(True, 0, R.Top-R.Bottom); end; VK_NEXT: begin R:=FGCache.VisibleGrid; MoveSel(True, 0, R.Bottom-R.Top); end; VK_HOME: begin if ssCtrl in Shift then MoveSel(False, FCol, FFixedRows) else if Relaxed then MoveSel(False, FFixedCols, FRow) else MoveSel(False, FCol, FFixedRows); end; VK_END: begin if ssCtrl in Shift then MoveSel(False, FCol, RowCount-1) else if Relaxed then MoveSel(False, ColCount-1, FRow) else MoveSel(False, FCol, RowCount-1); end; VK_F2: //, VK_RETURN: begin EditorShow(False); // if Key=VK_RETURN then EditorSelectAll; Key:=0; end; VK_RETURN: begin if not FEditorKey then begin EditorShow(True); Key := 0; end; end; VK_BACK: begin // Workaround: LM_CHAR doesnt trigger with BACKSPACE if not FEditorKey then begin EditorShowChar(^H); key:=0; end; end; VK_C: if not FEditorKey then begin if ssCtrl in Shift then begin Key := 0; doCopyToClipboard; end; end; VK_V: if not FEditorKey then begin if ssCtrl in Shift then begin Key := 0; doPasteFromClipboard; end; end; VK_X: if not FEditorKey then begin if ssCtrl in Shift then begin Key := 0; doCutToClipboard; end; end; end; {$ifdef dbgGrid}DebugLn('Grid.KeyDown FIN Key=',IntToStr(Key));{$endif} end; procedure TCustomGrid.KeyUp(var Key: Word; Shift: TShiftState); begin inherited KeyUp(Key, Shift); end; { Convert a fisical Mouse coordinate into fisical a cell coordinate } function TCustomGrid.MouseToCell(Mouse: TPoint): TPoint; var d: Integer; begin Result.X:= OffsetToColRow(True, True, Mouse.x, d); Result.Y:= OffsetToColRow(False,True, Mouse.y, d); end; procedure TCustomGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Longint); var d: Integer; begin aCol:= OffsetToColRow(True, True, X, d); aRow:= OffsetToColRow(False,True, Y, d); end; { Convert a fisical Mouse coordinate into logical a cell coordinate } function TCustomGrid.MouseToLogcell(Mouse: TPoint): TPoint; var gz: TGridZone; begin Gz:=MouseToGridZone(Mouse.x, Mouse.y); Result:=MouseToCell(Mouse); //if gz=gzNormal then Result:=MouseToCell(Mouse) //else begin if gz<>gzNormal then begin //Result:=MouseToCell(Mouse); if (gz=gzFixedRows)or(gz=gzFixedCells) then begin Result.x:= fTopLeft.x-1; if Result.xColCount-1 then acol:=ColCount-1; if aRowRowCount-1 then aRow:=RowCount-1; end; procedure TCustomGrid.MoveSelection; begin if Assigned(OnSelection) then OnSelection(Self, FCol, FRow); end; procedure TCustomGrid.BeginUpdate; begin Inc(FUpdateCount); end; procedure TCustomGrid.EndUpdate(UO: TUpdateOption); begin Dec(FUpdateCount); if FUpdateCount=0 then case UO of uoQuick: Invalidate; uoFull: VisualChange; end; end; procedure TCustomGrid.EndUpdate(FullUpdate: Boolean); begin if FullUpdate then EndUpdate(uoFull) else EndUpdate(uoQuick); end; procedure TCustomGrid.EndUpdate; begin EndUpdate(true); end; procedure TCustomGrid.EraseBackground(DC: HDC); begin // end; function TCustomGrid.IsCellSelected(aCol, aRow: Integer): Boolean; begin Result:= (FRange.Left<=aCol) and (aCol<=FRange.Right) and (FRange.Top<=aRow) and (aRow<=FRange.Bottom); end; procedure TCustomGrid.InvalidateCell(aCol, aRow: Integer); begin InvalidateCell(ACol,ARow, False); end; procedure TCustomGrid.InvalidateCell(aCol, aRow: Integer; Redraw: Boolean); var R: TRect; begin {$IfDef dbgPaint} DebugLn('InvalidateCell Col=',IntToStr(aCol), ' Row=',IntToStr(aRow),' Redraw=', BoolToStr(Redraw)); {$Endif} R:=CellRect(aCol, aRow); InvalidateRect(Handle, @R, Redraw); end; procedure TCustomGrid.InvalidateGrid; begin if FUpdateCount=0 then Invalidate; end; procedure TCustomGrid.Invalidate; begin if FUpdateCount=0 then begin {$IfDef dbgPaint} DebugLn('Invalidate');{$Endif} inherited Invalidate; end; end; procedure TCustomGrid.EditorGetValue; begin if not (csDesigning in ComponentState) then begin EditorDoGetValue; EditorHide; end; end; procedure TCustomGrid.EditorSetValue; begin if not (csDesigning in ComponentState) then begin EditordoSetValue; EditorPos; end; end; procedure TCustomGrid.EditorHide; begin if not EditorLocked and (Editor<>nil) and Editor.HandleAllocated and Editor.Visible then begin FEditorMode:=False; {$ifdef dbgGrid}DebugLn('EditorHide [',Editor.ClassName,'] INIT FCol=',IntToStr(FCol),' FRow=',IntToStr(FRow));{$endif} LockEditor; try DoEditorHide; finally UnLockEditor; end; {$ifdef dbgGrid}DebugLn('EditorHide FIN');{$endif} end; end; function TCustomGrid.EditorLocked: boolean; begin Result := FEditorHidingCount <> 0; end; procedure TCustomGrid.EditorShow(const SelAll: boolean); begin if csDesigning in ComponentState then exit; if not HandleAllocated then Exit; if (goEditing in Options) and not FEditorShowing and (Editor<>nil) and not Editor.Visible then begin {$ifdef dbgGrid} DebugLn('EditorShow [',Editor.ClassName,']INIT FCol=',IntToStr(FCol),' FRow=',IntToStr(FRow));{$endif} FEditorMode:=True; FEditorShowing:=True; doEditorShow; FEditorShowing:=False; if SelAll then EditorSelectAll; {$ifdef dbgGrid} DebugLn('EditorShow FIN');{$endif} end; end; procedure TCustomGrid.EditorWidthChanged(aCol, aWidth: Integer); begin EditorPos; end; procedure TCustomGrid.EditorPos; var msg: TGridMessage; begin {$ifdef dbgGrid} DebugLn('Grid.EditorPos INIT');{$endif} if FEditor<>nil then begin Msg.CellRect:=CellRect(FCol,FRow); if FEditorOptions and EO_AUTOSIZE = EO_AUTOSIZE then begin if EditorBorderStyle = bsNone then InflateRect(Msg.CellRect, -1, -1); FEditor.BoundsRect := Msg.CellRect; end else begin Msg.MsgID:=GM_SETPOS; Msg.Grid:=Self; Msg.Col:=FCol; Msg.Row:=FRow; FEditor.Dispatch(Msg); end; end; {$ifdef dbgGrid} DebugLn('Grid.EditorPos FIN');{$endif} end; procedure TCustomGrid.EditorSelectAll; var Msg: TGridMessage; begin {$ifdef dbgGrid}DebugLn('EditorSelectALL INIT');{$endif} if FEditor<>nil then if FEditorOptions and EO_SELECTALL = EO_SELECTALL then begin Msg.MsgID:=GM_SELECTALL; FEditor.Dispatch(Msg); end; {$ifdef dbgGrid}DebugLn('EditorSelectALL FIN');{$endif} end; procedure TCustomGrid.EditordoGetValue; var msg: TGridMessage; begin if (FEditor<>nil) and FEditor.Visible then begin Msg.MsgID:=GM_GETVALUE; Msg.grid:=Self; Msg.Col:=FCol; Msg.Row:=FRow; Msg.Value:=GetEditText(Fcol, FRow); //Cells[FCol,FRow]; FEditor.Dispatch(Msg); SetEditText(FCol, FRow, msg.Value); //Cells[FCol,FRow]:=msg.Value; end; end; procedure TCustomGrid.EditordoSetValue; var msg: TGridMessage; begin if FEditor<>nil then begin // Set the editor mask Msg.MsgID:=GM_SETMASK; Msg.Grid:=Self; Msg.Col:=FCol; Msg.Row:=FRow; Msg.Value:=GetEditMask(FCol, FRow); FEditor.Dispatch(Msg); // Set the editor value Msg.MsgID:=GM_SETVALUE; Msg.Grid:=Self; Msg.Col:=FCol; Msg.Row:=FRow; Msg.Value:=GetEditText(Fcol, FRow); //Cells[FCol,FRow]; FEditor.Dispatch(Msg); end; end; function TCustomGrid.EditorCanAcceptKey(const ch: Char): boolean; begin result := True; end; function TCustomGrid.EditorIsReadOnly: boolean; begin result := GetColumnReadOnly(Col); end; procedure TCustomGrid.GetAutoFillColumnInfo(const Index: Integer; var aMin,aMax,aPriority: Integer); var C: TGridColumn; begin if Indexnil then begin aMin := C.MinSize; aMax := C.MaxSize; aPriority := C.SizePriority; end else APriority := 1; end else APriority := 1; end; procedure TCustomGrid.EditorExit(Sender: TObject); begin if not EditorLocked then begin {$IfDef dbgGrid} DebugLn('EditorExit INIT');{$Endif} LockEditor; try EditorGetValue; if (FEditor<>nil)and(FEditor.Visible) then begin Editor.Visible:=False; //Editor.Parent:=nil; FEditorMode := False; //InvalidateCell(FCol,FRow, True); end; finally UnlockEditor; {$IfDef dbgGrid} DebugLn('EditorExit FIN'); {$Endif} end; end; end; procedure TCustomGrid.EditorKeyDown(Sender: TObject; var Key:Word; Shift:TShiftState); begin {$ifdef dbgGrid}DebugLn('Grid.EditorKeyDown Key=',dbgs(Key),' INIT');{$endif} FEditorKey:=True; // Just a flag to see from where the event comes KeyDown(Key, shift); case Key of VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT: begin if ssShift in Shift then begin FeditorKey:=False; exit; end; end; VK_TAB: begin if GoTabs in Options then begin MoveNextAuto; Key := 0; end; end; VK_RETURN: begin Key := 0; if not MoveNextAuto then begin EditorGetValue; if EditorAlwaysShown then EditorShow(True); end; end; end; FEditorKey:=False; {$ifdef dbgGrid}DebugLn('Grid.EditorKeyDown Key=',dbgs(Key),' FIN');{$endif} end; procedure TCustomGrid.EditorKeyPress(Sender: TObject; var Key: Char); {$ifdef dbgGrid} function PrintKey:String; begin Result := Dbgs(ord(key))+' $' + IntToHex(ord(key),2); if Key>#31 then Result := Key + ' ' + Result end; {$endif} begin {$ifdef dbgGrid}DebugLn('Grid.EditorKeyPress: INIT Key=',PrintKey);{$Endif} FEditorKey := True; KeyPress(Key); // grid must get all keypresses, even if they are from the editor {$ifdef dbgGrid}DebugLn('Grid.EditorKeyPress: inter Key=',PrintKey);{$Endif} case Key of ^C,^V,^X:; ^M, #27: Key:=#0; // key is already handled in KeyDown #8: if EditorIsReadOnly then Key := #0; else EditorCanProcessKey(Key) end; FEditorKey := False; {$ifdef dbgGrid}DebugLn('Grid.EditorKeyPress: FIN Key=',PrintKey);{$Endif} end; procedure TCustomGrid.EditorKeyUp(Sender: TObject; var key: Word; shift: TShiftState); begin FEditorKey := True; KeyUp(Key, Shift); FEditorKey := False; end; procedure TCustomGrid.SelectEditor; var aEditor: TWinControl; begin aEditor := GetDefaultEditor(Col); if (goEditing in Options) and Assigned(OnSelectEditor) then OnSelectEditor(Self, fCol, FRow, aEditor); if aEditor<>Editor then Editor:=aEditor; end; function TCustomGrid.EditorAlwaysShown: Boolean; begin Result:=(goEditing in Options)and(goAlwaysShowEditor in Options); end; procedure TCustomGrid.EditorShowChar(Ch: Char); {$ifndef win32} var msg: TGridMessage; {$endif} begin SelectEditor; if FEditor<>nil then begin //DebugLn('Posting editor LM_CHAR, ch=',ch, ' ', InttoStr(Ord(ch))); if EditorCanProcessKey(ch) and not EditorIsReadOnly then begin EditorShow(true); {$ifdef WIN32} // lcl win32 interface does a big mess with the message // as we only need the message to be handled by destination // then we send it directly to it bypassing the queue. //PostMessage(FEditor.Handle, LM_CHAR, Word(Ch), 0); SendMessage(FEditor.Handle, LM_CHAR, Word(Ch), 0); {$else} /// // Note. this is a workaround because the call above doesn't work /// {$ifdef EnableFieldEditMask} if (FEditor=FStringEditor) and (FStringEditor.IsMasked) then SendMessage(FEditor.Handle, CN_CHAR, Word(Ch), 0) else begin {$Endif} Msg.MsgID:=GM_SETVALUE; Msg.Grid:=Self; Msg.Col:=FCol; Msg.Row:=FRow; if Ch=^H then Msg.Value:='' else Msg.Value:=ch; FEditor.Dispatch(Msg); {$ifdef EnableFieldEditMask} end; {$endif} {$endif WIN32} end; end; end; procedure TCustomGrid.EditorSetMode(const AValue: Boolean); begin {$ifdef dbgGrid}DebugLn('Grid.EditorSetMode=',dbgs(Avalue),' INIT');{$endif} if not AValue then begin EditorHide; //SetFocus; end else begin EditorShow(false); end; {$ifdef dbgGrid}DebugLn('Grid.EditorSetMode FIN');{$endif} end; function TCustomGrid.GetSelectedColor: TColor; begin Result:=FSelectedColor; end; function TCustomGrid.GetEditMask(ACol, ARow: Longint): string; begin result:=''; end; function TCustomGrid.GetEditText(ACol, ARow: Longint): string; begin result:=''; end; function TCustomGrid.GetColumnAlignment(Column: Integer; ForTitle: Boolean): TAlignment; var C: TGridColumn; begin C := ColumnFromGridColumn(Column); if C<>nil then if ForTitle then Result := C.Title.Alignment else Result := C.Alignment else result := GetDefaultAlignment(Column); end; function TCustomGrid.GetColumnColor(Column: Integer; ForTitle: Boolean): TColor; var C: TGridColumn; begin C := ColumnFromGridColumn(Column); if C<>nil then if ForTitle then result := C.Title.Color else result := C.Color else if ForTitle then result := FixedColor else result := Self.Color; end; function TCustomGrid.GetColumnFont(Column: Integer; ForTitle: Boolean): TFont; var C: TGridColumn; begin C := ColumnFromGridColumn(Column); if C<>nil then if ForTitle then Result := C.Title.Font else Result := C.Font else begin if ForTitle then Result := TitleFont else Result := Self.Font; end; end; function TCustomGrid.GetColumnLayout(Column: Integer; ForTitle: boolean): TTextLayout; var C: TGridColumn; begin C := ColumnFromGridColumn(Column); if C<>nil then if ForTitle then Result := C.Title.Layout else Result := C.Layout else result := GetDefaultLayout(Column); end; function TCustomGrid.GetColumnReadOnly(Column: Integer): boolean; var C: TGridColumn; begin C := ColumnFromGridColumn(Column); if C<>nil then result := C.ReadOnly else result := GetDefaultReadOnly(Column); end; function TCustomGrid.GeTGridColumnTitle(Column: Integer): string; var C: TGridColumn; begin C := ColumnFromGridColumn(Column); if C<>nil then Result := C.Title.Caption else result := GetDefaultTitle(Column); end; function TCustomGrid.GetColumnWidth(Column: Integer): Integer; var C: TGridColumn; begin C := ColumnFromGridColumn(Column); if C<>nil then Result := C.Width else Result := GetDefaultColumnWidth(Column); end; function TCustomGrid.GetDefaultAlignment(Column: Integer): TAlignment; begin result := DefaultTextStyle.Alignment; end; function TCustomGrid.GetDefaultEditor(Column: Integer): TWinControl; var C: TGridColumn; bs: TColumnButtonStyle; begin result := nil; if (goEditing in Options) then begin C := ColumnFromGridColumn(Column); if C<>nil then begin bs := C.ButtonStyle; if (bs=cbsAuto) and (C.PickList<>nil) and (C.PickList.Count>0) then bs := cbsPicklist end else bs := cbsAuto; result := EditorByStyle( Bs ); // by default do the editor setup here // if user wants to change our setup, this can // be done in OnSelectEditor if (bs=cbsPickList) and (C<>nil) and (C.PickList<>nil) and (result = FPicklistEditor) then begin FPickListEditor.Items.Assign(C.PickList); FPickListEditor.DropDownCount := C.DropDownRows; end end; end; function TCustomGrid.GetDefaultColumnWidth(Column: Integer): Integer; begin result := FDefColWidth; end; function TCustomGrid.GetDefaultLayout(Column: Integer): TTextLayout; begin result := DefaultTextStyle.Layout; end; function TCustomGrid.GetDefaultReadOnly(Column: Integer): boolean; begin result := false; end; function TCustomGrid.GetDefaultTitle(Column: Integer): string; begin result := ''; end; procedure TCustomGrid.SetEditText(ACol, ARow: Longint; const Value: string); begin end; procedure TCustomGrid.SetSelectedColor(const AValue: TColor); begin if FSelectedColor<>AValue then begin FSelectedColor:=AValue; Invalidate; end; end; procedure TCustomGrid.SetFixedcolor(const AValue: TColor); begin if FFixedColor<>AValue then begin FFixedColor:=Avalue; Invalidate; end; end; function TCustomGrid.GetFixedcolor: TColor; begin result:=FFixedColor; end; procedure TCustomGrid.ColWidthsChanged; begin // end; procedure TCustomGrid.RowHeightsChanged; begin // end; procedure TCustomGrid.SaveContent(cfg: TXMLConfig); var i,j,k: Integer; Path: string; begin cfg.SetValue('grid/version', GRIDFILEVERSION); Cfg.SetValue('grid/saveoptions/create', soDesign in SaveOptions); if soDesign in SaveOptions then begin Cfg.SetValue('grid/design/columncount', ColCount); Cfg.SetValue('grid/design/rowcount', RowCount); Cfg.SetValue('grid/design/fixedcols', FixedCols); Cfg.SetValue('grid/design/fixedrows', Fixedrows); Cfg.SetValue('grid/design/defaultcolwidth', DefaultColWidth); Cfg.SetValue('grid/design/defaultRowHeight',DefaultRowHeight); j:=0; For i:=0 to ColCount-1 do begin k:=PtrInt(FCols[i]); if (k>=0)and(k<>DefaultColWidth) then begin inc(j); cfg.SetValue('grid/design/columns/columncount',j); cfg.SetValue('grid/design/columns/column'+IntToStr(j)+'/index', i); cfg.SetValue('grid/design/columns/column'+IntToStr(j)+'/width', k); end; end; j:=0; For i:=0 to RowCount-1 do begin k:=PtrInt(FRows[i]); if (k>=0)and(k<>DefaultRowHeight) then begin inc(j); cfg.SetValue('grid/design/rows/rowcount',j); cfg.SetValue('grid/design/rows/row'+IntToStr(j)+'/index', i); cfg.SetValue('grid/design/rows/row'+IntToStr(j)+'/height',k); end; end; Path:='grid/design/options/'; Cfg.SetValue(Path+'goFixedVertLine/value', goFixedVertLine in options); Cfg.SetValue(Path+'goFixedHorzLine/value', goFixedHorzLine in options); Cfg.SetValue(Path+'goVertLine/value', goVertLine in options); Cfg.SetValue(Path+'goHorzLine/value', goHorzLine in options); Cfg.SetValue(Path+'goRangeSelect/value', goRangeSelect in options); Cfg.SetValue(Path+'goDrawFocusSelected/value', goDrawFocusSelected in options); Cfg.SetValue(Path+'goRowSizing/value', goRowSizing in options); Cfg.SetValue(Path+'goColSizing/value', goColSizing in options); Cfg.SetValue(Path+'goRowMoving/value', goRowMoving in options); Cfg.SetValue(Path+'goColMoving/value', goColMoving in options); Cfg.SetValue(Path+'goEditing/value', goEditing in options); Cfg.SetValue(Path+'goTabs/value', goTabs in options); Cfg.SetValue(Path+'goRowSelect/value', goRowSelect in options); Cfg.SetValue(Path+'goAlwaysShowEditor/value', goAlwaysShowEditor in options); Cfg.SetValue(Path+'goThumbTracking/value', goThumbTracking in options); Cfg.SetValue(Path+'goColSpanning/value', goColSpanning in options); cfg.SetValue(Path+'goRelaxedRowSelect/value', goRelaxedRowSelect in options); cfg.SetValue(Path+'goDblClickAutoSize/value', goDblClickAutoSize in options); Cfg.SetValue(Path+'goSmoothScroll/value', goSmoothScroll in Options); end; Cfg.SetValue('grid/saveoptions/position', soPosition in SaveOptions); if soPosition in SaveOptions then begin Cfg.SetValue('grid/position/topleftcol',ftopleft.x); Cfg.SetValue('grid/position/topleftrow',ftopleft.y); Cfg.SetValue('grid/position/col',fCol); Cfg.SetValue('grid/position/row',fRow); if goRangeSelect in Options then begin Cfg.SetValue('grid/position/selection/left',Selection.left); Cfg.SetValue('grid/position/selection/top',Selection.top); Cfg.SetValue('grid/position/selection/right',Selection.right); Cfg.SetValue('grid/position/selection/bottom',Selection.bottom); end; end; end; procedure TCustomGrid.LoadContent(cfg: TXMLConfig; Version: Integer); var CreateSaved: Boolean; Opt: TGridOptions; i,j,k: Integer; path: string; procedure GetValue(optStr:string; aOpt:TGridOption); begin if Cfg.GetValue(Path+OptStr+'/value', False) then Opt:=Opt+[aOpt]; end; begin if soDesign in FSaveOptions then begin CreateSaved:=Cfg.GetValue('grid/saveoptions/create', false); if CreateSaved then begin Clear; FixedCols:=0; FixedRows:=0; ColCount:=Cfg.GetValue('grid/design/columncount', 5); RowCount:=Cfg.GetValue('grid/design/rowcount', 5); FixedCols:=Cfg.GetValue('grid/design/fixedcols', 1); FixedRows:=Cfg.GetValue('grid/design/fixedrows', 1); DefaultRowheight:=Cfg.GetValue('grid/design/defaultrowheight', 20); DefaultColWidth:=Cfg.getValue('grid/design/defaultcolwidth', 64); Path:='grid/design/columns/'; k:=cfg.getValue(Path+'columncount',0); For i:=1 to k do begin j:=cfg.getValue(Path+'column'+IntToStr(i)+'/index',-1); if (j>=0)and(j<=ColCount-1) then begin ColWidths[j]:=cfg.getValue(Path+'column'+IntToStr(i)+'/width',-1); end; end; Path:='grid/design/rows/'; k:=cfg.getValue(Path+'rowcount',0); For i:=1 to k do begin j:=cfg.getValue(Path+'row'+IntToStr(i)+'/index',-1); if (j>=0)and(j<=ColCount-1) then begin RowHeights[j]:=cfg.getValue(Path+'row'+IntToStr(i)+'/height',-1); end; end; Opt:=[]; Path:='grid/design/options/'; GetValue('goFixedVertLine', goFixedVertLine); GetValue('goFixedHorzLine', goFixedHorzLine); GetValue('goVertLine',goVertLine); GetValue('goHorzLine',goHorzLine); GetValue('goRangeSelect',goRangeSelect); GetValue('goDrawFocusSelected',goDrawFocusSelected); GetValue('goRowSizing',goRowSizing); GetValue('goColSizing',goColSizing); GetValue('goRowMoving',goRowMoving); GetValue('goColMoving',goColMoving); GetValue('goEditing',goEditing); GetValue('goRowSelect',goRowSelect); GetValue('goTabs',goTabs); GetValue('goAlwaysShowEditor',goAlwaysShowEditor); GetValue('goThumbTracking',goThumbTracking); GetValue('goColSpanning', goColSpanning); GetValue('goRelaxedRowSelect',goRelaxedRowSelect); GetValue('goDblClickAutoSize',goDblClickAutoSize); if Version>=2 then begin GetValue('goSmoothScroll',goSmoothScroll); end; Options:=Opt; end; CreateSaved:=Cfg.GetValue('grid/saveoptions/position', false); if CreateSaved then begin i:=Cfg.GetValue('grid/position/topleftcol',-1); j:=Cfg.GetValue('grid/position/topleftrow',-1); if CellToGridZone(i,j)=gzNormal then begin tryScrollto(i,j); end; i:=Cfg.GetValue('grid/position/col',-1); j:=Cfg.GetValue('grid/position/row',-1); if (i>=FFixedCols)and(i<=ColCount-1) and (j>=FFixedRows)and(j<=RowCount-1) then begin MoveExtend(false, i,j); end; if goRangeSelect in Options then begin FRange.left:=Cfg.getValue('grid/position/selection/left',FCol); FRange.Top:=Cfg.getValue('grid/position/selection/top',FRow); FRange.Right:=Cfg.getValue('grid/position/selection/right',FCol); FRange.Bottom:=Cfg.getValue('grid/position/selection/bottom',FRow); end; end; end; end; procedure TCustomGrid.Loaded; begin inherited Loaded; VisualChange; end; procedure TCustomGrid.LockEditor; begin inc(FEditorHidingCount); {$ifdef dbgGrid}DebugLn('==> LockEditor: ', dbgs(FEditorHidingCount)); {$endif} end; constructor TCustomGrid.Create(AOwner: TComponent); begin // Inherited create Calls SetBounds->WM_SIZE->VisualChange so // fGrid needs to be created before that FCols:=TList.Create; FRows:=TList.Create; FGCache.AccumWidth:=TList.Create; FGCache.AccumHeight:=TList.Create; FGSMHBar := GetSystemMetrics(SM_CYHSCROLL) + GetSystemMetricsGapSize(SM_CYHSCROLL); FGSMVBar := GetSystemMetrics(SM_CXVSCROLL) + GetSystemMetricsGapSize(SM_CXVSCROLL); //DebugLn('FGSMHBar= ', FGSMHBar, ' FGSMVBar= ', FGSMVBar); inherited Create(AOwner); FColumns := CreateColumns; FTitleFont := TFont.Create; FTitleFont.OnChange := @OnTitleFontChanged; FAutoAdvance := aaRight; FFocusRectVisible := True; FDefaultDrawing := True; FOptions:= [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goSmoothScroll ]; FScrollbars:=ssAutoBoth; fGridState:=gsNormal; fDefColWidth:=64;//40; fDefRowHeight:=20;//18; fGridLineColor:=clSilver;//clGray; FGridLineStyle:=psSolid; fFocusColor:=clRed; FFixedColor:=clBtnFace; FSelectedColor:= clBlack; FRange:=Rect(-1,-1,-1,-1); FDragDx:=3; SetBounds(0,0,200,100); ColCount:=5; RowCount:=5; FixedCols:=1; FixedRows:=1; Editor:=nil; BorderStyle := bsSingle; ParentColor := False; Color:=clWindow; FDefaultTextStyle := Canvas.TextStyle; FButtonEditor := TButtonCellEditor.Create(nil); FButtonEditor.Name:='ButtonEditor'; FButtonEditor.Caption:='...'; FButtonEditor.Visible:=False; FButtonEditor.OnClick := @EditButtonClicked; FStringEditor := TStringCellEditor.Create(nil); FStringEditor.name :='StringEditor'; FStringEditor.Text:=''; FStringEditor.Visible:=False; FStringEditor.Align:=alNone; FPicklistEditor := TPickListCellEditor.Create(nil); FPickListEditor.Name := 'PickListEditor'; FPickListEditor.Visible := False; FFastEditing := True; end; destructor TCustomGrid.Destroy; begin {$Ifdef dbg}DebugLn('TCustomGrid.Destroy');{$Endif} FreeThenNil(FPickListEditor); FreeThenNil(FStringEditor); FreeThenNil(FButtonEditor); FreeThenNil(FColumns); FreeThenNil(FGCache.AccumWidth); FreeThenNil(FGCache.AccumHeight); FreeThenNil(FCols); FreeThenNil(FRows); FreeThenNil(FTitleFont); inherited Destroy; end; procedure TCustomGrid.SaveToFile(FileName: string); var Cfg: TXMLConfig; begin if FileExists(FileName) then DeleteFile(FileName); Cfg:=TXMLConfig.Create(FileName); Try SaveContent(Cfg); Finally Cfg.Flush; FreeThenNil(Cfg); end; end; procedure TCustomGrid.LoadFromFile(FileName: string); var Cfg: TXMLConfig; Version: Integer; begin if not FileExists(FileName) then raise Exception.Create(rsGridFileDoesNotExists); Cfg:=TXMLConfig.Create(FileName); Try Version:=cfg.GetValue('grid/version',-1); if Version=-1 then raise Exception.Create(rsNotAValidGridFile); BeginUpdate; LoadContent(Cfg, Version); EndUpdate(True); Finally FreeThenNil(Cfg); end; end; procedure TCustomGrid.Clear; var OldR,OldC: Integer; begin OldR:=RowCount; OldC:=ColCount; FFixedCols:=0; FFixedRows:=0; FRows.Count:=0; FCols.Count:=0; FTopLeft:=Point(-1,-1); FRange:=Rect(-1,-1,-1,-1); FGCache.TLColOff := 0; FGCache.TlRowOff := 0; VisualChange; SizeChanged(OldR,OldC); end; procedure TCustomGrid.AutoAdjustColumns; var i: Integer; begin For i:=0 to ColCount do AutoAdjustColumn(i); end; { TVirtualGrid } function TVirtualGrid.GetCells(Col, Row: Integer): PCellProps; begin // todo: Check range Result:=nil; if (Col<0) or (Row<0) or (Col>=ColCount) or (Row>=RowCount) then raise EGridException.CreateFmt(rsIndexOutOfRange, [Col, Row]); Result:=FCells[Col,Row]; end; function Tvirtualgrid.Getrows(Row: Integer): PColRowprops; begin Result:= FRows[Row, 0]; end; function Tvirtualgrid.Getcols(Col: Integer): PColRowProps; begin result:=FCols[Col, 0]; end; procedure TVirtualGrid.SetCells(Col, Row: Integer; const AValue: PCellProps); var Cell: PCellProps; begin // todo: Check range Cell:=FCells[Col,Row]; if Cell<>nil then DisposeCell(Cell); Cell:=AValue; FCells[Col,Row]:=Cell; end; procedure Tvirtualgrid.Setrows(Row: Integer; const Avalue: PColRowProps); var C: PColRowProps; begin // todo: Check range C:=FRows[Row,0]; if C<>nil then DisposeColRow(C); FRows[Row,0]:=AValue; end; procedure Tvirtualgrid.Setcolcount(const Avalue: Integer); begin if FColCount=Avalue then Exit; {$Ifdef dbgMem} DebugLn('TVirtualGrid.SetColCount Value=',AValue); {$Endif} FColCount:=AValue; {$Ifdef dbgMem} DBGOut('TVirtualGrid.SetColCount->FCOLS: '); {$Endif} FCols.SetLength(FColCount, 1); {$Ifdef dbgMem} DBGOut('TVirtualGrid.SetColCount->FCELLS(',FColCount,',',FRowCount,'): '); {$Endif} FCells.SetLength(FColCount, FRowCount); end; procedure Tvirtualgrid.Setrowcount(const Avalue: Integer); begin if FRowCount=AValue then Exit; {$Ifdef dbgMem} DebugLn('TVirtualGrid.SetRowCount Value=',AValue); {$Endif} FRowCount:=AValue; {$Ifdef dbgMem} DBGOut('TVirtualGrid.SetRowCount->FROWS: '); {$Endif} FRows.SetLength(FRowCount,1); {$Ifdef dbgMem} DBGOut('TVirtualGrid.SetRowCount->FCELLS(',FColCount,',',FRowCount,'): '); {$Endif} FCells.SetLength(FColCount, FRowCount); end; procedure Tvirtualgrid.Setcols(Col: Integer; const Avalue: PColRowProps); var C: PColRowProps; begin // todo: Check range C:=FCols[Col,0]; if C<>nil then DisposeColRow(C); FCols[Col,0]:=AValue; end; procedure Tvirtualgrid.Clear; begin {$Ifdef dbgMem}DBGOut('FROWS: ');{$Endif}FRows.Clear; {$Ifdef dbgMem}DBGOut('FCOLS: ');{$Endif}FCols.Clear; {$Ifdef dbgMem}DBGOut('FCELLS: ');{$Endif}FCells.Clear; FColCount:=0; FRowCount:=0; end; procedure Tvirtualgrid.Disposecell(var P: Pcellprops); begin if P<>nil then begin if P^.Text<>nil then StrDispose(P^.Text); Dispose(P); P:=nil; end; end; procedure TVirtualGrid.DisposeColRow(var p: PColRowProps); begin if P<>nil then begin Dispose(P); P:=nil; end; end; function TVirtualGrid.GetDefaultCell: PcellProps; begin New(Result); Result^.Text:=nil; Result^.Attr:=nil; end; function TVirtualGrid.GetDefaultColRow: PColRowProps; begin New(Result); Result^.FixedAttr:=nil; Result^.NormalAttr:=nil; Result^.Size:=-1; end; procedure Tvirtualgrid.Dodestroyitem (Sender: Tobject; Col,Row: Integer; var Item: Pointer); begin {$Ifdef dbgMem} DebugLn('TVirtualGrid.doDestroyItem Col=',Col,' Row= ', Row,' Item=',Integer(Item)); {$endif} if Item<>nil then begin if (Sender=FCols)or(Sender=FRows) then begin DisposeColRow(PColRowProps(Item)); end else begin DisposeCell(PCellProps(Item)); end; Item:=nil; end; end; procedure Tvirtualgrid.doNewitem(Sender: Tobject; Col,Row:Integer; var Item: Pointer); begin {$Ifdef dbgMem} DebugLn('TVirtualGrid.doNewItem Col=',Col,' Row= ', Row,' Item=',Integer(Item)); {$endif} if Sender=FCols then begin // Procesar Nueva Columna Item:=GetDefaultColRow; end else if Sender=FRows then begin // Procesar Nuevo Renglon Item:=GetDefaultColRow; end else begin // Procesar Nueva Celda Item:=nil; end; end; constructor TVirtualGrid.Create; begin Inherited Create; {$Ifdef dbg}DebugLn('TVirtualGrid.Create');{$Endif} FCells:=TArray.Create; FCells.OnDestroyItem:=@doDestroyItem; FCells.OnNewItem:=@doNewItem; FCols:= TArray.Create; FCols.OnDestroyItem:=@doDestroyItem; FCols.OnNewItem:=@doNewItem; FRows:=TArray.Create; FRows.OnDestroyItem:=@doDestroyItem; FRows.OnNewItem:=@doNewItem; RowCount:=4; ColCount:=4; end; destructor TVirtualGrid.Destroy; begin {$Ifdef dbg}DebugLn('TVirtualGrid.Destroy');{$Endif} Clear; FreeThenNil(FRows); FreeThenNil(FCols); FreeThenNil(FCells); inherited Destroy; end; procedure TVirtualGrid.DeleteColRow(IsColumn: Boolean; index: Integer); begin FCells.DeleteColRow(IsColumn, index); if IsColumn then begin FCols.DeleteColRow(True, index); Dec(FColCount); end else begin FRows.DeleteColRow(True, index); Dec(fRowCount); end; end; procedure TVirtualGrid.MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer ); begin FCells.MoveColRow(IsColumn, FromIndex, ToIndex); if IsColumn then FCols.MoveColRow(True, FromIndex, ToIndex) else FRows.MoveColRow(True, FromIndex, ToIndex); end; procedure TVirtualGrid.ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer); begin FCells.ExchangeColRow(IsColumn, index, WithIndex); if IsColumn then FCols.ExchangeColRow(true, index, WithIndex) else FRows.ExchangeColRow(True, index, WithIndex); end; procedure TVirtualGrid.InsertColRow(IsColumn: Boolean; Index: Integer); begin if IsColumn then begin ColCount := ColCount + 1; MoveColRow(true, ColCount-1, Index); end else begin RowCount := RowCount + 1; MoveColRow(false, RowCount-1, Index); end; end; procedure TStringCellEditor.WndProc(var TheMessage: TLMessage); begin {$IfDef GridTraceMsg} TransMsg('StrCellEditor: ', TheMessage); {$Endif} if FGrid<>nil then case TheMessage.Msg of LM_CLEARSEL, LM_CUTTOCLIP, LM_PASTEFROMCLIP: begin if FGrid.EditorIsReadOnly then exit; end; end; inherited WndProc(TheMessage); end; { TStringCellEditor } procedure TStringCellEditor.Change; begin inherited Change; if FGrid<>nil then begin FGrid.SetEditText(FGrid.Col, FGrid.Row, Text); end; end; procedure TStringCellEditor.KeyDown(var Key: Word; Shift: TShiftState); function AllSelected: boolean; begin result := (SelLength>0) and (SelLength=Length(Text)); end; function AtStart: Boolean; begin Result:= (SelStart=0); end; function AtEnd: Boolean; begin result := ((SelStart+1)>Length(Text)) or AllSelected; end; procedure doEditorKeyDown; begin if FGrid<>nil then FGrid.EditorkeyDown(Self, key, shift); end; procedure doGridKeyDown; begin if FGrid<>nil then FGrid.KeyDown(Key, shift); end; function GetFastEntry: boolean; begin if FGrid<>nil then Result := FGrid.FastEditing else Result := False; end; procedure CheckEditingKey; begin if (FGrid=nil) or FGrid.EditorIsReadOnly then Key := 0; end; var IntSel: boolean; begin {$IfDef dbg} DebugLn('INI: Key=',Key,' SelStart=',SelStart,' SelLenght=',SelLength); {$Endif} inherited KeyDown(Key,Shift); case Key of VK_F2: if AllSelected then begin SelLength := 0; SelStart := Length(Text); end; VK_DELETE: CheckEditingKey; VK_UP, VK_DOWN: doGridKeyDown; VK_LEFT, VK_RIGHT: if GetFastEntry then begin IntSel:= ((Key=VK_LEFT) and not AtStart) or ((Key=VK_RIGHT) and not AtEnd); if not IntSel then begin doGridKeyDown; end; end; VK_END, VK_HOME: ; else doEditorKeyDown; end; {$IfDef dbg} DebugLn('FIN: Key=',Key,' SelStart=',SelStart,' SelLenght=',SelLength); {$Endif} end; procedure TStringCellEditor.msg_SetMask(var Msg: TGridMessage); begin EditMask:=msg.Value; end; procedure TStringCellEditor.msg_SetValue(var Msg: TGridMessage); begin Text:=Msg.Value; SelStart := Length(Text); end; procedure TStringCellEditor.msg_GetValue(var Msg: TGridMessage); begin Msg.Value:=Text; end; procedure TStringCellEditor.msg_SetGrid(var Msg: TGridMessage); begin FGrid:=Msg.Grid; Msg.Options:=EO_AUTOSIZE or EO_HOOKEXIT or EO_SELECTALL or EO_HOOKKEYPRESS or EO_HOOKKEYUP; end; procedure TStringCellEditor.msg_SelectAll(var Msg: TGridMessage); begin SelectAll; end; { TCustomDrawGrid } procedure TCustomDrawGrid.CalcCellExtent(acol, aRow: Integer; var aRect: TRect); begin // end; procedure TCustomDrawGrid.DrawCell(aCol,aRow: Integer; aRect: TRect; aState:TGridDrawState); begin if Assigned(OnDrawCell) and not(CsDesigning in ComponentState) then begin PrepareCanvas(aCol, aRow, aState); if DefaultDrawing then Canvas.FillRect(aRect); OnDrawCell(Self,aCol,aRow,aRect,aState) end else DefaultDrawCell(aCol,aRow,aRect,aState); inherited DrawCellGrid(aCol,aRow,aRect,aState); end; procedure TCustomDrawGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect); {.$ifdef FocusXOR} var DCIndex: Integer; FOldFocusColor: TColor; {.$endif} begin // Draw focused cell if we have the focus if Self.Focused or (EditorAlwaysShown and ((Feditor=nil) or not Feditor.Focused)) then begin CalcFocusRect(aRect); {.$ifdef FocusXOR} if FUseXORFeatures then begin DCIndex := SaveDC(Canvas.Handle); FOldFocusColor := FFocusColor; FFocusColor:= clWhite; Canvas.Pen.Mode := pmXOR; end; {.$endif} DrawRubberRect(Canvas, aRect, FFocusColor); {.$ifdef FocusXOR} if FUseXORFeatures then begin RestoreDC(Canvas.Handle, DCIndex); FFocusColor := FOldFocusColor; end; {.$endif} end; end; procedure TCustomDrawGrid.ColRowExchanged(IsColumn:Boolean; index, WithIndex: Integer); begin if not IsColumn or not Columns.Enabled then Fgrid.ExchangeColRow(IsColumn, index, WithIndex); if Assigned(OnColRowExchanged) then OnColRowExchanged(Self, IsColumn, index, WithIndex); end; procedure TCustomDrawGrid.ColRowInserted(IsColumn: boolean; index: integer); begin if not IsColumn or not Columns.Enabled then FGrid.InsertColRow(IsColumn, Index); if Assigned(OnColRowInserted) then OnColRowInserted(Self, IsColumn, index, index); end; procedure TCustomDrawGrid.ColRowDeleted(IsColumn: Boolean; index: Integer); begin if not IsColumn or not Columns.Enabled then FGrid.DeleteColRow(IsColumn, index); if Assigned(OnColRowDeleted) then OnColRowDeleted(Self, IsColumn, index, index); end; procedure TCustomDrawGrid.ColRowMoved(IsColumn: Boolean; FromIndex, ToIndex: Integer); begin if IsColumn and Columns.Enabled then inherited ColRowMoved(IsColumn, FromIndex, ToIndex) else FGrid.MoveColRow(IsColumn, FromIndex, ToIndex); if Assigned(OnColRowMoved) then OnColRowMoved(Self, IsColumn, FromIndex, toIndex); end; procedure TCustomDrawGrid.HeaderClick(IsColumn: Boolean; index: Integer); begin inherited HeaderClick(IsColumn, index); if Assigned(OnHeaderClick) then OnHeaderClick(Self, IsColumn, index); end; procedure TCustomDrawGrid.HeaderSized(IsColumn: Boolean; index: Integer); begin inherited HeaderSized(IsColumn, index); if Assigned(OnHeaderSized) then OnHeaderSized(Self, IsColumn, index); end; procedure TCustomDrawGrid.GetAutoFillColumnInfo(const Index: Integer; var aMin, aMax, aPriority: Integer); begin if IndexColCount then fGrid.ColCount:=ColCOunt; if OldRowCount<>RowCount then fGrid.RowCount:=RowCount; end; function TCustomDrawGrid.SelectCell(aCol, aRow: Integer): boolean; begin Result:= (ColWidths[aCol] > 0) and (RowHeights[aRow] > 0); if Assigned(OnSelectCell) then OnSelectCell(Self, aCol, aRow, Result); end; procedure TCustomDrawGrid.SetColor(Value: TColor); begin inherited SetColor(Value); Invalidate; end; function TCustomDrawGrid.CreateVirtualGrid: TVirtualGrid; begin Result:=TVirtualGrid.Create; end; constructor TCustomDrawGrid.Create(AOwner: TComponent); begin fGrid:=CreateVirtualGrid; //TVirtualGrid.Create; inherited Create(AOwner); end; destructor TCustomDrawGrid.Destroy; begin {$Ifdef dbg}DebugLn('TCustomDrawGrid.Destroy');{$Endif} //DebugLn('Font.Name',Font.Name); FreeThenNil(FGrid); inherited Destroy; end; procedure TCustomDrawGrid.DeleteColRow(IsColumn: Boolean; index: Integer); begin DoOPDeleteColRow(IsColumn, Index); end; procedure TCustomDrawGrid.ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer); begin DoOPExchangeColRow(IsColumn, Index, WithIndex); end; procedure TCustomDrawGrid.InsertColRow(IsColumn: boolean; index: integer); begin doOPInsertColRow(IsColumn, Index); end; procedure TCustomDrawGrid.MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer); begin DoOPMoveColRow(IsColumn, FromIndex, ToIndex); end; procedure TCustomDrawGrid.SortColRow(IsColumn: Boolean; index: Integer); begin if IsColumn then Sort(IsColumn, index, FFixedRows, RowCount-1) else Sort(IsColumn, index, FFixedCols, ColCount-1); end; procedure TCustomDrawGrid.SortColRow(IsColumn: Boolean; Index, FromIndex, ToIndex: Integer); begin Sort(IsColumn, Index, FromIndex, ToIndex); end; procedure TCustomDrawGrid.DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect; aState: TGridDrawState); var OldDefaultDrawing: boolean; begin OldDefaultDrawing:=FDefaultDrawing; FDefaultDrawing:=True; try PrepareCanvas(aCol, aRow, aState); finally FDefaultDrawing:=OldDefaultDrawing; end; if goColSpanning in Options then CalcCellExtent(acol, arow, aRect); Canvas.FillRect(aRect); end; { TCustomStringGrid } function TCustomStringGrid.Getcells(aCol, aRow: Integer): string; var C: PCellProps; begin Result:=''; C:=FGrid.Celda[aCol,aRow]; if C<>nil then Result:=C^ .Text; end; function TCustomStringGrid.GetCols(index: Integer): TStrings; var i: Integer; begin Result:=nil; if (ColCount>0)and(index>=0)and(indexnil then Result:=C^.Data; end; function TCustomStringGrid.GetRows(index: Integer): TStrings; var i: Integer; begin Result:=nil; if (RowCount>0)and(index>=0)and(indexnil then begin if C^.Text<>nil then StrDispose(C^.Text); C^.Text:=StrNew(pchar(aValue)); UpdateCell; end else begin if AValue<>'' then begin New(C); C^.Text:=StrNew(pchar(Avalue)); C^.Attr:=nil; C^.Data:=nil; FGrid.Celda[aCol,aRow]:=C; UpdateCell; end; end; end; procedure TCustomStringGrid.SetCols(index: Integer; const AValue: TStrings); var i: Integer; begin if Avalue=nil then exit; for i:=0 to AValue.Count-1 do begin Cells[index, i]:= AValue[i]; Objects[Index, i]:= AValue.Objects[i]; end; end; procedure TCustomStringGrid.SetObjects(ACol, ARow: Integer; AValue: TObject); var c: PCellProps; begin C:=FGrid.Celda[aCol,aRow]; if c<>nil then C^.Data:=AValue else begin c:=fGrid.GetDefaultCell; c^.Data:=Avalue; FGrid.Celda[aCol,aRow]:=c; end; end; procedure TCustomStringGrid.SetRows(index: Integer; const AValue: TStrings); var i: Integer; begin if Avalue=nil then exit; for i:=0 to AValue.Count-1 do begin Cells[i, index]:= AValue[i]; Objects[i, Index]:= AValue.Objects[i]; end; end; procedure TCustomStringGrid.WriteCells(Writer: TWriter); var i,j: Integer; c: Integer; begin with writer do begin WriteListBegin; //cell count c:=0; for i:=0 to ColCount-1 do for j:=0 to RowCount-1 do if Cells[i,j]<>'' then Inc(c); WriteInteger(c); for i:=0 to ColCount-1 do for j:=0 to RowCount-1 do if Cells[i,j]<>'' then begin WriteInteger(i); WriteInteger(j); WriteString(Cells[i,j]); end; WriteListEnd; end; end; procedure TCustomStringGrid.AutoAdjustColumn(aCol: Integer); var i,W: Integer; Ts: TSize; begin if (aCol<0)or(aCol>ColCount-1) then Exit; W:=0; For i:=0 to RowCount-1 do begin Ts:=Canvas.TextExtent(Cells[aCol, i]); if Ts.Cx>W then W:=Ts.Cx; end; if W=0 then W:=DefaultColWidth else W:=W + 8; ColWidths[aCol]:=W; end; procedure TCustomStringGrid.CalcCellExtent(acol, aRow: Integer; var aRect: TRect); var S: string; Ts: Tsize; nc: PcellProps; i: integer; begin inherited CalcCellExtent(acol,arow, aRect); S:=Cells[aCol,aRow]; if not Canvas.TextStyle.Clipping then begin //if not FCellAttr.TextStyle.Clipping then begin // Calcular el numero de celdas necesarias para contener todo // El Texto Ts:=Canvas.TextExtent(S); i:=aCol; while (Ts.Cx>(aRect.Right-aRect.Left))and(inil)and(Nc^.Text<>'')then Break; aRect.Right:=aRect.Right + getColWidths(i); end; //fcellAttr.TextStyle.Clipping:=i<>aCol; Canvas.TextStyle.clipping:=i<>aCol; end; end; procedure TCustomStringGrid.DefineProperties(Filer: TFiler); function NeedCells: boolean; var i,j: integer; AntGrid: TCustomStringGrid; begin result := false; AntGrid := TCustomStringGrid(Filer.Ancestor); if (AntGrid<>nil) then begin result := (AntGrid.ColCount<>ColCount) or (AntGrid.RowCount<>RowCount); if not result then for i:=0 to AntGrid.ColCount-1 do for j:=0 to AntGrid.RowCount-1 do if Cells[i,j]<>AntGrid.Cells[i,j] then begin result := true; break; end end else for i:=0 to ColCount-1 do for j:=0 to RowCount-1 do if Cells[i,j]<>'' then begin result := true; break; end; end; begin inherited DefineProperties(Filer); with Filer do begin DefineProperty('Cells', @ReadCells, @WriteCells, NeedCells); end; end; procedure TCustomStringGrid.DoCopyToClipboard; var SelStr: String; Sel: TRect; i: LongInt; j: LongInt; begin SelStr := ''; Sel := Selection; for i:=Sel.Top to Sel.Bottom do begin for j:=Sel.Left to Sel.Right do begin SelStr := SelStr + Cells[j,i]; if j<>Sel.Right then SelStr := SelStr + #9; end; SelStr := SelStr + #13#10; end; Clipboard.AsText := SelStr; { SelStr := StringReplace(SelStr, #13#10,'|', [rfReplaceAll]); SelStr := StringReplace(SelStr, #9,'*', [rfReplaceAll]); DebugLn('Copied: ',SelStr); } end; procedure TCustomStringGrid.DoCutToClipboard; begin doCopyToClipboard; //if not GridReadOnly then Clean(Selection, []); end; procedure TCustomStringGrid.DoPasteFromClipboard; begin if Clipboard.HasFormat(CF_TEXT) then begin SelectionSetText(Clipboard.AsText); end; end; procedure TCustomStringGrid.DrawCell(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); begin inherited DrawCell(aCol, aRow, aRect, aState); if DefaultDrawing then begin case Canvas.TextStyle.Alignment of Classes.taLeftJustify: Inc(aRect.Left, 3); Classes.taRightJustify: Dec(aRect.Right, 3); end; case Canvas.TextStyle.Layout of tlTop: Inc(aRect.Top, 3); tlBottom: Dec(aRect.Bottom, 3); end; Canvas.TextRect(aRect,ARect.Left,ARect.Top, Cells[aCol,aRow]); //MyTExtRect(aRect, 3, 0, Cells[aCol,aRow], Canvas.Textstyle.Clipping); end; end; function TCustomStringGrid.GetEditText(aCol, aRow: Integer): string; begin Result:=Cells[aCol, aRow]; if Assigned(OnGetEditText) then OnGetEditText(Self, aCol, aRow, result); end; procedure TCustomStringGrid.SaveContent(cfg: TXMLConfig); var i,j,k: Integer; c: PCellProps; begin inherited SaveContent(cfg); cfg.SetValue('grid/saveoptions/content', soContent in SaveOptions); if soContent in SaveOptions then begin // Save Cell Contents k:=0; For i:=0 to ColCount-1 do For j:=0 to RowCount-1 do begin C:=fGrid.Celda[i,j]; if (c<>nil) and (C^.Text<>'') then begin Inc(k); Cfg.SetValue('grid/content/cells/cellcount',k); cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/column',i); cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/row',j); cfg.SetValue('grid/content/cells/cell'+IntToStr(k)+'/text', c^.Text); end; end; end; end; procedure TCustomStringGrid.SelectionSetText(TheText: String); var L,SubL: TStringList; i,j,StartCol,StartRow: Integer; procedure CollectCols(const S: String); var P,Ini: PChar; St: String; begin Subl.Clear; P := Pchar(S); if P<>nil then while P^<>#0 do begin ini := P; while (P^<>#0) and (P^<>#9) do Inc(P); SetLength(St, P-Ini); Move(Ini^,St[1],P-Ini); SubL.Add(St); if P^<>#0 then Inc(P); end; end; begin L := TStringList.Create; SubL := TStringList.Create; StartCol := Selection.left; StartRow := Selection.Top; try L.Text := TheText; for j:=0 to L.Count-1 do begin CollectCols(L[j]); for i:=0 to SubL.Count-1 do Cells[i + StartCol, j + StartRow] := SubL[i]; end; finally SubL.Free; L.Free; end; end; procedure TCustomStringGrid.LoadContent(Cfg: TXMLConfig; Version:Integer); var ContentSaved: Boolean; i,j,k: Integer; begin inherited LoadContent(Cfg, Version); if soContent in FSaveOptions then begin ContentSaved:=Cfg.GetValue('grid/saveoptions/content', false); if ContentSaved then begin k:=cfg.getValue('grid/content/cells/cellcount', 0); while k>0 do begin i:=cfg.GetValue('grid/content/cells/cell'+IntToStr(k)+'/column', -1); j:=cfg.GetValue('grid/content/cells/cell'+IntTostr(k)+'/row',-1); if (j>=0)and(j<=rowcount-1)and(i>=0)and(i<=Colcount-1) then Cells[i,j]:=cfg.GetValue('grid/content/cells/cell'+IntToStr(k)+'/text',''); Dec(k); end; end; end; end; (* procedure TCustomStringGrid.DrawInteriorCells; var i,j: Integer; gds: TGridDrawState; c: PCellProps; begin with FGCache.VisibleGrid do if goColSpanning in Options then begin // // Ordered draw should be done in order to this work // Gds:=[]; // Draw Empty (nil) cells First For i:=Left to Right do For j:=Top to Bottom do begin if IsCellSelected(i,j) then Continue; C:=Fgrid.Celda[i,j]; if (c=nil) then DrawCell(i,j, CellRect(i,j), gds); end; // Draw Cells Empty Cells (Text='') with Attribute For i:=Left to Right do For j:=Top to Bottom do begin if IsCellSelected(i,j) then Continue; if (i=FCol)or(j=FRow) then Continue; C:=Fgrid.Celda[i,j]; if (c<>nil)and(C^.Text='') then DrawCell(i,j, CellRect(i,j), gds); end; // Draw Cells not Empty (Text<>'') For i:=Left to Right do For j:=Top to Bottom do begin if IsCellSelected(i,j) then Continue; C:=Fgrid.Celda[i,j]; if (C<>nil)and(C^.Text<>'') then DrawCell(i,j, CellRect(i,j), gds); end; gds:=[gdSelected]; For i:=Left To Right do For j:=Top to Bottom do if IsCellSelected(i,j) then begin DrawCell(i,j, CellRect(i,j), gds); end; end else inherited DrawInteriorCells; end; *) procedure TCustomStringGrid.SetEditText(aCol, aRow: Longint; const aValue: string); begin if Cells[aCol, aRow]<>aValue then Cells[aCol, aRow]:= aValue; inherited SetEditText(aCol, aRow, aValue); end; constructor TCustomStringGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); with DefaultTextStyle do begin Alignment := taLeftJustify; Layout := tlCenter; Clipping := True; //WordBreak := False end; ExtendedSelect := True; end; procedure TCustomStringGrid.AutoSizeColumn(aCol: Integer); begin AutoAdjustColumn(aCol); end; procedure TCustomStringGrid.AutoSizeColumns; var i: Integer; begin for i:=0 to ColCount-1 do AutoAdjustColumn(i) end; procedure TCustomStringGrid.Clean; begin Clean([gzNormal, gzFixedCols, gzFixedRows, gzFixedCells]); end; procedure TCustomStringGrid.Clean(CleanOptions: TCleanOptions); begin Clean(0,0,ColCount-1,RowCount-1, CleanOptions); end; procedure TCustomStringGrid.Clean(aRect: TRect; CleanOptions: TCleanOptions); begin with aRect do Clean(Left, Top, Right, Bottom, CleanOptions); end; procedure TCustomStringGrid.Clean(StartCol, StartRow, EndCol, EndRow: integer; CleanOptions: TCleanOptions); var aCol: LongInt; aRow: LongInt; begin if StartCol>EndCol then SwapInt(StartCol,EndCol); if StartRow>EndRow then SwapInt(StartRow,EndRow); if StartCol<0 then StartCol:=0; if EndCol>ColCount-1 then EndCol:=ColCount-1; if StartRow<0 then StartRow:=0; if EndRow>RowCount-1 then EndRow:=RowCount-1; BeginUpdate; for aCol:=StartCol to EndCol do for aRow:= StartRow to EndRow do if (CleanOptions=[]) or (CellToGridZone(aCol,aRow) in CleanOptions) then Cells[aCol,aRow] := ''; EndUpdate(false); end; procedure Register; begin RegisterComponents('Additional',[TStringGrid,TDrawGrid]); end; { TGridColumnTitle } procedure TGridColumnTitle.FontChanged(Sender: TObject); begin FisDefaultTitleFont := False; FColumn.ColumnChanged; end; function TGridColumnTitle.GetAlignment: TAlignment; begin if FAlignment = nil then result := taLeftJustify else result := FAlignment^; end; function TGridColumnTitle.GetCaption: string; begin if FCaption = nil then result := GetDefaultCaption else result := FCaption; end; function TGridColumnTitle.GetColor: TColor; begin if FColor = nil then if FColumn.Grid <> nil then result := FColumn.Grid.FixedColor else result := clBtnFace else result := FColor^; end; procedure TGridColumnTitle.FillTitleDefaultFont; var AGrid: TCustomGrid; begin AGrid := FColumn.Grid; if AGrid<>nil then FFont.Assign( AGrid.TitleFont ) //FFont.Assign( AGrid.Font ) else FFont.Assign( FColumn.Font ); end; function TGridColumnTitle.GetFont: TFont; begin Result := FFont; end; function TGridColumnTitle.GetLayout: TTextLayout; begin if FLayout = nil then result := tlCenter else result := FLayout^; end; function TGridColumnTitle.IsAlignmentStored: boolean; begin result := FAlignment <> nil; end; function TGridColumnTitle.IsCaptionStored: boolean; begin result := FCaption <> nil; end; function TGridColumnTitle.IsColorStored: boolean; begin result := FColor <> nil; end; function TGridColumnTitle.IsFontStored: boolean; begin result := FFont <> nil; end; function TGridColumnTitle.IsLayoutStored: boolean; begin result := FLayout <> nil; end; procedure TGridColumnTitle.SetAlignment(const AValue: TAlignment); begin if Falignment = nil then New(Falignment) else if FAlignment^ = AValue then exit; FAlignment^ := AValue; FColumn.ColumnChanged; end; procedure TGridColumnTitle.SetCaption(const AValue: string); begin if (FCaption=nil)or(CompareText(AValue, FCaption^)<>0) then begin if FCaption<>nil then StrDispose(FCaption); //DisposeStr(FCaption); FCaption := StrNew(PChar(AValue)); //FCaption := NewStr(AValue); FColumn.ColumnChanged; end; end; procedure TGridColumnTitle.SetColor(const AValue: TColor); begin if FColor=nil then New(FColor) else if FColor^=AValue then exit; FColor^ := AValue; FColumn.ColumnChanged; end; procedure TGridColumnTitle.SetFont(const AValue: TFont); begin if AValue.Handle<>FFont.Handle then begin FFont.Assign(AValue); end; end; procedure TGridColumnTitle.SetLayout(const AValue: TTextLayout); begin if FLayout = nil then New(FLayout) else if FLayout^ = AValue then exit; FLayout^ := AValue; FColumn.ColumnChanged; end; function TGridColumnTitle.GetDefaultCaption: string; begin Result := 'Title' end; constructor TGridColumnTitle.Create(TheColumn: TGridColumn); begin inherited Create; FColumn := TheColumn; FIsDefaultTitleFont := True; FFont := TFont.Create; FillTitleDefaultFont; FFont.OnChange := @FontChanged; end; destructor TGridColumnTitle.Destroy; begin if FFont<>nil then FFont.Free; if FAlignment<>nil then Dispose(FAlignment); if FColor<>nil then Dispose(FColor); if FCaption<>nil then StrDispose(FCaption); //DisposeStr(FCaption); if FLayout<>nil then Dispose(FLayout); inherited Destroy; end; function TGridColumnTitle.IsDefault: boolean; begin result := (FAlignment=nil) and (FColor=nil) and (FCaption=nil) and IsDefaultFont and (FLayout=nil); end; { TGridColumn } procedure TGridColumn.FontChanged(Sender: TObject); begin FisDefaultFont := False; ColumnChanged; end; function TGridColumn.GetAlignment: TAlignment; begin if FAlignment=nil then Result := GetDefaultAlignment else result := FAlignment^; end; function TGridColumn.GetColor: TColor; var TmpGrid: TCustomGrid; begin TmpGrid := Grid; if FColor=nil then if TmpGrid<>nil then result := TmpGrid.Color else result := clWindow else result := FColor^ end; function TGridColumn.GetExpanded: Boolean; begin result := True; end; function TGridColumn.GetFont: TFont; begin result := FFont; end; function TGridColumn.GetGrid: TCustomGrid; begin if Collection is TGridColumns then result := (Collection as TGridColumns).Grid else result := nil; end; function TGridColumn.GetLayout: TTextLayout; begin if FLayout=nil then result := tlCenter else result := FLayout^; end; function TGridColumn.GetMaxSize: Integer; begin if FMaxSize=nil then result := InternalDefaultMaxSize else result := FMaxSize^; end; function TGridColumn.GetMinSize: Integer; begin if FMinSize=nil then result := InternalDefaultMinSize else result := FMinSize^; end; function TGridColumn.GetSizePriority: Integer; begin if FSizePriority=nil then result := GetDefaultSizePriority else result := FSizePriority^; end; function TGridColumn.GetPickList: TStrings; begin Result := FPickList; end; function TGridColumn.GetReadOnly: Boolean; begin if FReadOnly=nil then result := InternalDefaultReadOnly else result := FReadOnly^; end; function TGridColumn.GetVisible: Boolean; begin if FVisible=nil then begin result := GetDefaultVisible; end else result := FVisible^; end; function TGridColumn.GetWidth: Integer; begin if FWidth=nil then result := InternalDefaultWidth else result := FWidth^; end; function TGridColumn.IsAlignmentStored: boolean; begin result := FAlignment <> nil; end; function TGridColumn.IsColorStored: boolean; begin result := FColor <> nil; end; function TGridColumn.IsFontStored: boolean; begin result := not FisDefaultFont; end; function TGridColumn.IsLayoutStored: boolean; begin result := FLayout <> nil; end; function TGridColumn.IsMinSizeStored: boolean; begin result := FMinSize <> nil; end; function TGridColumn.IsMaxSizeStored: boolean; begin result := FMaxSize <> nil; end; function TGridColumn.IsReadOnlyStored: boolean; begin result := FReadOnly <> nil; end; function TGridColumn.IsSizePriorityStored: boolean; begin result := FSizePriority <> nil; end; function TGridColumn.IsVisibleStored: boolean; begin result := (FVisible<>nil) and not FVisible^; end; function TGridColumn.IsWidthStored: boolean; begin result := FWidth <> nil; end; procedure TGridColumn.SetAlignment(const AValue: TAlignment); begin if FAlignment = nil then New(FAlignment) else if FAlignment^ = AValue then exit; FAlignment^ := AValue; ColumnChanged; end; procedure TGridColumn.SetButtonStyle(const AValue: TColumnButtonStyle); begin if FButtonStyle=AValue then exit; FButtonStyle:=AValue; ColumnChanged; end; procedure TGridColumn.SetColor(const AValue: TColor); begin if FColor = nil then New(FColor) else if FColor^ = AValue then exit; FColor^ := AValue; ColumnChanged; end; procedure TGridColumn.SetExpanded(const AValue: Boolean); begin //todo end; procedure TGridColumn.SetFont(const AValue: TFont); begin if AValue.Handle<>FFont.Handle then begin FFont.Assign(AValue); end; end; procedure TGridColumn.SetLayout(const AValue: TTextLayout); begin if FLayout = nil then New(FLayout) else if FLayout^ = AValue then exit; FLayout^ := AValue; ColumnChanged; end; procedure TGridColumn.SetMaxSize(const AValue: Integer); begin if FMaxSize = nil then New(FMaxSize) else if FMaxSize^ = AVAlue then exit; FMaxSize^ := AValue; ColumnChanged; end; procedure TGridColumn.SetMinSize(const Avalue: Integer); begin if FMinSize = nil then New(FMinSize) else if FMinSize^ = AVAlue then exit; FMinSize^ := AValue; ColumnChanged; end; procedure TGridColumn.SetPickList(const AValue: TStrings); begin if AValue=nil then FPickList.Clear else FPickList.Assign(AValue); end; procedure TGridColumn.SetReadOnly(const AValue: Boolean); begin if FReadOnly = nil then New(FReadOnly) else if FReadOnly^ = AValue then exit; FReadOnly^ := Avalue; ColumnChanged; end; procedure TGridColumn.SetSizePriority(const AValue: Integer); begin if FSizePriority = nil then New(FSizePriority) else if FSizePriority^ = AVAlue then exit; FSizePriority^ := AValue; ColumnChanged; end; procedure TGridColumn.SetTitle(const AValue: TGridColumnTitle); begin FTitle.Assign(AValue); end; procedure TGridColumn.SetVisible(const AValue: Boolean); begin if FVisible = nil then New(FVisible) else if FVisible^ = AValue then exit; FVisible^ := AValue; AllColumnsChange; end; procedure TGridColumn.SetWidth(const AValue: Integer); begin if FWidth = nil then New(FWidth) else if FWidth^ = AVAlue then exit; FWidth^ := AValue; FWidthChanged:=true; ColumnChanged; end; function TGridColumn.InternalDefaultReadOnly: boolean; begin result := false; end; function TGridColumn.GetDefaultVisible: boolean; begin Result := True; end; function TGridColumn.InternalDefaultWidth: Integer; begin result := 64; end; function TGridColumn.InternalDefaultMaxSize: Integer; begin // get a better default Result := 200; end; function TGridColumn.InternalDefaultMinSize: Integer; begin // get a better default result := 10; end; function TGridColumn.GetDefaultSizePriority: Integer; begin Result := 1; end; function TGridColumn.GetDisplayName: string; begin Result := 'GridColumn'; end; function TGridColumn.GetDefaultAlignment: TAlignment; begin result := taLeftJustify; end; procedure TGridColumn.ColumnChanged; begin Changed(False); FWidthChanged := False; end; procedure TGridColumn.AllColumnsChange; begin Changed(True); FWidthChanged := False; end; {$ifdef ver1_0} procedure TGridColumn.Changed(AllItems: Boolean); begin inherited Changed(AllItems); end; {$endif} function TGridColumn.CreateTitle: TGridColumnTitle; begin result := TGridColumnTitle.Create(Self); end; constructor TGridColumn.Create(ACollection: TCollection); begin inherited Create(ACollection); FTitle := CreateTitle; FIsDefaultFont := True; FFont := TFont.Create; FillDefaultFont; FFont.OnChange := @FontChanged; FPickList:= TStringList.Create; FButtonStyle := cbsAuto; FDropDownRows := 7; end; destructor TGridColumn.Destroy; begin if FAlignment<>nil then Dispose(FAlignment); if FColor<>nil then Dispose(FColor); if FVisible<>nil then Dispose(FVisible); if FReadOnly<>nil then Dispose(FReadOnly); if FWidth<>nil then Dispose(FWidth); if FLayout<>nil then Dispose(FLayout); FreeThenNil(FPickList); FreeThenNil(FFont); FreeThenNil(FTitle); inherited Destroy; end; procedure TGridColumn.FillDefaultFont; var AGrid: TCustomGrid; begin AGrid := Grid; if (AGrid<>nil) then begin FFont.Assign(AGrid.Font); end; end; function TGridColumn.IsDefault: boolean; begin result := FTitle.IsDefault and (FAlignment=nil) and (FColor=nil) and (FVisible=nil) and (FReadOnly=nil) and (FWidth=nil) and FIsDefaultFont and (FLayout=nil) and (FMaxSize=nil) and (FMinSize=nil) and (FSizePriority=nil); end; { TGridColumns } function TGridColumns.GetColumn(Index: Integer): TGridColumn; begin result := TGridColumn( inherited Items[Index] ); end; function TGridColumns.GetEnabled: Boolean; begin result := VisibleCount > 0; end; procedure TGridColumns.SetColumn(Index: Integer; Value: TGridColumn ); begin Items[Index].Assign( Value ); end; function TGridColumns.GetVisibleCount: Integer; var i: Integer; begin result := 0; for i:=0 to Count-1 do if Items[i].Visible then inc(result); end; procedure TGridColumns.Update(Item: TCollectionItem); begin //if (FGrid<>nil) and not (csLoading in FGrid.ComponentState) then FGrid.ColumnsChanged(TGridColumn(Item)); end; procedure TGridColumns.TitleFontChanged; var c: TGridColumn; i: Integer; begin for i:=0 to Count-1 do begin c := Items[i]; if (c<>nil)and(c.Title.IsDefaultFont) then c.Title.FillTitleDefaultFont; end; end; procedure TGridColumns.FontChanged; var c: TGridColumn; i: Integer; begin for i:=0 to Count-1 do begin c := Items[i]; if (c<>nil)and(c.IsDefaultFont) then c.FillDefaultFont; end; end; procedure TGridColumns.RemoveColumn(Index: Integer); begin if HasIndex(Index) then Delete(Index) else raise Exception.Create('Index out of range') end; procedure TGridColumns.MoveColumn(FromIndex, ToIndex: Integer); begin if HasIndex(FromIndex) then if HasIndex(ToIndex) then Items[FromIndex].Index := ToIndex else raise Exception.Create('ToIndex out of range') else raise Exception.Create('FromIndex out of range') end; procedure TGridColumns.ExchangeColumn(Index, WithIndex: Integer); begin if HasIndex(Index) then if HasIndex(WithIndex) then begin BeginUpdate; Items[WithIndex].Index := Index; Items[Index+1].Index := WithIndex; EndUpdate; end else raise Exception.Create('WithIndex out of range') else raise Exception.Create('Index out of range') end; procedure TGridColumns.InsertColumn(Index: Integer); begin BeginUpdate; Add; MoveColumn(Count-1, Index); EndUpdate; end; constructor TGridColumns.Create(AGrid: TCustomGrid); begin inherited Create( TGridColumn ); FGrid := AGrid; end; constructor TGridColumns.Create(AGrid: TCustomGrid; aItemClass: TCollectionItemClass); begin inherited Create( aItemClass ); FGrid := AGrid; end; function TGridColumns.Add: TGridColumn; begin result := TGridColumn( inherited add ); end; function TGridColumns.RealIndex(Index: Integer): Integer; var i: Integer; begin result := -1; if Index>=0 then for i:=0 to Count-1 do begin if Items[i].Visible then begin Dec(index); if Index<0 then begin result := i; exit; end; end; end; end; function TGridColumns.IndexOf(Column: TGridColumn): Integer; var i: Integer; begin result := -1; for i:=0 to Count-1 do if Items[i]=Column then begin result := i; break; end; end; function TGridColumns.IsDefault: boolean; var i: Integer; begin result := True; for i:=0 to Count-1 do result := Result and Items[i].IsDefault; end; function TGridColumns.HasIndex(Index: Integer): boolean; begin result := (index>-1)and(index25 then Left:=Right-25; SetBounds(Left, Top, Right-Left, Bottom-Top); End; end; { TPickListCellEditor } procedure TPickListCellEditor.WndProc(var TheMessage: TLMessage); begin {$IfDef GridTraceMsg} TransMsg('PicklistEditor: ', TheMessage); {$Endif} if TheMessage.msg=LM_KILLFOCUS then begin if (TheMessage.WParam and $FFFF) = Handle then begin // what a weird thing, we are losing the focus // and giving it to ourselves TheMessage.Result := 0; // doesn't allow such thing exit; end; end; inherited WndProc(TheMessage); end; procedure TPickListCellEditor.KeyDown(var Key: Word; Shift: TShiftState); function AllSelected: boolean; begin result := (SelLength>0) and (SelLength=Length(Text)); end; function AtStart: Boolean; begin Result:= (SelStart=0); end; function AtEnd: Boolean; begin result := ((SelStart+1)>Length(Text)) or AllSelected; end; procedure doEditorKeyDown; begin if FGrid<>nil then FGrid.EditorkeyDown(Self, key, shift); end; procedure doGridKeyDown; begin if FGrid<>nil then FGrid.KeyDown(Key, shift); end; function GetFastEntry: boolean; begin if FGrid<>nil then Result := FGrid.FastEditing else Result := False; end; procedure CheckEditingKey; begin // if editor is not readonly, start editing // else not interested if (FGrid=nil) or FGrid.EditorIsReadOnly then Key := 0; end; var IntSel: boolean; begin {$IfDef dbgGrid} DebugLn('TPickListCellEditor.KeyDown INI: Key=',Dbgs(Key)); {$Endif} inherited KeyDown(Key,Shift); case Key of VK_F2: if AllSelected then begin SelLength := 0; SelStart := Length(Text); end; VK_RETURN: if DroppedDown then begin CheckEditingKey; DroppedDown := False; if Key<>0 then begin doEditorKeyDown; Key:=0; end; end else doEditorKeyDown; VK_DELETE: CheckEditingKey; VK_UP, VK_DOWN: if not DroppedDown then doGridKeyDown; VK_LEFT, VK_RIGHT: if GetFastEntry then begin IntSel:= ((Key=VK_LEFT) and not AtStart) or ((Key=VK_RIGHT) and not AtEnd); if not IntSel then begin doGridKeyDown; end; end; VK_END, VK_HOME: ; else doEditorKeyDown; end; {$IfDef dbgGrid} DebugLn('TPickListCellEditor.KeyDown FIN: Key=',Dbgs(Key)); {$Endif} end; procedure TPickListCellEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); FMouseSelecting:=True; end; procedure TPickListCellEditor.Change; begin inherited Changed; if FGrid<>nil then begin {$ifdef dbgGrid} DebugLn('TPickListCellEditor.Change: Text=', Text); {$endif} if FMouseSelecting then begin // usually editor.change doesn't mean the editor is really // modified (for example when selecting using the keyboard // but when selecting with the mouse, editor.change is the // only way I found to detect that the user actually changed // something FMouseSelecting := False; if FGrid.EditorIsReadOnly then exit end; FGrid.SetEditText(FGrid.Col, FGrid.Row, Text); end; end; procedure TPickListCellEditor.DropDown; begin inherited DropDown; //DebugLn('*********** DROPDOWN ********** '); end; procedure TPickListCellEditor.CloseUp; begin inherited CloseUp; //DebugLn('*********** CLOSEUP ********** '); end; procedure TPickListCellEditor.msg_GetValue(var Msg: TGridMessage); begin Msg.Value:=Text; end; procedure TPickListCellEditor.msg_SetGrid(var Msg: TGridMessage); begin FGrid:=Msg.Grid; Msg.Options:=EO_AUTOSIZE or EO_HOOKEXIT or EO_SELECTALL or EO_HOOKKEYPRESS or EO_HOOKKEYUP; end; procedure TPickListCellEditor.msg_SetValue(var Msg: TGridMessage); begin Text:=Msg.Value; SelStart := Length(Text); end; end. { The_Log VERSION: 0.8.6: ---------------- Date: 20-Dic-2003 - Added GetEditText, GetEditMask, SetEditText and events OnGetEditText, OnGetEditMask, OnSetEditText - Added ColWidths and RowHeights lfm storing - Changed Default CellEditor from TCustomEdit to TCustomMaskEdit - Added Test StringGridEditor (enabled with -dWithGridEditor) VERSION: 0.8.5: ---------------- Date: 15-Sept-2003 - TCustomGrid is derived from TCustomControl instead of TScrollingWinControl means that: * No more transparent grid at design time * No more HorzScrolLBar and VertScrollbar in Object inspector * HorzScrollbar and VertScrollbar doesn't exists anymore * Scrollbar is handled with setscrollinfo or through the new ScrollbarXXXX protected methods. - TCustomDrawGrid attribute support was removed and added to a new TCustomStringGrid derivated component. - Removed CanSelect, OnCanSelect, TOnCanSelectEvent now it uses SelectCell OnSelectCell and TOnSelectCell. - Implemented Auto edit mode (Typing something will show editor) - Implemented EditorMode VERSION: 0.8.4: --------------- Date: 21-JAN-2003 - Moved log to the end of file - Editor should be set in OnSelectEditor or SelectEditor in descendants. - Added SkipUnselectable, this allow the seleccion [using UP,DOWN,LEFT,TOP, TABS (if goTabs)] select the next selectable cell. - Fixed goAlwaysShowEditor - Fixed bug (gtk-CRITICAL) when destroying the grid and the editor is visible - Fixed bug selecting a partial visible cell while the grid is scrolled - missing: tabb from the grid, and Shift-Tab in goTabs mode. VERSION: 0.8.3 --------------- CHANGES - Better Editor Support Renamed Editor functions Editors uses .Dispatch instead of .Perform Introduced EditorOptions: EO_AUTOSIZE = Let the grid automatically resize the editor EO_HOOKKEYS = Let the grid process known keydows first EO_HOOKEXIT = Let the grid handle the focus EO_SELECTALL = Editor wants to receive SelectAll msg on Key RETURN EO_WANTCHAR = Editor wants to Preview Keys on the grid (soon) EO_GETSETVAL = Editor wants to receive GetValue,SetValue msgs (soon) This Options should be set in GM_SETGRID message (msg.Options:= ..) - Deleted Scr1 Conditional FIXES Painting and Crashes at desing time TODOS Better editor Support TCustomgrid Inherited from TCustomControl to get rid of - published VertScrollBar - published HorzScrollBar - published AutoScroll - translucid look at design time? Detect ReadOnly grid in editors Detect changes in the grid. Column Resizing at design time ... VERSION: 0.8.2 --------------- CHANGES Demo Program Too many internal changes to be listed, scrollbars are now proportional to client/grid sizes (with goSmoothScroll option and almost proptional without it), removed OnEditor, etc. ADDED goSmoothScroll. (default) allows scroll the grid by pixel basis goThumbTracking. The grid acts always as if this is set, the value is ignored due to current implementation, however if the user set it explicitly then, when the user is scrolling, the focused cell will be following the scroll position. goTabs. goAlwaysShowEditor. Still need some working NEW AutoAdvance. Choose where the next cell position should go if a RETURN or TABS(if enabled) is pressed aaRight. Selected cell will go to the right aaDown. Selected cell will go to down BUGS goEditing: - pressing RETURN doesn't edit the current cell - pressing other keys doesn't start editing (need F2) goTabs: - Shift-TAB doesn't work goAlwaysShowEditor: - Still working :) ... VERSION: 0.8.1 --------------- DATE: 28-DEC-2002 CHANGES -- Continued migrating properties from TCustomGrid to TCustomDrawGrid (onCellAttr, DefaultCellAttr, FixedColor, etc.) FIXES -- FGrid in TCustomDrawGrid was not destroyed -- goEditing now works. I mean, you can now stop showing the editor at F2 (although editor needs more work) Default cell editor -- DefaultEditor parent is now TCustomStringGrid -- Some fpc 1.1 issues (Mattias) VERSION: 0.8.0 --------------- DATE: 20-DEC-2002 CHANGES Many internal changes (width,height removed from pcellsprop, fgrid removed from tcustomgrid, colRowToClientCellRect now uses col,row instead of point(col,row), cleaned DynamicArray, drawcells splitted in DrawFixedCells, DrawInteriorCells, DrawFocused so TCustomStringGrid can implement ordered cell drawin and TCustomGrid draw cells is simpler, etc). ADDED ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer); DeleteColRow(IsColumn:Boolea; index:Integer); MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer); SortColRow(IsColumn: Boolean; index: Integer); SortColRow(IsColumn: Boolean; index,FromIndex,ToIndex: Integer); property OnColRowMoved: TgridOperationEvent property OnColRowDeleted: TgridOperationEvents property OnColRowExchanged: TgridOperationEvents ADDED TcustomGrid derivatives can now replace sort algorithm overriding Sort method and using exchangeColRow as needed. VERSION: 0.7.3 ----------------- DATE: 10-DIC-2002 ADDED goDblClickAutoSize to grid Options, Doubleclicking col's right edge automatically adjust column width (in TCustomStringGrid). Implemented AutoAdjustColumn() and AutoAdjustColumns. FIXED col, row increment after grid.clear don't show the grid ( if fixed rows-cols = 0 ) ADDED version info to saved grid files. ADDED NEW DEMO: mysql_query. A program that connects to MySQL and shows query results in a grid which you can save and load. VERSION: 0.7.2 ----------------- DATE: 5-DIC-2002 FIXED a bug that prevents col, and row sizing. MouseDown uses only Left clicks VERSION: 0.7.1 ----------------- DATE: 3-DIC-2002 ADDED LoadFromFile and SaveToFile to XML file. SaveOptions (soDesign,soPosition,soAttributes,soContent); soDesign: Save & Load ColCount,RowCount,FixedCols,FixedRows, ColWidths, RowHeights and Options (TCustomGrid) soPosition: Save & Load Scroll Position, Row, Col and Selection (TCustomGrid) soAttributes: Save & Load Colors, Text Alignment & Layout, etc. (TCustomDrawGrid) soContent: Save & Load Text (TCustomStringGrid) ADDED TCustomgrid.Clear. Wipe completly the grid. ADDED goRelaxedRowSelect option You can see focused cell and navigate freely if goRowSelect is set. FIXED Crash on reducing Rowcount VERSION: 0.7.0 ----------------- RELEASE DATE: 30-NOV-2002 This unit version provides TCustomGrid, TCustomDrawGrid and TCustomStringGrid for lazarus from the component user perpective there should be to much differences. This release has only basic editing support. Old Features: Almost all that T*Grid can do. New Features : OnHeaderClick: Detect clicks on Row(Column) Headers, it uses a property: DragDx as a threshold in order to detect Col(Row) moving or clicking. OnCellAttr: In this Event You can easily customize the grid. OnDrawCell: Draw your specific cells here and then call .DefaultDrawCell to let the grid draw other cells. SortColumn, SortRow: Sorting capabilities are built! you need only write one OnCompareCells handler to do your custom sorting needs. Exposed: DeleteColumn, DeleteRow, MoveColumn, MoveRow. RowAttr[],RowColor[],RowFontColor[],RowAlign[] ColAttr[],ColColor[],ColFontColor[],ColAlign[] CellAttr[],CellColor[],CellFontColor[],CellAlign[] GridLineStyle, FocusColor, etc. Bugs: + Editor: it has a unneeded feature "auto cell filling" :) others. }