{ $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} unit Grids; {$mode objfpc}{$H+} interface uses Classes, SysUtils, LCLStrConsts, LCLProc, LCLType, LCLIntf, Controls, GraphType, Graphics, Forms, DynamicArray, LMessages, XMLCfg, StdCtrls, LResources, MaskEdit; 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_HOOKKEYS = $2; EO_HOOKEXIT = $4; EO_SELECTALL = $8; EO_WANTCHAR = $10; 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 = (aaDown,aaRight,aaLeft); TGridStatus = (stNormal, stEditorHiding, stEditorShowing, stFocusing); TItemType = (itNormal,itCell,itColumn,itRow,itFixed,itFixedColumn,itFixedRow,itSelected); const soAll: TSaveOptions = [soDesign, soAttributes, soContent, soPosition]; type TCustomGrid = 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; 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 = function (Sender: TObject; Acol,ARow,Bcol,BRow: Integer): 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=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 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; 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 HScrDiv,VScrDiv: Double; // Transform const for ThumbTracking TLColOff,TLRowOff: Integer; // TopLeft Offset in pixels MaxTopLeft: TPoint; // Max Top left ( cell coorditates) end; type TCustomGrid=class(TCustomControl) private FAutoAdvance: TAutoAdvance; FDefaultDrawing: Boolean; FEditor: TWinControl; FEditorHiding: Boolean; FEditorMode: Boolean; FEditorShowing: Boolean; FEditorKey: Boolean; FEditorOptions: Integer; FFlat: Boolean; FOnCompareCells: TOnCompareCells; FGridLineStyle: TPenStyle; FGridLineWidth: Integer; FDefColWidth, FDefRowHeight: Integer; FCol,FRow, FFixedCols, FFixedRows: Integer; 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 FVSbVisible, FHSbVisible: boolean; FDefaultTextStyle: TTextStyle; procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer); procedure CacheVisibleGrid; procedure CheckFixedCount(aCol,aRow,aFCol,aFRow: Integer); procedure CheckCount(aNewColCount, aNewRowCount: Integer); function CheckTopLeft(aCol,aRow: Integer; CheckCols,CheckRows: boolean): boolean; procedure SetFlat(const AValue: Boolean); procedure SetFocusRectVisible(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 EditorGetValue; procedure EditorHide; procedure EditorPos; procedure EditorSelectAll; procedure EditorShowChar(Ch: Char); procedure EditorSetMode(const AValue: Boolean); procedure EditorSetValue; function EditorShouldEdit: Boolean; procedure EditorShow; function GetLeftCol: Integer; function GetColCount: Integer; function GetColWidths(Acol: Integer): Integer; 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 MyTextRect(R: TRect; Offx,Offy:Integer; S:string; Clipping: boolean); 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 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 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 CheckLimits(var aCol,aRow: Integer); procedure ColRowDeleted(IsColumn: Boolean; index: Integer); dynamic; procedure ColRowExchanged(IsColumn: Boolean; index,WithIndex: Integer); dynamic; procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); dynamic; function ColRowToOffset(IsCol,Fisical:Boolean; index: Integer; var Ini,Fin:Integer): Boolean; procedure ColWidthsChanged; dynamic; procedure CreateWnd; override; procedure CreateParams(var Params: TCreateParams); override; procedure DblClick; override; procedure DefineProperties(Filer: TFiler); override; procedure DestroyHandle; override; procedure DoExit; override; procedure DoEnter; 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); 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 EditordoGetValue; virtual; procedure EditordoSetValue; virtual; function GetFixedcolor: TColor; virtual; function GetSelectedColor: TColor; virtual; function GetEditMask(ACol, ARow: Longint): string; dynamic; function GetEditText(ACol, ARow: Longint): string; dynamic; procedure SetEditText(ACol, ARow: Longint; const Value: string); dynamic; procedure HeaderClick(IsColumn: Boolean; index: Integer); dynamic; procedure HeaderSized(IsColumn: Boolean; index: Integer); dynamic; procedure InvalidateCell(aCol, aRow: Integer); overload; procedure InvalidateCell(aCol, aRow: Integer; Redraw: Boolean); overload; procedure InvalidateCol(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 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 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 ProcessEditor(LastEditor:TWinControl; DCol,DRow: Integer; WasVis: Boolean); procedure ResetOffset(chkCol, ChkRow: Boolean); procedure RowHeightsChanged; dynamic; procedure SaveContent(cfg: TXMLConfig); virtual; procedure ScrollBarRange(Which:Integer; {IsVisible:boolean; }aRange: 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 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 VisualChange; virtual; procedure WMHScroll(var message : TLMHScroll); message LM_HScroll; procedure WMVScroll(var message : TLMVScroll); message LM_VScroll; procedure WndProc(var TheMessage : TLMessage); override; property AutoAdvance: TAutoAdvance read FAutoAdvance write FAutoAdvance default aaRight; property BorderStyle default bsSingle; property Col: Integer read FCol write SetCol; property ColCount: Integer read GetColCount write SetColCount; property ColWidths[aCol: Integer]: Integer read GetColWidths write SetColWidths; property DefaultColWidth: Integer read FDefColWidth write SetDefColWidth; property DefaultRowHeight: Integer read FDefRowHeight write SetDefRowHeight; 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 EditorMode: Boolean read FEditorMode write EditorSetMode; 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; 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 TopRow: Integer read GetTopRow write SetTopRow; 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 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; procedure DeleteColRow(IsColumn: Boolean; index: Integer); procedure EditorExit(Sender: TObject); procedure EditorKeyDown(Sender: TObject; var Key:Word; Shift:TShiftState); procedure EndUpdate(UO: TUpdateOption); overload; procedure EndUpdate(FullUpdate: Boolean); overload; procedure ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer); function IscellSelected(aCol,aRow: Integer): Boolean; function IscellVisible(aCol, aRow: Integer): Boolean; procedure LoadFromFile(FileName: string); function MouseToCell(Mouse: TPoint): TPoint; function MouseToLogcell(Mouse: TPoint): TPoint; function MouseToGridZone(X,Y: Integer; CellCoords: Boolean): TGridZone; procedure MoveColRow(IsColumn: Boolean; FromIndex, ToIndex: Integer); procedure SaveToFile(FileName: string); procedure SortColRow(IsColumn: Boolean; index:Integer); overload; procedure SortColRow(IsColumn: Boolean; index,FromIndex,ToIndex: Integer); overload; 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; TDrawGrid=class(TCustomGrid) private FOnColRowDeleted: TgridOperationEvent; FOnColRowExchanged: 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 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; 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 DefaultDrawCell(aCol,aRow: Integer; var aRect: TRect; aState:TGridDrawState); virtual; // properties property Canvas; property Col; property ColWidths; property Editor; property EditorMode; 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; published property Align; property Anchors; property AutoAdvance; //property BiDiMode; property BorderStyle; property Color default clWindow; property ColCount; //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 OnColRowMoved: TgridOperationEvent read FOnColRowMoved write FOnColRowMoved; property OnCompareCells; property OnDblClick; property OnDrawCell; 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 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; property OnMouseWheelDown; property OnMouseWheelUp; } end; TStringGrid = class(TDrawGrid) 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 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 SetEditText(aCol, aRow: Longint; const aValue: string); override; public constructor Create(AOWner: TComponent); override; destructor Destroy; override; procedure AutoSizeColumns; property Cells[ACol, ARow: Integer]: string read GetCells write SetCells; property Cols[index: Integer]: TStrings read GetCols write SetCols; property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects; property Rows[index: Integer]: TStrings read GetRows write SetRows; end; procedure DebugRect(S:string; R:TRect); procedure DebugPoint(S:string; P:TPoint); procedure register; implementation { // Dibujar una linea en el borde izquierdo de esta celda Dc:=GetDC(handle); Pen:=CreatePen(PS_SOLID, 3, clRed); OldPen:=SelectObject(Dc, Pen); MoveToEx(Dc, R.left, 0, nil); LineTo(Dc, R.Left, FGCache.MaxClientXY.Y); SelectObject(Dc, OldPen); DeleteObject(Pen); ReleaseDC(Handle, Dc); FMoveLast:=P; } {function RndStr:string; var i: Integer; begin Result:=''; For i:=1 to 10 do begin Result:=Result+ Char(Ord('A')+Random(20)); end; end;} 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; var hex: string; begin with TheMsg do begin hex:= S + '['+IntToHex(msg, 8)+'] W='+IntToHex(WParam,8)+' L='+IntToHex(LParam,8)+' '; case Msg of CM_BASE..CM_MOUSEWHEEL: case Msg of CM_MOUSEENTER: DebugLn(hex, 'CM_MOUSEENTER'); CM_MOUSELEAVE: DebugLn(hex, 'CM_MOUSELEAVE'); CM_TEXTCHANGED: DebugLn(hex, 'CM_TEXTCHANGED'); CM_PARENTCTL3DCHANGED: DebugLn(hex, 'CM_PARENTCTL3DCHANGED'); CM_UIACTIVATE: DebugLn(hex, 'CM_UIACTIVATE'); CM_CONTROLLISTCHANGE: DebugLn(hex, 'CM_CONTROLLISTCHANGE'); CM_PARENTCOLORCHANGED: DebugLn(hex, 'CM_PARENTCOLORCHANGED'); CM_PARENTFONTCHANGED: DebugLn(hex, 'CM_PARENTFONTCHANGED'); CM_PARENTSHOWHINTCHANGED: DebugLn(hex, 'CM_PARENTSHOWHINTCHANGED'); CM_PARENTBIDIMODECHANGED: DebugLn(hex, 'CM_PARENTBIDIMODECHANGED'); CM_CONTROLCHANGE: DebugLn(Hex, 'CM_CONTROLCHANGE'); CM_SHOWINGCHANGED: DebugLn(Hex, 'CM_SHOWINGCHANGED'); CM_VISIBLECHANGED: DebugLn(Hex, 'CM_VISIBLECHANGED'); else DebugLn(Hex, 'CM_BASE + ', IntToStr(Msg - CM_BASE)); end; else case Msg of //CN_BASE MESSAGES CN_COMMAND: DebugLn(hex, 'LM_CNCOMMAND'); // NORMAL MESSAGES LM_SETFOCUS: DebugLn(hex, 'LM_SetFocus'); LM_LBUTTONDOWN: DebugLn(hex, 'LM_MOUSEDOWN'); LM_LBUTTONUP: DebugLn(hex, 'LM_LBUTTONUP'); LM_RBUTTONDOWN: DebugLn(hex, 'LM_RBUTTONDOWN'); LM_RBUTTONUP: DebugLn(hex, 'LM_RBUTTONUP'); LM_GETDLGCODE: DebugLn(hex, 'LM_GETDLGCODE'); LM_KEYDOWN: DebugLn(hex, 'LM_KEYDOWN'); LM_KEYUP: DebugLn(hex, 'LM_KEYUP'); LM_CAPTURECHANGED: DebugLn(hex, 'LM_CAPTURECHANGED'); LM_ERASEBKGND: DebugLn(hex, 'LM_ERASEBKGND'); LM_KILLFOCUS: DebugLn(hex, 'LM_KILLFOCUS'); LM_CHAR: DebugLn(hex, 'LM_CHAR'); LM_SHOWWINDOW: DebugLn(hex, 'LM_SHOWWINDOW'); LM_SIZE: DebugLn(hex, 'LM_SIZE'); LM_WINDOWPOSCHANGED: DebugLn(hex, 'LM_WINDOWPOSCHANGED'); LM_HSCROLL: DebugLn(hex, 'LM_HSCROLL'); LM_VSCROLL: DebugLn(hex, 'LM_VSCROLL'); LM_MOUSEMOVE: ;//DebugLn(hex, 'LM_MOUSEMOVE'); LM_MOUSEWHEEL: DebugLn(Hex, 'LM_MOUSEWHEEL'); else DebugLn(hex, GetMessageName(Msg)); end; end; end; end; {$Endif GridTraceMsg} { TCustomGrid } function TCustomGrid.GetRowHeights(Arow: Integer): Integer; begin if (aRow=0) then Result:=Integer(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;//+FFixedCols; end; function TCustomGrid.GetVisibleRowCount: Integer; var R: TRect; begin R:=FGCache.VisibleGrid; Result:=r.bottom-r.top+1;//+FFixedRows; 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; begin if (aCol=0) then Result:=Integer(FCols[aCol]) else Result:=-1; if result<0 then Result:=fDefColWidth; 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); FEditorOptions:=Msg.Options; if Msg.Options and EO_HOOKKEYS = EO_HOOKKEYS then begin FEditor.OnKeyDown:=@EditorKeyDown; end; if Msg.Options 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_HOOKKEYS = EO_HOOKKEYS then DBGOut('EO_HOOKKEYS '); 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.SetFixedCols(const AValue: Integer); begin if FFixedCols=AValue then exit; CheckFixedCount(ColCount, RowCount, AValue, FFixedRows); FFixedCols:=AValue; fTopLeft.x:=AValue; fCol:=Avalue; if not (csLoading in componentState) then doTopleftChange(true); 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; 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<>Integer(FRows[ARow]) then begin FRows[ARow]:=Pointer(AValue); VisualChange; if (FEditor<>nil)and(Feditor.Visible)and(ARow<=FRow) then EditorPos; RowHeightsChanged; end; end; procedure TCustomGrid.Setcolwidths(Acol: Integer; Avalue: Integer); begin if AValue<0 then Avalue:=-1; if Avalue<>Integer(FCols[ACol]) then begin FCols[ACol]:=Pointer(AValue); VisualChange; if (FEditor<>nil)and(Feditor.Visible)and(ACol<=FCol) then EditorPos; ColWidthsChanged; end; 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; var OldCount: integer; begin if IsColumn then begin AddDel(FCols, NewValue); FGCache.AccumWidth.Count:=NewValue; OldCount:=RowCount; if (OldValue=0)and(NewValue>=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; FixSelection; VisualChange; end; procedure TCustomGrid.SetColCount(Valor: Integer); var OldC: Integer; begin if Valor=FCols.Count then Exit; if Valor<1 then Clear else begin OldC:=FCols.Count; CheckFixedCount(Valor, RowCount, FFixedCols, FFixedRows); CheckCount(Valor, RowCount); AdjustCount(True, OldC, Valor); end; 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; for i:=0 to ColCount-1 do FCols[i] := Pointer(-1); VisualChange; 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 OnCompareCells(Self, index, P, index, i)>0 do I:=I+1; while OnCompareCells(Self, index, P, index, j)<0 do J:=J-1; end else begin while OnCompareCells(Self, P, index, i, index)>0 do I:=I+1; while OnCompareCells(Self, P, index, j, index)<0 do J:=J-1; end; if I<=J then begin ExchangeColRow(not ColSorting, i,j); I:=I+1; J:=j-1; end; until I>J; if L=R; end; begin 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.VisualChange; var Tw,Th: Integer; Dh,DV: 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 WClientWidth then HscrDiv := Double(ColCount-FixedCols-1)/(HsbRange-ClientWidth); end; end else if FScrollBars in [ssHorizontal, ssBoth] then HsbRange:=0; ScrollBarShow(SB_HORZ, HsbVisible); If HsbVisible then ScrollBarRange(SB_HORZ, {HsbVisible, }HsbRange ); with FGCache do if ScrollBarAutomatic(ssVertical) then begin if VSbVisible then begin VSbRange:= GridHeight + 2 - Integer(BorderStyle){ + dh}; if not (goSmoothScroll in Options) then begin TH:= Integer(accumHeight[MaxTopLeft.Y])-(VsbRange-ClientHeight); VsbRange:=VsbRange + TH -FixedHeight + 1; end; if VSbRange>ClientHeight then VScrDiv:= Double(RowCount-FixedRows-1)/(VsbRange-ClientHeight); end; end else if FScrollBars in [ssVertical, ssBoth] then VsbRange:= 0; ScrollBarShow(SB_VERT, VsbVisible); if VsbVisible then ScrollbarRange(SB_VERT, {VsbVisible, }VsbRange ); CacheVisibleGrid; Invalidate; end; procedure TCustomGrid.CreateParams(var Params: TCreateParams); const ClassStylesOff = CS_VREDRAW or CS_HREDRAW; begin inherited CreateParams(Params); with Params do begin WindowClass.Style := WindowClass.Style and DWORD(not ClassStylesOff); Style := Style or WS_VSCROLL or WS_HSCROLL or WS_CLIPCHILDREN; end; end; procedure TCustomGrid.ScrollBarRange(Which: Integer; aRange: Integer); var ScrollInfo: TScrollInfo; begin if HandleAllocated then begin {$Ifdef DbgScroll} DebugLn('ScrollbarRange: Which=',IntToStr(Which),' Range=',IntToStr(aRange)); {$endif} ScrollInfo.cbSize := SizeOf(ScrollInfo); ScrollInfo.fMask := SIF_RANGE or SIF_PAGE or SIF_DISABLENOSCROLL; ScrollInfo.nMin := 0; ScrollInfo.nMax := ARange; if Which = SB_VERT then ScrollInfo.nPage := ClientHeight else ScrollInfo.nPage := ClientWidth; if ScrollInfo.nPage<1 then ScrollInfo.nPage:=1; SetScrollInfo(Handle, Which, ScrollInfo, True); end; end; procedure TCustomGrid.ScrollBarPosition(Which, Value: integer); var ScrollInfo: TScrollInfo; Vis: Boolean; begin if HandleAllocated then begin {$Ifdef DbgScroll} DebugLn('ScrollbarPosition: Which=',IntToStr(Which), ' Value= ',IntToStr(Value)); {$endif} if Which = SB_VERT then Vis := FVSbVisible else if Which = SB_HORZ then Vis := FHSbVisible else vis := false; ScrollInfo.cbSize := SizeOf(ScrollInfo); ScrollInfo.fMask := SIF_POS; ScrollInfo.nPos:= Value; SetScrollInfo(Handle, Which, ScrollInfo, Vis); end; end; { function TCustomGrid.ScrollBarIsVisible(Which: Integer): Boolean; begin Result:=false; if HandleAllocated then begin Result:= getScrollbarVisible(handle, Which); end; end; } procedure TCustomGrid.ScrollBarPage(Which: Integer; aPage: Integer); var ScrollInfo: TScrollInfo; begin if HandleAllocated then begin ScrollInfo.cbSize := SizeOf(ScrollInfo); ScrollInfo.fMask := SIF_PAGE; ScrollInfo.nPage:= aPage; SetScrollInfo(Handle, Which, ScrollInfo, True); end; end; procedure TCustomGrid.ScrollBarShow(Which: Integer; aValue: boolean); begin if HandleAllocated then begin {$Ifdef DbgScroll} DebugLn('ScrollbarShow: Which=',IntToStr(Which), ' Avalue=',BoolToStr(AValue)); {$endif} ShowScrollBar(Handle,Which,aValue); if Which in [SB_BOTH, SB_VERT] then FVSbVisible := AValue else if Which in [SB_BOTH, SB_HORZ] then FHSbVisible := AValue; end; end; function TCustomGrid.ScrollBarAutomatic(Which: TScrollStyle): boolean; begin result:=false; if (Which=ssVertical)or(Which=ssHorizontal) then begin if Which=ssVertical then Which:=ssAutoVertical else Which:=ssAutoHorizontal; Result:= FScrollBars in [Which, ssAutoBoth]; end; end; { Returns a reactagle corresponding to a fisical cell[aCol,aRow] } function TCustomGrid.CellRect(ACol, ARow: Integer): TRect; begin //Result:=ColRowToClientCellRect(aCol,aRow); ColRowToOffset(True, True, ACol, Result.Left, Result.Right); ColRowToOffSet(False,True, ARow, Result.Top, Result.Bottom); end; // The visible grid Depends on TopLeft and ClientWidht,ClientHeight, // Col/Row Count, So it Should be called inmediately after any change // like that function TCustomGrid.GetVisibleGrid: TRect; var w: Integer; MaxRight: Integer; MaxBottom: Integer; begin if (FTopLeft.X<0)or(FTopLeft.y<0) then begin Result:=Rect(-1,-1,-1,-1); Exit; end; // visible TopLeft Cell Result.TopLeft:=fTopLeft; Result.BottomRight:=Result.TopLeft; // Max visible coordinates MaxRight:= FGCache.ClientWidth; MaxBottom:=FGCache.ClientHeight; // Left Margin of next visible Column and Rightmost visible cell w:=GetColWidths(Result.Left) + FGCache.FixedWidth- FGCache.TLColOff; while (Result.Right=0) and (fTopLeft.x=0) and (fTopLeft.y FGCache.ClientWidth then XInc:=1; Yinc:=0; if RNew.Top + FGCAche.TLRowOff < FGcache.FixedHeight then Yinc:=-1 else if RNew.Bottom + FGCache.TLRowOff > FGCache.ClientHeight then YInc:=1; with FTopLeft do if ((XInc=0)and(YInc=0)) or ((X=aCol)and(y=aRow)) Or // Only Perfect fit ! ((X+XInc>=ColCount)or(Y+Yinc>=RowCount)) Or // Last Posible ((X+XInc<0)Or(Y+Yinc<0)) // Least Posible 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 end; procedure TCustomGrid.ColRowExchanged(isColumn: Boolean; index, WithIndex: 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); DrawEdges; DrawBackGround; if FGCache.ValidGrid then begin { DrawFixedCells; DrawInteriorCells; DrawFocused; } DrawByRows; DrawColRowMoving; end; DrawBorder; end; end; procedure TCustomGrid.PrepareCanvas(aCol, aRow: Integer; aState: TGridDrawState ); begin Canvas.TextStyle := DefaultTextStyle; 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; end else begin 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; function TCustomGrid.SelectCell(ACol, ARow: Integer): Boolean; begin Result:=true; //Result:=MoveExtend(False, aCol, aRow); 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; begin if (FGridState=gsColMoving)and(fMoveLast.x>=0) then begin Canvas.Pen.Width:=3; Canvas.Pen.Color:=clRed; Canvas.MoveTo(fMoveLast.y, 0); Canvas.Lineto(fMovelast.y, FGCache.MaxClientXY.Y); Canvas.Pen.Width:=1; end else if (FGridState=gsRowMoving)and(FMoveLast.y>=0) then begin Canvas.Pen.Width:=3; Canvas.Pen.Color:=clRed; Canvas.MoveTo(0, FMoveLast.X); Canvas.LineTo(FGCache.MaxClientXY.X, FMoveLast.X); Canvas.Pen.Width:=1; 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 exit; {$ENDIF} // Draw columns in this row with FGCache.VisibleGrid do if ARow=Top) and (ARow<=Bottom)) or IsCellVisible(FCol,ARow)) then begin if EditorShouldEdit 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.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; 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 Pen.Color := cl3DHilight; MoveTo(Right - 1, Top); LineTo(Left, Top); LineTo(Left, Bottom); 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.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; //DebugLn('TCustomGrid.WMEraseBkgnd'); 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; // // NOTE: WMHScroll and VMHScroll // This methods are used to pre-calculate the scroll position // procedure TCustomGrid.WMHScroll(var message: TLMHScroll); var C,TL,CTL: Integer; begin // Avoid invalidating right know, just let the scrollbar // calculate its position { BeginUpdate; Inherited; message.Result:=1; EndUpdate(uoNone); } {$IfDef dbgScroll} DebugLn('HSCROLL: Code=',IntToStr(message.ScrollCode),' Position=', IntToStr(message.Pos)); {$Endif} if FGCache.HScrDiv<=0 then Exit; if FEditor<>nil then EditorGetValue; if goThumbTracking in Options then begin C:=FFixedCols + Round( message.Pos * FGCache.HScrDiv ); if (FCol<>C) then begin Inc(FUpdateScrollBarsCount); MoveExtend(False, C, FRow); Dec(FUpdateScrollBarsCount); end; end else begin TL:= Integer(FGCache.AccumWidth[ FGCache.MaxTopLeft.X ]) - FGCAche.FixedWidth; CTL:= Integer(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, SB_THUMBTRACK: C := message.Pos; // 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; { R.Topleft:=Point(FGCache.FixedWidth, 0); R.BottomRight:= FGCache.MaxClientXY; InvalidateRect(Handle, @R, false); } Invalidate; end; end; end; procedure TCustomGrid.WMVScroll(var message: TLMVScroll); var C, TL, CTL: Integer; begin // Avoid invalidating right know, just let the scrollbar // calculate its position { BeginUpdate; Inherited; message.Result:=1; EndUpdate(uoNone); } {$IfDef dbgScroll} DebugLn('VSCROLL: Code=',IntToStr(message.ScrollCode),' Position=', IntToStr(message.Pos)); {$Endif} if FGCache.VScrDiv<=0 then Exit; if FEditor<>nil then EditorGetValue; if goThumbTracking in Options then begin C:=FFixedRows + Round( message.Pos * FGCache.VScrDiv ); if (C<>FRow) then begin Inc(FUpdateScrollBarsCount); MoveExtend(False, FCol, C); Dec(FUpdateScrollBarsCount); end; end else begin TL:= Integer(FGCache.AccumHeight[ FGCache.MaxTopLeft.Y ]) - FGCache.FixedHeight; CTL:= Integer(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, SB_THUMBTRACK: C := message.Pos; // 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; { R.TopLeft:=Point(0, FGCache.FixedHeight); R.BottomRight:=FGCache.MaxClientXY; InvalidateRect(Handle, @R, false); } Invalidate; end; end; end; procedure TCustomGrid.WMSize(var Msg: TLMSize); begin Inherited; visualChange; 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); { else inherited; } end; procedure TCustomGrid.WndProc(var TheMessage: TLMessage); begin {$IfDef GridTraceMsg} TransMsg('GRID: ', TheMessage); {$Endif} with TheMessage do if (csDesigning in ComponentState) and ((Msg = LM_HSCROLL)or(Msg = LM_VSCROLL)) then Exit; 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, Integer(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, Integer(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.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; 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]-Integer(FGCache.AccumWidth[aCol]); while (x>FixedCols)and(W+Integer(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]-Integer(FGCache.AccumHeight[aRow]); while (y>FixedRows)and(W+Integer(FGCache.AccumHeight[y])>=RowHeights[y-1]) do begin Dec(y); end; end; Result := Not PointIgual(OldTopleft,FTopLeft); if Result then doTopleftChange(False) 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.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); 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); 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 if x>FSplitter.y then ColWidths[FSplitter.x]:=x-FSplitter.y else if ColWidths[FSplitter.x]>0 then ColWidths[FSplitter.X]:=0; 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 Cursor:=crHSplit 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 if y>FSplitter.x then RowHeights[FSplitter.y]:=y-FSplitter.x else if RowHeights[FSplitter.y]>0 then RowHeights[FSplitter.Y]:=0; 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 Cursor:=crVSplit 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; Invalidate; 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+Integer(AccumWidth[Result])+TLColOff; if Offset>GridWidth-1 then begin Result:=ColCount-1; Exit; end; end; while Offset>(Integer(AccumWidth[Result])+GetColWidths(Result)-1) do Inc(Result); Rest:=Offset; if Result<>0 then Rest:=Offset-Integer(AccumWidth[Result]); end else begin if Fisical and (Offset>FixedHeight-1) then begin Result:=FTopLeft.Y; Offset:=Offset-FixedHeight+Integer(AccumHeight[Result])+TLRowOff; if Offset>GridHeight-1 then begin Result:=RowCount-1; Exit; // Out of Range end; end; while Offset>(Integer(AccumHeight[Result])+GetRowHeights(Result)-1) do Inc(Result); Rest:=Offset; if Result<>0 then Rest:=Offset-Integer(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:=Integer(AccumWidth[index]); Dim:=GetColWidths(index); end else begin Ini:=Integer(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-Integer(AccumWidth[FTopLeft.X]) + FixedWidth - TLColOff; end else begin if index>=FFixedRows then Ini:=Ini-Integer(AccumHeight[FTopLeft.Y]) + FixedHeight - TLRowOff; end; Fin:=Ini + Dim; end; Result:=true; end; function TCustomGrid.MouseToGridZone(X, Y: Integer; CellCoords: Boolean): TGridZone; begin Result:=gzNormal; if CellCoords then begin if (X fire an OnSelection event MoveSelection; // Click(); end; (* if (GoEditing in Options)and(FEditor=nil) and not Focused then begin {$IfDef dbgFocus} DebugLn(' AUTO-FOCUSING '); {$Endif} LCLIntf.SetFocus(Self.Handle); end; *) end; end; {$ifDef dbgFocus} DebugLn('MouseDown END'); {$Endif} end; procedure TCustomGrid.MouseMove(Shift: TShiftState; X, Y: Integer); var p: TPoint; begin inherited MouseMove(Shift, X, Y); if not FGCache.ValidGrid then Exit; case fGridState of gsSelecting: begin if not (goEditing in Options) then begin P:=MouseToLogcell(Point(X,Y)); MoveExtend(False, P.x, P.y); end; end; gsColMoving: if goColMoving in Options then doColMoving(X,Y); gsRowMoving: if goRowMoving in Options then doRowMoving(X,Y); else begin if goColSizing in Options then doColSizing(X,Y); if goRowSizing in Options then doRowSizing(X,Y); end; end; end; procedure TCustomGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Cur: TPoint; begin inherited MouseUp(Button, Shift, X, Y); if not FGCache.ValidGrid then Exit; {$IfDef dbgFocus}DebugLn('MouseUP INIT');{$Endif} Cur:=MouseToCell(Point(x,y)); case fGridState of gsSelecting: begin if SelectActive then begin MoveExtend(False, Cur.x, Cur.y); SelectActive:=False; end; end; gsColMoving: begin //DebugLn('Move Col From ',Fsplitter.x,' to ', FMoveLast.x); if FMoveLast.X>=0 then begin MoveColRow(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 MoveColRow(False, Fsplitter.Y, FMoveLast.Y); Cursor:=crDefault; end else if Cur.Y=FSplitter.Y then HeaderClick(False, FSplitter.Y); end; gsColSizing: begin HeaderSized( True, FSplitter.X); end; gsRowSizing: begin HeaderSized( False, FSplitter.Y); end; end; fGridState:=gsNormal; {$IfDef dbgFocus}DebugLn('MouseUP END RND=',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 SonIguales(L1,L2: TList): boolean; var i: Integer; begin Result:=False; // store by default for i:=0 to L1.Count-1 do begin Result:=L1[i]=L2[i]; if not Result then break; end; end; function SonDefault(IsColumn: Boolean; L1: TList): boolean; var i: Integer; begin Result := True; for i:=0 to L1.Count-1 do begin if IsColumn then Result := Integer(L1[i]) = DefaultColWidth else Result := Integer(L1[i]) = DefaultRowHeight; if not Result then break; end; end; function NeedWidths: boolean; begin if Filer.Ancestor <> nil then Result := not SonIguales(TCustomGrid(Filer.Ancestor).FCols, FCols) else Result := not SonDefault(True, FCols); end; function NeedHeights: boolean; begin if Filer.Ancestor <> nil then Result := not SonIguales(TCustomGrid(Filer.Ancestor).FRows, FRows) else Result := not SonDefault(false, FRows); end; begin inherited DefineProperties(Filer); with Filer do begin DefineProperty('ColWidths', @ReadColWidths, @WriteColWidths, NeedWidths); DefineProperty('RowHeights', @ReadRowHeights, @WriteRowHeights, NeedHeights); end; end; procedure TCustomGrid.DestroyHandle; begin editorGetValue; inherited DestroyHandle; end; procedure TCustomGrid.doExit; begin if FEditorShowing then begin {$IfDef dbgFocus}DebugLn('DoExit - EditorShowing');{$Endif} end else begin {$IfDef dbgFocus}DebugLn('DoExit - Ext');{$Endif} Invalidate; end; inherited DoExit; end; procedure TCustomGrid.DoEnter; begin inherited DoEnter; if FEditorHiding then begin {$IfDef dbgFocus}DebugLn('DoEnter - EditorHiding');{$Endif} end else begin {$IfDef dbgFocus}DebugLn('DoEnter - Ext');{$Endif} if EditorShouldEdit then begin SelectEditor; if Feditor=nil then Invalidate else EditorShow; end else Invalidate; end; end; procedure TCustomGrid.KeyDown(var Key: Word; Shift: TShiftState); var Sh: Boolean; procedure MoveSel(Rel: Boolean; aCol,aRow: Integer); begin // Always reset Offset in kerboard Events FGCache.TLColOff:=0; FGCache.TLRowOff:=0; SelectActive:=Sh; MoveNextSelectable(Rel, aCol, aRow); Key:=0; end; var R: TRect; Relaxed: Boolean; //PF: TCustomForm; begin 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; 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; if Key=VK_RETURN then EditorSelectAll; Key:=0; end; VK_BACK: begin // Workaround: LM_CHAR doesnt trigger with BACKSPACE EditorShowChar(^H); key:=0; end; {$IfDef Dbg} else DebugLn(ClassName,'.KeyDown: ', Key); {$Endif} end; 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; { 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, False); 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.xnil) and not Editor.Visible then begin {$IfDef dbgFocus} DebugLn('EditorShow INIT FCol=',FCol,' FRow=',FRow);{$Endif} FEditorMode:=True; FEditorShowing:=True; ScrollToCell(FCol,FRow); EditorSetValue; Editor.Parent:=Self; Editor.Visible:=True; LCLIntf.SetFocus(Editor.Handle); InvalidateCell(FCol,FRow,True); FEditorShowing:=False; {$IfDef dbgFocus} DebugLn('EditorShow FIN');{$Endif} end; end; procedure TCustomGrid.EditorPos; var msg: TGridMessage; begin if FEditor<>nil then begin Msg.CellRect:=CellRect(FCol,FRow); if FEditorOptions and EO_AUTOSIZE = EO_AUTOSIZE then begin with Msg.CellRect do begin Right:=Right-Left; Bottom:=Bottom-Top; FEditor.SetBounds(Left, Top, Right, Bottom); end; end else begin Msg.MsgID:=GM_SETPOS; Msg.Grid:=Self; Msg.Col:=FCol; Msg.Row:=FRow; FEditor.Dispatch(Msg); end; end; end; procedure TCustomGrid.EditorSelectAll; var Msg: TGridMessage; begin if FEditor<>nil then if FEditorOptions and EO_SELECTALL = EO_SELECTALL then begin Msg.MsgID:=GM_SELECTALL; FEditor.Dispatch(Msg); end; end; procedure TCustomGrid.EditordoGetValue; begin // end; procedure TCustomGrid.EditordoSetValue; begin // end; procedure TCustomGrid.EditorExit(Sender: TObject); begin if not FEditorHiding then begin {$IfDef dbgFocus} DebugLn('EditorExit INIT');{$Endif} FEditorHiding:=True; EditorGetValue; if Editor<>nil then begin Editor.Visible:=False; Editor.Parent:=nil; //InvalidateCell(FCol,FRow, True); end; FEditorHiding:=False; {$IfDef dbgFocus} DebugLn('EditorExit FIN'); {$Endif} end; end; procedure TCustomGrid.EditorKeyDown(Sender: TObject; var Key:Word; Shift:TShiftState); begin FEditorKey:=True; // Just a flag to see from where the event comes case Key of VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT: begin if not(ssShift in Shift) then KeyDown(Key, Shift); end; VK_RETURN, VK_TAB: begin if (Key=VK_TAB) and not (goTabs in Options) then begin // let the focus go KeyDown(Key, Shift); //DebugLn('Editor KeyTab Pressed, Focus Should leave the grid'); Exit; end; Key:=0; case FAutoAdvance of aaRight: Key:=VK_RIGHT * Integer( FColFixedCols ); end; if Key=0 then begin EditorGetValue; EditorShow; // Select All ! end else KeyDown(Key, Shift); end; end; FEditorKey:=False; end; procedure TCustomGrid.SelectEditor; var aEditor: TWinControl; begin aEditor:= Editor; if (goEditing in Options) and Assigned(OnSelectEditor) then OnSelectEditor(Self, fCol,FRow, aEditor); if aEditor<>Editor then Editor:=aEditor; end; function TCustomGrid.EditorShouldEdit: Boolean; begin Result:=(goEditing in Options)and(goAlwaysShowEditor in Options); end; procedure TCustomGrid.EditorShowChar(Ch: Char); var msg: TGridMessage; begin SelectEditor; if FEditor<>nil then begin EditorShow; EditorSelectAll; //DebugLn('Posting editor LM_CHAR, ch=',ch, ' ', InttoStr(Ord(ch))); {$ifdef WIN32} PostMessage(FEditor.Handle, LM_CHAR, Word(Ch), 0); {$else} /// // Note. this is a workaround because the call above doesn't work /// 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); {$endif} end; end; procedure TCustomGrid.EditorSetMode(const AValue: Boolean); begin if not AValue then begin EditorHide; //SetFocus; end else begin EditorShow; end; 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; 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:=Integer(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:=Integer(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', 24); 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 MouseToGridZone(i,j,true)=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; 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); FFocusRectVisible := True; FDefaultDrawing := True; FOptions:= [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goSmoothScroll ]; FScrollbars:=ssAutoBoth; fGridState:=gsNormal; fDefColWidth:=64;//40; fDefRowHeight:=24;//18; fGridLineColor:=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; Color:=clWhite; FDefaultTextStyle := Canvas.TextStyle; end; destructor TCustomGrid.Destroy; begin {$Ifdef dbg}DebugLn('TCustomGrid.Destroy');{$Endif} FreeThenNil(FGCache.AccumWidth); FreeThenNil(FGCache.AccumHeight); FreeThenNil(FCols); FreeThenNil(FRows); 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 TStringCellEditor.WndProc(var TheMessage: TLMessage); begin DbgOut(Name+'.WndProc msg= '); case TheMessage.Msg of LM_SHOWWINDOW: DebugLn('LM_SHOWWINDOW'); LM_SETFOCUS: DebugLn('LM_SETFOCUS'); LM_PAINT: DebugLn('LM_PAINT'); LM_KEYUP: DebugLn('LM_KEYUP'); LM_WINDOWPOSCHANGED: DebugLn('LM_WINDOWPOSCHANGED'); LM_MOVE: DebugLn('LM_MOVE'); LM_KILLFOCUS: DebugLn('LM_KILLFOCUS'); CM_BASE..CM_MOUSEWHEEL: begin case TheMessage.Msg of CM_MOUSEENTER: DebugLn('CM_MOUSEENTER'); CM_MOUSELEAVE: DebugLn('CM_MOUSELEAVE'); CM_VISIBLECHANGED: DebugLn('CM_VISIBLECHANGED'); CM_TEXTCHANGED: DebugLn('CM_TEXTCHANGED'); CM_SHOWINGCHANGED: DebugLn('CM_SHOWINGCHANGED'); else DebugLn('CM_BASE + ',TheMessage.Msg-CM_BASE); end end; CN_BASE..CN_NOTIFY: begin DebugLn('CN_BASE + ',TheMessage.Msg-CN_BASE); end; else DebugLn(TheMessage.Msg,' (',IntToHex(TheMessage.Msg, 4),')'); end; inherited WndProc(TheMessage); end; } { TStringCellEditor } procedure TStringCellEditor.Change; begin inherited Change; if FGrid<>nil then FGrid.SetEditText(FGrid.Col, FGrid.Row, Text); end; procedure TStringCellEditor.KeyDown(var Key: Word; Shift: TShiftState); procedure doInherited; begin inherited keyDown(key, shift); key:=0; end; function AtStart: Boolean; begin Result:= (SelStart=0); end; function AtEnd: Boolean; begin Result:= (SelStart+1)>Length(Text); end; begin {$IfDef dbg} DebugLn('INI: Key=',Key,' SelStart=',SelStart,' SelLenght=',SelLength); {$Endif} { case Key of VK_LEFT: if AtStart then doInherited; VK_RIGHT: if AtEnd then doInherited; end; } if FGrid<>nil then begin Fgrid.EditorKeyDown(Self, Key, Shift); end; inherited keyDown(key, shift); {$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; 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; end; procedure TStringCellEditor.msg_SelectAll(var Msg: TGridMessage); begin SelectAll; end; { TDrawGrid } procedure TDrawGrid.CalcCellExtent(acol, aRow: Integer; var aRect: TRect); begin // end; procedure TDrawGrid.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 TDrawGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect); begin // Draw focused cell if we have the focus if Self.Focused Or (EditorShouldEdit and ((Feditor=nil) or not Feditor.Focused)) then begin Canvas.Pen.Color:=FFocusColor; Canvas.Pen.Style:=psDot; if goRowSelect in Options then begin Canvas.MoveTo(FGCache.FixedWidth+1, aRect.Top); Canvas.LineTo(FGCache.MaxClientXY.x-2, aRect.Top); Canvas.LineTo(FGCache.MaxClientXY.x-2, aRect.Bottom-2); Canvas.LineTo(FGCache.FixedWidth+1, aRect.Bottom-2); Canvas.LineTo(FGCache.FixedWidth+1, aRect.Top+1); end else begin Canvas.MoveTo(aRect.Left, aRect.Top); Canvas.LineTo(ARect.Right-2,aRect.Top); Canvas.LineTo(aRect.Right-2,aRect.bottom-2); Canvas.LineTo(aRect.Left, aRect.Bottom-2); Canvas.Lineto(aRect.left, aRect.top+1); end; Canvas.Pen.Style:=psSolid; end; end; procedure TDrawGrid.ColRowExchanged(IsColumn:Boolean; index, WithIndex: Integer); begin Fgrid.ExchangeColRow(IsColumn, index, WithIndex); if Assigned(OnColRowExchanged) then OnColRowExchanged(Self, IsColumn, index, WithIndex); end; procedure TDrawGrid.ColRowDeleted(IsColumn: Boolean; index: Integer); begin FGrid.DeleteColRow(IsColumn, index); if Assigned(OnColRowDeleted) then OnColRowDeleted(Self, IsColumn, index, index); end; procedure TDrawGrid.ColRowMoved(IsColumn: Boolean; FromIndex, ToIndex: Integer); begin FGrid.MoveColRow(IsColumn, FromIndex, ToIndex); if Assigned(OnColRowMoved) then OnColRowMoved(Self, IsColumn, FromIndex, toIndex); end; procedure TDrawGrid.HeaderClick(IsColumn: Boolean; index: Integer); begin inherited HeaderClick(IsColumn, index); if Assigned(OnHeaderClick) then OnHeaderClick(Self, IsColumn, index); end; procedure TDrawGrid.HeaderSized(IsColumn: Boolean; index: Integer); begin inherited HeaderSized(IsColumn, index); If Assigned(OnHeaderSized) then OnHeaderSized(Self, IsColumn, index); end; function TDrawGrid.GetEditMask(aCol, aRow: Longint): string; begin result:=''; if assigned(OnGetEditMask) then OnGetEditMask(self, aCol, aRow, Result); end; function TDrawGrid.GetEditText(aCol, aRow: Longint): string; begin result:=''; if assigned(OnGetEditText) then OnGetEditText(self, aCol, aRow, Result); end; procedure TDrawGrid.SetEditText(ACol, ARow: Longint; const Value: string); begin if Assigned(OnSetEditText) then OnSetEditText(Self, aCol, aRow, Value); end; procedure TDrawGrid.SizeChanged(OldColCount, OldRowCount: Integer); begin if OldColCount<>ColCount then fGrid.ColCount:=ColCOunt; if OldRowCount<>RowCount then fGrid.RowCount:=RowCount; end; function TDrawGrid.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 TDrawGrid.SetColor(Value: TColor); begin inherited SetColor(Value); Invalidate; end; function TDrawGrid.CreateVirtualGrid: TVirtualGrid; begin Result:=TVirtualGrid.Create; end; constructor TDrawGrid.Create(AOwner: TComponent); begin fGrid:=CreateVirtualGrid; //TVirtualGrid.Create; inherited Create(AOwner); end; destructor TDrawGrid.Destroy; begin {$Ifdef dbg}DebugLn('TDrawGrid.Destroy');{$Endif} //DebugLn('Font.Name',Font.Name); FreeThenNil(FGrid); inherited Destroy; end; procedure TDrawGrid.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; { TStringGrid } function TStringGrid.Getcells(aCol, aRow: Integer): string; var C: PCellProps; begin Result:=''; C:=FGrid.Celda[aCol,aRow]; if C<>nil then Result:=C^ .Text; end; function TStringGrid.GetCols(index: Integer): TStrings; var i: Integer; begin Result:=nil; if (ColCount>0)and(index>=0)and(indexnil then Result:=C^.Data; end; function TStringGrid.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)); InvalidateCell(aCol, aRow); 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; InvalidateCell(aCol, aRow); end; end; end; procedure TStringGrid.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 TStringGrid.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 TStringGrid.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 TStringGrid.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 TStringGrid.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 TStringGrid.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 TStringGrid.DefineProperties(Filer: TFiler); function NeedCells: boolean; var i,j: integer; AntGrid: TStringGrid; begin AntGrid := TStringGrid(Filer.Ancestor); //DebugLn('TStringGrid.DefineProperties: Ancestor=',Integer(AntGrid)); if AntGrid<>nil then begin result:=false; 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 result:=true; end; begin inherited DefineProperties(Filer); with Filer do begin DefineProperty('Cells', @ReadCells, @WriteCells, NeedCells); end; end; procedure TStringGrid.DrawCell(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); //var // ts: TTextStyle; begin inherited DrawCell(aCol, aRow, aRect, aState); if DefaultDrawing then begin Canvas.TextRect(aRect, 3, 0, Cells[aCol,aRow]); //MyTExtRect(aRect, 3, 0, Cells[aCol,aRow], Canvas.Textstyle.Clipping); end; end; procedure TStringGrid.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:=Cells[FCol,FRow]; // default value FEditor.Dispatch(Msg); SetEditText(FCol, FRow, msg.Value); //Cells[FCol,FRow]:=msg.Value; end; end; procedure TStringGrid.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 TStringGrid.GetEditText(aCol, aRow: Integer): string; begin Result:=Cells[aCol, aRow]; if Assigned(OnGetEditText) then OnGetEditText(Self, aCol, aRow, result); end; procedure TStringGrid.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 TStringGrid.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 TStringGrid.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 TStringGrid.SelectEditor; begin if goEditing in Options then Editor:=fDefEditor; inherited SelectEditor; end; procedure TStringGrid.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 TStringGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); if not (csDesigning in componentState) then begin FDefEditor:=TStringCellEditor.Create(nil); FDefEditor.Name:='Default_StringCellEditor'; FDefEditor.Text:=''; FDefEditor.Visible:=False; FDefEditor.Align:=alNone; end else begin FDefEditor:=nil; end; with DefaultTextStyle do begin Alignment := taLeftJustify; Layout := tlCenter; Clipping := True; //WordBreak := False end; end; destructor TStringGrid.Destroy; begin {$Ifdef dbg}DebugLn('TStringGrid.Destroy');{$Endif} if FdefEditor<>nil then begin FDefEDitor.Parent:=nil; FreeThenNil(FDefEditor); end; inherited Destroy; end; procedure TStringGrid.AutoSizeColumns; var i: Integer; begin for i:=0 to ColCount-1 do AutoAdjustColumn(i) end; procedure Register; begin RegisterComponents('Additional',[TStringGrid,TDrawGrid]); 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. - TDrawGrid attribute support was removed and added to a new TStringGrid 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 TDrawGrid (onCellAttr, DefaultCellAttr, FixedColor, etc.) FIXES -- FGrid in TDrawGrid 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 TStringGrid -- 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 TStringGrid 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 TStringGrid). 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. (TDrawGrid) soContent: Save & Load Text (TStringGrid) 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, TDrawGrid and TStringGrid 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. }