{*********************************************************} {* OVCTABLE.PAS 4.06 *} {*********************************************************} {* ***** BEGIN LICENSE BLOCK ***** *} {* Version: MPL 1.1 *} {* *} {* The contents of this file are subject to the Mozilla Public License *} {* Version 1.1 (the "License"); you may not use this file except in *} {* compliance with the License. You may obtain a copy of the License at *} {* http://www.mozilla.org/MPL/ *} {* *} {* Software distributed under the License is distributed on an "AS IS" basis, *} {* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *} {* for the specific language governing rights and limitations under the *} {* License. *} {* *} {* The Original Code is TurboPower Orpheus *} {* *} {* The Initial Developer of the Original Code is TurboPower Software *} {* *} {* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *} {* TurboPower Software Inc. All Rights Reserved. *} {* *} {* Contributor(s): *} {* *} {* ***** END LICENSE BLOCK ***** *} (*Changes) 10/20/01- Hdc changed to TOvcHdc for BCB Compatibility *) {$I OVC.INC} {$B-} {Complete Boolean Evaluation} {$I+} {Input/Output-Checking} {$P+} {Open Parameters} {$T-} {Typed @ Operator} {.W-} {Windows Stack Frame} {$X+} {Extended Syntax} unit ovctable; {Orpheus table definitions} interface uses SysUtils, Classes, {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF} Graphics, Controls, Forms, StdCtrls, Menus, Dialogs, OvcMisc, OvcData, OvcConst, OvcBase, OvcCmd, OvcTCmmn, OvcTCAry, OvcTSelL, OvcTCell, OvcTCHdr, OvcTGPns, OvcTbClr, OvcTbRws, OvcTbCls, OvcDrag; type TOvcCustomTable = class(TOvcTableAncestor) {-The custom class for tables} protected {private} {property fields - even size} FActiveCol : TColNum; {column of active cell} FActiveRow : TRowNum; {row of active cell} FBlockColBegin : TColNum; {start column for settings} FBlockColEnd : TColNum; {end column for settings} FBlockRowBegin : TRowNum; {start row for settings} FBlockRowEnd : TRowNum; {end row for settings} FCells : TOvcTableCells; {independent cells} FColors : TOvcTableColors; {table cell colors} FCols : TOvcTableColumns; {table column definitions} FGridPenSet : TOvcGridPenSet; {set of grid pens} FLeftCol : TColNum; {leftmost column} FLockedCols : TColNum; {number of locked columns} FLockedRows : TRowNum; {number of locked rows} FLockedRowsCell : TOvcBaseTableCell; {cell for column headings} FRows : TOvcTableRows; {table row definitions} FSelAnchorCol : TColNum; {selection: anchor column} FSelAnchorRow : TRowNum; {selection: anchor row} FTopRow : TRowNum; {topmost row} FColorUnused : TColor; {color of unused area} FOldRowColBehavior: Boolean; {property fields - odd size} FAccess : TOvcTblAccess; {default access mode for the table} FAdjust : TOvcTblAdjust; {default adjustment for the table} FBorderStyle : TBorderStyle; {border type around table} FOptions : TOvcTblOptionSet; {set of table options} FScrollBars : TScrollStyle; {scroll bar presence} Filler : byte; {$IFDEF LCL} FCtl3D : Boolean; {$ENDIF} {property event fields} FActiveCellChanged : TCellNotifyEvent; {active cell changed event} FActiveCellMoving : TCellMoveNotifyEvent; {active cell moving event} FBeginEdit : TCellBeginEditNotifyEvent;{active cell about to be edited} FClipboardCopy : TNotifyEvent; {copy to clipboard requested} FClipboardCut : TNotifyEvent; {cut to clipboard requested} FClipboardPaste : TNotifyEvent; {paste from clipboard requested} FColumnsChanged : TColChangeNotifyEvent; {column insert/delete/exchange} FDoneEdit : TCellNotifyEvent; {active cell has been edited} FEndEdit : TCellEndEditNotifyEvent;{active cell about to be stopped being edited} FEnteringColumn : TColNotifyEvent; {entering column event} FEnteringRow : TRowNotifyEvent; {entering row event} FGetCellData : TCellDataNotifyEvent; {get cell data event} FGetCellAttributes : TCellAttrNotifyEvent; {get cell attributes event} FLeavingColumn : TColNotifyEvent; {leaving column event} FLeavingRow : TRowNotifyEvent; {leaving row event} FLockedCellClick : TCellNotifyEvent; {locked cell clicked event} FPaintUnusedArea : TNotifyEvent; {unused bit needs painting event} FRowsChanged : TRowChangeNotifyEvent; {row insert/delete/exchange} FSizeCellEditor : TSizeCellEditorNotifyEvent;{sizing of cell editor} FTopLeftCellChanged : TCellNotifyEvent; {top left cell change event} FTopLeftCellChanging: TCellChangeNotifyEvent; {top left cell moving event} FUserCommand : TUserCommandEvent; {user command event} FOnResizeColumn : TColResizeEvent; FOnResizeRow : TRowResizeEvent; {other fields - even size} tbColNums : POvcTblDisplayArray; {displayed column numbers} tbRowNums : POvcTblDisplayArray; {displayed row numbers} tbRowsOnLastPage : TRowNum; {number of complete rows on last page} tbLastTopRow : TRowNum; {the last row number that can be top} tbColsOnLastPage : TColNum; {num of complete columns on rightmost page} tbLastLeftCol : TColNum; {the last column number that can be leftmost} tbLockCount : integer; {the lock display count} tbCmdTable : PString; {the command table name for the grid} tbState : TOvcTblStates; {the state of the table} tbSizeOffset : integer; {the offset of the sizing line} tbSizeIndex : integer; {the index of the sized row/col} tbMoveIndex : integer; {the index of the column being moved} tbMoveIndexTo : integer; {the index of the column being targeted by move} tbLastEntRow : TRowNum; {last row that was entered} tbLastEntCol : TColNum; {last column that was entered} tbActCell : TOvcBaseTableCell; {the active cell object} tbInvCells : TOvcCellArray; {cells that need repainting} tbSelList : TOvcSelectionList; {list of selected cells} tbCellAttrFont : TFont; {cached font for painting cells} tbColMoveCursor : HCursor; {cursor for column moves} tbRowMoveCursor : HCursor; {cursor for row moves} tbHSBarPosCount : integer; {number of positions for horz scrollbar} tbDrag : TOvcDragShow; {other fields - odd size} tbHasHSBar : boolean; {true if horiz scroll bar present} tbHasVSBar : boolean; {true if vert scroll bar present} tbUpdateSBs : boolean; {true if the scroll bars must be updated} tbIsSelecting : boolean; {is in mouse selection mode} tbIsDeselecting : boolean; {is in mouse deselection mode} tbIsKeySelecting : boolean; {is in key selection mode} tbMustUpdate : boolean; {scrolling has left an invalid region} tbMustFinishLoading : boolean; {finish loading data in CreateWnd} ProcessingVScrollMessage: Boolean;{Internal flag} protected {property read routines} function GetAllowRedraw : boolean; function GetColCount : TColNum; function GetColOffset(ColNum : TColNum) : integer; function GetRowLimit : TRowNum; function GetRowOffset(RowNum : TRowNum) : integer; {property write routines} procedure SetAccess(A : TOvcTblAccess); procedure SetActiveCol(ColNum : TColNum); procedure SetActiveRow(RowNum : TRowNum); procedure SetAdjust(A : TOvcTblAdjust); procedure SetAllowRedraw(AR : boolean); procedure SetBorderStyle(const BS : TBorderStyle); procedure SetBlockAccess(A : TOvcTblAccess); procedure SetBlockAdjust(A : TOvcTblAdjust); procedure SetBlockCell(C : TOvcBaseTableCell); procedure SetBlockColBegin(ColNum : TColNum); procedure SetBlockColEnd(ColNum : TColNum); procedure SetBlockColor(C : TColor); procedure SetBlockFont(F : TFont); procedure SetBlockRowBegin(RowNum : TRowNum); procedure SetBlockRowEnd(RowNum : TRowNum); procedure SetColors(C : TOvcTableColors); procedure SetColCount(CC : integer); procedure SetCols(CS : TOvcTableColumns); procedure SetLeftCol(ColNum : TColNum); procedure SetLockedCols(ColNum : TColNum); procedure SetLockedRows(RowNum : TRowNum); procedure SetLockedRowsCell(C : TOvcBaseTableCell); procedure SetOptions(O : TOvcTblOptionSet); procedure SetPaintUnusedArea(PUA : TNotifyEvent); procedure SetRowLimit(RowNum : TRowNum); procedure SetRows(RS : TOvcTableRows); procedure SetScrollBars(const SB : TScrollStyle); procedure SetTopRow(RowNum : TRowNum); procedure SetColorUnused(CU : TColor); {overridden Delphi VCL methods} procedure ChangeScale(M, D : integer); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; {general methods} function tbCalcActiveCellRect(var ACR : TRect) : boolean; function tbCalcCellsFromRect(const UR : TRect; var GR : TRect) : integer; procedure tbCalcColData(var CD : POvcTblDisplayArray; NewLeftCol : TColNum); procedure tbCalcColsOnLastPage; procedure tbCalcHSBarPosCount; function tbCalcRequiresVSBar : boolean; procedure tbCalcRowData(var RD : POvcTblDisplayArray; NewTopRow : TRowNum); procedure tbCalcRowsOnLastPage; procedure tbDrawActiveCell; procedure tbDrawCells(RowInxStart, RowInxEnd : integer; ColInxStart, ColInxEnd : integer); procedure tbDrawInvalidCells(InvCells : TOvcCellArray); procedure tbDrawMoveLine; procedure tbDrawRow(RowInx : integer; ColInxStart, ColInxEnd : integer); procedure tbDrawSizeLine; procedure tbDrawUnusedBit; { - HWnd changed to TOvcHWnd for BCB Compatibility } function tbEditCellHasFocus(FocusHandle : TOvcHWnd{HWND}) : boolean; procedure tbEnsureColumnIsVisible(ColNum : TColNum); procedure tbEnsureRowIsVisible(RowNum : TRowNum); function tbFindCell(RowNum : TRowNum; ColNum : TColNum) : TOvcBaseTableCell; function tbFindColInx(ColNum : TColNum) : integer; function tbFindRowInx(RowNum : TRowNum) : integer; function tbIsOnGridLine(MouseX, MouseY : integer; var VerticalGrid : boolean) : boolean; function tbIsInMoveArea(MouseX, MouseY : integer; var IsColMove : boolean) : boolean; procedure tbSetActiveCellWithSel(RowNum : TRowNum; ColNum : TColNum); procedure tbSetActiveCellPrim(RowNum : TRowNum; ColNum : TColNum); {selection methods} procedure tbDeselectAll(CA : TOvcCellArray); function tbDeselectAllIterator(RowNum1 : TRowNum; ColNum1 : TColNum; RowNum2 : TRowNum; ColNum2 : TColNum; ExtraData : pointer) : boolean; procedure tbSelectCol(ColNum : TColNum); procedure tbSelectRow(RowNum : TRowNum); procedure tbSelectTable; procedure tbSetAnchorCell(RowNum : TRowNum; ColNum : TColNum; Action : TOvcTblSelectionType); procedure tbUpdateSelection(RowNum : TRowNum; ColNum : TColNum; Action : TOvcTblSelectionType); {notification procedures} procedure DoActiveCellChanged(RowNum : TRowNum; ColNum : TColNum); virtual; procedure DoActiveCellMoving(Command : word; var RowNum : TRowNum; var ColNum : TColNum); virtual; procedure DoBeginEdit(RowNum : TRowNum; ColNum : TColNum; var AllowIt : boolean); virtual; procedure DoClipboardCopy; virtual; procedure DoClipboardCut; virtual; procedure DoClipboardPaste; virtual; procedure DoColumnsChanged(ColNum1, ColNum2 : TColNum; Action : TOvcTblActions); virtual; procedure DoDoneEdit(RowNum : TRowNum; ColNum : TColNum); virtual; procedure DoEndEdit(Cell : TOvcBaseTableCell; RowNum : TRowNum; ColNum : TColNum; var AllowIt : boolean); virtual; procedure DoEnteringColumn(ColNum : TColNum); virtual; procedure DoEnteringRow(RowNum : TRowNum); virtual; procedure DoGetCellAttributes(RowNum : TRowNum; ColNum : TColNum; var CellAttr : TOvcCellAttributes); virtual; procedure DoGetCellData(RowNum : TRowNum; ColNum : TColNum; var Data : pointer; Purpose : TOvcCellDataPurpose); virtual; procedure DoLeavingColumn(ColNum : TColNum); virtual; procedure DoLeavingRow(RowNum : TRowNum); virtual; procedure DoLockedCellClick(RowNum : TRowNum; ColNum : TColNum); virtual; procedure DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt); override; procedure DoPaintUnusedArea; virtual; procedure DoRowsChanged(RowNum1, RowNum2 : TRowNum; Action : TOvcTblActions); virtual; procedure DoSizeCellEditor(RowNum : TRowNum; ColNum : TColNum; var CellRect : TRect; var CellStyle: TOvcTblEditorStyle); virtual; procedure DoTopLeftCellChanged(RowNum : TRowNum; ColNum : TColNum); virtual; procedure DoTopLeftCellChanging(var RowNum : TRowNum; var ColNum : TColNum); virtual; procedure DoUserCommand(Cmd : word); virtual; {row/col data retrieval} function tbIsColHidden(ColNum : TColNum) : boolean; function tbIsRowHidden(RowNum : TRowNum) : boolean; procedure tbQueryColData(ColNum : TColNum; var W : integer; var A : TOvcTblAccess; var H : boolean); procedure tbQueryRowData(RowNum : TRowNum; var Ht: integer; var H : boolean); {invalidation} procedure tbInvalidateColHdgPrim(ColNum : TColNum; InvCells : TOvcCellArray); procedure tbInvalidateRowHdgPrim(RowNum : TRowNum; InvCells : TOvcCellArray); {scrollbar stuff} procedure tbSetScrollPos(SB : TOvcScrollBar); procedure tbSetScrollRange(SB : TOvcScrollBar); {active cell movement} procedure tbMoveActCellBotOfPage; procedure tbMoveActCellBotRight; procedure tbMoveActCellDown; procedure tbMoveActCellFirstCol; procedure tbMoveActCellFirstRow; procedure tbMoveActCellLastCol; procedure tbMoveActCellLastRow; procedure tbMoveActCellLeft; procedure tbMoveActCellPageDown; procedure tbMoveActCellPageLeft; procedure tbMoveActCellPageRight; procedure tbMoveActCellPageUp; procedure tbMoveActCellRight; procedure tbMoveActCellTopLeft; procedure tbMoveActCellTopOfPage; procedure tbMoveActCellUp; {scrollbar scrolling routine} procedure tbScrollBarDown; procedure tbScrollBarLeft; procedure tbScrollBarPageDown; procedure tbScrollBarPageLeft; procedure tbScrollBarPageRight; procedure tbScrollBarPageUp; procedure tbScrollBarRight; procedure tbScrollBarUp; {table scrolling routines} procedure tbScrollTableLeft(NewLeftCol : TColNum); procedure tbScrollTableRight(NewLeftCol : TColNum); procedure tbScrollTableUp(NewTopRow : TRowNum); procedure tbScrollTableDown(NewTopRow : TRowNum); {notifications} procedure tbCellChanged(Sender : TObject); override; procedure tbColChanged(Sender : TObject; ColNum1, ColNum2 : TColNum; Action : TOvcTblActions); procedure tbGridPenChanged(Sender : TObject); procedure tbRowChanged(Sender : TObject; RowNum1, RowNum2 : TRowNum; Action : TOvcTblActions); procedure tbColorsChanged(Sender : TObject); {streaming routines} procedure DefineProperties(Filer : TFiler); override; procedure tbFinishLoadingDefaultCells; procedure tbReadColData(Reader : TReader); procedure tbReadRowData(Reader : TReader); procedure tbWriteColData(Writer : TWriter); procedure tbWriteRowData(Writer : TWriter); {Cell-Table interaction messages} procedure ctimLoadDefaultCells(var Msg : TMessage); message ctim_LoadDefaultCells; procedure ctimQueryOptions(var Msg : TMessage); message ctim_QueryOptions; procedure ctimQueryColor(var Msg : TMessage); message ctim_QueryColor; procedure ctimQueryFont(var Msg : TMessage); message ctim_QueryFont; procedure ctimQueryLockedCols(var Msg : TMessage); message ctim_QueryLockedCols; procedure ctimQueryLockedRows(var Msg : TMessage); message ctim_QueryLockedRows; procedure ctimQueryActiveCol(var Msg : TMessage); message ctim_QueryActiveCol; procedure ctimQueryActiveRow(var Msg : TMessage); message ctim_QueryActiveRow; procedure ctimRemoveCell(var Msg : TMessage); message ctim_RemoveCell; procedure ctimStartEdit(var Msg : TMessage); message ctim_StartEdit; procedure ctimStartEditMouse(var Msg : TWMMouse); message ctim_StartEditMouse; procedure ctimStartEditKey(var Msg : TWMKey); message ctim_StartEditKey; {Delphi component messages} procedure CMColorChanged(var Msg : TMessage); message CM_COLORCHANGED; {$IFNDEF LCL} procedure CMCtl3DChanged(var Msg : TMessage); message CM_CTL3DCHANGED; {$ENDIF} procedure CMDesignHitTest(var Msg : TCMDesignHitTest); message CM_DESIGNHITTEST; procedure CMFontChanged(var Msg : TMessage); message CM_FONTCHANGED; {Windows messages} procedure WMCancelMode(var Msg : TMessage); message WM_CANCELMODE; procedure WMEraseBkGnd(var Msg : TWMEraseBkGnd); message WM_ERASEBKGND; procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE; procedure WMHScroll(var Msg : TWMScroll); message WM_HSCROLL; procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN; procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS; procedure WMLButtonDblClk(var Msg : TWMMouse); message WM_LBUTTONDBLCLK; procedure WMLButtonDown(var Msg : TWMMouse); message WM_LBUTTONDOWN; procedure WMLButtonUp(var Msg : TWMMouse); message WM_LBUTTONUP; procedure WMMouseMove(var Msg : TWMMouse); message WM_MOUSEMOVE; procedure WMNCHitTest(var Msg : TMessage); message WM_NCHITTEST; procedure WMSetCursor(var Msg : TWMSetCursor); message WM_SETCURSOR; procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS; procedure WMVScroll(var Msg : TWMScroll); message WM_VSCROLL; {unpublishable or should not be published properties} property AllowRedraw : boolean read GetAllowRedraw write SetAllowRedraw stored false; property BlockAccess : TOvcTblAccess write SetBlockAccess; property BlockAdjust : TOvcTblAdjust write SetBlockAdjust; property BlockColBegin : TColNum read FBlockColBegin write SetBlockColBegin; property BlockColEnd : TColNum read FBlockColEnd write SetBlockColEnd; property BlockColor : TColor write SetBlockColor; property BlockCell : TOvcBaseTableCell write SetBlockCell; property BlockFont : TFont write SetBlockFont; property BlockRowBegin : TRowNum read FBlockRowBegin write SetBlockRowBegin; property BlockRowEnd : TRowNum read FBlockRowEnd write SetBlockRowEnd; property ColOffset [ColNum : TColNum] : integer read GetColOffset; property RowOffset [RowNum : TRowNum] : integer read GetRowOffset; property TableState : TOvcTblStates read tbState; {publishable properties} property Access : TOvcTblAccess read FAccess write SetAccess; property ActiveCol : TColNum read FActiveCol write SetActiveCol; property ActiveRow : TRowNum read FActiveRow write SetActiveRow; property Adjust : TOvcTblAdjust read FAdjust write SetAdjust; property BorderStyle : TBorderStyle read FBorderStyle write SetBorderStyle; property ColCount : TColNum read GetColCount write SetColCount; property Colors : TOvcTableColors read FColors write SetColors; property ColorUnused : TColor read FColorUnused write SetColorUnused; property Columns : TOvcTableColumns read FCols write SetCols; property GridPenSet : TOvcGridPenSet read FGridPenSet write FGridPenSet; property LeftCol : TColNum read FLeftCol write SetLeftCol; property LockedCols : TColNum read FLockedCols write SetLockedCols; property LockedRows : TRowNum read FLockedRows write SetLockedRows; property LockedRowsCell : TOvcBaseTableCell read FLockedRowsCell write SetLockedRowsCell; property OldRowColBehavior : Boolean read FOldRowColBehavior write FOldRowColBehavior; property Options : TOvcTblOptionSet read FOptions write SetOptions; property RowLimit : TRowNum read GetRowLimit write SetRowLimit; property Rows : TOvcTableRows read FRows write SetRows; property ScrollBars : TScrollStyle read FScrollBars write SetScrollBars; property TopRow : TRowNum read FTopRow write SetTopRow; {$IFDEF LCL} property Ctl3D : Boolean read FCtl3D write FCtl3D default True; {$ENDIF} {New events} property OnActiveCellChanged : TCellNotifyEvent read FActiveCellChanged write FActiveCellChanged; property OnActiveCellMoving : TCellMoveNotifyEvent read FActiveCellMoving write FActiveCellMoving; property OnBeginEdit : TCellBeginEditNotifyEvent read FBeginEdit write FBeginEdit; property OnClipboardCopy : TNotifyEvent read FClipboardCopy write FClipboardCopy; property OnClipboardCut : TNotifyEvent read FClipboardCut write FClipboardCut; property OnClipboardPaste : TNotifyEvent read FClipboardPaste write FClipboardPaste; property OnColumnsChanged : TColChangeNotifyEvent read FColumnsChanged write FColumnsChanged; property OnDoneEdit : TCellNotifyEvent read FDoneEdit write FDoneEdit; property OnEndEdit : TCellEndEditNotifyEvent read FEndEdit write FEndEdit; property OnEnteringColumn : TColNotifyEvent read FEnteringColumn write FEnteringColumn; property OnEnteringRow : TRowNotifyEvent read FEnteringRow write FEnteringRow; property OnGetCellData : TCellDataNotifyEvent read FGetCellData write FGetCellData; property OnGetCellAttributes : TCellAttrNotifyEvent read FGetCellAttributes write FGetCellAttributes; property OnLeavingColumn : TColNotifyEvent read FLeavingColumn write FLeavingColumn; property OnLeavingRow : TRowNotifyEvent read FLeavingRow write FLeavingRow; property OnLockedCellClick : TCellNotifyEvent read FLockedCellClick write FLockedCellClick; property OnPaintUnusedArea : TNotifyEvent read FPaintUnusedArea write SetPaintUnusedArea; property OnResizeColumn : TColResizeEvent read FOnResizeColumn write FOnResizeColumn; property OnResizeRow : TRowResizeEvent read FOnResizeRow write FOnResizeRow; property OnRowsChanged : TRowChangeNotifyEvent read FRowsChanged write FRowsChanged; property OnSizeCellEditor : TSizeCellEditorNotifyEvent read FSizeCellEditor write FSizeCellEditor; property OnTopLeftCellChanged : TCellNotifyEvent read FTopLeftCellChanged write FTopLeftCellChanged; property OnTopLeftCellChanging : TCellChangeNotifyEvent read FTopLeftCellChanging write FTopLeftCellChanging; property OnUserCommand : TUserCommandEvent read FUserCommand write FUserCommand; public {overridden methods} constructor Create(AOwner : TComponent); override; destructor Destroy; override; procedure CreateParams(var Params : TCreateParams); override; procedure CreateWnd; override; procedure Loaded; override; procedure Paint; override; {$IFNDEF LCL} procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override; {$ELSE} procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override; {$ENDIF} {new public methods} function CalcRowColFromXY(X, Y : integer; var RowNum : TRowNum; var ColNum : TColNum) : TOvcTblRegion; function FilterKey(var Msg : TWMKey) : TOvcTblKeyNeeds; override; procedure GetDisplayedColNums(var NA : TOvcTableNumberArray); procedure GetDisplayedRowNums(var NA : TOvcTableNumberArray); procedure ResolveCellAttributes(RowNum : TRowNum; ColNum : TColNum; var CellAttr : TOvcCellAttributes); override; {methods for setting cells, faster than setting row/col properties} procedure SetActiveCell(RowNum : TRowNum; ColNum : TColNum); procedure SetTopLeftCell(RowNum : TRowNum; ColNum : TColNum); {methods for calculating next/prev row/col numbers for main area} function IncCol(ColNum : TColNum; Direction : integer) : TColNum; function IncRow(RowNum : TRowNum; Direction : integer) : TRowNum; {methods for invalidating cells to force a redraw} procedure InvalidateCell(RowNum : TRowNum; ColNum : TColNum); procedure InvalidateColumn(ColNum : TColNum); procedure InvalidateRow(RowNum : TRowNum); procedure InvalidateTable; procedure InvalidateCellsInRect(const R : TRect); procedure InvalidateColumnHeading(ColNum : TColNum); procedure InvalidateRowHeading(RowNum : TRowNum); procedure InvalidateTableNotLockedCols; procedure InvalidateTableNotLockedRows; {selection methods} function HaveSelection : boolean; function InSelection(RowNum : TRowNum; ColNum : TColNum) : boolean; procedure IterateSelections(SI : TSelectionIterator; ExtraData : pointer); {editing state method} function InEditingState : boolean; function SaveEditedData : boolean; function StartEditingState : boolean; function StopEditingState(SaveValue : boolean) : boolean; {scrollbar scrolling routine} procedure ProcessScrollBarClick(ScrollBar : TOvcScrollBar; ScrollCode : TScrollCode); virtual; {active cell movement routine} procedure MoveActiveCell(Command : word); virtual; {public property} property Cells : TOvcTableCells read FCells; end; TOvcTable = class(TOvcCustomTable) public property AllowRedraw; property BlockAccess; property BlockAdjust; property BlockColBegin; property BlockColEnd; property BlockColor; property BlockCell; property BlockFont; property BlockRowBegin; property BlockRowEnd; property Canvas; property ColOffset; property RowOffset; property TableState; published {Properties} property LockedRows default 1; property TopRow default 1; property ActiveRow default 1; property RowLimit default 10; property LockedCols default 1; property LeftCol default 1; property ActiveCol default 1; property OldRowColBehavior default false; {$IFDEF VERSION4} property Anchors; property Constraints; property DragKind; {$ENDIF} property Access default otxNormal; property Adjust default otaCenterLeft; property Align; property BorderStyle default bsSingle; property ColCount stored False; property Color default tbDefTableColor; property ColorUnused default clWindow; property Colors; property Columns; property Controller; property Ctl3D; property DragCursor; property DragMode; property Enabled; property Font; property GridPenSet; property LockedRowsCell; property Options default []; property ParentColor default False; {$IFNDEF LCL} property ParentCtl3D; {$ENDIF} property ParentFont; property ParentShowHint; property PopupMenu; property Rows; property ScrollBars default ssBoth; property ShowHint; property TabOrder; property TabStop default True; property Visible; {Events} property OnActiveCellChanged; property OnActiveCellMoving; property OnBeginEdit; property OnClipboardCopy; property OnClipboardCut; property OnClipboardPaste; property OnColumnsChanged; property OnDblClick; property OnDoneEdit; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEndEdit; property OnEnter; property OnEnteringColumn; property OnEnteringRow; property OnExit; property OnGetCellData; property OnGetCellAttributes; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnLeavingColumn; property OnLeavingRow; property OnLockedCellClick; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnPaintUnusedArea; property OnResizeColumn; property OnResizeRow; property OnRowsChanged; property OnSizeCellEditor; property OnTopLeftCellChanged; property OnTopLeftCellChanging; property OnUserCommand; end; implementation {===== Local Routines ================================================} function NewString(const S: string): PString; begin New(Result); Result^ := S; end; procedure DisposeString(P: PString); begin if (P <> nil) and (P^ <> '') then Dispose(P); end; {===== TOvcTable creation and destruction ============================} constructor TOvcCustomTable.Create(AOwner : TComponent); begin inherited Create(AOwner); ProcessingVScrollMessage := false; tbState := [otsNormal]; if NewStyleControls then ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csDoubleClicks] else ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csDoubleClicks, csFramed]; Height := tbDefHeight; Width := tbDefWidth; FColorUnused := clWindow; ParentColor := false; Color := tbDefTableColor; TabStop := true; FGridPenSet := TOvcGridPenSet.Create; FGridPenSet.OnCfgChanged := tbGridPenChanged; FColors := TOvcTableColors.Create; FColors.OnCfgChanged := tbColorsChanged; FCols := TOvcTableColumns.Create(Self, tbDefColCount, TOvcTableColumn); FCols.OnColumnChanged := tbColChanged; FCols.Table := Self; FCells := TOvcTableCells.Create(Self); FCells.OnCfgChanged := tbCellChanged; FCells.Table := Self; tbInvCells := TOvcCellArray.Create; FRows := TOvcTableRows.Create; RowLimit := tbDefRowCount; FRows.OnCfgChanged := tbRowChanged; FBorderStyle := tbDefBorderStyle; FScrollBars := tbDefScrollBars; FAccess := tbDefAccess; FAdjust := tbDefAdjust; tbCellAttrFont := TFont.Create; FActiveCol := tbDefLockedCols; FLockedCols := tbDefLockedCols; FLeftCol := tbDefLockedCols; FSelAnchorCol := tbDefLockedCols; FActiveRow := tbDefLockedRows; FLockedRows := tbDefLockedRows; FTopRow := tbDefLockedRows; FSelAnchorRow := tbDefLockedRows; {$IFDEF LCL} FCtl3D := True; {$ENDIF} {$IFNDEF LCL} tbColMoveCursor := LoadBaseCursor('ORCOLUMNMOVECURSOR'); tbRowMoveCursor := LoadBaseCursor('ORROWMOVECURSOR'); {$ELSE} {$IFDEF MSWINDOWS} //Has never worked, plus crashes Carbon, so leave out for now. tbColMoveCursor := LoadCursorFromLazarusResource('ORCOLUMNMOVECURSOR'); tbRowMoveCursor := LoadCursorFromLazarusResource('ORROWMOVECURSOR'); {$ENDIF} {$ENDIF} tbSelList := TOvcSelectionList.Create(tbDefRowCount, tbDefColCount); tbLastEntRow := -1; tbLastEntCol := -1; tbCmdTable := NewString(GetOrphStr(SCGridTableName)); AssignDisplayArray(tbColNums, succ(tbDefColCount)); AssignDisplayArray(tbRowNums, succ(tbDefRowCount)); if csDesigning in ComponentState then tbState := tbState + [otsDesigning] else tbState := tbState + [otsUnfocused]; tbMustFinishLoading := true; end; {--------} destructor TOvcCustomTable.Destroy; begin if not (csDestroying in ComponentState) then Destroying; FCols.Free; FCells.Free; FRows.Free; tbInvCells.Free; tbSelList.Free; tbCellAttrFont.Free; if Assigned(tbColNums) then AssignDisplayArray(tbColNums, 0); if Assigned(tbRowNums) then AssignDisplayArray(tbRowNums, 0); DisposeString(tbCmdTable); GridPenSet.Free; FColors.Free; inherited Destroy; end; {--------} procedure TOvcCustomTable.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do Style := LongInt(Style) or OvcData.ScrollBarStyles[FScrollBars] or OvcData.BorderStyles[FBorderStyle]; if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin Params.Style := Params.Style and not WS_BORDER; Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE; end; {$IFDEF LCL} inherited SetBorderStyle(FBorderStyle); {$ENDIF} end; {--------} procedure TOvcCustomTable.CreateWnd; begin inherited CreateWnd; {post a message to ourselves to finish loading the cells} {--the reason for this is that cell components _may_ be } { on a data module: we must wait until all data modules} { have been created, otherwise we may not pick up some } { cell references (Delphi 2 does not guarantee any } { particular order for form/data module creation). } PostMessage(Handle, ctim_LoadDefaultCells, 0, 0); tbLockCount := 0; tbHasHSBar := false; tbHasVSBar := false; if (FScrollBars = ssBoth) or (FScrollBars = ssHorizontal) then tbHasHSBar := true; if (FScrollBars = ssBoth) or (FScrollBars = ssVertical) then tbHasVSBar := true; tbCalcColData(tbColNums, LeftCol); tbCalcRowData(tbRowNums, TopRow); {make sure the column/row properties are valid} LeftCol := LeftCol; TopRow := TopRow; ActiveCol := ActiveCol; ActiveRow := ActiveRow; FSelAnchorCol := ActiveCol; FSelAnchorRow := ActiveRow; {Set up the scrollbars} tbSetScrollRange(otsbHorizontal); tbSetScrollPos(otsbHorizontal); tbSetScrollRange(otsbVertical); tbSetScrollPos(otsbVertical); {Must trigger the active cell and topleft cell change events} DoTopLeftCellChanged(TopRow, LeftCol); DoActiveCellChanged(ActiveRow, ActiveCol); if not (otsDesigning in tbState) and (otoAlwaysEditing in Options) then PostMessage(Handle, ctim_StartEdit, 0, 0); end; {--------} procedure TOvcCustomTable.Loaded; begin inherited Loaded; end; {==TOvcTable property streaming routines=============================} procedure TOvcCustomTable.DefineProperties(Filer : TFiler); begin inherited DefineProperties(Filer); with Filer do begin DefineProperty('RowData', tbReadRowData, tbWriteRowData, true); DefineProperty('ColData', tbReadColData, tbWriteColData, true); end; end; {--------} procedure TOvcCustomTable.tbFinishLoadingDefaultCells; var i : integer; begin FCols.tcStopLoading; {if our cell list is empty refresh it now} if (taCellList.Count = 0) then begin if Assigned(FLockedRowsCell) then tbIncludeCell(FLockedRowsCell); for i := 0 to pred(FCols.Count) do tbIncludeCell(FCols.DefaultCell[i]); {we don't have to do the Cells matrix: no design time support} end; end; {--------} procedure TOvcCustomTable.tbReadColData(Reader : TReader); var ColObj : TOvcTableColumn; Fixups : TStringList; begin AllowRedraw := false; with Reader do begin ReadListBegin; FCols.Clear; Fixups := FCols.tcStartLoading; while not EndOfList do begin ColObj := TOvcTableColumn.Create(Self); ColObj.Width := Readinteger; ColObj.Hidden := ReadBoolean; if ReadBoolean then Fixups.AddObject(ReadString, ColObj); FCols.Append(ColObj); end; ReadListEnd; end; AllowRedraw := true; end; {--------} procedure TOvcCustomTable.tbReadRowData(Reader : TReader); var RowNum : TRowNum; RS : TRowStyle; begin with Reader do begin ReadListBegin; FRows.Clear; FRows.DefaultHeight := Readinteger; while not EndOfList do begin RowNum := Readinteger; RS.Hidden := ReadBoolean; RS.Height := Readinteger; FRows[RowNum] := RS; end; ReadListEnd; end; end; {--------} procedure TOvcCustomTable.tbWriteColData(Writer : TWriter); var ColNum : TColNum; S : string; begin if tbMustFinishLoading then begin tbFinishLoadingCellList; tbFinishLoadingDefaultCells; tbMustFinishLoading := false; end; with Writer do begin WriteListBegin; for ColNum := 0 to pred(ColCount) do with FCols[ColNum] do begin WriteInteger(Width); WriteBoolean(Hidden); if (DefaultCell <> nil) then begin WriteBoolean(true); S := DefaultCell.Owner.Name; if (S <> '') then S := S + '.' + DefaultCell.Name else S := DefaultCell.Name; WriteString(S); end else WriteBoolean(false); end; WriteListEnd; end; end; {--------} procedure TOvcCustomTable.tbWriteRowData(Writer : TWriter); var RowNum : TRowNum; RS : TRowStyle; begin with Writer do begin WriteListBegin; Writeinteger(FRows.DefaultHeight); for RowNum := 0 to pred(FRows.Limit) do if FRows.RowIsSpecial[RowNum] then begin Writeinteger(RowNum); RS := FRows[RowNum]; WriteBoolean(RS.Hidden); Writeinteger(RS.Height); end; WriteListEnd; end; end; {====================================================================} {==TOvcTable property read routines==================================} function TOvcCustomTable.GetAllowRedraw : boolean; begin Result := (tbLockCount = 0); end; {--------} function TOvcCustomTable.GetColCount : TColNum; begin Result := FCols.Count; end; {--------} function TOvcCustomTable.GetColOffset(ColNum : TColNum) : integer; var ColInx : integer; begin ColInx := tbFindColInx(ColNum); if (ColInx <> -1) then Result := tbColNums^.Ay[ColInx].Offset else Result := -1; end; {--------} function TOvcCustomTable.GetRowLimit : TRowNum; begin Result := FRows.Limit; end; {--------} function TOvcCustomTable.GetRowOffset(RowNum : TRowNum) : integer; var RowInx : integer; begin RowInx := tbFindRowInx(RowNum); if (RowInx <> -1) then Result := tbRowNums^.Ay[RowInx].Offset else Result := -1; end; {--------} procedure TOvcCustomTable.ResolveCellAttributes(RowNum : TRowNum; ColNum : TColNum; var CellAttr : TOvcCellAttributes); var TempAccess : TOvcTblAccess; TempAdjust : TOvcTblAdjust; TempColor : TColor; TempFontColor : TColor; TempSparseAttr: TOvcSparseAttr; begin FCells.ResolveFullAttr(RowNum, ColNum, TempSparseAttr); with CellAttr do begin {calculate the access rights} TempAccess := TempSparseAttr.scaAccess; if (TempAccess = otxDefault) then begin TempAccess := caAccess; if (TempAccess = otxDefault) then TempAccess := Access; end; caAccess := TempAccess; {calculate the adjustment} TempAdjust := TempSparseAttr.scaAdjust; if (TempAdjust = otaDefault) then begin TempAdjust := caAdjust; if (TempAdjust = otaDefault) then TempAdjust := Adjust; end; caAdjust := TempAdjust; {calculate the font} if Assigned(TempSparseAttr.scaFont) then caFont.Assign(TempSparseAttr.scaFont); {calculate the colors} if (RowNum = ActiveRow) and (ColNum = ActiveCol) then if (otsFocused in tbState) then if InEditingState or ((otoAlwaysEditing in Options) and (caAccess = otxNormal)) then begin TempColor := Colors.Editing; TempFontColor := Colors.EditingText end else begin TempColor := Colors.ActiveFocused; TempFontColor := Colors.ActiveFocusedText; end else begin TempColor := Colors.ActiveUnfocused; TempFontColor := Colors.ActiveUnfocusedText; end else begin if (RowNum = ActiveRow) and (otoBrowseRow in FOptions) then if (otsFocused in tbState) then begin TempColor := Colors.ActiveFocused; TempFontColor := Colors.ActiveFocusedText; end else begin TempColor := Colors.ActiveUnfocused; TempFontColor := Colors.ActiveUnfocusedText; end else if InSelection(RowNum, ColNum) then begin TempColor := Colors.Selected; TempFontColor := Colors.SelectedText; end else begin TempColor := TempSparseAttr.scaColor; if Assigned(TempSparseAttr.scaFont) then TempFontColor := TempSparseAttr.scaFont.Color else if (RowNum < LockedRows) or (ColNum < LockedCols) then TempFontColor := Colors.LockedText else TempFontColor := caFontColor; if (TempColor = clOvcTableDefault) then if (RowNum < LockedRows) or (ColNum < LockedCols) then TempColor := Colors.Locked else TempColor := caColor; end; end; caColor := TempColor; caFontColor := TempFontColor; end; DoGetCellAttributes(RowNum, ColNum, CellAttr); end; {====================================================================} {==TOvcTable property write routines=================================} procedure TOvcCustomTable.SetAccess(A : TOvcTblAccess); var TempAccess : TOvcTblAccess; begin if (A = otxDefault) then TempAccess := tbDefAccess else TempAccess := A; if (TempAccess <> FAccess) then begin AllowRedraw := false; try if (TempAccess = otxInvisible) or (FAccess = otxInvisible) then InvalidateTable; FAccess := TempAccess; finally AllowRedraw := true; end;{try..finally} end; end; {--------} procedure TOvcCustomTable.SetActiveCell(RowNum : TRowNum; ColNum : TColNum); begin DoActiveCellMoving(ccNone, RowNum, ColNum); tbSetActiveCellWithSel(RowNum, ColNum); end; {--------} procedure TOvcCustomTable.tbSetActiveCellWithSel(RowNum : TRowNum; ColNum : TColNum); begin if tbIsKeySelecting then tbUpdateSelection(RowNum, ColNum, tstDeselectAll) else tbSetAnchorCell(RowNum, ColNum, tstDeselectAll); tbSetActiveCellPrim(RowNum, ColNum); end; {--------} procedure TOvcCustomTable.tbSetActiveCellPrim(RowNum : TRowNum; ColNum : TColNum); var TempInvCells : TOvcCellArray; begin {verify the row/column numbers to be visible} RowNum := IncRow(RowNum, 0); ColNum := IncCol(ColNum, 0); {if nothing to do, get out} if (RowNum = FActiveRow) and (ColNum = FActiveCol) then Exit; {if can't do anything visually, just set the internal fields and then exit} if (not HandleAllocated) or (tbRowNums^.Count = 0) or (tbColNums^.Count = 0) then begin FActiveRow := RowNum; FActiveCol := ColNum; Exit; end; {set the new active cell} TempInvCells := nil; AllowRedraw := false; try TempInvCells := TOvcCellArray.Create; if (RowNum <> FActiveRow) then begin tbInvalidateRowHdgPrim(FActiveRow, TempInvCells); InvalidateRowHeading(RowNum); DoLeavingRow(FActiveRow); end; if (ColNum <> FActiveCol) then begin tbInvalidateColHdgPrim(FActiveCol, TempInvCells); InvalidateColumnHeading(ColNum); DoLeavingColumn(FActiveCol); end; tbInvCells.DeleteCell(ActiveRow, ActiveCol); TempInvCells.AddCell(ActiveRow, ActiveCol); if not OldRowColBehavior then if FActiveRow <> RowNum then DoEnteringRow(RowNum); FActiveRow := RowNum; if not OldRowColBehavior then if FActiveCol <> ColNum then DoEnteringColumn(ColNum); FActiveCol := ColNum; tbDrawInvalidCells(TempInvCells); tbEnsureRowIsVisible(RowNum); tbEnsureColumnIsVisible(ColNum); if not (otsDesigning in tbState) and (otoAlwaysEditing in Options) then PostMessage(Handle, ctim_StartEdit, 0, 0) else InvalidateCell(ActiveRow, ActiveCol); finally AllowRedraw := true; TempInvCells.Free; end;{try..finally} tbSetScrollPos(otsbHorizontal); tbSetScrollPos(otsbVertical); DoActiveCellChanged(RowNum, ColNum); end; {--------} procedure TOvcCustomTable.SetActiveCol(ColNum : TColNum); begin SetActiveCell(FActiveRow, ColNum); end; {--------} procedure TOvcCustomTable.SetActiveRow(RowNum : TRowNum); begin SetActiveCell(RowNum, FActiveCol); end; {--------} procedure TOvcCustomTable.SetAdjust(A : TOvcTblAdjust); var TempAdjust : TOvcTblAdjust; begin if (A = otaDefault) then TempAdjust := tbDefAdjust else TempAdjust := A; if (TempAdjust <> FAdjust) then begin AllowRedraw := false; try InvalidateTable; FAdjust := TempAdjust; finally AllowRedraw := true; end;{try..finally} end; end; {--------} procedure TOvcCustomTable.SetAllowRedraw(AR : boolean); var CellRect : TRect; MustFocus: boolean; R : TRect; CellStyle: TOvcTblEditorStyle; begin if AR {AllowRedraw is true} then begin dec(tbLockCount); if (tbLockCount <= 0) then begin {Setting the tbLockCount explicitly to zero is to catch programmers who call AllowRedraw := true once to often} tbLockCount := 0; {Update the scroll bars} if tbUpdateSBs then begin tbUpdateSBs := false; tbSetScrollPos(otsbHorizontal); tbSetScrollPos(otsbVertical); end; {if in row selection mode invalidate it} if (otoBrowseRow in Options) then InvalidateRow(ActiveRow); {draw the invalid and active cells if we have a handle} if HandleAllocated then begin {redraw invalid cells} if not tbInvCells.Empty then tbDrawInvalidCells(tbInvCells); if (otsHiddenEdit in tbState) then begin if tbCalcActiveCellRect(CellRect) then begin {note: cell style is ignored here} CellStyle := tesNormal; DoSizeCellEditor(ActiveRow, ActiveCol, CellRect, CellStyle); MustFocus := Focused; tbActCell.EditMove(CellRect); tbState := tbState - [otsHiddenEdit] + [otsEditing]; if MustFocus then {$IFNDEF LCL} Windows.SetFocus(tbActCell.EditHandle); {$ELSE} LclIntf.SetFocus(tbActCell.EditHandle); {$ENDIF} end end else tbDrawActiveCell; end; end; end else begin inc(tbLockCount); if (tbLockCount = 1) and (HandleAllocated) then begin if (otoBrowseRow in Options) then InvalidateRow(ActiveRow); if (otsEditing in tbState) then begin {$IFNDEF LCL} MustFocus := tbEditCellHasFocus(Windows.GetFocus); {$ELSE} MustFocus := tbEditCellHasFocus(LclIntf.GetFocus); {$ENDIF} GetWindowRect(tbActCell.EditHandle, R); R.TopLeft := ScreenToClient(R.TopLeft); R.BottomRight := ScreenToClient(R.BottomRight); InvalidateCellsInRect(R); tbActCell.EditHide; tbState := tbState - [otsEditing] + [otsHiddenEdit]; if MustFocus then SetFocus; end else if not (otoBrowseRow in Options) then InvalidateCell(ActiveRow, ActiveCol); end; end; end; {--------} procedure TOvcCustomTable.SetBorderStyle(const BS : TBorderStyle); begin if (BS <> BorderStyle) then begin FBorderStyle := BS; {$IFNDEF LCL} RecreateWnd; {$ELSE} MyMisc.RecreateWnd(Self); {$ENDIF} end; end; {--------} procedure TOvcCustomTable.SetBlockAccess(A : TOvcTblAccess); var R : TRowNum; C : TColNum; begin for R := BlockRowBegin to BlockRowEnd do for C := BlockColBegin to BlockColEnd do FCells.Access[R, C] := A; end; {--------} procedure TOvcCustomTable.SetBlockAdjust(A : TOvcTblAdjust); var R : TRowNum; C : TColNum; begin for R := BlockRowBegin to BlockRowEnd do for C := BlockColBegin to BlockColEnd do FCells.Adjust[R, C] := A; end; {--------} procedure TOvcCustomTable.SetBlockCell(C : TOvcBaseTableCell); var Rn : TRowNum; Cn : TColNum; begin for Rn := BlockRowBegin to BlockRowEnd do for Cn := BlockColBegin to BlockColEnd do FCells.Cell[Rn, Cn] := C; end; {--------} procedure TOvcCustomTable.SetBlockColBegin(ColNum : TColNum); begin if (ColNum <> FBlockColBegin) then if (0 <= ColNum) and (ColNum < ColCount) then begin FBlockColBegin := ColNum; if (FBlockColEnd < FBlockColBegin) then FBlockColEnd := ColNum; end; end; {--------} procedure TOvcCustomTable.SetBlockColEnd(ColNum : TColNum); begin if (ColNum <> FBlockColEnd) then if (0 <= ColNum) and (ColNum < ColCount) then begin FBlockColEnd := ColNum; if (FBlockColEnd < FBlockColBegin) then FBlockColBegin := ColNum; end; end; {--------} procedure TOvcCustomTable.SetBlockColor(C : TColor); var Rn : TRowNum; Cn : TColNum; begin for Rn := BlockRowBegin to BlockRowEnd do for Cn := BlockColBegin to BlockColEnd do FCells.Color[Rn, Cn] := C; end; {--------} procedure TOvcCustomTable.SetBlockFont(F : TFont); var R : TRowNum; C : TColNum; begin for R := BlockRowBegin to BlockRowEnd do for C := BlockColBegin to BlockColEnd do FCells.Font[R, C] := F; end; {--------} procedure TOvcCustomTable.SetBlockRowBegin(RowNum : TRowNum); begin if (RowNum <> FBlockRowBegin) then if (0 <= RowNum) and (RowNum < RowLimit) then begin FBlockRowBegin := RowNum; if (FBlockRowEnd < FBlockRowBegin) then FBlockRowEnd := RowNum; end; end; {--------} procedure TOvcCustomTable.SetBlockRowEnd(RowNum : TRowNum); begin if (RowNum <> FBlockRowEnd) then if (0 <= RowNum) and (RowNum < RowLimit) then begin FBlockRowEnd := RowNum; if (FBlockRowEnd < FBlockRowBegin) then FBlockRowBegin := RowNum; end; end; {--------} procedure TOvcCustomTable.SetColors(C : TOvcTableColors); begin FColors.Assign(C); end; {--------} procedure TOvcCustomTable.SetColorUnused(CU : TColor); begin if (CU <> ColorUnused) then begin AllowRedraw := false; FColorUnused := CU; tbInvCells.AddUnusedBit; AllowRedraw := true; end; end; {--------} procedure TOvcCustomTable.SetColCount(CC : integer); begin if (CC <> ColCount) and (CC > LockedCols) then begin AllowRedraw := false; try Columns.Count := CC; tbSelList.SetColCount(CC); tbSetScrollRange(otsbHorizontal); if (CC <= ActiveCol) then ActiveCol := pred(CC); if (CC <= LeftCol) then LeftCol := pred(CC); if (CC <= FSelAnchorCol) then FSelAnchorCol := pred(CC); if (CC <= BlockColBegin) then BlockColBegin := pred(CC); if (CC <= BlockColEnd) then BlockColEnd := pred(CC); tbSetScrollPos(otsbHorizontal); finally AllowRedraw := true; end;{try..finally} end; end; {--------} procedure TOvcCustomTable.SetCols(CS : TOvcTableColumns); begin AllowRedraw := false; try FCols.Free; FCols := CS; FCols.Table := Self; FCols.OnColumnChanged := tbColChanged; tbColChanged(FCols, 0, 0, taGeneral); finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.SetLeftCol(ColNum : TColNum); begin SetTopLeftCell(TopRow, ColNum); end; {--------} procedure TOvcCustomTable.SetLockedCols(ColNum : TColNum); begin if not HandleAllocated then FLockedCols := ColNum else if (ColNum <> FLockedCols) then if (0 <= ColNum) and (ColNum < ColCount) then begin AllowRedraw := false; try FLockedCols := ColNum; if LeftCol < ColNum then LeftCol := LeftCol; {this does do something!} if (ActiveCol < ColNum) then ActiveCol := LeftCol; {this does do something!} tbCalcColData(tbColNums, LeftCol); InvalidateTable; finally AllowRedraw := true; end;{try..finally} tbSetScrollRange(otsbHorizontal); tbSetScrollPos(otsbHorizontal); end; end; {--------} procedure TOvcCustomTable.SetLockedRows(RowNum : TRowNum); begin if not HandleAllocated then FLockedRows := RowNum else if (RowNum <> FLockedRows) then if (0 <= RowNum) then begin AllowRedraw := false; try FLockedRows := RowNum; if (TopRow < RowNum) then TopRow := TopRow; {this does do something!} if (ActiveRow < RowNum) then ActiveRow := ActiveRow; {this does do something!} tbCalcRowData(tbRowNums, TopRow); InvalidateTable; finally AllowRedraw := true; end;{try..finally} tbSetScrollRange(otsbVertical); tbSetScrollPos(otsbVertical); end; end; {--------} procedure TOvcCustomTable.SetLockedRowsCell(C : TOvcBaseTableCell); var DoIt : boolean; begin DoIt := false; if (C <> FLockedRowsCell) then if Assigned(C) then begin if (C.References = 0) or ((C.References > 0) and (C.Table = Self)) then DoIt := true; end else DoIt := true; if DoIt then begin if Assigned(FLockedRowsCell) then FLockedRowsCell.DecRefs; FLockedRowsCell := C; if Assigned(FLockedRowsCell) then begin if (FLockedRowsCell.References = 0) then FLockedRowsCell.Table := Self; FLockedRowsCell.IncRefs; end; tbCellChanged(Self); end; end; {--------} procedure TOvcCustomTable.SetOptions(O : TOvcTblOptionSet); begin AllowRedraw := false; try FOptions := O; if HaveSelection then begin tbIsSelecting := false; tbIsDeselecting := false; tbSetAnchorCell(ActiveRow, ActiveCol, tstDeselectAll); end; {patch up the options set to exclude meaningless combinations} if (otoBrowseRow in FOptions) then begin FOptions := FOptions + [otoNoSelection, otoNoRowResizing{, otoNoColResizing}] - [otoMouseDragSelect, otoRowSelection, otoColSelection]; end; if (otoAlwaysEditing in FOptions) then begin FOptions := FOptions + [otoNoSelection, otoNoRowResizing, otoNoColResizing] - [otoMouseDragSelect, otoRowSelection, otoColSelection]; end else if (otoNoSelection in FOptions) then begin FOptions := FOptions - [otoMouseDragSelect, otoRowSelection, otoColSelection]; end; if (otoRowSelection in FOptions) then FOptions := FOptions - [otoAllowRowMoves]; if (otoColSelection in FOptions) then FOptions := FOptions - [otoAllowColMoves]; InvalidateTable; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.SetPaintUnusedArea(PUA : TNotifyEvent); begin AllowRedraw := false; FPaintUnusedArea := PUA; tbInvCells.AddUnusedBit; AllowRedraw := true; end; {--------} procedure TOvcCustomTable.SetRowLimit(RowNum : TRowNum); begin if (RowNum <> FRows.Limit) and (RowNum > LockedRows) then begin AllowRedraw := false; try FRows.Limit := RowNum; tbSelList.SetRowCount(RowLimit); tbSetScrollRange(otsbVertical); if (RowNum <= ActiveRow) then ActiveRow := pred(RowNum); if (RowNum <= TopRow) then TopRow := pred(RowNum); if (RowNum <= FSelAnchorRow) then FSelAnchorRow := pred(RowNum); if (RowNum <= BlockRowBegin) then BlockRowBegin := pred(RowNum); if (RowNum <= BlockRowEnd) then BlockRowEnd := pred(RowNum); tbSetScrollPos(otsbVertical); finally AllowRedraw := true; end;{try..finally} end; end; {--------} procedure TOvcCustomTable.SetRows(RS : TOvcTableRows); begin AllowRedraw := false; try FRows.Free; FRows := RS; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.SetScrollBars(const SB : TScrollStyle); begin if (SB <> ScrollBars) then begin FScrollBars := SB; {$IFNDEF LCL} RecreateWnd; {$ELSE} MyMisc.RecreateWnd(Self); {$ENDIF} end; end; {--------} procedure TOvcCustomTable.SetTopRow(RowNum : TRowNum); begin SetTopLeftCell(RowNum, LeftCol); end; {--------} procedure TOvcCustomTable.SetTopLeftCell(RowNum : TRowNum; ColNum : TColNum); begin {ensure that the new top left cell minimises the unused space} if (ColNum > tbLastLeftCol) then ColNum := tbLastLeftCol; if (RowNum > tbLastTopRow) then RowNum := tbLastTopRow; {ensure that RowNum and C are not hidden} RowNum := IncRow(RowNum, 0); ColNum := IncCol(ColNum, 0); DoTopLeftCellChanging(RowNum, ColNum); {change the topmost row and leftmost column if required} if not HandleAllocated then begin FTopRow := RowNum; FLeftCol := ColNum; end else if (RowNum <> FTopRow) or (ColNum <> FLeftCol) then begin AllowRedraw := false; {note: the tbScrollTableXxx routines set FTopRow and FLeftCol} try if (RowNum > FTopRow) then tbScrollTableUp(RowNum) else if (RowNum < FTopRow) then tbScrollTableDown(RowNum); if (ColNum > FLeftCol) then tbScrollTableLeft(ColNum) else if (ColNum < FLeftCol) then tbScrollTableRight(ColNum); finally AllowRedraw := true; end;{try..finally} tbSetScrollPos(otsbVertical); tbSetScrollPos(otsbHorizontal); DoTopLeftCellChanged(RowNum, ColNum); end; end; {====================================================================} {==TOvcTable Scroller routines=======================================} procedure TOvcCustomTable.tbSetScrollPos(SB : TOvcScrollBar); var ColNum : TColNum; ColCnt : TColNum; Divisor : LongInt; {$IFNDEF MSWINDOWS} SI : TScrollInfo; {$ENDIF} begin if (SB = otsbVertical) then begin if tbHasVSBar then if HandleAllocated and (tbLockCount = 0) then begin {$IFDEF MSWINDOWS} if (tbLastTopRow < 16*1024) then SetScrollPos(Handle, SB_VERT, TopRow, true) else begin if (tbLastTopRow > (16 * 1024)) then Divisor := RowLimit div $400 else Divisor := RowLimit div $40; SetScrollPos(Handle, SB_VERT, TopRow div Divisor, True); end {$ELSE} SI.fMask := SIF_POS; SI.nPos := TopRow; SI.nTrackPos := SI.nPos; SetScrollInfo(Handle, SB_Vert, SI, True); {$ENDIF} end else tbUpdateSBs := true; end else {SB = otsbHorizontal} begin if tbHasHSBar then if HandleAllocated and (tbLockCount = 0) then begin ColCnt := 0; for ColNum := LockedCols to pred(LeftCol) do if not tbIsColHidden(ColNum) then inc(ColCnt); {$IFDEF MSWINDOWS} SetScrollPos(Handle, SB_HORZ, ColCnt, true) {$ELSE} SI.fMask := SIF_POS; SI.nPos := ColCnt; SI.nTrackPos := SI.nPos; SetScrollInfo(Handle, SB_Horz, SI, True); {$ENDIF} end else tbUpdateSBs := true; end; end; {--------} procedure TOvcCustomTable.tbSetScrollRange(SB : TOvcScrollBar); var Divisor : LongInt; {$IFNDEF MSWINDOWS} SI : TScrollInfo; {$ENDIF} begin if (SB = otsbVertical) then begin if HandleAllocated then tbCalcRowsOnLastPage; if tbHasVSBar and HandleAllocated then begin {$IFDEF MSWINDOWS} // tbCalcRowsOnLastPage; if (tbLastTopRow < 16*1024) then if tbCalcRequiresVSBar then SetScrollRange(Handle, SB_Vert, LockedRows, tbLastTopRow, false) else SetScrollRange(Handle, SB_Vert, LockedRows, LockedRows, false) else begin if (tbLastTopRow > (16*1024)) then Divisor := Succ(tbLastTopRow div $400) else Divisor := Succ(tbLastTopRow div $40); SetScrollRange(Handle, SB_Vert, LockedRows, tbLastTopRow div Divisor, False) end; {$ELSE} SI.fMask := SIF_RANGE or SIF_PAGE; SI.nMin := LockedRows; SI.nMax := Pred(RowLimit); SI.nPage := (ClientHeight div Rows[LockedRows].Height) - LockedRows; if SI.nPage < 1 then SI.nPage := 1; SetScrollInfo(Handle, SB_Vert, SI, True); {$ENDIF} end end else {SB = otsbHorizontal} begin tbCalcColsOnLastPage; if tbHasHSBar and HandleAllocated then begin {$IFDEF MSWINDOWS} tbCalcHSBarPosCount; SetScrollRange(Handle, SB_HORZ, 0, pred(tbHSBarPosCount), false); {$ELSE} SI.fMask := SIF_RANGE or SIF_PAGE; SI.nMin := 0; SI.nMax := Pred(ColCount) - LockedCols; SI.nPage := ColCount div 3; if SI.nPage < 1 then SI.nPage := 1; SetScrollInfo(Handle, SB_Horz, SI, True); {$ENDIF} end; end; end; {====================================================================} {==TOvcTable editing routines========================================} function TOvcCustomTable.FilterKey(var Msg : TWMKey) : TOvcTblKeyNeeds; var Cmd : word; begin Result := otkDontCare; Cmd := Controller.EntryCommands.TranslateUsing([tbCmdTable^], TMessage(Msg)); {first the hard coded keys} case Msg.CharCode of VK_RETURN : if (otoEnterToArrow in Options) then Result := otkMustHave; VK_TAB : if (otoTabToArrow in Options) then Result := otkMustHave; VK_ESCAPE : Result := otkMustHave; end;{case} {now the translated commands} case Cmd of ccTableEdit : Result := otkMustHave; ccBotOfPage, ccBotRightCell, ccDown, ccEnd, ccFirstPage, ccHome, ccLastPage, ccLeft, ccNextPage, ccPageLeft, ccPageRight, ccPrevPage, ccRight, ccTopLeftCell, ccTopOfPage, ccUp, ccWordLeft, ccWordRight : Result := otkWouldLike; end;{case} end; {--------} function TOvcCustomTable.SaveEditedData : boolean; var Data : pointer; begin Result := true; if InEditingState then begin Result := false; if not tbActCell.CanSaveEditedData(true) then Exit; Result := true; DoEnteringColumn(ActiveCol); DoEnteringRow(ActiveRow); DoGetCellData(ActiveRow, ActiveCol, Data, cdpForSave); tbActCell.SaveEditedData(Data); end; end; {--------} function TOvcCustomTable.StartEditingState : boolean; var CellRect : TRect; Data : pointer; CellAttr : TOvcCellAttributes; CellStyle: TOvcTblEditorStyle; begin Result := true; if InEditingState then Exit; DoBeginEdit(ActiveRow, ActiveCol, Result); if not Result then Exit; Result := false; AllowRedraw := false; try tbEnsureRowIsVisible(ActiveRow); tbEnsureColumnIsVisible(ActiveCol); tbActCell := tbFindCell(ActiveRow, ActiveCol); if Assigned(tbActCell) then begin FillChar(CellAttr, sizeof(CellAttr), 0); CellAttr.caFont := tbCellAttrFont; CellAttr.caFont.Assign(Font); tbActCell.ResolveAttributes(ActiveRow, ActiveCol, CellAttr); if (CellAttr.caAccess = otxNormal) then begin if not tbCalcActiveCellRect(CellRect) then {we're in big trouble, lads}; CellStyle := tesNormal; DoSizeCellEditor(ActiveRow, ActiveCol, CellRect, CellStyle); DoEnteringColumn(ActiveCol); DoEnteringRow(ActiveRow); DoGetCellData(ActiveRow, ActiveCol, Data, cdpForEdit); tbState := tbState - [otsNormal] + [otsHiddenEdit]; CellAttr.caColor := Colors.Editing; CellAttr.caFontColor := Colors.EditingText; tbActCell.StartEditing(ActiveRow, ActiveCol, CellRect, CellAttr, CellStyle, Data); Result := (tbActCell.EditHandle <> 0); if not Result then begin tbState := tbState + [otsNormal] - [otsHiddenEdit]; tbActCell := nil; end; end else tbActCell := nil; end; finally AllowRedraw := true; end;{try..finally} end; {--------} function TOvcCustomTable.StopEditingState(SaveValue : boolean) : boolean; var Data : pointer; MustFocus : boolean; R : TRect; begin Result := true; if not InEditingState then Exit; Result := false; if not tbActCell.CanSaveEditedData(SaveValue) then Exit; DoEndEdit(tbActCell, ActiveRow, ActiveCol, Result); if not Result then Exit; Result := true; GetWindowRect(tbActCell.EditHandle, R); AllowRedraw := false; try {$IFNDEF LCL} MustFocus := tbEditCellHasFocus(Windows.GetFocus); {$ELSE} MustFocus := tbEditCellHasFocus(LclIntf.GetFocus); {$ENDIF} if not MustFocus then MustFocus := Focused; DoEnteringColumn(ActiveCol); DoEnteringRow(ActiveRow); DoGetCellData(ActiveRow, ActiveCol, Data, cdpForSave); R.TopLeft := ScreenToClient(R.TopLeft); R.BottomRight := ScreenToClient(R.BottomRight); InvalidateCellsInRect(R); tbActCell.StopEditing(SaveValue, Data); tbActCell := nil; try DoDoneEdit(ActiveRow, ActiveCol); finally if not (otoAlwaysEditing in Options) then InvalidateCell(ActiveRow, ActiveCol); tbState := tbState - [otsEditing, otsHiddenEdit] + [otsNormal]; if MustFocus then SetFocus else tbState := tbState - [otsFocused] + [otsUnfocused]; end;{try..finally} finally AllowRedraw := true; end;{try..finally} end; {====================================================================} {==TOvcTable selection methods=======================================} procedure TOvcCustomTable.tbDeselectAll(CA : TOvcCellArray); begin with tbSelList do begin Iterate(tbDeselectAllIterator, pointer(CA)); DeselectAll; end; end; {--------} function TOvcCustomTable.tbDeselectAllIterator(RowNum1 : TRowNum; ColNum1 : TColNum; RowNum2 : TRowNum; ColNum2 : TColNum; ExtraData : pointer) : boolean; var RowNum : TRowNum; ColNum : TColNum; RowInx : integer; CA : TOvcCellArray absolute ExtraData; begin {optimisations: 1. generally ColNum1 = ColNum2 2. take it from the viewpoint of what rows are visible rather than what rows are selected} Result := true; for ColNum := ColNum1 to ColNum2 do if (tbFindColInx(ColNum) <> -1) then with tbRowNums^ do for RowInx := 0 to pred(Count) do begin RowNum := Ay[RowInx].Number; if (RowNum1 <= RowNum) and (RowNum <= RowNum2) then CA.AddCell(RowNum, ColNum); end; end; {--------} function TOvcCustomTable.HaveSelection : boolean; begin Result := tbSelList.HaveSelection; end; {--------} function TOvcCustomTable.InSelection(RowNum : TRowNum; ColNum : TColNum) : boolean; begin if HaveSelection then Result := tbSelList.IsCellSelected(RowNum, ColNum) else Result := false; end; {--------} procedure TOvcCustomTable.IterateSelections(SI : TSelectionIterator; ExtraData : pointer); begin with tbSelList do Iterate(SI, ExtraData); end; {--------} procedure TOvcCustomTable.tbSelectCol(ColNum : TColNum); var RowInx : integer; ColInx : integer; begin tbSelList.SelectCellRange(LockedRows, ColNum, pred(RowLimit), ColNum); ColInx := tbFindColInx(ColNum); if (ColInx <> -1) then with tbRowNums^ do for RowInx := 0 to pred(Count) do tbInvCells.AddCell(Ay[RowInx].Number, ColNum); end; {--------} procedure TOvcCustomTable.tbSelectRow(RowNum : TRowNum); var RowInx : integer; ColInx : integer; begin tbSelList.SelectCellRange(RowNum, LockedCols, RowNum, pred(ColCount)); RowInx := tbFindRowInx(RowNum); if (RowInx <> -1) then with tbColNums^ do for ColInx := 0 to pred(Count) do tbInvCells.AddCell(RowNum, Ay[ColInx].Number); end; {--------} procedure TOvcCustomTable.tbSelectTable; begin tbSelList.SelectAll; InvalidateTable; end; {--------} procedure TOvcCustomTable.tbSetAnchorCell(RowNum : TRowNum; ColNum : TColNum; Action : TOvcTblSelectionType); begin {deselect the current selection(s) if required} if (Action = tstDeselectAll) then tbDeselectAll(tbInvCells); {set the anchor point to a sensible value} if (ColNum < LockedCols) then FSelAnchorCol := LockedCols else if (ColNum >= ColCount) then FSelAnchorCol := pred(ColCount) else FSelAnchorCol := ColNum; if (RowNum < LockedRows) then FSelAnchorRow := LockedRows else if (RowNum >= RowLimit) then FSelAnchorRow := pred(RowLimit) else FSelAnchorRow := RowNum; {tell the selection list object} tbSelList.SetRangeAnchor(RowNum, ColNum, Action); {try and work out whether we are selecting or deselecting} tbIsSelecting := false; tbIsDeselecting := false; if (Action = tstAdditional) then begin if InSelection(RowNum, ColNum) then tbIsDeselecting := true else tbIsSelecting := true; end; end; {--------} procedure TOvcCustomTable.tbUpdateSelection(RowNum : TRowNum; ColNum : TColNum; Action : TOvcTblSelectionType); var R : TRowNum; C : TColNum; OldSelRow1 : TRowNum; OldSelRow2 : TRowNum; OldSelCol1 : TColNum; OldSelCol2 : TColNum; NewSelRow1 : TRowNum; NewSelRow2 : TRowNum; NewSelCol1 : TColNum; NewSelCol2 : TColNum; RowInx : integer; ColInx : integer; NewInvCells: TOvcCellArray; DeselCells : TOvcCellArray; begin NewInvCells := nil; DeselCells := nil; try {create temporary cell arrays: one for new invalid cells, one for any deselected cells} NewInvCells := TOvcCellArray.Create; DeselCells := TOvcCellArray.Create; {deselect currently selected cells if required} if (Action = tstDeselectAll) then tbDeselectAll(DeselCells); {calculate the old and new selections (the parameters RowNum, ColNum form the address of the new active cell)} OldSelRow1 := MinL(ActiveRow, FSelAnchorRow); OldSelRow2 := MaxL(ActiveRow, FSelAnchorRow); NewSelRow1 := MinL(RowNum, FSelAnchorRow); NewSelRow2 := MaxL(RowNum, FSelAnchorRow); if (otoBrowseRow in Options) then begin OldSelCol1 := LockedCols; OldSelCol2 := pred(ColCount); NewSelCol1 := LockedCols; NewSelCol2 := pred(ColCount); end else begin OldSelCol1 := MinI(ActiveCol, FSelAnchorCol); OldSelCol2 := MaxI(ActiveCol, FSelAnchorCol); NewSelCol1 := MinI(ColNum, FSelAnchorCol); NewSelCol2 := MaxI(ColNum, FSelAnchorCol); end; {extend the range in the selection list} tbSelList.ExtendRange(RowNum, ColNum, tbIsSelecting or tbIsKeySelecting); {for the old selection, remove the cells from the deselected cell array (if they are there) and add them to the new selected cell array} for RowInx := 0 to pred(tbRowNums^.Count) do begin R := tbRowNums^.Ay[RowInx].Number; if (OldSelRow1 <= R) and (R <= OldSelRow2) then for ColInx := 0 to pred(tbColNums^.Count) do begin C := tbColNums^.Ay[ColInx].Number; if (OldSelCol1 <= C) and (C <= OldSelCol2) then begin DeselCells.DeleteCell(R, C); NewInvCells.AddCell(R, C); end; end; end; {for the new selection, for each cell remove it from the new selected cell array; if it wasn't there add it to the same array} for RowInx := 0 to pred(tbRowNums^.Count) do begin R := tbRowNums^.Ay[RowInx].Number; if (NewSelRow1 <= R) and (R <= NewSelRow2) then for ColInx := 0 to pred(tbColNums^.Count) do begin C := tbColNums^.Ay[ColInx].Number; if (NewSelCol1 <= C) and (C <= NewSelCol2) then if not NewInvCells.DeleteCell(R, C) then NewInvCells.AddCell(R, C); end; end; {add the current active cell to the new selected cell array} NewInvCells.AddCell(ActiveRow, ActiveCol); {merge the cells from the temporary arrays into the main invalid cell array} tbInvCells.Merge(NewInvCells); tbInvCells.Merge(DeselCells); finally NewInvCells.Free; DeselCells.Free end;{try..finally} end; {====================================================================} {==TOvcTable notification methods====================================} procedure TOvcCustomTable.tbCellChanged(Sender : TObject); begin {don't bother if we're being loaded or destroyed} if ((ComponentState * [csLoading, csDestroying]) <> []) then Exit; {if we have a handle repaint the table} if HandleAllocated then begin AllowRedraw := false; try InvalidateTable; finally AllowRedraw := true; end;{try..finally} end; end; {--------} procedure TOvcCustomTable.tbColChanged(Sender : TObject; ColNum1, ColNum2 : TColNum; Action : TOvcTblActions); var CC : TColNum; DoIt : boolean; begin {don't bother if we're being loaded or destroyed} if ((ComponentState * [csLoading, csDestroying]) <> []) then Exit; {similarly don't bother if we have no handle} if not HandleAllocated then begin tbSelList.SetColCount(ColCount); Exit; end; {make sure there's no flicker} AllowRedraw := false; try {decide whether there's anything to do to the visible display} DoIt := false; with tbColNums^ do {$IFDEF LCL} //Apparent TurboPower bug revealed when checks on if Count > 0 then {$ENDIF} case Action of taGeneral : DoIt := true; taSingle : begin DoIt := (Ay[0].Number <= ColNum1) and (ColNum1 <= Ay[pred(Count)].Number); {check for unhiding a column after all others} if not DoIt then DoIt := (ColNum1 > Ay[pred(Count)].Number) and (ClientWidth > Ay[Count].Offset); DoColumnsChanged(ColNum1, -1, taSingle); end; taAll : DoIt := true; taInsert : begin DoIt := (Ay[0].Number <= ColNum1) and (ColNum1 <= Ay[pred(Count)].Number); {check for appending a column} if not DoIt then DoIt := (ColNum1 > Ay[pred(Count)].Number) and (ClientWidth > Ay[Count].Offset); FCells.InsertCol(ColNum1); DoColumnsChanged(ColNum1, -1, taInsert); end; taDelete : begin DoIt := (Ay[0].Number <= ColNum1) and (ColNum1 <= Ay[pred(Count)].Number); FCells.DeleteCol(ColNum1); DoColumnsChanged(ColNum1, -1, taDelete); end; taExchange: begin DoIt := (Ay[0].Number <= ColNum1) and (ColNum1 <= Ay[pred(Count)].Number); if not DoIt then DoIt := (Ay[0].Number <= ColNum2) and (ColNum2 <= Ay[pred(Count)].Number); FCells.ExchangeCols(ColNum1, ColNum2); DoColumnsChanged(ColNum1, ColNum2, taExchange); end; end;{case} {if nothing to do to the visible columns, then do it!} if not DoIt then begin {must still reset the horizontal scroll bar even so} tbSelList.SetColCount(ColCount); tbSetScrollRange(otsbHorizontal); tbSetScrollPos(otsbHorizontal); Exit; end; {redisplay the table} tbCalcColData(tbColNums, LeftCol); InvalidateTable; {the column could have changed because it was hidden or deleted... ...must make sure that LeftCol and ActiveCol haven't been hidden as well.} if (Action = taSingle) or (Action = taDelete) then begin if (ColNum1 = LeftCol) then LeftCol := LeftCol; {this does do something!} if (ColNum1 = ActiveCol) then ActiveCol := ActiveCol; {this does do something!} end; {reset the block column values} CC := ColCount; if (CC <= BlockColBegin) then BlockColBegin := pred(CC); if (CC <= BlockColEnd) then BlockColEnd := pred(CC); tbSelList.SetColCount(ColCount); tbSetScrollRange(otsbHorizontal); tbSetScrollPos(otsbHorizontal); if (LeftCol > tbLastLeftCol) then LeftCol := tbLastLeftCol; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.tbColorsChanged(Sender : TObject); begin {don't bother if we're being loaded or destroyed} if ((ComponentState * [csLoading, csDestroying]) <> []) then Exit; {if we have a handle repaint the table} if HandleAllocated then begin AllowRedraw := false; try InvalidateTable; finally AllowRedraw := true; end;{try..finally} end; end; {--------} procedure TOvcCustomTable.tbGridPenChanged(Sender : TObject); begin {don't bother if we're being loaded or destroyed} if ((ComponentState * [csLoading, csDestroying]) <> []) then Exit; {if we have a handle repaint the table} if HandleAllocated then begin AllowRedraw := false; try InvalidateTable; finally AllowRedraw := true; end;{try..finally} end; end; {--------} procedure TOvcCustomTable.tbRowChanged(Sender : TObject; RowNum1, RowNum2 : TRowNum; Action : TOvcTblActions); var RL : TRowNum; DoIt : boolean; begin {don't bother if we're being loaded or destroyed} if ((ComponentState * [csLoading, csDestroying]) <> []) then Exit; {similarly don't bother if we have no handle} if not HandleAllocated then begin tbSelList.SetRowCount(RowLimit); Exit; end; {make sure there's no flicker} AllowRedraw := false; try {decide whether there's anything to do to the visible display} DoIt := false; with tbRowNums^ do case Action of taGeneral : DoIt := true; taSingle : begin DoIt := (Ay[0].Number <= RowNum1) and (RowNum1 <= Ay[pred(Count)].Number); {check for unhiding a row after all others} if not DoIt then DoIt := (RowNum1 > Ay[pred(Count)].Number) and (ClientHeight > Ay[Count].Offset); DoRowsChanged(RowNum1, -1, taSingle); end; taAll : DoIt := true; taInsert : begin DoIt := (Ay[0].Number <= RowNum1) and (RowNum1 <= Ay[pred(Count)].Number); {check for appending a row} if not DoIt then DoIt := (RowNum1 > Ay[pred(Count)].Number) and (ClientHeight > Ay[Count].Offset); FCells.InsertRow(RowNum1); DoRowsChanged(RowNum1, -1, taInsert); end; taDelete : begin DoIt := (Ay[0].Number <= RowNum1) and (RowNum1 <= Ay[pred(Count)].Number); FCells.DeleteRow(RowNum1); DoRowsChanged(RowNum1, -1, taDelete); end; taExchange: begin DoIt := (Ay[0].Number <= RowNum1) and (RowNum1 <= Ay[pred(Count)].Number); if not DoIt then DoIt := (Ay[0].Number <= RowNum2) and (RowNum2 <= Ay[pred(Count)].Number); FCells.ExchangeRows(RowNum1, RowNum2); DoRowsChanged(RowNum1, RowNum2, taExchange); end; end;{case} {if nothing to do to the visible rows, then do it!} if not DoIt then begin {must still reset the vertical scroll bar even so} tbSelList.SetRowCount(RowLimit); tbSetScrollRange(otsbVertical); tbSetScrollPos(otsbVertical); Exit; end; {redisplay the table} tbCalcRowData(tbRowNums, TopRow); InvalidateTable; {the row could have changed because it was hidden or deleted... ...must make sure that TopRow and ActiveRow haven't been hidden as well.} if (Action = taSingle) or (Action = taDelete) then begin if (RowNum1 = TopRow) then TopRow := TopRow; {this does do something!} if (RowNum1 = ActiveRow) then ActiveRow := ActiveRow; {this does do something!} end; {reset the block row values} RL := RowLimit; if (RL <= BlockRowBegin) then BlockRowBegin := pred(RL); if (RL <= BlockRowEnd) then BlockRowEnd := pred(RL); tbSelList.SetRowCount(RowLimit); tbSetScrollRange(otsbVertical); tbSetScrollPos(otsbVertical); finally AllowRedraw := true; end;{try..finally} end; {====================================================================} {==TOvcTable invalidate cell methods=================================} procedure TOvcCustomTable.InvalidateCell(RowNum : TRowNum; ColNum : TColNum); var CInx : integer; RInx : integer; begin RInx := tbFindRowInx(RowNum); if (RInx <> -1) then begin CInx := tbFindColInx(ColNum); if (CInx <> -1) then tbInvCells.AddCell(RowNum, ColNum); end; end; {--------} procedure TOvcCustomTable.InvalidateCellsInRect(const R : TRect); var GR : TRect; WhatToPaint : integer; RowInx : integer; ColInx : integer; begin WhatToPaint := tbCalcCellsFromRect(R, GR); if (WhatToPaint <> 2) then for RowInx := GR.Top to GR.Bottom do for ColInx := GR.Left to GR.Right do InvalidateCell(tbRowNums^.Ay[RowInx].Number, tbColNums^.Ay[ColInx].Number); if (WhatToPaint <> 0) then tbInvCells.AddUnusedBit; end; {--------} procedure TOvcCustomTable.InvalidateColumn(ColNum : TColNum); var RowInx : integer; ColInx : integer; begin ColInx := tbFindColInx(ColNum); if (ColInx <> -1) then with tbRowNums^ do for RowInx := 0 to pred(Count) do tbInvCells.AddCell(Ay[RowInx].Number, ColNum); end; {--------} procedure TOvcCustomTable.tbInvalidateColHdgPrim(ColNum : TColNum; InvCells : TOvcCellArray); var RowInx : integer; ColInx : integer; begin ColInx := tbFindColInx(ColNum); if (ColInx <> -1) then with tbRowNums^ do for RowInx := 0 to pred(LockedRows) do InvCells.AddCell(Ay[RowInx].Number, ColNum); end; {--------} procedure TOvcCustomTable.InvalidateColumnHeading(ColNum : TColNum); begin tbInvalidateColHdgPrim(ColNum, tbInvCells); end; {--------} procedure TOvcCustomTable.InvalidateRow(RowNum : TRowNum); var RowInx : integer; ColInx : integer; begin RowInx := tbFindRowInx(RowNum); if (RowInx <> -1) then with tbColNums^ do for ColInx := 0 to pred(Count) do tbInvCells.AddCell(RowNum, Ay[ColInx].Number); end; {--------} procedure TOvcCustomTable.tbInvalidateRowHdgPrim(RowNum : TRowNum; InvCells : TOvcCellArray); var RowInx : integer; ColInx : integer; begin RowInx := tbFindRowInx(RowNum); if (RowInx <> -1) then with tbColNums^ do for ColInx := 0 to pred(LockedCols) do InvCells.AddCell(RowNum, Ay[ColInx].Number); end; {--------} procedure TOvcCustomTable.InvalidateRowHeading(RowNum : TRowNum); begin tbInvalidateRowHdgPrim(RowNum, tbInvCells); end; {--------} procedure TOvcCustomTable.InvalidateTable; var RowInx : integer; ColInx : integer; PredColNumsCount : integer; PredRowNumsCount : integer; begin {$IFDEF LCL} //Apparent TurboPower bug revealed when checks on if (tbColNums^.Count > 0) and (tbRowNums^.Count > 0) then begin {$ENDIF} PredColNumsCount := pred(tbColNums^.Count); PredRowNumsCount := pred(tbRowNums^.Count); for RowInx := 0 to PredRowNumsCount do for ColInx := 0 to PredColNumsCount do tbInvCells.AddCell(tbRowNums^.Ay[RowInx].Number, tbColNums^.Ay[ColInx].Number); {$IFDEF LCL} end; {$ENDIF} tbInvCells.AddUnusedBit; end; {--------} procedure TOvcCustomTable.InvalidateTableNotLockedCols; var RowInx : integer; ColInx : integer; StartColInx : integer; PredColNumsCount : integer; PredRowNumsCount : integer; begin StartColInx := 0; PredColNumsCount := pred(tbColNums^.Count); PredRowNumsCount := pred(tbRowNums^.Count); while (StartColInx <= PredColNumsCount) and (tbColNums^.Ay[StartColInx].Number < LockedCols) do inc(StartColInx); for RowInx := 0 to PredRowNumsCount do for ColInx := StartColInx to PredColNumsCount do tbInvCells.AddCell(tbRowNums^.Ay[RowInx].Number, tbColNums^.Ay[ColInx].Number); tbInvCells.AddUnusedBit; end; {--------} procedure TOvcCustomTable.InvalidateTableNotLockedRows; var RowInx : integer; ColInx : integer; StartRowInx : integer; PredColNumsCount : integer; PredRowNumsCount : integer; begin StartRowInx := 0; PredColNumsCount := pred(tbColNums^.Count); PredRowNumsCount := pred(tbRowNums^.Count); while (StartRowInx <= PredRowNumsCount) and (tbRowNums^.Ay[StartRowInx].Number < LockedRows) do inc(StartRowInx); for RowInx := StartRowInx to PredRowNumsCount do for ColInx := 0 to PredColNumsCount do tbInvCells.AddCell(tbRowNums^.Ay[RowInx].Number, tbColNums^.Ay[ColInx].Number); tbInvCells.AddUnusedBit; end; {====================================================================} {==TOvcTable miscellaneous===========================================} function TOvcCustomTable.tbCalcActiveCellRect(var ACR : TRect) : boolean; var RInx : integer; CInx : integer; begin Result := false; RInx := tbFindRowInx(ActiveRow); if (RInx = -1) then Exit; CInx := tbFindColInx(ActiveCol); if (CInx = -1) then Exit; Result := true; with ACR do begin Top := tbRowNums^.Ay[RInx].Offset; Bottom := tbRowNums^.Ay[succ(RInx)].Offset; Left := tbColNums^.Ay[CInx].Offset; Right := tbColNums^.Ay[succ(CInx)].Offset; end; with GridPenSet.NormalGrid do case Effect of geVertical : dec(ACR.Right); geHorizontal : dec(ACR.Bottom); geBoth : begin dec(ACR.Right); dec(ACR.Bottom); end; ge3D : InflateRect(ACR, -1, -1); end;{case} end; {--------} function TOvcCustomTable.tbCalcCellsFromRect(const UR : TRect; var GR : TRect) : integer; {-Converts a paint rect into a 'grid' rect. A grid rect is a rectangle of cells, defined by their display indexes rather than their row/column numbers. The function result is a definition of the type of rectangle produced: 0--top left and bottom right corners of the original rect are exclusively within the table; 1--top left of the rect is in the displayed table, the bottom right is in the 'unused' bit (the bit between the displayed cells and the client area; 2--the original rectangle is exclusively in the 'unused bit'. } var Row : TRowNum; Col : TColNum; Region : TOvcTblRegion; begin Result := 0; Region := CalcRowColFromXY(UR.Left, UR.Top, Row, Col); if (Region = otrInUnused) then begin Result := 2; FillChar(GR, sizeof(GR), $FF); {set 'em all to -1} Exit; end; GR.Left := tbFindColInx(Col); GR.Top := tbFindRowInx(Row); Region := CalcRowColFromXY(UR.Right, UR.Bottom, Row, Col); if (Region = otrInUnused) or (Region = otrOutside) then Result := 1; if (Col = CRCFXY_ColToRight) then GR.Right := pred(tbColNums^.Count) else GR.Right := tbFindColInx(Col); if (Row = CRCFXY_RowBelow) then GR.Bottom := pred(tbRowNums^.Count) else GR.Bottom := tbFindRowInx(Row); end; {--------} procedure TOvcCustomTable.tbCalcColData(var CD : POvcTblDisplayArray; NewLeftCol : TColNum); var X : integer; Width : integer; Access : TOvcTblAccess; Hidden : boolean; ColNum : TColNum; FullWidth : integer; PredColCount : TColNum; PredLocked : TColNum; begin {initialise} X := 0; ColNum := -1; CD^.Count := 0; FullWidth := ClientWidth; {save expense of function call in loop} PredColCount := pred(ColCount); {save expense of function call in loop} PredLocked := pred(LockedCols); {save expense of function call in loop} {deal with the locked columns first} if (LockedCols <> 0) then while (X < FullWidth) and (ColNum < PredLocked) do begin inc(ColNum); tbQueryColData(ColNum, Width, Access, Hidden); if not Hidden then begin with CD^ do begin with Ay[Count] do begin Number := ColNum; Offset := X; end; inc(Count); if (Count >= AllocNm) then AssignDisplayArray(CD, AllocNm+16); end; inc(X, Width); end; end; {now deal with the rightmost columns} ColNum := pred(NewLeftCol); while (X < FullWidth) and (ColNum < PredColCount) do begin inc(ColNum); tbQueryColData(ColNum, Width, Access, Hidden); if not Hidden then begin with CD^ do begin with Ay[Count] do begin Number := ColNum; Offset := X; end; inc(Count); if (Count >= AllocNm) then AssignDisplayArray(CD, AllocNm+16); end; inc(X, Width); end; end; {use the next spare element for storing the offset for the grid} with CD^ do Ay[Count].Offset := X; end; {--------} function TOvcCustomTable.CalcRowColFromXY(X, Y : integer; var RowNum : TRowNum; var ColNum : TColNum) : TOvcTblRegion; var ColInx : integer; RowInx : integer; CW : integer; CH : integer; TW : integer; TH : integer; begin RowNum := CRCFXY_RowBelow; ColNum := CRCFXY_ColToRight; CW := ClientWidth; CH := ClientHeight; {calculate the table width and height} with tbColNums^ do TW := MinI(CW, Ay[Count].Offset); with tbRowNums^ do TH := MinI(CH, Ay[Count].Offset); {make a first pass at calculating the region} if (X < 0) or (Y < 0) or (X >= CW) or (Y >= CH) then Result := otrOutside {definitely} else Result := otrInMain; {possibly, could also be one of the other two} {calculate row first} with tbRowNums^ do if (0 <= Y) and (Y < TH) then begin RowInx := 0; while (Ay[RowInx].Offset <= Y) do inc(RowInx); RowNum := Ay[pred(RowInx)].Number; end; {now calculate column} with tbColNums^ do if (0 <= X) and (X < TW) then begin ColInx := 0; while (Ay[ColInx].Offset <= X) do inc(ColInx); ColNum := Ay[pred(ColInx)].Number; end; {now patch up the region} if (Result = otrInMain) then if (RowNum = CRCFXY_RowBelow) or (ColNum = CRCFXY_ColToRight) then Result := otrInUnused else if (RowNum < LockedRows) or (ColNum < LockedCols) then Result := otrInLocked; {now patch up the row and column numbers} if (Result = otrOutside) or (Result = otrInUnused) then begin if (RowNum = CRCFXY_RowBelow) and (Y < 0) then RowNum := CRCFXY_RowAbove; if (ColNum = CRCFXY_ColToRight) and (X < 0) then ColNum := CRCFXY_ColToLeft; end; end; {--------} {$IFDEF SuppressWarnings} {$Warnings OFF} {$ENDIF} procedure TOvcCustomTable.tbCalcColsOnLastPage; var CD : POvcTblDisplayArray; OldLeftCol : TColNum; NewLeftCol : TColNum; StillGoing : boolean; begin OldLeftCol := 0; if (ColCount <= LockedCols) then begin tbColsOnLastPage := 0; Exit; end; CD := nil; AssignDisplayArray(CD, tbColNums^.AllocNm); try NewLeftCol := IncCol(pred(ColCount), 0); tbCalcColData(CD, NewLeftCol); if (CD^.Ay[CD^.Count].Offset > ClientWidth) then begin tbLastLeftCol := NewLeftCol; tbColsOnLastPage := 1; Exit; end; StillGoing := true; while StillGoing do begin OldLeftCol := NewLeftCol; NewLeftCol := IncCol(NewLeftCol, -1); if (NewLeftCol = OldLeftCol) then StillGoing := false else begin tbCalcColData(CD, NewLeftCol); StillGoing := (CD^.Ay[CD^.Count].Offset < ClientWidth); end; end; tbColsOnLastPage := ColCount - NewLeftCol; tbLastLeftCol := OldLeftCol; if tbLastLeftCol < LeftCol then LeftCol := tbLastLeftCol; finally AssignDisplayArray(CD, 0); end;{try..finally} end; {$IFDEF SuppressWarnings} {$Warnings ON} {$ENDIF} {--------} procedure TOvcCustomTable.tbCalcRowData(var RD : POvcTblDisplayArray; NewTopRow : TRowNum); var Y : integer; Height : integer; Hidden : boolean; RowNum : TRowNum; FullHeight : integer; PredRowLimit : TRowNum; PredLocked : TRowNum; begin {initialise} Y := 0; RowNum := -1; RD^.Count := 0; FullHeight := ClientHeight; {save expense of function call in loop} PredRowLimit := pred(RowLimit); {save expense of function call in loop} PredLocked := pred(LockedRows); {save expense of function call in loop} {deal with the locked rows first} if (LockedRows <> 0) then while (Y < FullHeight) and (RowNum < PredLocked) do begin inc(RowNum); tbQueryRowData(RowNum, Height, Hidden); if not Hidden then begin with RD^ do begin with Ay[Count] do begin Number := RowNum; Offset := Y; end; inc(Count); if (Count >= AllocNm) then AssignDisplayArray(RD, AllocNm+16); end; inc(Y, Height); end; end; {now deal with the rows underneath the fixed rows} RowNum := pred(NewTopRow); while (Y < FullHeight) and (RowNum < PredRowLimit) do begin inc(RowNum); tbQueryRowData(RowNum, Height, Hidden); if not Hidden then begin with RD^ do begin with Ay[Count] do begin Number := RowNum; Offset := Y; end; inc(Count); if (Count >= AllocNm) then AssignDisplayArray(RD, AllocNm+16); end; inc(Y, Height); end; end; {use the next spare element for storing the offset for the grid} with RD^ do Ay[Count].Offset := Y; end; {--------} {$IFDEF SuppressWarnings} {$Warnings OFF} {$ENDIF} procedure TOvcCustomTable.tbCalcRowsOnLastPage; var RD : POvcTblDisplayArray; OldTopRow : TRowNum; NewTopRow : TRowNum; StillGoing : boolean; begin OldTopRow := 0; if (RowLimit <= LockedRows) then begin tbRowsOnLastPage := 0; Exit; end; RD := nil; AssignDisplayArray(RD, tbRowNums^.AllocNm); try NewTopRow := IncRow(pred(RowLimit), 0); tbCalcRowData(RD, NewTopRow); if (RD^.Ay[RD^.Count].Offset >= ClientHeight) then begin tbLastTopRow := NewTopRow; tbRowsOnLastPage := 1; Exit; end; StillGoing := true; while StillGoing do begin OldTopRow := NewTopRow; NewTopRow := IncRow(OldTopRow, -1); if (NewTopRow = OldTopRow) then StillGoing := false else begin tbCalcRowData(RD, NewTopRow); StillGoing := (RD^.Ay[RD^.Count].Offset < ClientHeight); end; end; tbRowsOnLastPage := RowLimit - OldTopRow; tbLastTopRow := OldTopRow; if tbLastTopRow < TopRow then TopRow := tbLastTopRow; finally AssignDisplayArray(RD, 0); end;{try..finally} end; {$IFDEF SuppressWarnings} {$Warnings ON} {$ENDIF} {--------} procedure TOvcCustomTable.tbCalcHSBarPosCount; var Col : TColNum; begin tbHSBarPosCount := 0; for Col := LockedCols to tbLastLeftCol do if not tbIsColHidden(Col) then inc(tbHSBarPosCount); end; {--------} function TOvcCustomTable.tbCalcRequiresVSBar : boolean; var Row : TRowNum; begin {a fast check for possible hidden rows: if there are none and the last page's top row is not equal to the number of locked rows then obviously a vertical scrollbar is required.} if (LockedRows < tbLastTopRow) and (Rows.Count = 0) then begin Result := true; Exit; end; {otherwise check to see whether all rows between the locked rows and the last page's top row are hidden: if so no vertical scroll bar is required.} Result := false; for Row := LockedRows to pred(tbLastTopRow) do if not Rows.Hidden[Row] then begin Result := true; Exit; end; end; {--------} procedure TOvcCustomTable.ChangeScale(M, D : integer); var i : TColNum; begin inherited ChangeScale(M, D); if (M <> D) then begin Rows.rwScaleHeights(M, D); for i := 0 to pred(ColCount) do with Columns[i] do Width := MulDiv(Width, M, D); end; end; {--------} { - HWnd changed to TOvcHWnd for BCB Compatibility } function TOvcCustomTable.tbEditCellHasFocus( FocusHandle : TOvcHWnd{HWND}) : boolean; var ChildHandle : HWND; begin Result := false; if not InEditingState then Exit; if (tbActCell.EditHandle = 0) then Exit; Result := true; if (FocusHandle = tbActCell.EditHandle) then Exit; ChildHandle := GetWindow(tbActCell.EditHandle, GW_CHILD); while (ChildHandle <> 0) do begin if (FocusHandle = ChildHandle) then Exit; ChildHandle := GetWindow(ChildHandle, GW_CHILD); end; Result := false; end; {--------} procedure TOvcCustomTable.tbEnsureColumnIsVisible(ColNum : TColNum); var ColInx : integer; CW : integer; FarRight : integer; LeftInx : integer; LColOfs : integer; LColWd : integer; begin {get the index for the column} ColInx := tbFindColInx(ColNum); if (ColInx = -1) then begin {the column is not even visible} {make this column the left column} LeftCol := ColNum; end else begin CW := ClientWidth; with tbColNums^ do FarRight := Ay[succ(ColInx)].Offset; if (FarRight > CW) then begin {the column is partially visible} {pretend that we're scrolling the table left column by column, until either (1) the column we want is fully visible, or (2) the column we want is the leftmost column then set the leftmost column} LeftInx := tbFindColInx(LeftCol); LColOfs := tbColNums^.Ay[LeftInx].Offset; LColWd := tbColNums^.Ay[succ(LeftInx)].Offset - LColOfs; dec(FarRight, LColWd); inc(LColOfs, LColWd); inc(LeftInx); while (LeftInx < ColInx) and (FarRight > CW) do begin LColWd := tbColNums^.Ay[succ(LeftInx)].Offset - LColOfs; dec(FarRight, LColWd); inc(LColOfs, LColWd); inc(LeftInx); end; if (LeftInx < tbColNums^.Count) then LeftCol := tbColNums^.Ay[LeftInx].Number; end; end; end; {--------} procedure TOvcCustomTable.tbEnsureRowIsVisible(RowNum : TRowNum); var RowInx : integer; CH : integer; FarBottom: integer; TopInx : integer; TpRowOfs : integer; TpRowHt : integer; begin RowInx := tbFindRowInx(RowNum); if (RowInx = -1) then begin {the row is not even visible} {make this row the top row} TopRow := RowNum; end else begin CH := ClientHeight; with tbRowNums^ do FarBottom := Ay[succ(RowInx)].Offset; if (FarBottom > CH) then begin {the row is partially visible} {pretend that we're scrolling the table up row by row, until either (1) the row we want is fully visible, or (2) the row we want is the topmost row then set the topmost row} TopInx := tbFindRowInx(TopRow); TpRowOfs := tbRowNums^.Ay[TopInx].Offset; TpRowHt := tbRowNums^.Ay[succ(TopInx)].Offset - TpRowOfs; dec(FarBottom, TpRowHt); inc(TpRowOfs, TpRowHt); inc(TopInx); while (TopInx < RowInx) and (FarBottom > CH) do begin TpRowHt := tbRowNums^.Ay[succ(TopInx)].Offset - TpRowOfs; dec(FarBottom, TpRowHt); inc(TpRowOfs, TpRowHt); inc(TopInx); end; if (TopInx < tbRowNums^.Count) then TopRow := tbRowNums^.Ay[TopInx].Number; end; end; end; {--------} function TOvcCustomTable.tbFindCell(RowNum : TRowNum; ColNum : TColNum) : TOvcBaseTableCell; begin Result := FCells[RowNum, ColNum]; if not Assigned(Result) then if (RowNum < LockedRows) then Result := FLockedRowsCell else Result := FCols[ColNum].DefaultCell; end; {--------} function TOvcCustomTable.tbFindColInx(ColNum : TColNum) : integer; var L, M, R : integer; CurNumber : TColNum; begin Result := -1; with tbColNums^ do begin if (Count = 0) then Exit; L := 0; R := pred(Count); repeat M := (L + R) div 2; CurNumber := Ay[M].Number; if (ColNum = CurNumber) then begin Result := M; Exit; end else if (ColNum < CurNumber) then R := pred(M) else L := succ(M); until (L > R); end; end; {--------} function TOvcCustomTable.tbFindRowInx(RowNum : TRowNum) : integer; var L, M, R : integer; CurNumber : TRowNum; begin Result := -1; with tbRowNums^ do begin if (Count = 0) then Exit; L := 0; R := pred(Count); repeat M := (L + R) div 2; CurNumber := Ay[M].Number; if (RowNum = CurNumber) then begin Result := M; Exit; end else if (RowNum < CurNumber) then R := pred(M) else L := succ(M); until (L > R); end; end; {--------} procedure TOvcCustomTable.GetDisplayedColNums(var NA : TOvcTableNumberArray); var i : integer; WorkCount : integer; begin WorkCount := MinL(NA.NumElements, tbColNums^.Count); for i := 0 to pred(WorkCount) do NA.Number[i] := tbColNums^.Ay[i].Number; NA.Count := tbColNums^.Count end; {--------} procedure TOvcCustomTable.GetDisplayedRowNums(var NA : TOvcTableNumberArray); var i : integer; WorkCount : integer; begin WorkCount := MinL(NA.NumElements, tbRowNums^.Count); for i := 0 to pred(WorkCount) do NA.Number[i] := tbRowNums^.Ay[i].Number; NA.Count := tbRowNums^.Count end; {--------} function TOvcCustomTable.IncCol(ColNum : TColNum; Direction : integer) : TColNum; {-Return a valid unhidden column number. If Direction is: -ve : start at C and find the previous unhidden column number, if there is none previous to this one, return C. +ve : start at R and find the next unhidden column number, if there is none after this one, return C 0 : verify that C is unhidden, if not find the next unhidden column number, if none after this one, find the previous one. If still none, return C.} var CL, CC : TColNum; begin {save the values of properties in local variables} CL := LockedCols; CC := ColCount; {adjust ColNum to be in range} if (ColNum < CL) or (ColNum >= CC) then ColNum := CL; {first direction=0, ie to see whether the column is visible} Result := ColNum; if (Direction = 0) then {check not hidden} if not tbIsColHidden(Result) then Exit; {now direction>=0, ie to increment the column number} if (Direction >= 0) then {go forwards} begin inc(Result); while Result < CC do begin if not tbIsColHidden(Result) then Exit; inc(Result); end; Result := ColNum; end; {now direction<=0, ie to decrement the column number} if (Direction <= 0) then {go backwards} begin dec(Result); while (Result >= CL) do begin if not tbIsColHidden(Result) then Exit; dec(Result); end; Result := ColNum; end; end; {--------} function TOvcCustomTable.IncRow(RowNum : TRowNum; Direction : integer) : TRowNum; {-Return a valid unhidden row number. If Direction is: -ve : start at R and find the previous unhidden row number, if there is none previous to this one, return R. +ve : start at R and find the next unhidden row number, if there is none after this one, return R 0 : verify that R is unhidden, if not find the next unhidden row number, if none after this one, find the previous one. If still none, return R.} var RL, RC : TRowNum; begin {save the values of properties in local variables} RL := LockedRows; RC := RowLimit; {adjust RowNum to be in range} if (RowNum < RL) or (RowNum >= RC) then RowNum := RL; {first direction=0, ie to see whether the column is visible} Result := RowNum; if (Direction = 0) then {check not hidden} if not tbIsRowHidden(Result) then Exit; {now direction>=0, ie to increment the column number} if (Direction >= 0) then {go forwards} begin inc(Result); while (Result < RC) do begin if not tbIsRowHidden(Result) then Exit; inc(Result); end; Result := RowNum; end; {now direction<=0, ie to decrement the column number} if (Direction <= 0) then {go backwards} begin dec(Result); while (Result >= RL) do begin if not tbIsRowHidden(Result) then Exit; dec(Result); end; Result := RowNum; end; end; {--------} function TOvcCustomTable.InEditingState : boolean; begin Result := (tbState * [otsEditing, otsHiddenEdit]) <> []; end; {--------} function TOvcCustomTable.tbIsColHidden(ColNum : TColNum) : boolean; begin if (ColNum < 0) or (ColNum >= FCols.Count) then Result := True else Result := FCols[ColNum].Hidden; end; {--------} function TOvcCustomTable.tbIsOnGridLine(MouseX, MouseY : integer; var VerticalGrid : boolean) : boolean; var GridLine : integer; Inx : integer; LockedColsOffset : integer; LockedRowsOffset : integer; begin Result := false; {calc the offsets of the column and row} LockedColsOffset := -1; Inx := 0; with tbColNums^ do while (Inx < Count) do begin if (Ay[Inx].Number >= LockedCols) then Break; inc(Inx); LockedColsOffset := Ay[Inx].Offset; end; LockedRowsOffset := -1; Inx := 0; with tbRowNums^ do while (Inx < Count) do begin if (Ay[Inx].Number >= LockedRows) then Break; inc(Inx); LockedRowsOffset := Ay[Inx].Offset; end; {do the obvious test: cursor is not within the locked area} if (MouseX >= LockedColsOffset) and (MouseY >= LockedRowsOffset) then Exit; {check rows first} if (MouseX < LockedColsOffset) then begin Inx := 0; with tbRowNums^ do while (Inx < Count) do begin inc(Inx); GridLine := Ay[Inx].Offset; if (GridLine-2 <= MouseY) and (MouseY <= GridLine+2) then begin VerticalGrid := false; Result := true; tbSizeIndex := pred(Inx); Exit; end; end; end; {check columns next} if (MouseY < LockedRowsOffset) then begin Inx := 0; with tbColNums^ do while (Inx < Count) do begin inc(Inx); GridLine := Ay[Inx].Offset; if (GridLine-2 <= MouseX) and (MouseX <= GridLine+2) then begin VerticalGrid := true; Result := true; tbSizeIndex := pred(Inx); Exit; end; end; end; end; {--------} function TOvcCustomTable.tbIsInMoveArea(MouseX, MouseY : integer; var IsColMove : boolean) : boolean; var Inx : integer; LockedColsOffset : integer; LockedRowsOffset : integer; begin Result := false; IsColMove := false; {calc the offsets of the column and row} LockedColsOffset := -1; Inx := 0; with tbColNums^ do while (Inx < Count) do begin if (Ay[Inx].Number >= LockedCols) then Break; inc(Inx); LockedColsOffset := Ay[Inx].Offset; end; LockedRowsOffset := -1; Inx := 0; with tbRowNums^ do while (Inx < Count) do begin if (Ay[Inx].Number >= LockedRows) then Break; inc(Inx); LockedRowsOffset := Ay[Inx].Offset; end; {do the obvious test: cursor is not within the locked area} if (MouseX >= LockedColsOffset) and (MouseY >= LockedRowsOffset) then Exit; {the cursor is within the column move area if it's in a locked cell above the main area of the table; otherwise the cursor is within the row move area if it's in a locked cell to the left of the main area of the table} Result := (MouseX >= LockedColsOffset) and (MouseY < LockedRowsOffset) and (MouseX < tbColNums^.Ay[tbColNums^.Count].Offset); if Result then IsColMove := true else Result := (MouseX < LockedColsOffset) and (MouseY >= LockedRowsOffset) and (MouseY < tbRowNums^.Ay[tbRowNums^.Count].Offset); end; {--------} function TOvcCustomTable.tbIsRowHidden(RowNum : TRowNum) : boolean; begin Result := Rows[RowNum].Hidden; end; {--------} procedure TOvcCustomTable.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (AComponent is TOvcBaseTableCell) and (Operation = opRemove) then begin AllowRedraw := false; try if (FLockedRowsCell = TOvcBaseTableCell(AComponent)) then begin FLockedRowsCell.DecRefs; FLockedRowsCell := nil; tbCellChanged(Self); end; if Assigned(FCols) then FCols.tcNotifyCellDeletion(TOvcBaseTableCell(AComponent)); if Assigned(FCells) then FCells.tcNotifyCellDeletion(TOvcBaseTableCell(AComponent)); finally AllowRedraw := true; end;{try..finally} end; end; {--------} procedure TOvcCustomTable.tbQueryColData(ColNum : TColNum; var W : integer; var A : TOvcTblAccess; var H : boolean); var ColData : TOvcTableColumn; begin ColData := FCols[ColNum]; if Assigned(ColData) then with ColData do begin W := Width; if (DefaultCell <> nil) then A := DefaultCell.Access else A := otxReadOnly; H := Hidden; end; end; {--------} procedure TOvcCustomTable.tbQueryRowData(RowNum : TRowNum; var Ht: integer; var H : boolean); var RowData : TRowStyle; begin RowData := FRows[RowNum]; with RowData do begin Ht:= Height; H := Hidden; end; end; {--------} {$IFNDEF LCL} procedure TOvcCustomTable.SetBounds(ALeft, ATop, AWidth, AHeight: integer); {$ELSE} procedure TOvcCustomTable.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); {$ENDIF} // LCL port: Behavior of SetBounds changed in 0.9.29, so using DoSetBounds. // http://wiki.lazarus.freepascal.org/Lazarus_0.9.30_release_notes#overriding_TControl.SetBounds // Calls to TOvcTable.SetBounds will just be handled by ancestor. var WidthChanged : boolean; HeightChanged : boolean; begin if (not HandleAllocated) then begin {$IFNDEF LCL} inherited SetBounds(ALeft, ATop, AWidth, AHeight); {$ELSE} inherited DoSetBounds(ALeft, ATop, AWidth, AHeight); {$ENDIF} Exit; end; WidthChanged := (Width <> AWidth); HeightChanged := (Height <> AHeight); if WidthChanged or HeightChanged then begin AllowRedraw := false; try {$IFNDEF LCL} inherited SetBounds(ALeft, ATop, AWidth, AHeight); {$ELSE} inherited DoSetBounds(ALeft, ATop, AWidth, AHeight); {$ENDIF} if WidthChanged then tbCalcColData(tbColNums, LeftCol); if HeightChanged then tbCalcRowData(tbRowNums, TopRow); tbSetScrollRange(otsbVertical); tbSetScrollRange(otsbHorizontal); if (TopRow > tbLastTopRow) then TopRow := tbLastTopRow; if (LeftCol > tbLastLeftCol) then LeftCol := tbLastLeftCol; InvalidateTable; finally AllowRedraw := true; end;{try..finally} end else {$IFNDEF LCL} inherited SetBounds(ALeft, ATop, AWidth, AHeight); {$ELSE} inherited DoSetBounds(ALeft, ATop, AWidth, AHeight); {$ENDIF} end; {====================================================================} {==TOvcTable active cell movement====================================} procedure TOvcCustomTable.tbMoveActCellBotOfPage; var RowInx : integer; NewActiveRow : TRowNum; NewActiveCol : TColNum; begin with tbRowNums^ do if (Ay[Count].Offset <= ClientHeight) then NewActiveRow := IncRow(Ay[pred(Count)].Number, 0) else begin RowInx := pred(Count); if (RowInx > 0) then dec(RowInx); if (Ay[RowInx].Number < LockedRows) then NewActiveRow := IncRow(TopRow, 0) else NewActiveRow := IncRow(Ay[RowInx].Number, 0); end; NewActiveCol := ActiveCol; DoActiveCellMoving(ccBotOfPage, NewActiveRow, NewActiveCol); if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; {--------} procedure TOvcCustomTable.tbMoveActCellBotRight; var NewActiveRow : TRowNum; NewActiveCol : TColNum; begin NewActiveRow := IncRow(pred(RowLimit), 0); NewActiveCol := IncCol(pred(ColCount), 0); DoActiveCellMoving(ccBotRightCell, NewActiveRow, NewActiveCol); if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; {--------} procedure TOvcCustomTable.tbMoveActCellDown; var NewTopRow : TRowNum; NewActiveRow : TRowNum; NewActiveCol : TColNum; i : integer; begin NewTopRow := TopRow; NewActiveRow := IncRow(ActiveRow, 1); NewActiveCol := ActiveCol; DoActiveCellMoving(ccDown, NewActiveRow, NewActiveCol); if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then begin {we need to take care of a special case: if the current active cell is *exactly* on the last row of the page, we need to artificially move the top row down by one, before setting the active cell, otherwise the top row is forced to the active cell later on--a bit disconcerting.} with tbRowNums^ do if (Ay[Count].Offset = ClientHeight) and (ActiveRow = Ay[pred(Count)].Number) and (NewActiveRow > ActiveRow) then begin for i := 1 to NewActiveRow-ActiveRow do NewTopRow := IncRow(TopRow, 1); if (NewTopRow < NewActiveRow) then begin AllowRedraw := False; try TopRow := NewTopRow; tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); finally AllowRedraw := True; end;{try..finally} end else tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end else begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; end; {--------} procedure TOvcCustomTable.tbMoveActCellFirstCol; var NewActiveRow : TRowNum; NewActiveCol : TColNum; begin NewActiveCol := IncCol(LockedCols, 0); NewActiveRow := ActiveRow; DoActiveCellMoving(ccHome, NewActiveRow, NewActiveCol); if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; {--------} procedure TOvcCustomTable.tbMoveActCellFirstRow; var NewActiveRow : TRowNum; NewActiveCol : TColNum; begin NewActiveRow := IncRow(LockedRows, 0); NewActiveCol := ActiveCol; DoActiveCellMoving(ccFirstPage, NewActiveRow, NewActiveCol); if (ActiveRow <> NewActiveRow) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; {--------} procedure TOvcCustomTable.tbMoveActCellLastCol; var NewActiveRow : TRowNum; NewActiveCol : TColNum; begin NewActiveCol := IncCol(pred(ColCount), 0); NewActiveRow := ActiveRow; DoActiveCellMoving(ccEnd, NewActiveRow, NewActiveCol); if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; {--------} procedure TOvcCustomTable.tbMoveActCellLastRow; var NewActiveRow : TRowNum; NewActiveCol : TColNum; begin // Apparent TurboPower bug: not initializing NewActiveCol. // But not sure what it should be set to. NewActiveRow := IncRow(pred(RowLimit), 0); if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then begin NewActiveCol := ActiveCol; DoActiveCellMoving(ccLastPage, NewActiveRow, NewActiveCol); tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; {--------} procedure TOvcCustomTable.tbMoveActCellLeft; var NewActiveRow : TRowNum; NewActiveCol : TColNum; begin NewActiveCol := IncCol(ActiveCol, -1); NewActiveRow := ActiveRow; DoActiveCellMoving(ccLeft, NewActiveRow, NewActiveCol); if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; {--------} procedure TOvcCustomTable.tbMoveActCellPageDown; var NewTopRow, CurRow, LastRow : TRowNum; CurInx, LastInx : integer; NewActiveRow : TRowNum; NewActiveCol : TColNum; begin CurRow := ActiveRow; CurInx := tbFindRowInx(CurRow); with tbRowNums^ do begin LastInx := pred(Count); LastRow := Ay[LastInx].Number; end; if (CurRow = LastRow) then NewTopRow := IncRow(LastRow, 1) else NewTopRow := LastRow; AllowRedraw := false; try TopRow := NewTopRow; if (CurInx = -1) then NewActiveRow := IncRow(TopRow, 0) else if (CurInx < tbRowNums^.Count) then NewActiveRow := IncRow(tbRowNums^.Ay[CurInx].Number, 0) else NewActiveRow := IncRow(tbRowNums^.Ay[pred(tbRowNums^.Count)].Number, 0); NewActiveCol := ActiveCol; DoActiveCellMoving(ccNextPage, NewActiveRow, NewActiveCol); if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.tbMoveActCellPageLeft; var Walker, CurLeftCol : TRowNum; CurInx : integer; NewActiveRow : TRowNum; NewActiveCol : TColNum; begin CurLeftCol := LeftCol; if (ActiveCol = LeftCol) then begin Walker := IncCol(CurLeftCol, -1); if (Walker = CurLeftCol) then Exit; end; CurInx := tbFindColInx(ActiveCol); AllowRedraw := false; try tbScrollBarPageLeft; if (CurInx = -1) or (CurLeftCol = LeftCol) then NewActiveCol := IncCol(LeftCol, 0) else if (CurInx < tbColNums^.Count) then NewActiveCol := IncCol(tbColNums^.Ay[CurInx].Number, 0) else NewActiveCol := IncCol(tbColNums^.Ay[pred(tbColNums^.Count)].Number, 0); NewActiveRow := ActiveRow; DoActiveCellMoving(ccPageLeft, NewActiveRow, NewActiveCol); if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.tbMoveActCellPageRight; var NewLeftCol, CurCol, LastCol : TColNum; CurInx, LastInx : integer; NewActiveRow : TRowNum; NewActiveCol : TColNum; begin CurCol := ActiveCol; CurInx := tbFindColInx(CurCol); with tbColNums^ do begin LastInx := pred(Count); LastCol := Ay[LastInx].Number; end; if (CurCol = LastCol) then NewLeftCol := IncCol(LastCol, 1) else NewLeftCol := LastCol; AllowRedraw := false; try LeftCol := NewLeftCol; if (CurInx = -1) then NewActiveCol := IncCol(LeftCol, 0) else if (CurInx < tbColNums^.Count) then NewActiveCol := IncCol(tbColNums^.Ay[CurInx].Number, 0) else NewActiveCol := IncCol(tbColNums^.Ay[pred(tbColNums^.Count)].Number, 0); NewActiveRow := ActiveRow; DoActiveCellMoving(ccPageRight, NewActiveRow, NewActiveCol); if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.tbMoveActCellPageUp; var Walker, CurTopRow : TRowNum; CurInx : integer; NewActiveRow : TRowNum; NewActiveCol : TColNum; begin CurTopRow := TopRow; if (ActiveRow = TopRow) then begin Walker := IncRow(CurTopRow, -1); if (Walker = CurTopRow) then Exit; end; CurInx := tbFindRowInx(ActiveRow); AllowRedraw := false; try tbScrollBarPageUp; if (CurInx = -1) or (CurTopRow = TopRow) then NewActiveRow := IncRow(TopRow, 0) else if (CurInx < tbRowNums^.Count) then NewActiveRow := IncRow(tbRowNums^.Ay[CurInx].Number, 0) else NewActiveRow := IncRow(tbRowNums^.Ay[pred(tbRowNums^.Count)].Number, 0); NewActiveCol := ActiveCol; DoActiveCellMoving(ccPrevPage, NewActiveRow, NewActiveCol); if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.tbMoveActCellRight; var NewActiveRow : TRowNum; NewLeftCol, NewActiveCol : TColNum; i : integer; begin NewLeftCol := LeftCol; NewActiveCol := IncCol(ActiveCol, 1); NewActiveRow := ActiveRow; DoActiveCellMoving(ccRight, NewActiveRow, NewActiveCol); if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then begin {we need to take care of a special case: if the current active cell is *exactly* on the last column of the page, we need to artificially move the leftmost column across by one, before setting the active cell, otherwise the leftmost column is forced to the active cell later on--a bit disconcerting.} with tbColNums^ do if (NewActiveCol > ActiveCol) and (ActiveCol = Ay[pred(Count)].Number) and (Ay[Count].Offset = ClientWidth) then begin for i := 1 to NewActiveCol-ActiveCol do NewLeftCol := IncCol(LeftCol, 1); if (NewLeftCol < NewActiveCol) then begin AllowRedraw := False; try LeftCol := NewLeftCol; tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); finally AllowRedraw := True; end;{try..finally} end else tbSetActiveCellWithSel(NewActiveRow, NewActiveCol) end else tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; {--------} procedure TOvcCustomTable.tbMoveActCellTopLeft; var NewActiveRow : TRowNum; NewActiveCol : TColNum; begin NewActiveRow := IncRow(LockedRows, 0); NewActiveCol := IncCol(LockedCols, 0); DoActiveCellMoving(ccTopLeftCell, NewActiveRow, NewActiveCol); if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; {--------} procedure TOvcCustomTable.tbMoveActCellTopOfPage; var NewActiveRow : TRowNum; NewActiveCol : TColNum; begin NewActiveRow := IncRow(TopRow, 0); NewActiveCol := ActiveCol; DoActiveCellMoving(ccTopOfPage, NewActiveRow, NewActiveCol); if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; {--------} procedure TOvcCustomTable.tbMoveActCellUp; var NewActiveRow : TRowNum; NewActiveCol : TColNum; begin NewActiveRow := IncRow(ActiveRow, -1); NewActiveCol := ActiveCol; DoActiveCellMoving(ccUp, NewActiveRow, NewActiveCol); if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then begin tbSetActiveCellWithSel(NewActiveRow, NewActiveCol); end; end; {--------} procedure TOvcCustomTable.MoveActiveCell(Command : word); begin if (otoNoSelection in Options) then tbIsKeySelecting := false; case Command of {NOTE: this case statement has been optimised, the ccXxx constants are in ASCENDING order of value not name--it's lucky that the former implies the latter.} ccBotOfPage : tbMoveActCellBotOfPage; ccBotRightCell : tbMoveActCellBotRight; ccDown : tbMoveActCellDown; ccEnd : tbMoveActCellLastCol; ccFirstPage : tbMoveActCellFirstRow; ccHome : tbMoveActCellFirstCol; ccLastPage : tbMoveActCellLastRow; ccLeft : tbMoveActCellLeft; ccNextPage : tbMoveActCellPageDown; ccPageLeft : tbMoveActCellPageLeft; ccPageRight : tbMoveActCellPageRight; ccPrevPage : tbMoveActCellPageUp; ccRight : tbMoveActCellRight; ccTopLeftCell : tbMoveActCellTopLeft; ccTopOfPage : tbMoveActCellTopOfPage; ccUp : tbMoveActCellUp; end;{case} end; {====================================================================} {==TOvcTable scrollbar event handlers================================} procedure TOvcCustomTable.ProcessScrollBarClick(ScrollBar : TOvcScrollBar; ScrollCode : TScrollCode); var Form : TCustomForm; begin {check to see whether the cell being edited is valid; no scrolling allowed if it isn't (tough).} if InEditingState then begin if not tbActCell.CanSaveEditedData(true) then Exit; end; {perform the scroll} if (ScrollBar = otsbVertical) then case ScrollCode of scLineUp : tbScrollBarUp; scLineDown : tbScrollBarDown; scPageUp : tbScrollBarPageUp; scPageDown : tbScrollBarPageDown; end{case} else {it's otsbHorizontal} case ScrollCode of scLineUp : tbScrollBarLeft; scLineDown : tbScrollBarRight; scPageUp : tbScrollBarPageLeft; scPageDown : tbScrollBarPageRight; end;{case} if (otsDesigning in tbState) then begin Form := TCustomForm(GetParentForm(Self)); if (Form <> nil) and (Form.Designer <> nil) then Form.Designer.Modified; end; end; {--------} procedure TOvcCustomTable.tbScrollBarDown; begin TopRow := IncRow(TopRow, 1); end; {--------} procedure TOvcCustomTable.tbScrollBarPageDown; var LastInx : integer; LastRow : TRowNum; begin with tbRowNums^ do begin LastInx := pred(Count); LastRow := Ay[LastInx].Number; end; if (TopRow <> LastRow) then TopRow := LastRow else TopRow := IncRow(TopRow, 1); end; {--------} procedure TOvcCustomTable.tbScrollBarPageUp; var CurTopRow : TRowNum; Walker : TRowNum; CH : integer; OurRowNums: POvcTblDisplayArray; NewTopRow : TRowNum; begin {-Scroll the table so that the current top row appears at the bottom of the table window (if possible).} CurTopRow := TopRow; Walker := IncRow(CurTopRow, -1); if (Walker = CurTopRow) then Exit; OurRowNums := nil; AssignDisplayArray(OurRowNums, tbRowNums^.AllocNm); try CH := ClientHeight; NewTopRow := Walker; tbCalcRowData(OurRowNums, NewTopRow); while (OurRowNums^.Ay[OurRowNums^.Count].Offset < CH) or (OurRowNums^.Ay[pred(OurRowNums^.Count)].Number > CurTopRow) do begin Walker := IncRow(NewTopRow, -1); if (Walker = NewTopRow) then Break; NewTopRow := Walker; tbCalcRowData(OurRowNums, NewTopRow); end; finally AssignDisplayArray(OurRowNums, 0); end;{try..finally} TopRow := NewTopRow; end; {--------} procedure TOvcCustomTable.tbScrollBarUp; begin TopRow := IncRow(TopRow, -1); end; {--------} procedure TOvcCustomTable.tbScrollBarLeft; begin LeftCol := IncCol(LeftCol, -1); end; {--------} procedure TOvcCustomTable.tbScrollBarPageLeft; var CurLeftCol : TColNum; Walker : TColNum; CW : integer; OurColNums : POvcTblDisplayArray; NewLeftCol : TColNum; begin CurLeftCol := LeftCol; Walker := IncCol(CurLeftCol, -1); if (Walker = CurLeftCol) then Exit; OurColNums := nil; AssignDisplayArray(OurColNums, tbColNums^.AllocNm); try CW := ClientWidth; NewLeftCol := Walker; tbCalcColData(OurColNums, NewLeftCol); while (OurColNums^.Ay[OurColNums^.Count].Offset < CW) or (OurColNums^.Ay[pred(OurColNums^.Count)].Number > CurLeftCol) do begin Walker := IncCol(NewLeftCol, -1); if (Walker = NewLeftCol) then Break; NewLeftCol := Walker; tbCalcColData(OurColNums, NewLeftCol); end; finally AssignDisplayArray(OurColNums, 0); end;{try..finally} LeftCol := NewLeftCol; end; {--------} procedure TOvcCustomTable.tbScrollBarPageRight; var LastInx : integer; LastCol : TColNum; begin with tbColNums^ do begin LastInx := pred(Count); LastCol := Ay[LastInx].Number; end; if (LeftCol <> LastCol) then LeftCol := LastCol else LeftCol := IncCol(LeftCol, 1); end; {--------} procedure TOvcCustomTable.tbScrollBarRight; begin LeftCol := IncCol(LeftCol, 1); end; {====================================================================} {==TOvcTable table scrolling routines================================} procedure TOvcCustomTable.tbScrollTableLeft(NewLeftCol : TColNum); var NewColInx : integer; NewCLOfs : integer; OldColRight : TColNum; OldColInx : integer; OldCLOfs : integer; ColNum : TColNum; R : TRect; CW : integer; begin {the window is scrolled left, ie the new leftmost column is to the right of the current leftmost column} AllowRedraw := false; try NewColInx := tbFindColInx(NewLeftCol); CW := ClientWidth; if (NewColInx = -1) or (tbColNums^.Ay[succ(NewColInx)].Offset > CW) then begin {the new leftmost column is not (fully) visible} FLeftCol := NewLeftCol; tbCalcColData(tbColNums, LeftCol); InvalidateTableNotLockedCols; end else begin {the new leftmost column is fully visible} OldColInx := tbFindColInx(FLeftCol); with tbColNums^ do begin OldColRight := Ay[pred(Count)].Number; if (Ay[Count].Offset < CW) then begin inc(OldColRight); tbInvCells.AddUnusedBit; end; NewCLOfs := Ay[NewColInx].Offset; OldCLOfs := Ay[OldColInx].Offset; end; R := Rect(OldCLOfs, 0, CW, ClientHeight); ScrollWindow(Handle, (OldCLOfs-NewCLOfs), 0, @R, @R); FLeftCol := NewLeftCol; tbCalcColData(tbColNums, LeftCol); {$IFDEF MSWINDOWS} if (OldColRight <= tbColNums^.Ay[pred(tbColNums^.Count)].Number) then begin tbInvCells.AddUnusedBit; for ColNum := OldColRight to tbColNums^.Ay[pred(tbColNums^.Count)].Number do InvalidateColumn(ColNum); end; {$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all columns InvalidateTableNotLockedCols; {$ENDIF} R.Left := OldCLOfs + (CW - NewCLOfs); ValidateRect(Handle, @R); tbMustUpdate := true; UpdateWindow(Handle); end; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.tbScrollTableRight(NewLeftCol : TColNum); var OldLeftCol: TColNum; OldColInx : integer; OldCLOfs : integer; OrigOfs : integer; ColNum : TColNum; R : TRect; begin {the window is scrolled right, ie the new leftmost column is to the left of the current leftmost column} AllowRedraw := false; try OldLeftCol := FLeftCol; OldColInx := tbFindColInx(OldLeftCol); OrigOfs := tbColNums^.Ay[OldColInx].Offset; FLeftCol := NewLeftCol; tbCalcColData(tbColNums, LeftCol); OldColInx := tbFindColInx(OldLeftCol); if (OldColInx = -1) then begin {the old leftmost column is no longer visible} InvalidateTableNotLockedCols; end else begin {the old leftmost column is (partially) visible} OldCLOfs := tbColNums^.Ay[OldColInx].Offset; R := Rect(OrigOfs, 0, ClientWidth, ClientHeight); ScrollWindow(Handle, (OldClOfs-OrigOfs), 0, @R, @R); {$IFDEF MSWINDOWS} for ColNum := FLeftCol to pred(OldLeftCol) do InvalidateColumn(ColNum); {$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all columns InvalidateTableNotLockedCols; {$ENDIF} R.Right := OldCLOfs; ValidateRect(Handle, @R); tbMustUpdate := true; UpdateWindow(Handle); end; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.tbScrollTableUp(NewTopRow : TRowNum); var NewRowInx : integer; NewRTOfs : integer; OldRowBottom : TRowNum; OldRowInx : integer; OldRTOfs : integer; RowNum : TRowNum; R : TRect; CH : integer; begin {the window is scrolled up, ie the new topmost row is underneath the current topmost row} AllowRedraw := false; try NewRowInx := tbFindRowInx(NewTopRow); CH := ClientHeight; if (NewRowInx = -1) or (tbRowNums^.Ay[succ(NewRowInx)].Offset > CH) then begin {the new topmost row is not (fully) visible} FTopRow := NewTopRow; tbCalcRowData(tbRowNums, TopRow); InvalidateTableNotLockedRows; end else begin {the new topmost row is fully visible} OldRowInx := tbFindRowInx(FTopRow); with tbRowNums^ do begin OldRowBottom := Ay[pred(Count)].Number; if (Ay[Count].Offset < CH) then begin inc(OldRowBottom); tbInvCells.AddUnusedBit; end; NewRTOfs := Ay[NewRowInx].Offset; OldRTOfs := Ay[OldRowInx].Offset; end; R := Rect(0, OldRTOfs, ClientWidth, CH); ScrollWindow(Handle, 0, (OldRTOfs-NewRTOfs), @R, @R); FTopRow := NewTopRow; tbCalcRowData(tbRowNums, TopRow); {$IFDEF MSWINDOWS} if (OldRowBottom <= tbRowNums^.Ay[pred(tbRowNums^.Count)].Number) then begin tbInvCells.AddUnusedBit; for RowNum := OldRowBottom to tbRowNums^.Ay[pred(tbRowNums^.Count)].Number do InvalidateRow(RowNum); end; {$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all rows InvalidateTableNotLockedRows; {$ENDIF} R.Top := OldRTOfs + (CH - NewRTOfs); ValidateRect(Handle, @R); tbMustUpdate := true; UpdateWindow(Handle); end; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.tbScrollTableDown(NewTopRow : TRowNum); var OldTopRow : TRowNum; OldRowInx : integer; OldRTOfs : integer; OrigOfs : integer; RowNum : TRowNum; R : TRect; begin {the window is scrolled down, ie the new topmost row is above the current topmost row} AllowRedraw := false; try OldTopRow := FTopRow; OldRowInx := tbFindRowInx(OldTopRow); OrigOfs := tbRowNums^.Ay[OldRowInx].Offset; FTopRow := NewTopRow; tbCalcRowData(tbRowNums, TopRow); OldRowInx := tbFindRowInx(OldTopRow); if (OldRowInx = -1) then begin {the old topmost row is no longer visible} InvalidateTableNotLockedRows; end else begin {the old topmost row is (partially) visible} OldRTOfs := tbRowNums^.Ay[OldRowInx].Offset; R := Rect(0, OrigOfs, ClientWidth, ClientHeight); ScrollWindow(Handle, 0, (OldRTOfs-OrigOfs), @R, @R); {$IFDEF MSWINDOWS} for RowNum := FTopRow to pred(OldTopRow) do InvalidateRow(RowNum); {$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all rows InvalidateTableNotLockedRows; {$ENDIF} R.Bottom := OldRTOfs; ValidateRect(Handle, @R); tbMustUpdate := true; UpdateWindow(Handle); end; finally AllowRedraw := true; end;{try..finally} end; {====================================================================} {==TOvcTable drawing routines========================================} procedure TOvcCustomTable.tbDrawActiveCell; var RowOfs : integer; ColOfs : integer; RowInx : integer; ColInx : integer; Ht : integer; Wd : integer; ActRowOfs : integer; ActRowBottom : integer; ActColOfs : integer; ActColRight : integer; GridPen : TOvcGridPen; BrushColor : TColor; DrawItFocused: boolean; begin ActRowOfs := 0; ActRowBottom := 0; ActColOfs := 0; ActColRight := 0; {Find the cell's row on the screen, exit if not present} RowInx := tbFindRowInx(ActiveRow); if (RowInx = -1) then Exit; {Find the cell's column on the screen, exit if not present} ColInx := tbFindColInx(ActiveCol); if (ColInx = -1) then Exit; {If we are in editing mode, display the editing control for the cell, otherwise, draw the focus box around the cell contents} if InEditingState then begin {$IFDEF MSWINDOWS} UpdateWindow(tbActCell.EditHandle); //Not implemented on Gtk/Qt and recurses w/ Carbon {$ENDIF} end else begin {draw the box round the cell} with Canvas do begin {get the correct grid pen} if (otsFocused in tbState) then begin GridPen := GridPenSet.CellWhenFocused; DrawItFocused := true; end else begin GridPen := GridPenSet.CellWhenUnfocused; DrawItFocused := false; end; if GridPen.Effect = geNone then Exit; RowOfs := tbRowNums^.Ay[RowInx].Offset; Ht := tbRowNums^.Ay[succ(RowInx)].Offset - RowOfs; ColOfs := tbColNums^.Ay[ColInx].Offset; Wd := tbColNums^.Ay[succ(ColInx)].Offset - ColOfs; {calculate where to draw the vertical/horizontal lines} case GridPenSet.NormalGrid.Effect of geNone : begin ActRowOfs := RowOfs; ActRowBottom := RowOfs+Ht-1; ActColOfs := ColOfs; ActColRight := ColOfs+Wd-1 end; geVertical : begin ActRowOfs := RowOfs; ActRowBottom := RowOfs+Ht-1; ActColOfs := ColOfs; ActColRight := ColOfs+Wd-2; end; geHorizontal: begin ActRowOfs := RowOfs; ActRowBottom := RowOfs+Ht-2; ActColOfs := ColOfs; ActColRight := ColOfs+Wd-1; end; geBoth : begin ActRowOfs := RowOfs; ActRowBottom := RowOfs+Ht-2; ActColOfs := ColOfs; ActColRight := ColOfs+Wd-2; end; ge3D : begin ActRowOfs := RowOfs+1; ActRowBottom := RowOfs+Ht-2; ActColOfs := ColOfs+1; ActColRight := ColOfs+Wd-2; end; end;{case} {get the correct background color for the pen} if DrawItFocused then {$IFNDEF LCL} BrushColor := Colors.ActiveFocused else BrushColor := Colors.ActiveUnfocused; {$ELSE} BrushColor := Self.Colors.ActiveFocused else BrushColor := Self.Colors.ActiveUnfocused; {$ENDIF} Brush.Color := Color; {$IFNDEF LCL} Windows.SetBkColor(Handle, ColorToRGB(BrushColor)); {$ELSE} LclIntf.SetBkColor(Handle, ColorToRGB(BrushColor)); {$ENDIF} {set up the pen} with Pen do begin Width := 1; Style := GridPen.Style; Color := GridPen.NormalColor; end; {right line} if GridPen.Effect in [geVertical, geBoth, ge3D] then begin MoveTo(ActColRight, ActRowOfs); LineTo(ActColRight, ActRowBottom+1); end; {bottom line} if GridPen.Effect in [geHorizontal, geBoth, ge3D] then begin MoveTo(ActColOfs, ActRowBottom); LineTo(ActColRight+1, ActRowBottom); end; {if in 3D, must change colors} if (GridPen.Effect = ge3D) then Pen.Color := GridPen.SecondColor; {left line} if GridPen.Effect in [geVertical, geBoth, ge3D] then begin MoveTo(ActColOfs, ActRowOfs); LineTo(ActColOfs, ActRowBottom+1); end; {top line} if GridPen.Effect in [geHorizontal, geBoth, ge3D] then begin MoveTo(ActColOfs, ActRowOfs); LineTo(ActColRight+1, ActRowOfs); end; end; end; end; {--------} procedure TOvcCustomTable.tbDrawCells(RowInxStart, RowInxEnd : integer; ColInxStart, ColInxEnd : integer); var RowInx : integer; begin {Delphi bug fix - refresh the canvas handle to force brush to be recreated} Canvas.Refresh; {draw cells that need it} if (RowInxStart < 0) or (RowInxEnd < 0) or (ColInxStart < 0) or (ColInxEnd < 0) then Exit; with tbRowNums^ do for RowInx := RowInxStart to RowInxEnd do tbDrawRow(RowInx, ColInxStart, ColInxEnd); end; {--------} procedure TOvcCustomTable.tbDrawInvalidCells(InvCells : TOvcCellArray); var RowInx : integer; ColInx : integer; EndColInx : integer; CellInx : integer; NextCellInx: integer; OldRowNum : TRowNum; CellAddr : TOvcCellAddress; NewCellAddr: TOvcCellAddress; EndCol : TColNum; ContinueTrying : boolean; begin if (InvCells.Count > 0) then begin {Delphi bug fix - refresh the canvas handle to force brush to be recreated} Canvas.Refresh; {set up for while loop} OldRowNum := -1; CellInx := 0; while (CellInx < InvCells.Count) do begin InvCells.GetCellAddr(CellInx, CellAddr); RowInx := tbFindRowInx(CellAddr.Row); if (RowInx <> -1) then begin ColInx := tbFindColInx(CellAddr.Col); if (ColInx <> -1) then begin {have we switched rows?} if (OldRowNum <> CellAddr.Row) then OldRowNum := CellAddr.Row; {try and get a block of columns} EndCol := CellAddr.Col; NextCellInx := succ(CellInx); ContinueTrying := true; while ContinueTrying do begin if (NextCellInx >= InvCells.Count) then ContinueTrying := false else begin InvCells.GetCellAddr(NextCellInx, NewCellAddr); if (OldRowNum = NewCellAddr.Row) and (NewCellAddr.Col = succ(EndCol)) then begin EndCol := NewCellAddr.Col; inc(NextCellInx); end else ContinueTrying := false; end end; if (EndCol <> CellAddr.Col) then begin EndColInx := tbFindColInx(EndCol); CellInx := pred(NextCellInx); {just in case (hidden cols perhaps?)} while (EndColInx = -1) do begin dec(EndCol); EndColInx := tbFindColInx(EndCol); end end else EndColInx := ColInx; tbDrawRow(RowInx, ColInx, EndColInx); end; end; inc(CellInx); end; end; if InvCells.MustDoUnusedBit then DoPaintUnusedArea; InvCells.Clear; end; {--------} procedure TOvcCustomTable.tbDrawMoveLine; var OldPen : TPen; MoveOffset : integer; begin if tbDrag <> nil then tbDrag.HideDragImage; if (otsMoving in tbState) then with Canvas do begin OldPen := TPen.Create; try OldPen.Assign(Pen); try Pen.Mode := pmXor; Pen.Style := psSolid; Pen.Color := clWhite; Pen.Width := 3; if (otsDoingCol in tbState) then begin if (tbMoveIndex < tbMoveIndexTo) then MoveOffset := tbColNums^.Ay[succ(tbMoveIndexTo)].Offset else MoveOffset := tbColNums^.Ay[tbMoveIndexTo].Offset; MoveTo(MoveOffset, 0); LineTo(MoveOffset, ClientHeight); end else {doing row} begin if (tbMoveIndex < tbMoveIndexTo) then MoveOffset := tbRowNums^.Ay[succ(tbMoveIndexTo)].Offset else MoveOffset := tbRowNums^.Ay[tbMoveIndexTo].Offset; MoveTo(0, MoveOffset); LineTo(ClientWidth, MoveOffset); end finally Canvas.Pen := OldPen; end;{try..finally} finally OldPen.Free; end;{try..finally} end; if tbDrag <> nil then tbDrag.ShowDragImage; end; {--------} procedure TOvcCustomTable.tbDrawRow(RowInx : integer; ColInxStart, ColInxEnd : integer); var RowOfs : integer; RowHt : integer; RowNum : TRowNum; ColInx : integer; ColNum : TColNum; ColOfs : integer; ColWd : integer; Cell : TOvcBaseTableCell; Data : pointer; GridPen : TOvcGridPen; BrushColor: TColor; CellAttr : TOvcCellAttributes; DestRect : TRect; RowIsLocked : boolean; ColIsLocked : boolean; IsActiveRow : boolean; begin {calculate data about the row, tell the user we're entering the row} with tbRowNums^ do begin RowNum := Ay[RowInx].Number; RowOfs := Ay[RowInx].Offset; RowHt := Ay[succ(RowInx)].Offset - RowOfs; end; IsActiveRow := ActiveRow = RowNum; RowIsLocked := RowNum < LockedRows; { Don't fire the OnEnteringRow when we are painting, unless } { OldRowColBehavior is true } if OldRowColBehavior then DoEnteringRow(RowNum); {set up the cell attribute record} FillChar(CellAttr, sizeof(CellAttr), 0); CellAttr.caFont := tbCellAttrFont; {for all required cells} for ColInx := ColInxEnd downto ColInxStart do begin {calculate data about the column, tell the user we're entering the column} with tbColNums^ do begin ColNum := Ay[ColInx].Number; ColOfs := Ay[ColInx].Offset; ColWd := Ay[succ(ColInx)].Offset - ColOfs; end; ColIsLocked := (ColNum < LockedCols); { Don't fire the OnEnteringCol when we are painting, unless } { OldRowColBehavior is true } if OldRowColBehavior then DoEnteringColumn(ColNum); {get the gridpen for the cell} if (RowIsLocked or ColIsLocked) then GridPen := GridPenSet.LockedGrid else GridPen := GridPenSet.NormalGrid; {calculate row height/column width available to the cell} DestRect := Rect(ColOfs, RowOfs, ColOfs+ColWd, RowOfs+RowHt); case GridPen.Effect of geVertical : dec(DestRect.Right); geHorizontal: dec(DestRect.Bottom); geBoth : begin dec(DestRect.Right); dec(DestRect.Bottom); end; ge3D : InflateRect(DestRect, -1, -1); end;{case} {don't do painting for the cell being edited} Cell := nil; if not (IsActiveRow and (ColNum = ActiveCol) and (InEditingState)) then begin {get the cell} Cell := tbFindCell(RowNum, ColNum); if Assigned(Cell) then begin {paint it} DoGetCellData(RowNum, ColNum, Data, cdpForPaint); CellAttr.caFont.Assign(Font); Cell.ResolveAttributes(RowNum, ColNum, CellAttr); Cell.Paint(Canvas, DestRect, RowNum, ColNum, CellAttr, Data); end; end; {if no cell found or it's the active cell in editing mode clear the rectangle} if not Assigned(Cell) or (IsActiveRow and (ColNum = ActiveCol) and InEditingState) then begin with CellAttr do begin caAccess := otxDefault; caAdjust := otaDefault; caColor := Color; caFont.Assign(Font); caFontColor := Font.Color; end; ResolveCellAttributes(RowNum, ColNum, CellAttr); Canvas.Brush.Color := CellAttr.caColor; Canvas.FillRect(DestRect); end; {Check to see if there is a grid to display} if (GridPen.Effect <> geNone) then with Canvas do begin {Get ready to draw the cell's grid} BrushColor := Color; Brush.Color := BrushColor; Pen.Style := GridPen.Style; Pen.Width := 1; {$IFNDEF LCL} Windows.SetBkColor(Handle, ColorToRGB(BrushColor)); {$ELSE} LclIntf.SetBkColor(Handle, ColorToRGB(BrushColor)); {$ENDIF} {draw the top and left lines, only if required of course} if (GridPen.Effect = ge3D) then begin {set the pen color for the top & left} Pen.Color := GridPen.SecondColor; {draw the lines} MoveTo(ColOfs, pred(RowOfs+RowHt)); LineTo(ColOfs, RowOfs); LineTo(ColOfs+ColWd, RowOfs); end; {set the pen color for the bottom & right} Pen.Color := GridPen.NormalColor; {draw right line} if (GridPen.Effect <> geHorizontal) then begin MoveTo(ColOfs+ColWd-1, RowOfs); LineTo(ColOfs+ColWd-1, RowOfs+RowHt); end; {draw bottom line} if (GridPen.Effect <> geVertical) then begin MoveTo(ColOfs, pred(RowOfs+RowHt)); LineTo(ColOfs+ColWd, pred(RowOfs+RowHt)); end; end; end; end; {--------} procedure TOvcCustomTable.tbDrawSizeLine; var OldPen : TPen; begin if (otsSizing in tbState) then with Canvas do begin OldPen := TPen.Create; try OldPen.Assign(Pen); Pen.Color := clBlack; Pen.Mode := pmXor; Pen.Style := psDot; Pen.Width := 1; if (otsDoingRow in tbState) then begin MoveTo(0, tbSizeOffset); LineTo(ClientWidth, tbSizeOffset); end else begin MoveTo(tbSizeOffset, 0); LineTo(tbSizeOffset, ClientHeight); end; finally Canvas.Pen := OldPen; OldPen.Free; end;{try..finally} end; end; {--------} procedure TOvcCustomTable.tbDrawUnusedBit; var R : TRect; CR : TRect; ChangedBrush : boolean; begin ChangedBrush := false; {$IFNDEF LCL} Windows.GetClientRect(Handle, CR); {$ELSE} LclIntf.GetClientRect(Handle, CR); {$ENDIF} with R, tbColNums^ do begin Left := Ay[Count].Offset; Right := CR.Right; Top := 0; Bottom := CR.Bottom; end; if (R.Left < R.Right) then with Canvas do begin Brush.Color := ColorUnused; FillRect(R); ChangedBrush := true; end; with R, tbRowNums^ do begin Right := Left; Left := 0; Top := Ay[Count].Offset; end; if (R.Top < R.Bottom) then with Canvas do begin if not ChangedBrush then Brush.Color := ColorUnused; FillRect(R); end; end; {--------} procedure TOvcCustomTable.Paint; var UR, GR : TRect; WhatToPaint : integer; RowInx : integer; ColInx : integer; begin {don't do anything if the table is locked from drawing and there is no scrolling going on (tbMustUpdate is *only* set in the tbScrollTableXxx methods to force an update).} if (tbLockCount > 0) and (not tbMustUpdate) then begin Exit; end; if tbDrag <> nil then tbDrag.HideDragImage; {$IFNDEF LCL} Windows.GetClipBox(Canvas.Handle, UR); {$ELSE} LclIntf.GetClipBox(Canvas.Handle, @UR); {$ENDIF} WhatToPaint := tbCalcCellsFromRect(UR, GR); if (WhatToPaint = 0) and (otsEditing in tbState) and ((GR.Top = ActiveRow) and (GR.Bottom = ActiveRow) and (GR.Left = ActiveCol) and (GR.Right = ActiveCol)) then Exit; {if we are actually processing a WM_PAINT message, then paint the invalid cells, etc} if (tbLockCount = 0) then begin if (WhatToPaint <> 2) then tbDrawCells(GR.Top, GR.Bottom, GR.Left, GR.Right); if (WhatToPaint <> 0) then DoPaintUnusedArea; tbDrawActiveCell; end {otherwise we are in the middle of a scroll operation, so just invalidate the cells that need it} else {tbLockCount > 0, ie tbMustUpdate is true} begin if (WhatToPaint <> 2) then for RowInx := GR.Top to GR.Bottom do for ColInx := GR.Left to GR.Right do InvalidateCell(tbRowNums^.Ay[RowInx].Number, tbColNums^.Ay[ColInx].Number); if (WhatToPaint <> 0) then tbInvCells.AddUnusedBit; tbMustUpdate := false; end; if tbDrag <> nil then tbDrag.ShowDragImage; end; {====================================================================} {==TOvcTable event handlers==========================================} procedure TOvcCustomTable.DoActiveCellChanged(RowNum : TRowNum; ColNum : TColNum); begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FActiveCellChanged) then FActiveCellChanged(Self, RowNum, ColNum); end; {--------} procedure TOvcCustomTable.DoActiveCellMoving(Command : word; var RowNum : TRowNum; var ColNum : TColNum); begin if ((ComponentState * [csLoading, csDestroying]) <> []) then Exit; if Assigned(FActiveCellMoving) then FActiveCellMoving(Self, Command, RowNum, ColNum); if InEditingState and ((RowNum <> ActiveRow) or (ColNum <> ActiveCol)) then if not StopEditingState(true) then begin RowNum := ActiveRow; ColNum := ActiveCol; Exit; end; end; {--------} procedure TOvcCustomTable.DoBeginEdit(RowNum : TRowNum; ColNum : TColNum; var AllowIt : boolean); begin if ((ComponentState * [csLoading, csDestroying]) <> []) then AllowIt := false else begin AllowIt := true; if Assigned(FBeginEdit) then FBeginEdit(Self, RowNum, ColNum, AllowIt); end; end; {--------} procedure TOvcCustomTable.DoClipboardCopy; begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FClipboardCopy) then FClipboardCopy(Self); end; {--------} procedure TOvcCustomTable.DoClipboardCut; begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FClipboardCut) then FClipboardCut(Self); end; {--------} procedure TOvcCustomTable.DoClipboardPaste; begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FClipboardPaste) then FClipboardPaste(Self); end; {--------} procedure TOvcCustomTable.DoColumnsChanged(ColNum1, ColNum2 : TColNum; Action : TOvcTblActions); var i : integer; begin for i := 0 to pred(taCellList.Count) do if (TOvcTableCellAncestor(taCellList[i]) is TOvcTCColHead) then TOvcTCColHead(taCellList[i]).chColumnsChanged(ColNum1, ColNum2, Action); if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FColumnsChanged) then FColumnsChanged(Self, ColNum1, ColNum2, Action); end; {--------} procedure TOvcCustomTable.DoDoneEdit(RowNum : TRowNum; ColNum : TColNum); begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FDoneEdit) then FDoneEdit(Self, RowNum, ColNum); end; {--------} procedure TOvcCustomTable.DoEndEdit(Cell : TOvcBaseTableCell; RowNum : TRowNum; ColNum : TColNum; var AllowIt : boolean); begin if ((ComponentState * [csLoading, csDestroying]) <> []) then AllowIt := false else begin AllowIt := true; if Assigned(FEndEdit) then FEndEdit(Self, Cell, RowNum, ColNum, AllowIt); end; end; {--------} procedure TOvcCustomTable.DoEnteringColumn(ColNum : TColNum); begin if (ColNum <> tbLastEntCol) then begin tbLastEntCol := ColNum; if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FEnteringColumn) then FEnteringColumn(Self, ColNum); end; end; {--------} procedure TOvcCustomTable.DoEnteringRow(RowNum : TRowNum); begin if (RowNum <> tbLastEntRow) then begin tbLastEntRow := RowNum; if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FEnteringRow) then FEnteringRow(Self, RowNum); end; end; {--------} procedure TOvcCustomTable.DoGetCellAttributes(RowNum : TRowNum; ColNum : TColNum; var CellAttr : TOvcCellAttributes); begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FGetCellAttributes) then FGetCellAttributes(Self, RowNum, ColNum, CellAttr); end; {--------} procedure TOvcCustomTable.DoGetCellData(RowNum : TRowNum; ColNum : TColNum; var Data : pointer; Purpose : TOvcCellDataPurpose); begin Data := nil; if ((ComponentState * [csLoading, csDestroying]) = []) and HandleAllocated and Assigned(FGetCellData) then FGetCellData(Self, RowNum, ColNum, Data, Purpose); end; {--------} procedure TOvcCustomTable.DoLeavingColumn(ColNum : TColNum); begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FLeavingColumn) then FLeavingColumn(Self, ColNum); end; {--------} procedure TOvcCustomTable.DoLeavingRow(RowNum : TRowNum); begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FLeavingRow) then FLeavingRow(Self, RowNum); end; {--------} procedure TOvcCustomTable.DoLockedCellClick(RowNum : TRowNum; ColNum : TColNum); begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FLockedCellClick) then FLockedCellClick(Self, RowNum, ColNum); end; {--------} procedure TOvcCustomTable.DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt); begin inherited DoOnMouseWheel(Shift, Delta, XPos, YPos); if (ssCtrl in Shift) then begin if (Delta > 0) then tbMoveActCellPageUp else tbMoveActCellPageDown; end else begin if Delta < 0 then MoveActiveCell(ccDown) else MoveActiveCell(ccUp); end; end; procedure TOvcCustomTable.DoPaintUnusedArea; begin if ((ComponentState * [csLoading, csDestroying]) <> []) then Exit; if Assigned(FPaintUnusedArea) then FPaintUnusedArea(Self) else tbDrawUnusedBit; end; {--------} procedure TOvcCustomTable.DoRowsChanged(RowNum1, RowNum2 : TRowNum; Action : TOvcTblActions); begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FRowsChanged) then FRowsChanged(Self, RowNum1, RowNum2, Action); end; {--------} procedure TOvcCustomTable.DoSizeCellEditor(RowNum : TRowNum; ColNum : TColNum; var CellRect : TRect; var CellStyle: TOvcTblEditorStyle); begin if Assigned(FSizeCellEditor) then FSizeCellEditor(Self, RowNum, ColNum, CellRect, CellStyle); end; {--------} procedure TOvcCustomTable.DoTopLeftCellChanged(RowNum : TRowNum; ColNum : TColNum); begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FTopLeftCellChanged) then FTopLeftCellChanged(Self, RowNum, ColNum); end; {--------} procedure TOvcCustomTable.DoTopLeftCellChanging(var RowNum : TRowNum; var ColNum : TColNum); begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FTopLeftCellChanging) then FTopLeftCellChanging(Self, RowNum, ColNum); end; {--------} procedure TOvcCustomTable.DoUserCommand(Cmd : word); begin if ((ComponentState * [csLoading, csDestroying]) = []) and Assigned(FUserCommand) then FUserCommand(Self, Cmd); end; {====================================================================} {==TOvcTable Windows Message handlers================================} procedure TOvcCustomTable.CMColorChanged(var Msg : TMessage); begin inherited; AllowRedraw := false; tbNotifyCellsOfTableChange; AllowRedraw := true; end; {--------} {$IFNDEF LCL} procedure TOvcCustomTable.CMCtl3DChanged(var Msg : TMessage); begin if (csLoading in ComponentState) or not HandleAllocated then Exit; if NewStyleControls and (FBorderStyle = bsSingle) then {$IFNDEF LCL} RecreateWnd; {$ELSE} MyMisc.RecreateWnd(Self); {$ENDIF} inherited; end; {$ENDIF} {--------} procedure TOvcCustomTable.CMDesignHitTest(var Msg : TCMDesignHitTest); var IsVert : boolean; IsColMove : boolean; OnGridLine : boolean; begin Msg.Result := 1; if (otsDesigning in tbState) then begin if ((tbState * [otsSizing, otsMoving]) <> []) then Exit; Msg.Result := 0; OnGridLine := tbIsOnGridLine(Msg.Pos.X, Msg.Pos.Y, IsVert); if OnGridLine then Msg.Result := 1 else Msg.Result := longint(tbIsInMoveArea(Msg.Pos.X, Msg.Pos.Y, IsColMove)); end; end; {--------} procedure TOvcCustomTable.CMFontChanged(var Msg : TMessage); begin inherited; AllowRedraw := false; tbNotifyCellsOfTableChange; AllowRedraw := true; end; {--------} procedure TOvcCustomTable.ctimQueryOptions(var Msg : TMessage); begin {$IFNDEF LCL} Msg.Result := longint(word(FOptions)); {$ELSE} // Msg.Result := longint(FOptions); //this used to compile - not sure what changed in Laz 1.6 Msg.Result := longint(word(FOptions)); {$ENDIF} end; {--------} procedure TOvcCustomTable.ctimQueryColor(var Msg : TMessage); begin Msg.Result := longint(Color); end; {--------} procedure TOvcCustomTable.ctimQueryFont(var Msg : TMessage); begin Msg.Result := LRESULT(Font); //64 end; {--------} procedure TOvcCustomTable.ctimQueryLockedCols(var Msg : TMessage); begin Msg.Result := longint(LockedCols); end; {--------} procedure TOvcCustomTable.ctimQueryLockedRows(var Msg : TMessage); begin Msg.Result := longint(LockedRows); end; {--------} procedure TOvcCustomTable.ctimQueryActiveCol(var Msg : TMessage); begin Msg.Result := longint(ActiveCol); end; {--------} procedure TOvcCustomTable.ctimQueryActiveRow(var Msg : TMessage); begin Msg.Result := longint(ActiveRow); end; {--------} procedure TOvcCustomTable.ctimRemoveCell(var Msg : TMessage); begin Notification(TComponent(Msg.LParam), opRemove); Msg.Result := 0; end; {--------} procedure TOvcCustomTable.ctimStartEdit(var Msg : TMessage); begin if not StartEditingState then begin AllowRedraw := false; InvalidateCell(ActiveRow, ActiveCol); AllowRedraw := true; end; Msg.Result := 1; end; {--------} procedure TOvcCustomTable.ctimStartEditMouse(var Msg : TWMMouse); begin if Assigned(tbActCell) and InEditingState then if tbActCell.AcceptActivationClick then begin {$IFNDEF LCL} Windows.SetFocus(tbActCell.EditHandle); {$ELSE} LclIntf.SetFocus(tbActCell.EditHandle); {$ENDIF} PostMessage(tbActCell.EditHandle, WM_LBUTTONDOWN, Msg.Keys, longint(Msg.Pos)) end; Msg.Result := 1; end; {--------} procedure TOvcCustomTable.ctimStartEditKey(var Msg : TWMKey); begin if Assigned(tbActCell) and InEditingState then begin {$IFNDEF LCL} Windows.SetFocus(tbActCell.EditHandle); {$ELSE} LclIntf.SetFocus(tbActCell.EditHandle); {$ENDIF} PostMessage(tbActCell.EditHandle, WM_KEYDOWN, Msg.CharCode, Msg.KeyData); end; Msg.Result := 1; end; {--------} procedure TOvcCustomTable.ctimLoadDefaultCells(var Msg : TMessage); begin AllowRedraw := false; tbFinishLoadingCellList; tbFinishLoadingDefaultCells; Msg.Result := 0; tbMustFinishLoading := false; AllowRedraw := true; end; {--------} procedure TOvcCustomTable.WMCancelMode(var Msg : TMessage); begin inherited; tbIsKeySelecting := false; if (otsMouseSelect in tbState) then tbState := tbState - [otsMouseSelect] + [otsNormal]; end; {--------} procedure TOvcCustomTable.WMEraseBkGnd(var Msg : TWMEraseBkGnd); begin Msg.Result := 1; {no erasing of the background, we'll do it all} end; {--------} procedure TOvcCustomTable.WMGetDlgCode(var Msg : TMessage); begin Msg.Result := DLGC_WANTCHARS or DLGC_WANTARROWS; if (otoTabToArrow in Options) then Msg.Result := Msg.Result or DLGC_WANTTAB; end; {--------} procedure TOvcCustomTable.WMHScroll(var Msg : TWMScroll); {------} procedure ProcessThumb; var i : integer; NewLeftCol : TColNum; begin NewLeftCol := LockedCols; for i := 0 to pred(Msg.Pos) do NewLeftCol := IncCol(NewLeftCol, 1); if (NewLeftCol <> LeftCol) then LeftCol := NewLeftCol; end; {------} begin {ignore SB_ENDSCROLL and SB_THUMBTRACK messages (the latter if required to by the Options property): this'll possibly avoid multiple validations} if (Msg.ScrollCode = SB_ENDSCROLL) or ((Msg.ScrollCode = SB_THUMBTRACK) and (not (otoThumbTrack in Options))) then begin inherited; Exit; end; {if not focused then do so; if being designed update the table view} if (otsUnfocused in tbState) then {$IFDEF MSWINDOWS} //Apparently can't focus scroll bar with GTK? SetFocus {$ENDIF} else if (otsDesigning in tbState) then Update; {check to see whether the cell being edited is valid; no scrolling allowed if it isn't (tough).} if InEditingState then begin if not tbActCell.CanSaveEditedData(true) then Exit; end; {process the scrollbar message} case Msg.ScrollCode of SB_LINELEFT : ProcessScrollBarClick(otsbHorizontal, scLineUp); SB_LINERIGHT : ProcessScrollBarClick(otsbHorizontal, scLineDown); SB_PAGELEFT : ProcessScrollBarClick(otsbHorizontal, scPageUp); SB_PAGERIGHT : ProcessScrollBarClick(otsbHorizontal, scPageDown); SB_THUMBPOSITION : ProcessThumb; SB_THUMBTRACK : if (otoThumbTrack in Options) then ProcessThumb; else inherited; Exit; end; Msg.Result := 0; end; {--------} procedure TOvcCustomTable.WMKeyDown(var Msg : TWMKey); var Cmd : word; ShiftFlags : byte; begin inherited; {If Tab key is being converted to arrow key, do it} if (otoTabToArrow in Options) and (Msg.CharCode = VK_TAB) then begin {get shift value} ShiftFlags := GetShiftFlags; {convert Tab combination to command} if (ShiftFlags = 0) then Cmd := ccRight else if (ShiftFlags = ss_Shift) then Cmd := ccLeft else Cmd := ccNone; end {If Enter key is being converted to right arrow, do it.} else if (otoEnterToArrow in Options) and (Msg.CharCode = VK_RETURN) then begin {get shift value} ShiftFlags := GetShiftFlags; {convert Enter combination to command} if (ShiftFlags = 0) then Cmd := ccRight else Cmd := ccNone; end {Otherwise just translate into a command} else Cmd := Controller.EntryCommands.TranslateUsing([tbCmdTable^], TMessage(Msg)); if InEditingState then begin if (not (otoAlwaysEditing in Options)) and ((Cmd = ccTableEdit) or (Msg.CharCode = VK_ESCAPE)) then begin if not StopEditingState(Msg.CharCode <> VK_ESCAPE) then begin inherited; Exit; end; end end else {not editing} if (Cmd = ccTableEdit) or ((Cmd > ccLastCmd) and (Cmd < ccUserFirst) and ((Msg.CharCode = VK_SPACE) or ((VK_0 <= Msg.CharCode) and (Msg.CharCode <= VK_DIVIDE)) or (Msg.CharCode >= $BA))) then begin PostMessage(Handle, ctim_StartEdit, 0, 0); if (Cmd <> ccTableEdit) then PostMessage(Handle, ctim_StartEditKey, Msg.CharCode, Msg.KeyData); end; tbIsKeySelecting := false; case Cmd of ccBotOfPage, ccBotRightCell, ccDown, ccEnd, ccFirstPage, ccHome, ccLastPage, ccLeft, ccNextPage, ccPageLeft, ccPageRight, ccPrevPage, ccRight, ccTopLeftCell, ccTopOfPage, ccUp : MoveActiveCell(Cmd); ccExtendDown : begin tbIsKeySelecting := true; MoveActiveCell(ccDown); end; ccExtendEnd : begin tbIsKeySelecting := true; MoveActiveCell(ccEnd); end; ccExtendHome : begin tbIsKeySelecting := true; MoveActiveCell(ccHome); end; ccExtendLeft : begin tbIsKeySelecting := true; MoveActiveCell(ccLeft); end; ccExtendPgDn : begin tbIsKeySelecting := true; MoveActiveCell(ccNextPage); end; ccExtendPgUp : begin tbIsKeySelecting := true; MoveActiveCell(ccPrevPage); end; ccExtendRight : begin tbIsKeySelecting := true; MoveActiveCell(ccRight); end; ccExtendUp : begin tbIsKeySelecting := true; MoveActiveCell(ccUp); end; ccExtBotOfPage : begin tbIsKeySelecting := true; MoveActiveCell(ccBotOfPage); end; ccExtFirstPage : begin tbIsKeySelecting := true; MoveActiveCell(ccFirstPage); end; ccExtLastPage : begin tbIsKeySelecting := true; MoveActiveCell(ccLastPage); end; ccExtTopOfPage : begin tbIsKeySelecting := true; MoveActiveCell(ccTopOfPage); end; ccExtWordLeft : begin tbIsKeySelecting := true; MoveActiveCell(ccWordLeft); end; ccExtWordRight : begin tbIsKeySelecting := true; MoveActiveCell(ccWordRight); end; ccCopy : DoClipboardCopy; ccCut : DoClipboardCut; ccPaste : DoClipboardPaste; else if (Cmd >= ccUserFirst) then DoUserCommand(Cmd); end; end; {--------} procedure TOvcCustomTable.WMKillFocus(var Msg : TWMKillFocus); begin inherited; if (otsEditing in tbState) then begin Exit; end; AllowRedraw := false; try InvalidateCell(ActiveRow, ActiveCol); tbState := tbState - [otsFocused] + [otsUnfocused]; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.WMLButtonDblClk(var Msg : TWMMouse); var Row : TRowNum; Col : TColNum; Region : TOvcTblRegion; begin inherited; if not (otsDesigning in tbState) then begin Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col); if Region = (otrInMain) then begin PostMessage(Handle, ctim_StartEdit, Msg.Keys, longint(Msg.Pos)); PostMessage(Handle, ctim_StartEditMouse, Msg.Keys, longint(Msg.Pos)); end; end; end; {--------} procedure TOvcCustomTable.WMLButtonDown(var Msg : TWMMouse); var Row : TRowNum; Col : TColNum; Action : TOvcTblSelectionType; Region : TOvcTblRegion; R : TRect; P : TPoint; ShiftKeyDown : boolean; CtrlKeyDown : boolean; AllowDrag : boolean; WasUnfocused : boolean; begin inherited; {are we currently unfocused? if so focus the table} WasUnfocused := false; if (otsUnfocused in tbState) then begin WasUnfocused := true; AllowRedraw := false; try {note: by the time SetFocus returns WMSetFocus will have been called} SetFocus; {..to get round an MDI bug..} if not Focused then {$IFNDEF LCL} Windows.SetFocus(Handle); {$ELSE} LclIntf.SetFocus(Handle); {$ENDIF} finally AllowRedraw := true; end;{try..finally} end; {are we currently showing a sizing cursor? if so the user wants to resize a column/row} if (otsShowSize in tbState) then begin tbState := tbState - [otsShowSize] + [otsSizing]; if (otsDoingRow in tbState) then begin if (Msg.YPos >= tbRowNums^.Ay[tbSizeIndex].Offset+6) then tbSizeOffset := Msg.YPos; tbDrawSizeLine; end else {we're sizing a column} begin if (Msg.XPos >= tbColNums^.Ay[tbSizeIndex].Offset+6) then tbSizeOffset := Msg.XPos; tbDrawSizeLine; end; Exit; end; {are we currently showing a row/col move cursor? if so the user wants to move that row/col} if (otsShowMove in tbState) then begin tbState := tbState - [otsShowMove] + [otsMoving]; {work out the row/column we're in} CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col); if (otsDoingCol in tbState) then begin tbMoveIndex := tbFindColInx(Col); R.Left := ColOffset[Col]; R.Right := MinI(ClientWidth, R.Left + Columns[Col].Width); R.Top := RowOffset[0]; R.Bottom := RowOffset[1]; end else begin{doing row} tbMoveIndex := tbFindRowInx(Row); R.Top := RowOffset[Row]; R.Bottom := RowOffset[Row + 1]; R.Bottom := MinI(ClientHeight, R.Top + Rows[Row].Height); R.Left := ColOffset[0]; R.Right := ColOffset[1]; end; R.TopLeft := ClientToScreen(R.TopLeft); R.BottomRight := ClientToScreen(R.BottomRight); P := ClientToScreen(Point(Msg.XPos, Msg.YPos)); tbDrag := TOvcDragShow.Create(P.x, P.y, R, clBtnFace); tbMoveIndexTo := tbMoveIndex; tbDrawMoveLine; Exit; end; {are we focused and do we allow selections? if so be prepared to start or extend the current selection (note that AlwaysEditing will be false)} if (otsFocused in tbState) and (not (otoNoSelection in Options)) then begin {if we are editing a cell then stop editing it now (if possible)} if InEditingState then begin {$IFNDEF LCL} Windows.SetFocus(tbActCell.EditHandle); {$ELSE} LclIntf.SetFocus(tbActCell.EditHandle); {$ENDIF} end; {get the state of the shift & ctrl keys} ShiftKeyDown := (Msg.Keys and MK_SHIFT) <> 0; CtrlKeyDown := (Msg.Keys and MK_CONTROL) <> 0; {calculate where the mouse button was pressed} Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col); case Region of otrInMain : {the mouse was clicked in the main area} begin AllowRedraw := false; try AllowDrag := true; {confirm the new active cell} DoActiveCellMoving(ccMouse, Row, Col); {if neither shift nor control are down, or control is down on its own, we have to reset the anchor point} if (not ShiftKeyDown) then begin if CtrlKeyDown then Action := tstAdditional else begin Action := tstDeselectAll; {if the active cell hasn't changed (ie the user clicked on the active cell, must start editing} if (ActiveRow = Row) and (ActiveCol = Col) and not WasUnfocused then begin PostMessage(Handle, ctim_StartEdit, 0, 0); PostMessage(Handle, ctim_StartEditMouse, Msg.Keys, longint(Msg.Pos)); AllowDrag := false; end; end; tbSetAnchorCell(Row, Col, Action); end {if the shift key is down then the user is either extending the last selection only (control is up) or the last selection in addition to the other selections (control is down); extend the selection} else {shift key is down} begin if CtrlKeyDown then Action := tstAdditional else begin Action := tstDeselectAll; tbIsSelecting := true; end; tbUpdateSelection(Row, Col, Action); end; {now set the active cell} tbSetActiveCellPrim(Row, Col); finally AllowRedraw := true; end;{try..finally} {until we get a mouse up message we are selecting with the mouse (if we're allowed to, that is)} if (otoMouseDragSelect in Options) and AllowDrag then tbState := tbState - [otsNormal] + [otsMouseSelect]; end; otrInLocked : begin {the mouse was clicked on a locked cell} if InEditingState then if not StopEditingState(true) then Exit; AllowRedraw := false; try if (otoRowSelection in Options) and (Row >= LockedRows) then tbSelectRow(Row); if (otoColSelection in Options) and (Col >= LockedCols) then tbSelectCol(Col); if (otoRowSelection in Options) and (otoColSelection in Options) and (Row < LockedRows) and (Col < LockedCols) then tbSelectTable; finally AllowRedraw := true; end;{try..finally} if (otsNormal in tbState) then DoLockedCellClick(Row, Col); end; otrInUnused : begin {clicking in the unused area deselects all selections} if InEditingState then if not StopEditingState(true) then Exit; {move to new location} if (Row = CRCFXY_RowBelow) then Row := IncRow(pred(RowLimit), 0); if (Col = CRCFXY_ColToRight) then Col := IncCol(pred(ColCount), 0); {if row or col should changed, notify and doit} if (Col <> ActiveCol) or (Row <> ActiveRow) then begin DoActiveCellMoving(ccNone, Row, Col); tbSetAnchorCell(Row, Col, tstDeselectAll); tbSetActiveCellPrim(Row, Col); end; end; end;{case} Exit; end; {are we focused? (and selections are not allowed)} if (otsFocused in tbState) then if ((tbState * [otsNormal, otsEditing, otsHiddenEdit]) <> []) then begin Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col); case Region of otrInMain : begin if InEditingState then {$IFNDEF LCL} Windows.SetFocus(tbActCell.EditHandle); {$ELSE} LclIntf.SetFocus(tbActCell.EditHandle); {$ENDIF} AllowRedraw := false; try DoActiveCellMoving(ccMouse, Row, Col); if not (otoAlwaysEditing in Options) then if (ActiveRow = Row) and (ActiveCol = Col) and not WasUnfocused then begin PostMessage(Handle, ctim_StartEdit, 0, 0); PostMessage(Handle, ctim_StartEditMouse, Msg.Keys, longint(Msg.Pos)); end; tbSetActiveCellPrim(Row, Col); finally AllowRedraw := true; end;{try..finally} PostMessage(Handle, ctim_StartEditMouse, Msg.Keys, longint(Msg.Pos)); end; otrInLocked : if (otsNormal in tbState) then DoLockedCellClick(Row, Col); end;{case} Exit; end; end; {--------} procedure TOvcCustomTable.WMLButtonUp(var Msg : TWMMouse); var Form : TForm; ColNum : TColNum; ColFrom : TColNum; ColTo : TColNum; RowNum : TRowNum; RowFrom : TRowNum; RowTo : TRowNum; DoingCol: boolean; begin inherited; if tbDrag <> nil then begin tbDrag.Free; tbDrag := nil; end; if (otsMouseSelect in tbState) then begin {tbIsSelecting := false;} tbState := tbState - [otsMouseSelect] + [otsNormal]; Exit; end; if (otsSizing in tbState) then begin tbDrawSizeLine; AllowRedraw := false; try if (otsDoingRow in tbState) then begin if (tbSizeOffset < tbRowNums^.Ay[tbSizeIndex].Offset+6) then tbSizeOffset := tbRowNums^.Ay[tbSizeIndex].Offset+6; FRows.Height[tbRowNums^.Ay[tbSizeIndex].Number] := tbSizeOffset - tbRowNums^.Ay[tbSizeIndex].Offset; if Assigned(OnResizeRow) then OnResizeRow(Self, tbRowNums^.Ay[tbSizeIndex].Number, FRows.Height[tbRowNums^.Ay[tbSizeIndex].Number]); end else begin if (tbSizeOffset < tbColNums^.Ay[tbSizeIndex].Offset+6) then tbSizeOffset := tbColNums^.Ay[tbSizeIndex].Offset+6; FCols[tbColNums^.Ay[tbSizeIndex].Number].Width := tbSizeOffset - tbColNums^.Ay[tbSizeIndex].Offset; if Assigned(OnResizeColumn) then OnResizeColumn(Self, tbColNums^.Ay[tbSizeIndex].Number, FCols[tbColNums^.Ay[tbSizeIndex].Number].Width); end; // Apparent TurboPower bug: otsDoingRow appears twice in set. Probably second // otsDoingRow should be otsDoingCol (see otsMoving code below). // tbState := tbState - [otsSizing, otsDoingRow, otsDoingRow] + [otsNormal]; tbState := tbState - [otsSizing, otsDoingRow, otsDoingCol] + [otsNormal]; //Fixed if (otsDesigning in tbState) then begin Form := TForm(GetParentForm(Self)); if (Form <> nil) and (Form.Designer <> nil) then Form.Designer.Modified; end; InvalidateTable; finally AllowRedraw := true; end;{try..finally} end; if (otsMoving in tbState) then begin tbDrawMoveLine; DoingCol := otsDoingCol in tbState; tbState := tbState - [otsMoving, otsDoingRow, otsDoingCol] + [otsNormal]; if (tbMoveIndex <> tbMoveIndexTo) then begin AllowRedraw := false; try if DoingCol then begin ColFrom := tbColNums^.Ay[tbMoveIndex].Number; ColTo := tbColNums^.Ay[tbMoveIndexTo].Number; if (ColTo > ColFrom) then for ColNum := ColFrom to pred(ColTo) do Columns.Exchange(ColNum, succ(ColNum)) else for ColNum := pred(ColFrom) downto ColTo do Columns.Exchange(ColNum, succ(ColNum)); if ActiveCol = ColFrom then ActiveCol := ColTo else if (ColTo > ColFrom) then begin if (ColFrom < ActiveCol) and (ActiveCol <= ColTo) then ActiveCol := IncCol(ActiveCol, -1); end else begin if (ColTo <= ActiveCol) and (ActiveCol < ColFrom) then ActiveCol := IncCol(ActiveCol, +1); end; end else {doing rows} begin RowFrom := tbRowNums^.Ay[tbMoveIndex].Number; RowTo := tbRowNums^.Ay[tbMoveIndexTo].Number; if (RowTo > RowFrom) then for RowNum := RowFrom to pred(RowTo) do Rows.Exchange(RowNum, succ(RowNum)) else for RowNum := pred(RowFrom) downto RowTo do Rows.Exchange(RowNum, succ(RowNum)); if ActiveRow = RowFrom then ActiveRow := RowTo else if (RowTo > RowFrom) then begin if (RowFrom < ActiveRow) and (ActiveRow <= RowTo) then ActiveRow := IncRow(ActiveRow, -1); end else begin if (RowTo <= ActiveRow) and (ActiveRow < RowFrom) then ActiveRow := IncRow(ActiveRow, +1); end; end; finally AllowRedraw := true; end;{try..finally} if (otsDesigning in tbState) then begin Form := TForm(GetParentForm(Self)); if (Form <> nil) and (Form.Designer <> nil) then Form.Designer.Modified; end; end; end; end; {--------} procedure TOvcCustomTable.WMMouseMove(var Msg : TWMMouse); var Row : TRowNum; Col : TColNum; NewMoveIndexTo : integer; Region : TOvcTblRegion; Action : TOvcTblSelectionType; P : TPoint; begin inherited; if tbDrag <> nil then begin P := ClientToScreen(Point(Msg.XPos, Msg.YPos)); tbDrag.DragMove(P.x, P.y); end; if (otsMouseSelect in tbState) then begin Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col); if (Region = otrOutside) or (Region = otrInUnused) then begin if (Row = CRCFXY_RowAbove) then Row := IncRow(ActiveRow, -1) else if (Row = CRCFXY_RowBelow) then with tbRowNums^ do Row := MinL(pred(RowLimit), succ(Ay[pred(Count)].Number)); if (Col = CRCFXY_ColToLeft) then Col := IncCol(ActiveCol, -1) else if (Col = CRCFXY_ColToRight) then with tbColNums^ do Col := MinI(pred(ColCount), succ(Ay[pred(Count)].Number)); end else if (Region = otrInLocked) then begin if (Row < LockedRows) then Row := IncRow(ActiveRow, -1); if (Col < LockedCols) then Col := IncCol(ActiveCol, -1); end; DoActiveCellMoving(ccMouse, Row, Col); if (Row = ActiveRow) and (Col = ActiveCol) then Exit; {there's nothing to do, just moved within cell} if ((Msg.Keys and MK_CONTROL) <> 0) then Action := tstAdditional else begin Action := tstDeselectAll; tbIsSelecting := true; end; AllowRedraw := false; try tbUpdateSelection(Row, Col, Action); tbSetActiveCellPrim(Row, Col); finally AllowRedraw := true; end;{try..finally} Exit; end; if (otsSizing in tbState) then begin tbDrawSizeLine; if (otsDoingRow in tbState) then begin if (Msg.YPos >= tbRowNums^.Ay[tbSizeIndex].Offset+6) then tbSizeOffset := Msg.YPos; end else begin if (Msg.XPos >= tbColNums^.Ay[tbSizeIndex].Offset+6) then tbSizeOffset := Msg.XPos; end; tbDrawSizeLine; Exit; end; if (otsMoving in tbState) then begin CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col); if (otsDoingCol in tbState) then begin if (Col >= LockedCols) then begin NewMoveIndexTo := tbFindColInx(Col); if (NewMoveIndexTo <> tbMoveIndexTo) then begin tbDrawMoveLine; tbMoveIndexTo := NewMoveIndexTo; tbDrawMoveLine; end; end; end else {we're moving rows} begin if (Row >= LockedRows) then begin NewMoveIndexTo := tbFindRowInx(Row); if (NewMoveIndexTo <> tbMoveIndexTo) then begin tbDrawMoveLine; tbMoveIndexTo := NewMoveIndexTo; tbDrawMoveLine; end; end; end; end; end; {--------} procedure TOvcCustomTable.WMNCHitTest(var Msg : TMessage); begin if (otsDesigning in tbState) then DefaultHandler(Msg) else inherited; end; {--------} procedure TOvcCustomTable.WMSetCursor(var Msg : TWMSetCursor); var CurMousePos : TPoint; NewCursor : HCursor; IsVert : boolean; IsColMove : boolean; OnGridLine : boolean; InMoveArea : boolean; begin {ignore non client hit tests, let our ancestor deal with it} if (Msg.HitTest <> HTCLIENT) then begin inherited; if ((tbState * [otsShowSize, otsShowMove]) <> []) then tbState := tbState - [otsShowSize, otsShowMove, otsDoingRow, otsDoingCol] + [otsNormal]; Exit; end; {if the table is unfocused or we are editing, let our ancestor deal with it} if (otsUnfocused in tbState) or InEditingState then begin inherited; Exit; end; {get the mouse cursor position in terms of the table client area} GetCursorPos(CurMousePos); CurMousePos := ScreenToClient(CurMousePos); {work out whether the cursor is over a grid line or on the column move area; take into account whether such definitions are allowed} OnGridLine := tbIsOnGridLine(CurMousePos.X, CurMousePos.Y, IsVert); if OnGridLine then if IsVert then OnGridLine := (not (otoNoColResizing in Options)) or (otsDesigning in tbState) else OnGridLine := (not (otoNoRowResizing in Options)) or (otsDesigning in tbState); InMoveArea := false; if (not OnGridLine) and ((otoAllowColMoves in Options) or (otoAllowRowMoves in Options) or (otsDesigning in tbState)) then begin InMoveArea := tbIsInMoveArea(CurMousePos.X, CurMousePos.Y, IsColMove); if InMoveArea then if IsColMove then InMoveArea := otoAllowColMoves in Options else InMoveArea := otoAllowRowMoves in Options; end; {now set the cursor} if InMoveArea then begin if IsColMove then begin NewCursor := tbColMoveCursor; tbState := tbState - [otsNormal, otsShowSize, otsDoingRow] + [otsShowMove, otsDoingCol]; end else {row move} begin NewCursor := tbRowMoveCursor; tbState := tbState - [otsNormal, otsShowSize, otsDoingCol] + [otsShowMove, otsDoingRow]; end; end else if OnGridLine then if IsVert then begin NewCursor := Screen.Cursors[crHSplit]; tbState := tbState - [otsNormal, otsShowMove, otsDoingRow] + [otsShowSize, otsDoingCol]; end else begin NewCursor := Screen.Cursors[crVSplit]; tbState := tbState - [otsNormal, otsShowMove, otsDoingCol] + [otsShowSize, otsDoingRow]; end else begin NewCursor := Screen.Cursors[Cursor]; tbState := tbState - [otsShowMove, otsShowSize, otsDoingRow, otsDoingCol] + [otsNormal]; end; {$IFNDEF LCL} SetCursor(NewCursor); {$ELSE} LclIntf.SetCursor(NewCursor); {Don't call control's SetCursor!} {$ENDIF} Msg.Result := 1; end; {--------} procedure TOvcCustomTable.WMSetFocus(var Msg : TWMSetFocus); begin inherited; if (otsEditing in tbState) then begin if tbEditCellHasFocus(Msg.FocusedWnd) then GetParentForm(Self).Perform(WM_NEXTDLGCTL, 1, 0) else {$IFNDEF LCL} Windows.SetFocus(tbActCell.EditHandle); {$ELSE} LclIntf.SetFocus(tbActCell.EditHandle); {$ENDIF} Exit; end; if (otsFocused in tbState) then Exit; AllowRedraw := false; try InvalidateCell(ActiveRow, ActiveCol); tbState := tbState - [otsUnfocused] + [otsFocused]; finally AllowRedraw := true; end;{try..finally} end; {--------} procedure TOvcCustomTable.WMVScroll(var Msg : TWMScroll); procedure ProcessThumb; var Divisor : LongInt; begin if (Msg.Pos <> TopRow) then begin if RowLimit < (16*1024) then TopRow := Msg.Pos else if Msg.Pos = LockedRows then TopRow := LockedRows else begin if (RowLimit > (16*1024)) then Divisor := Succ(RowLimit div $400) else Divisor := Succ(RowLimit div $40); if (Msg.Pos = RowLimit div Divisor) then TopRow := pred(RowLimit) else TopRow := Msg.Pos * Divisor; end; end; end; begin if ProcessingVScrollMessage then Exit; ProcessingVScrollMessage := true; try {ignore SB_ENDSCROLL and SB_THUMBTRACK messages (the latter if required to by the Options property): this'll possibly avoid multiple validations} if (Msg.ScrollCode = SB_ENDSCROLL) or ((Msg.ScrollCode = SB_THUMBTRACK) and (not (otoThumbTrack in Options))) then begin inherited; Exit; end; {if we're not focused then do so; if we're being designed update the table view} if (otsUnFocused in tbState) then {$IFDEF MSWINDOWS} SetFocus //Apparently can't focus scroll bar with GTK? {$ENDIF} else if (otsDesigning in tbState) then Update; {check to see whether the cell being edited is valid; no scrolling allowed if it isn't (tough).} if InEditingState then begin if not tbActCell.CanSaveEditedData(true) then Exit; end; {process the scrollbar message} case Msg.ScrollCode of SB_LINEUP : ProcessScrollBarClick(otsbVertical, scLineUp); SB_LINEDOWN : ProcessScrollBarClick(otsbVertical, scLineDown); SB_PAGEUP : ProcessScrollBarClick(otsbVertical, scPageUp); SB_PAGEDOWN : ProcessScrollBarClick(otsbVertical, scPageDown); SB_THUMBPOSITION : ProcessThumb; SB_THUMBTRACK : if (otoThumbTrack in Options) then ProcessThumb; else inherited; Exit; end; Msg.Result := 0; finally ProcessingVScrollMessage := false; end; end; {====================================================================} end.