home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 February / DPPCPRO0299.ISO / February / Delphi / Install / DATA.Z / GRIDS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-09  |  136.3 KB  |  4,744 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Grids;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses SysUtils, Messages, Windows, Classes, Graphics, Menus, Controls, Forms,
  17.   StdCtrls, Mask;
  18.  
  19. const
  20.   MaxCustomExtents = MaxListSize;
  21.   MaxShortInt = High(ShortInt);
  22.  
  23. type
  24.   EInvalidGridOperation = class(Exception);
  25.  
  26.   { Internal grid types }
  27.   TGetExtentsFunc = function(Index: Longint): Integer of object;
  28.  
  29.   TGridAxisDrawInfo = record
  30.     EffectiveLineWidth: Integer;
  31.     FixedBoundary: Integer;
  32.     GridBoundary: Integer;
  33.     GridExtent: Integer;
  34.     LastFullVisibleCell: Longint;
  35.     FullVisBoundary: Integer;
  36.     FixedCellCount: Integer;
  37.     FirstGridCell: Integer;
  38.     GridCellCount: Integer;
  39.     GetExtent: TGetExtentsFunc;
  40.   end;
  41.  
  42.   TGridDrawInfo = record
  43.     Horz, Vert: TGridAxisDrawInfo;
  44.   end;
  45.  
  46.   TGridState = (gsNormal, gsSelecting, gsRowSizing, gsColSizing,
  47.     gsRowMoving, gsColMoving);
  48.  
  49.   { TInplaceEdit }
  50.   { The inplace editor is not intended to be used outside the grid }
  51.  
  52.   TCustomGrid = class;
  53.  
  54.   TInplaceEdit = class(TCustomMaskEdit)
  55.   private
  56.     FGrid: TCustomGrid;
  57.     FClickTime: Longint;
  58.     procedure InternalMove(const Loc: TRect; Redraw: Boolean);
  59.     procedure SetGrid(Value: TCustomGrid);
  60.     procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  61.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  62.     procedure WMPaste(var Message); message WM_PASTE;
  63.     procedure WMCut(var Message); message WM_CUT;
  64.     procedure WMClear(var Message); message WM_CLEAR;
  65.   protected
  66.     procedure CreateParams(var Params: TCreateParams); override;
  67.     procedure DblClick; override;
  68.     function EditCanModify: Boolean; override;
  69.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  70.     procedure KeyPress(var Key: Char); override;
  71.     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  72.     procedure BoundsChanged; virtual;
  73.     procedure UpdateContents; virtual;
  74.     procedure WndProc(var Message: TMessage); override;
  75.     property  Grid: TCustomGrid read FGrid;
  76.   public
  77.     constructor Create(AOwner: TComponent); override;
  78.     procedure Deselect;
  79.     procedure Hide;
  80.     procedure Invalidate;
  81.     procedure Move(const Loc: TRect);
  82.     function PosEqual(const Rect: TRect): Boolean;
  83.     procedure SetFocus;
  84.     procedure UpdateLoc(const Loc: TRect);
  85.     function Visible: Boolean;
  86.   end;
  87.  
  88.   { TCustomGrid }
  89.  
  90.   { TCustomGrid is an abstract base class that can be used to implement
  91.     general purpose grid style controls.  The control will call DrawCell for
  92.     each of the cells allowing the derived class to fill in the contents of
  93.     the cell.  The base class handles scrolling, selection, cursor keys, and
  94.     scrollbars.
  95.       DrawCell
  96.         Called by Paint. If DefaultDrawing is true the font and brush are
  97.         intialized to the control font and cell color.  The cell is prepainted
  98.         in the cell color and a focus rect is drawn in the focused cell after
  99.         DrawCell returns.  The state passed will reflect whether the cell is
  100.         a fixed cell, the focused cell or in the selection.
  101.       SizeChanged
  102.         Called when the size of the grid has changed.
  103.       BorderStyle
  104.         Allows a single line border to be drawn around the control.
  105.       Col
  106.         The current column of the focused cell (runtime only).
  107.       ColCount
  108.         The number of columns in the grid.
  109.       ColWidths
  110.         The width of each column (up to a maximum MaxCustomExtents, runtime
  111.         only).
  112.       DefaultColWidth
  113.         The default column width.  Changing this value will throw away any
  114.         customization done either visually or through ColWidths.
  115.       DefaultDrawing
  116.         Indicates whether the Paint should do the drawing talked about above in
  117.         DrawCell.
  118.       DefaultRowHeight
  119.         The default row height.  Changing this value will throw away any
  120.         customization done either visually or through RowHeights.
  121.       FixedCols
  122.         The number of non-scrolling columns.  This value must be at least one
  123.         below ColCount.
  124.       FixedRows
  125.         The number of non-scrolling rows.  This value must be at least one
  126.         below RowCount.
  127.       GridLineWidth
  128.         The width of the lines drawn between the cells.
  129.       LeftCol
  130.         The index of the left most displayed column (runtime only).
  131.       Options
  132.         The following options are available:
  133.           goFixedHorzLine:     Draw horizontal grid lines in the fixed cell area.
  134.           goFixedVertLine:     Draw veritical grid lines in the fixed cell area.
  135.           goHorzLine:          Draw horizontal lines between cells.
  136.           goVertLine:          Draw vertical lines between cells.
  137.           goRangeSelect:       Allow a range of cells to be selected.
  138.           goDrawFocusSelected: Draw the focused cell in the selected color.
  139.           goRowSizing:         Allows rows to be individually resized.
  140.           goColSizing:         Allows columns to be individually resized.
  141.           goRowMoving:         Allows rows to be moved with the mouse
  142.           goColMoving:         Allows columns to be moved with the mouse.
  143.           goEditing:           Places an edit control over the focused cell.
  144.           goAlwaysShowEditor:  Always shows the editor in place instead of
  145.                                waiting for a keypress or F2 to display it.
  146.           goTabs:              Enables the tabbing between columns.
  147.           goRowSelect:         Selection and movement is done a row at a time.
  148.       Row
  149.         The row of the focused cell (runtime only).
  150.       RowCount
  151.         The number of rows in the grid.
  152.       RowHeights
  153.         The hieght of each row (up to a maximum MaxCustomExtents, runtime
  154.         only).
  155.       ScrollBars
  156.         Determines whether the control has scrollbars.
  157.       Selection
  158.         A TGridRect of the current selection.
  159.       TopLeftChanged
  160.         Called when the TopRow or LeftCol change.
  161.       TopRow
  162.         The index of the top most row displayed (runtime only)
  163.       VisibleColCount
  164.         The number of columns fully displayed.  There could be one more column
  165.         partially displayed.
  166.       VisibleRowCount
  167.         The number of rows fully displayed.  There could be one more row
  168.         partially displayed. }
  169.  
  170.   TGridOption = (goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  171.     goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing, goRowMoving,
  172.     goColMoving, goEditing, goTabs, goRowSelect,
  173.     goAlwaysShowEditor, goThumbTracking);
  174.   TGridOptions = set of TGridOption;
  175.   TGridDrawState = set of (gdSelected, gdFocused, gdFixed);
  176.   TGridScrollDirection = set of (sdLeft, sdRight, sdUp, sdDown);
  177.  
  178.   TGridCoord = record
  179.     X: Longint;
  180.     Y: Longint;
  181.   end;
  182.  
  183.   TGridRect = record
  184.     case Integer of
  185.       0: (Left, Top, Right, Bottom: Longint);
  186.       1: (TopLeft, BottomRight: TGridCoord);
  187.   end;
  188.  
  189.   TSelectCellEvent = procedure (Sender: TObject; Col, Row: Longint;
  190.     var CanSelect: Boolean) of object;
  191.   TDrawCellEvent = procedure (Sender: TObject; Col, Row: Longint;
  192.     Rect: TRect; State: TGridDrawState) of object;
  193.  
  194.   TCustomGrid = class(TCustomControl)
  195.   private
  196.     FAnchor: TGridCoord;
  197.     FBorderStyle: TBorderStyle;
  198.     FCanEditModify: Boolean;
  199.     FColCount: Longint;
  200.     FColWidths: Pointer;
  201.     FTabStops: Pointer;
  202.     FCurrent: TGridCoord;
  203.     FDefaultColWidth: Integer;
  204.     FDefaultRowHeight: Integer;
  205.     FFixedCols: Integer;
  206.     FFixedRows: Integer;
  207.     FFixedColor: TColor;
  208.     FGridLineWidth: Integer;
  209.     FOptions: TGridOptions;
  210.     FRowCount: Longint;
  211.     FRowHeights: Pointer;
  212.     FScrollBars: TScrollStyle;
  213.     FTopLeft: TGridCoord;
  214.     FSizingIndex: Longint;
  215.     FSizingPos, FSizingOfs: Integer;
  216.     FMoveIndex, FMovePos: Longint;
  217.     FHitTest: TPoint;
  218.     FInplaceEdit: TInplaceEdit;
  219.     FInplaceCol, FInplaceRow: Longint;
  220.     FDefaultDrawing: Boolean;
  221.     FEditorMode: Boolean;
  222.     FColOffset: Integer;
  223.     function CalcCoordFromPoint(X, Y: Integer;
  224.       const DrawInfo: TGridDrawInfo): TGridCoord;
  225.     procedure CalcDrawInfo(var DrawInfo: TGridDrawInfo);
  226.     procedure CalcDrawInfoXY(var DrawInfo: TGridDrawInfo;
  227.       UseWidth, UseHeight: Integer);
  228.     procedure CalcFixedInfo(var DrawInfo: TGridDrawInfo);
  229.     function CalcMaxTopLeft(const Coord: TGridCoord;
  230.       const DrawInfo: TGridDrawInfo): TGridCoord;
  231.     procedure CalcSizingState(X, Y: Integer; var State: TGridState;
  232.       var Index: Longint; var SizingPos, SizingOfs: Integer;
  233.       var FixedInfo: TGridDrawInfo);
  234.     procedure ChangeSize(NewColCount, NewRowCount: Longint);
  235.     procedure ClampInView(const Coord: TGridCoord);
  236.     procedure DrawSizingLine(const DrawInfo: TGridDrawInfo);
  237.     procedure DrawMove;
  238.     procedure FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
  239.     procedure GridRectToScreenRect(GridRect: TGridRect;
  240.       var ScreenRect: TRect; IncludeLine: Boolean);
  241.     procedure HideEdit;
  242.     procedure Initialize;
  243.     procedure InvalidateGrid;
  244.     procedure InvalidateRect(ARect: TGridRect);
  245.     procedure InvertRect(const Rect: TRect);
  246.     procedure ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal);
  247.     procedure MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
  248.     procedure MoveAnchor(const NewAnchor: TGridCoord);
  249.     procedure MoveAndScroll(Mouse, CellHit: Integer; var DrawInfo: TGridDrawInfo;
  250.       var Axis: TGridAxisDrawInfo; Scrollbar: Integer);
  251.     procedure MoveCurrent(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
  252.     procedure MoveTopLeft(ALeft, ATop: Longint);
  253.     procedure ResizeCol(Index: Longint; OldSize, NewSize: Integer);
  254.     procedure ResizeRow(Index: Longint; OldSize, NewSize: Integer);
  255.     procedure SelectionMoved(const OldSel: TGridRect);
  256.     procedure ScrollDataInfo(DX, DY: Integer; var DrawInfo: TGridDrawInfo);
  257.     procedure TopLeftMoved(const OldTopLeft: TGridCoord);
  258.     procedure UpdateScrollPos;
  259.     procedure UpdateScrollRange;
  260.     function GetColWidths(Index: Longint): Integer;
  261.     function GetRowHeights(Index: Longint): Integer;
  262.     function GetSelection: TGridRect;
  263.     function GetTabStops(Index: Longint): Boolean;
  264.     function GetVisibleColCount: Integer;
  265.     function GetVisibleRowCount: Integer;
  266.     procedure ReadColWidths(Reader: TReader);
  267.     procedure ReadRowHeights(Reader: TReader);
  268.     procedure SetBorderStyle(Value: TBorderStyle);
  269.     procedure SetCol(Value: Longint);
  270.     procedure SetColCount(Value: Longint);
  271.     procedure SetColWidths(Index: Longint; Value: Integer);
  272.     procedure SetDefaultColWidth(Value: Integer);
  273.     procedure SetDefaultRowHeight(Value: Integer);
  274.     procedure SetEditorMode(Value: Boolean);
  275.     procedure SetFixedColor(Value: TColor);
  276.     procedure SetFixedCols(Value: Integer);
  277.     procedure SetFixedRows(Value: Integer);
  278.     procedure SetGridLineWidth(Value: Integer);
  279.     procedure SetLeftCol(Value: Longint);
  280.     procedure SetOptions(Value: TGridOptions);
  281.     procedure SetRow(Value: Longint);
  282.     procedure SetRowCount(Value: Longint);
  283.     procedure SetRowHeights(Index: Longint; Value: Integer);
  284.     procedure SetScrollBars(Value: TScrollStyle);
  285.     procedure SetSelection(Value: TGridRect);
  286.     procedure SetTabStops(Index: Longint; Value: Boolean);
  287.     procedure SetTopRow(Value: Longint);
  288.     procedure UpdateEdit;
  289.     procedure UpdateText;
  290.     procedure WriteColWidths(Writer: TWriter);
  291.     procedure WriteRowHeights(Writer: TWriter);
  292.     procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE;
  293.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  294.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  295.     procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
  296.     procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
  297.     procedure WMChar(var Msg: TWMChar); message WM_CHAR;
  298.     procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
  299.     procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
  300.     procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
  301.     procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
  302.     procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
  303.     procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  304.     procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  305.     procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
  306.     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
  307.     procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;
  308.     procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
  309.   protected
  310.     FGridState: TGridState;
  311.     FSaveCellExtents: Boolean;
  312.     function CreateEditor: TInplaceEdit; virtual;
  313.     procedure CreateParams(var Params: TCreateParams); override;
  314.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  315.     procedure KeyPress(var Key: Char); override;
  316.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  317.       X, Y: Integer); override;
  318.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  319.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  320.       X, Y: Integer); override;
  321.     procedure AdjustSize(Index, Amount: Longint; Rows: Boolean); dynamic;
  322.     function BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
  323.     procedure DoExit; override;
  324.     function CellRect(ACol, ARow: Longint): TRect;
  325.     function CanEditAcceptKey(Key: Char): Boolean; dynamic;
  326.     function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; dynamic;
  327.     function CanEditModify: Boolean; dynamic;
  328.     function CanEditShow: Boolean; virtual;
  329.     function GetEditText(ACol, ARow: Longint): string; dynamic;
  330.     procedure SetEditText(ACol, ARow: Longint; const Value: string); dynamic;
  331.     function GetEditMask(ACol, ARow: Longint): string; dynamic;
  332.     function GetEditLimit: Integer; dynamic;
  333.     function GetGridWidth: Integer;
  334.     function GetGridHeight: Integer;
  335.     procedure HideEditor;
  336.     procedure ShowEditor;
  337.     procedure ShowEditorChar(Ch: Char);
  338.     procedure InvalidateEditor;
  339.     procedure MoveColumn(FromIndex, ToIndex: Longint);
  340.     procedure ColumnMoved(FromIndex, ToIndex: Longint); dynamic;
  341.     procedure MoveRow(FromIndex, ToIndex: Longint);
  342.     procedure RowMoved(FromIndex, ToIndex: Longint); dynamic;
  343.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  344.       AState: TGridDrawState); virtual; abstract;
  345.     procedure DefineProperties(Filer: TFiler); override;
  346.     function MouseCoord(X, Y: Integer): TGridCoord;
  347.     procedure MoveColRow(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
  348.     function SelectCell(ACol, ARow: Longint): Boolean; virtual;
  349.     procedure SizeChanged(OldColCount, OldRowCount: Longint); dynamic;
  350.     function Sizing(X, Y: Integer): Boolean;
  351.     procedure ScrollData(DX, DY: Integer);
  352.     procedure InvalidateCell(ACol, ARow: Longint);
  353.     procedure InvalidateCol(ACol: Longint);
  354.     procedure InvalidateRow(ARow: Longint);
  355.     procedure TopLeftChanged; dynamic;
  356.     procedure TimedScroll(Direction: TGridScrollDirection); dynamic;
  357.     procedure Paint; override;
  358.     procedure ColWidthsChanged; dynamic;
  359.     procedure RowHeightsChanged; dynamic;
  360.     procedure DeleteColumn(ACol: Longint);
  361.     procedure DeleteRow(ARow: Longint);
  362.     procedure UpdateDesigner;
  363.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  364.     property Col: Longint read FCurrent.X write SetCol;
  365.     property Color default clWindow;
  366.     property ColCount: Longint read FColCount write SetColCount default 5;
  367.     property ColWidths[Index: Longint]: Integer read GetColWidths write SetColWidths;
  368.     property DefaultColWidth: Integer read FDefaultColWidth write SetDefaultColWidth default 64;
  369.     property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
  370.     property DefaultRowHeight: Integer read FDefaultRowHeight write SetDefaultRowHeight default 24;
  371.     property EditorMode: Boolean read FEditorMode write SetEditorMode;
  372.     property FixedColor: TColor read FFixedColor write SetFixedColor default clBtnFace;
  373.     property FixedCols: Integer read FFixedCols write SetFixedCols default 1;
  374.     property FixedRows: Integer read FFixedRows write SetFixedRows default 1;
  375.     property GridHeight: Integer read GetGridHeight;
  376.     property GridLineWidth: Integer read FGridLineWidth write SetGridLineWidth default 1;
  377.     property GridWidth: Integer read GetGridWidth;
  378.     property InplaceEditor: TInplaceEdit read FInplaceEdit;
  379.     property LeftCol: Longint read FTopLeft.X write SetLeftCol;
  380.     property Options: TGridOptions read FOptions write SetOptions
  381.       default [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  382.       goRangeSelect];
  383.     property ParentColor default False;
  384.     property Row: Longint read FCurrent.Y write SetRow;
  385.     property RowCount: Longint read FRowCount write SetRowCount default 5;
  386.     property RowHeights[Index: Longint]: Integer read GetRowHeights write SetRowHeights;
  387.     property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
  388.     property Selection: TGridRect read GetSelection write SetSelection;
  389.     property TabStops[Index: Longint]: Boolean read GetTabStops write SetTabStops;
  390.     property TopRow: Longint read FTopLeft.Y write SetTopRow;
  391.     property VisibleColCount: Integer read GetVisibleColCount;
  392.     property VisibleRowCount: Integer read GetVisibleRowCount;
  393.   public
  394.     constructor Create(AOwner: TComponent); override;
  395.     destructor Destroy; override;
  396.   published
  397.     property TabStop default True;
  398.   end;
  399.  
  400.   { TDrawGrid }
  401.  
  402.   { A grid relies on the OnDrawCell event to display the cells.
  403.      CellRect
  404.        This method returns control relative screen coordinates of the cell or
  405.        an empty rectangle if the cell is not visible.
  406.      EditorMode
  407.        Setting to true shows the editor, as if the F2 key was pressed, when
  408.        goEditing is turned on and goAlwaysShowEditor is turned off.
  409.      MouseToCell
  410.        Takes control relative screen X, Y location and fills in the column and
  411.        row that contain that point.
  412.      OnColumnMoved
  413.        Called when the user request to move a column with the mouse when
  414.        the goColMoving option is on.
  415.      OnDrawCell
  416.        This event is passed the same information as the DrawCell method
  417.        discussed above.
  418.      OnGetEditMask
  419.        Called to retrieve edit mask in the inplace editor when goEditing is
  420.        turned on.
  421.      OnGetEditText
  422.        Called to retrieve text to edit when goEditing is turned on.
  423.      OnRowMoved
  424.        Called when the user request to move a row with the mouse when
  425.        the goRowMoving option is on.
  426.      OnSetEditText
  427.        Called when goEditing is turned on to reflect changes to the text
  428.        made by the editor.
  429.      OnTopLeftChanged
  430.        Invoked when TopRow or LeftCol change. }
  431.  
  432.   TGetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; var Value: string) of object;
  433.   TSetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; const Value: string) of object;
  434.   TMovedEvent = procedure (Sender: TObject; FromIndex, ToIndex: Longint) of object;
  435.  
  436.   TDrawGrid = class(TCustomGrid)
  437.   private
  438.     FOnColumnMoved: TMovedEvent;
  439.     FOnDrawCell: TDrawCellEvent;
  440.     FOnGetEditMask: TGetEditEvent;
  441.     FOnGetEditText: TGetEditEvent;
  442.     FOnRowMoved: TMovedEvent;
  443.     FOnSelectCell: TSelectCellEvent;
  444.     FOnSetEditText: TSetEditEvent;
  445.     FOnTopLeftChanged: TNotifyEvent;
  446.   protected
  447.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  448.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  449.       AState: TGridDrawState); override;
  450.     function GetEditMask(ACol, ARow: Longint): string; override;
  451.     function GetEditText(ACol, ARow: Longint): string; override;
  452.     procedure RowMoved(FromIndex, ToIndex: Longint); override;
  453.     function SelectCell(ACol, ARow: Longint): Boolean; override;
  454.     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  455.     procedure TopLeftChanged; override;
  456.   public
  457.     function CellRect(ACol, ARow: Longint): TRect;
  458.     procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  459.     property Canvas;
  460.     property Col;
  461.     property ColWidths;
  462.     property EditorMode;
  463.     property GridHeight;
  464.     property GridWidth;
  465.     property LeftCol;
  466.     property Selection;
  467.     property Row;
  468.     property RowHeights;
  469.     property TabStops;
  470.     property TopRow;
  471.   published
  472.     property Align;
  473.     property BorderStyle;
  474.     property Color;
  475.     property ColCount;
  476.     property Ctl3D;
  477.     property DefaultColWidth;
  478.     property DefaultRowHeight;
  479.     property DefaultDrawing;
  480.     property DragCursor;
  481.     property DragMode;
  482.     property Enabled;
  483.     property FixedColor;
  484.     property FixedCols;
  485.     property RowCount;
  486.     property FixedRows;
  487.     property Font;
  488.     property GridLineWidth;
  489.     property Options;
  490.     property ParentColor;
  491.     property ParentCtl3D;
  492.     property ParentFont;
  493.     property ParentShowHint;
  494.     property PopupMenu;
  495.     property ScrollBars;
  496.     property ShowHint;
  497.     property TabOrder;
  498.     property TabStop;
  499.     property Visible;
  500.     property VisibleColCount;
  501.     property VisibleRowCount;
  502.     property OnClick;
  503.     property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
  504.     property OnDblClick;
  505.     property OnDragDrop;
  506.     property OnDragOver;
  507.     property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell;
  508.     property OnEndDrag;
  509.     property OnEnter;
  510.     property OnExit;
  511.     property OnGetEditMask: TGetEditEvent read FOnGetEditMask write FOnGetEditMask;
  512.     property OnGetEditText: TGetEditEvent read FOnGetEditText write FOnGetEditText;
  513.     property OnKeyDown;
  514.     property OnKeyPress;
  515.     property OnKeyUp;
  516.     property OnMouseDown;
  517.     property OnMouseMove;
  518.     property OnMouseUp;
  519.     property OnRowMoved: TMovedEvent read FOnRowMoved write FOnRowMoved;
  520.     property OnSelectCell: TSelectCellEvent read FOnSelectCell write FOnSelectCell;
  521.     property OnSetEditText: TSetEditEvent read FOnSetEditText write FOnSetEditText;
  522.     property OnStartDrag;
  523.     property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
  524.   end;
  525.  
  526.   { TStringGrid }
  527.  
  528.   { TStringGrid adds to TDrawGrid the ability to save a string and associated
  529.     object (much like TListBox).  It also adds to the DefaultDrawing the drawing
  530.     of the string associated with the current cell.
  531.       Cells
  532.         A ColCount by RowCount array of strings which are associated with each
  533.         cell.  By default, the string is drawn into the cell before OnDrawCell
  534.         is called.  This can be turned off (along with all the other default
  535.         drawing) by setting DefaultDrawing to false.
  536.       Cols
  537.         A TStrings object that contains the strings and objects in the column
  538.         indicated by Index.  The TStrings will always have a count of RowCount.
  539.         If a another TStrings is assigned to it, the strings and objects beyond
  540.         RowCount are ignored.
  541.       Objects
  542.         A ColCount by Rowcount array of TObject's associated with each cell.
  543.         Object put into this array will *not* be destroyed automatically when
  544.         the grid is destroyed.
  545.       Rows
  546.         A TStrings object that contains the strings and objects in the row
  547.         indicated by Index.  The TStrings will always have a count of ColCount.
  548.         If a another TStrings is assigned to it, the strings and objects beyond
  549.         ColCount are ignored. }
  550.  
  551.   TStringGrid = class;
  552.  
  553.   TStringGridStrings = class(TStrings)
  554.   private
  555.     FGrid: TStringGrid;
  556.     FIndex: Integer;
  557.     procedure CalcXY(Index: Integer; var X, Y: Integer);
  558.   protected
  559.     procedure Clear; override;
  560.     function Add(const S: string): Integer; override;
  561.     function Get(Index: Integer): string; override;
  562.     function GetCount: Integer; override;
  563.     function GetObject(Index: Integer): TObject; override;
  564.     procedure Put(Index: Integer; const S: string); override;
  565.     procedure PutObject(Index: Integer; AObject: TObject); override;
  566.     procedure SetUpdateState(Updating: Boolean); override;
  567.   public
  568.     constructor Create(AGrid: TStringGrid; AIndex: Longint);
  569.     procedure Assign(Source: TPersistent); override;
  570.   end;
  571.  
  572.  
  573.   TStringGrid = class(TDrawGrid)
  574.   private
  575.     FData: Pointer;
  576.     FRows: Pointer;
  577.     FCols: Pointer;
  578.     FUpdating: Boolean;
  579.     FNeedsUpdating: Boolean;
  580.     FEditUpdate: Integer;
  581.     procedure DisableEditUpdate;
  582.     procedure EnableEditUpdate;
  583.     procedure Initialize;
  584.     procedure Update(ACol, ARow: Integer);
  585.     procedure SetUpdateState(Updating: Boolean);
  586.     function GetCells(ACol, ARow: Integer): string;
  587.     function GetCols(Index: Integer): TStrings;
  588.     function GetObjects(ACol, ARow: Integer): TObject;
  589.     function GetRows(Index: Integer): TStrings;
  590.     procedure SetCells(ACol, ARow: Integer; const Value: string);
  591.     procedure SetCols(Index: Integer; Value: TStrings);
  592.     procedure SetObjects(ACol, ARow: Integer; Value: TObject);
  593.     procedure SetRows(Index: Integer; Value: TStrings);
  594.     function EnsureColRow(Index: Integer; IsCol: Boolean): TStringGridStrings;
  595.     function EnsureDataRow(ARow: Integer): Pointer;
  596.   protected
  597.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  598.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  599.       AState: TGridDrawState); override;
  600.     function GetEditText(ACol, ARow: Longint): string; override;
  601.     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  602.     procedure RowMoved(FromIndex, ToIndex: Longint); override;
  603.   public
  604.     constructor Create(AOwner: TComponent); override;
  605.     destructor Destroy; override;
  606.     property Cells[ACol, ARow: Integer]: string read GetCells write SetCells;
  607.     property Cols[Index: Integer]: TStrings read GetCols write SetCols;
  608.     property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects;
  609.     property Rows[Index: Integer]: TStrings read GetRows write SetRows;
  610.   end;
  611.  
  612. implementation
  613.  
  614. uses Consts;
  615.  
  616. type
  617.   PIntArray = ^TIntArray;
  618.   TIntArray = array[0..MaxCustomExtents] of Integer;
  619.  
  620. procedure InvalidOp(id: Integer);
  621. begin
  622.   raise EInvalidGridOperation.CreateRes(id);
  623. end;
  624.  
  625. function IMin(A, B: Integer): Integer;
  626. begin
  627.   Result := B;
  628.   if A < B then Result := A;
  629. end;
  630.  
  631. function IMax(A, B: Integer): Integer;
  632. begin
  633.   Result := B;
  634.   if A > B then Result := A;
  635. end;
  636.  
  637. function CoordInRect(const ACoord: TGridCoord; const ARect: TGridRect): Boolean;
  638. begin
  639.   with ACoord, ARect do
  640.     Result := (X >= Left) and (X <= Right) and (Y >= Top) and (Y <= Bottom);
  641. end;
  642.  
  643. function GridRect(Coord1, Coord2: TGridCoord): TGridRect;
  644. begin
  645.   with Result do
  646.   begin
  647.     Left := Coord2.X;
  648.     if Coord1.X < Coord2.X then Left := Coord1.X;
  649.     Right := Coord1.X;
  650.     if Coord1.X < Coord2.X then Right := Coord2.X;
  651.     Top := Coord2.Y;
  652.     if Coord1.Y < Coord2.Y then Top := Coord1.Y;
  653.     Bottom := Coord1.Y;
  654.     if Coord1.Y < Coord2.Y then Bottom := Coord2.Y;
  655.   end;
  656. end;
  657.  
  658. function GridRectUnion(const ARect1, ARect2: TGridRect): TGridRect;
  659. begin
  660.   with Result do
  661.   begin
  662.     Left := ARect1.Left;
  663.     if ARect1.Left > ARect2.Left then Left := ARect2.Left;
  664.     Right := ARect1.Right;
  665.     if ARect1.Right < ARect2.Right then Right := ARect2.Right;
  666.     Top := ARect1.Top;
  667.     if ARect1.Top > ARect2.Top then Top := ARect2.Top;
  668.     Bottom := ARect1.Bottom;
  669.     if ARect1.Bottom < ARect2.Bottom then Bottom := ARect2.Bottom;
  670.   end;
  671. end;
  672.  
  673. function PointInGridRect(Col, Row: Longint; const Rect: TGridRect): Boolean;
  674. begin
  675.   Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
  676.     and (Row <= Rect.Bottom);
  677. end;
  678.  
  679. type
  680.   TXorRects = array[0..3] of TRect;
  681.  
  682. procedure XorRects(const R1, R2: TRect; var XorRects: TXorRects);
  683. var
  684.   Intersect, Union: TRect;
  685.  
  686.   function PtInRect(X, Y: Integer; const Rect: TRect): Boolean;
  687.   begin
  688.     with Rect do Result := (X >= Left) and (X <= Right) and (Y >= Top) and
  689.       (Y <= Bottom);
  690.   end;
  691.  
  692.   function Includes(const P1: TPoint; var P2: TPoint): Boolean;
  693.   begin
  694.     with P1 do
  695.     begin
  696.       Result := PtInRect(X, Y, R1) or PtInRect(X, Y, R2);
  697.       if Result then P2 := P1;
  698.     end;
  699.   end;
  700.  
  701.   function Build(var R: TRect; const P1, P2, P3: TPoint): Boolean;
  702.   begin
  703.     Build := True;
  704.     with R do
  705.       if Includes(P1, TopLeft) then
  706.       begin
  707.         if not Includes(P3, BottomRight) then BottomRight := P2;
  708.       end
  709.       else if Includes(P2, TopLeft) then BottomRight := P3
  710.       else Build := False;
  711.   end;
  712.  
  713. begin
  714.   FillChar(XorRects, SizeOf(XorRects), 0);
  715.   if not Bool(IntersectRect(Intersect, R1, R2)) then
  716.   begin
  717.     { Don't intersect so its simple }
  718.     XorRects[0] := R1;
  719.     XorRects[1] := R2;
  720.   end
  721.   else
  722.   begin
  723.     UnionRect(Union, R1, R2);
  724.     if Build(XorRects[0],
  725.       Point(Union.Left, Union.Top),
  726.       Point(Union.Left, Intersect.Top),
  727.       Point(Union.Left, Intersect.Bottom)) then
  728.       XorRects[0].Right := Intersect.Left;
  729.     if Build(XorRects[1],
  730.       Point(Intersect.Left, Union.Top),
  731.       Point(Intersect.Right, Union.Top),
  732.       Point(Union.Right, Union.Top)) then
  733.       XorRects[1].Bottom := Intersect.Top;
  734.     if Build(XorRects[2],
  735.       Point(Union.Right, Intersect.Top),
  736.       Point(Union.Right, Intersect.Bottom),
  737.       Point(Union.Right, Union.Bottom)) then
  738.       XorRects[2].Left := Intersect.Right;
  739.     if Build(XorRects[3],
  740.       Point(Union.Left, Union.Bottom),
  741.       Point(Intersect.Left, Union.Bottom),
  742.       Point(Intersect.Right, Union.Bottom)) then
  743.       XorRects[3].Top := Intersect.Bottom;
  744.   end;
  745. end;
  746.  
  747. procedure ModifyExtents(var Extents: Pointer; Index, Amount: Longint;
  748.   Default: Integer);
  749. var
  750.   LongSize: LongInt;
  751.   NewSize: Cardinal;
  752.   OldSize: Cardinal;
  753.   I: Cardinal;
  754. begin
  755.   if Amount <> 0 then
  756.   begin
  757.     if not Assigned(Extents) then OldSize := 0
  758.     else OldSize := PIntArray(Extents)^[0];
  759.     if (Index < 0) or (OldSize < Index) then InvalidOp(SIndexOutOfRange);
  760.     LongSize := OldSize + Amount;
  761.     if LongSize < 0 then InvalidOp(STooManyDeleted)
  762.     else if LongSize >= MaxListSize - 1 then InvalidOp(SGridTooLarge);
  763.     NewSize := Cardinal(LongSize);
  764.     if NewSize > 0 then Inc(NewSize);
  765.     ReallocMem(Extents, NewSize * SizeOf(Integer));
  766.     if Assigned(Extents) then
  767.     begin
  768.       I := Index;
  769.       while I < NewSize do
  770.       begin
  771.         PIntArray(Extents)^[I] := Default;
  772.         Inc(I);
  773.       end;
  774.       PIntArray(Extents)^[0] := NewSize-1;
  775.     end;
  776.   end;
  777. end;
  778.  
  779. procedure UpdateExtents(var Extents: Pointer; NewSize: Longint;
  780.   Default: Integer);
  781. var
  782.   OldSize: Integer;
  783. begin
  784.   OldSize := 0;
  785.   if Assigned(Extents) then OldSize := PIntArray(Extents)^[0];
  786.   ModifyExtents(Extents, OldSize, NewSize - OldSize, Default);
  787. end;
  788.  
  789. procedure MoveExtent(var Extents: Pointer; FromIndex, ToIndex: Longint);
  790. var
  791.   Extent: Integer;
  792. begin
  793.   if Assigned(Extents) then
  794.   begin
  795.     Extent := PIntArray(Extents)^[FromIndex];
  796.     if FromIndex < ToIndex then
  797.       Move(PIntArray(Extents)^[FromIndex + 1], PIntArray(Extents)^[FromIndex],
  798.         (ToIndex - FromIndex) * SizeOf(Integer))
  799.     else if FromIndex > ToIndex then
  800.       Move(PIntArray(Extents)^[ToIndex], PIntArray(Extents)^[ToIndex + 1],
  801.         (FromIndex - ToIndex) * SizeOf(Integer));
  802.     PIntArray(Extents)^[ToIndex] := Extent;
  803.   end;
  804. end;
  805.  
  806. function CompareExtents(E1, E2: Pointer): Boolean;
  807. var
  808.   I: Integer;
  809. begin
  810.   Result := False;
  811.   if E1 <> nil then
  812.   begin
  813.     if E2 <> nil then
  814.     begin
  815.       for I := 0 to PIntArray(E1)^[0] do
  816.         if PIntArray(E1)^[I] <> PIntArray(E2)^[I] then Exit;
  817.       Result := True;
  818.     end
  819.   end
  820.   else Result := E2 = nil;
  821. end;
  822.  
  823. { Private. LongMulDiv multiplys the first two arguments and then
  824.   divides by the third.  This is used so that real number
  825.   (floating point) arithmetic is not necessary.  This routine saves
  826.   the possible 64-bit value in a temp before doing the divide.  Does
  827.   not do error checking like divide by zero.  Also assumes that the
  828.   result is in the 32-bit range (Actually 31-bit, since this algorithm
  829.   is for unsigned). }
  830.  
  831. function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; stdcall;
  832.   external 'kernel32.dll' name 'MulDiv';
  833.  
  834. type
  835.   TSelection = record
  836.     StartPos, EndPos: Integer;
  837.   end;
  838.  
  839. constructor TInplaceEdit.Create(AOwner: TComponent);
  840. begin
  841.   inherited Create(AOwner);
  842.   ParentCtl3D := False;
  843.   Ctl3D := False;
  844.   TabStop := False;
  845.   BorderStyle := bsNone;
  846. end;
  847.  
  848. procedure TInplaceEdit.CreateParams(var Params: TCreateParams);
  849. begin
  850.   inherited CreateParams(Params);
  851.   Params.Style := Params.Style or ES_MULTILINE;
  852. end;
  853.  
  854. procedure TInplaceEdit.SetGrid(Value: TCustomGrid);
  855. begin
  856.   FGrid := Value;
  857. end;
  858.  
  859. procedure TInplaceEdit.CMShowingChanged(var Message: TMessage);
  860. begin
  861.   { Ignore showing using the Visible property }
  862. end;
  863.  
  864. procedure TInplaceEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
  865. begin
  866.   inherited;
  867.   if goTabs in Grid.Options then
  868.     Message.Result := Message.Result or DLGC_WANTTAB;
  869. end;
  870.  
  871. procedure TInplaceEdit.WMPaste(var Message);
  872. begin
  873.   if not EditCanModify then Exit;
  874.   inherited
  875. end;
  876.  
  877. procedure TInplaceEdit.WMClear(var Message);
  878. begin
  879.   if not EditCanModify then Exit;
  880.   inherited;
  881. end;
  882.  
  883. procedure TInplaceEdit.WMCut(var Message);
  884. begin
  885.   if not EditCanModify then Exit;
  886.   inherited;
  887. end;
  888.  
  889. procedure TInplaceEdit.DblClick;
  890. begin
  891.   Grid.DblClick;
  892. end;
  893.  
  894. function TInplaceEdit.EditCanModify: Boolean;
  895. begin
  896.   Result := Grid.CanEditModify;
  897. end;
  898.  
  899. procedure TInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
  900.  
  901.   procedure SendToParent;
  902.   begin
  903.     Grid.KeyDown(Key, Shift);
  904.     Key := 0;
  905.   end;
  906.  
  907.   procedure ParentEvent;
  908.   var
  909.     GridKeyDown: TKeyEvent;
  910.   begin
  911.     GridKeyDown := Grid.OnKeyDown;
  912.     if Assigned(GridKeyDown) then GridKeyDown(Grid, Key, Shift);
  913.   end;
  914.  
  915.   function ForwardMovement: Boolean;
  916.   begin
  917.     Result := goAlwaysShowEditor in Grid.Options;
  918.   end;
  919.  
  920.   function Ctrl: Boolean;
  921.   begin
  922.     Result := ssCtrl in Shift;
  923.   end;
  924.  
  925.   function Selection: TSelection;
  926.   begin
  927.     SendMessage(Handle, EM_GETSEL, Longint(@Result.StartPos), Longint(@Result.EndPos));
  928.   end;
  929.  
  930.   function RightSide: Boolean;
  931.   begin
  932.     with Selection do
  933.       Result := ((StartPos = 0) or (EndPos = StartPos)) and
  934.         (EndPos = GetTextLen);
  935.    end;
  936.  
  937.   function LeftSide: Boolean;
  938.   begin
  939.     with Selection do
  940.       Result := (StartPos = 0) and ((EndPos = 0) or (EndPos = GetTextLen));
  941.   end;
  942.  
  943. begin
  944.   case Key of
  945.     VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT, VK_ESCAPE: SendToParent;
  946.     VK_INSERT:
  947.       if Shift = [] then SendToParent
  948.       else if (Shift = [ssShift]) and not Grid.CanEditModify then Key := 0;
  949.     VK_LEFT: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
  950.     VK_RIGHT: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
  951.     VK_HOME: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
  952.     VK_END: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
  953.     VK_F2:
  954.       begin
  955.         ParentEvent;
  956.         if Key = VK_F2 then
  957.         begin
  958.           Deselect;
  959.           Exit;
  960.         end;
  961.       end;
  962.     VK_TAB: if not (ssAlt in Shift) then SendToParent;
  963.   end;
  964.   if (Key = VK_DELETE) and not Grid.CanEditModify then Key := 0;
  965.   if Key <> 0 then
  966.   begin
  967.     ParentEvent;
  968.     inherited KeyDown(Key, Shift);
  969.   end;
  970. end;
  971.  
  972. procedure TInplaceEdit.KeyPress(var Key: Char);
  973. var
  974.   Selection: TSelection;
  975. begin
  976.   Grid.KeyPress(Key);
  977.   if (Key in [#32..#255]) and not Grid.CanEditAcceptKey(Key) then
  978.   begin
  979.     Key := #0;
  980.     MessageBeep(0);
  981.   end;
  982.   case Key of
  983.     #9, #27: Key := #0;
  984.     #13:
  985.       begin
  986.         SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  987.         if (Selection.StartPos = 0) and (Selection.EndPos = GetTextLen) then
  988.           Deselect else
  989.           SelectAll;
  990.         Key := #0;
  991.       end;
  992.     ^H, ^V, ^X, #32..#255:
  993.       if not Grid.CanEditModify then Key := #0;
  994.   end;
  995.   if Key <> #0 then inherited KeyPress(Key);
  996. end;
  997.  
  998. procedure TInplaceEdit.KeyUp(var Key: Word; Shift: TShiftState);
  999. begin
  1000.   Grid.KeyUp(Key, Shift);
  1001. end;
  1002.  
  1003. procedure TInplaceEdit.WndProc(var Message: TMessage);
  1004. begin
  1005.   case Message.Msg of
  1006.     WM_SETFOCUS:
  1007.       begin
  1008.         if GetParentForm(Self).SetFocusedControl(Grid) then Dispatch(Message);
  1009.         Exit;
  1010.       end;
  1011.     WM_LBUTTONDOWN:
  1012.       begin
  1013.         if GetMessageTime - FClickTime < GetDoubleClickTime then
  1014.           Message.Msg := WM_LBUTTONDBLCLK;
  1015.         FClickTime := 0;
  1016.       end;
  1017.   end;
  1018.   inherited WndProc(Message);
  1019. end;
  1020.  
  1021. procedure TInplaceEdit.Deselect;
  1022. begin
  1023.   SendMessage(Handle, EM_SETSEL, $7FFFFFFF, Longint($FFFFFFFF));
  1024. end;
  1025.  
  1026. procedure TInplaceEdit.Invalidate;
  1027. var
  1028.   Cur: TRect;
  1029. begin
  1030.   ValidateRect(Handle, nil);
  1031.   InvalidateRect(Handle, nil, True);
  1032.   Windows.GetClientRect(Handle, Cur);
  1033.   MapWindowPoints(Handle, Grid.Handle, Cur, 2);
  1034.   ValidateRect(Grid.Handle, @Cur);
  1035.   InvalidateRect(Grid.Handle, @Cur, False);
  1036. end;
  1037.  
  1038. procedure TInplaceEdit.Hide;
  1039. begin
  1040.   if HandleAllocated and IsWindowVisible(Handle) then
  1041.   begin
  1042.     Invalidate;
  1043.     SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_HIDEWINDOW or SWP_NOZORDER or
  1044.       SWP_NOREDRAW);
  1045.     if Focused then Windows.SetFocus(Grid.Handle);
  1046.   end;
  1047. end;
  1048.  
  1049. function TInplaceEdit.PosEqual(const Rect: TRect): Boolean;
  1050. var
  1051.   Cur: TRect;
  1052. begin
  1053.   GetWindowRect(Handle, Cur);
  1054.   MapWindowPoints(HWND_DESKTOP, Grid.Handle, Cur, 2);
  1055.   Result := EqualRect(Rect, Cur);
  1056. end;
  1057.  
  1058. procedure TInplaceEdit.InternalMove(const Loc: TRect; Redraw: Boolean);
  1059. begin
  1060.   if IsRectEmpty(Loc) then Hide
  1061.   else
  1062.   begin
  1063.     CreateHandle;
  1064.     Redraw := Redraw or not IsWindowVisible(Handle);
  1065.     Invalidate;
  1066.     with Loc do
  1067.       SetWindowPos(Handle, HWND_TOP, Left, Top, Right - Left, Bottom - Top,
  1068.         SWP_SHOWWINDOW or SWP_NOREDRAW);
  1069.     BoundsChanged;
  1070.     if Redraw then Invalidate;
  1071.     if Grid.Focused then
  1072.       Windows.SetFocus(Handle);
  1073.   end;
  1074. end;
  1075.  
  1076. procedure TInplaceEdit.BoundsChanged;
  1077. var
  1078.   R: TRect;
  1079. begin
  1080.   R := Rect(2, 2, Width - 2, Height);
  1081.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  1082.   SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  1083. end;
  1084.  
  1085. procedure TInplaceEdit.UpdateLoc(const Loc: TRect);
  1086. begin
  1087.   InternalMove(Loc, False);
  1088. end;
  1089.  
  1090. function TInplaceEdit.Visible: Boolean;
  1091. begin
  1092.   Result := IsWindowVisible(Handle);
  1093. end;
  1094.  
  1095. procedure TInplaceEdit.Move(const Loc: TRect);
  1096. begin
  1097.   InternalMove(Loc, True);
  1098. end;
  1099.  
  1100. procedure TInplaceEdit.SetFocus;
  1101. begin
  1102.   if IsWindowVisible(Handle) then
  1103.     Windows.SetFocus(Handle);
  1104. end;
  1105.  
  1106. procedure TInplaceEdit.UpdateContents;
  1107. begin
  1108.   Text := '';
  1109.   EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
  1110.   Text := Grid.GetEditText(Grid.Col, Grid.Row);
  1111.   MaxLength := Grid.GetEditLimit;
  1112. end;
  1113.  
  1114. { TCustomGrid }
  1115.  
  1116. constructor TCustomGrid.Create(AOwner: TComponent);
  1117. const
  1118.   GridStyle = [csCaptureMouse, csOpaque, csDoubleClicks];
  1119. begin
  1120.   inherited Create(AOwner);
  1121.   if NewStyleControls then
  1122.     ControlStyle := GridStyle else
  1123.     ControlStyle := GridStyle + [csFramed];
  1124.   FCanEditModify := True;
  1125.   FColCount := 5;
  1126.   FRowCount := 5;
  1127.   FFixedCols := 1;
  1128.   FFixedRows := 1;
  1129.   FGridLineWidth := 1;
  1130.   FOptions := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  1131.     goRangeSelect];
  1132.   FFixedColor := clBtnFace;
  1133.   FScrollBars := ssBoth;
  1134.   FBorderStyle := bsSingle;
  1135.   FDefaultColWidth := 64;
  1136.   FDefaultRowHeight := 24;
  1137.   FDefaultDrawing := True;
  1138.   FSaveCellExtents := True;
  1139.   FEditorMode := False;
  1140.   Color := clWindow;
  1141.   ParentColor := False;
  1142.   TabStop := True;
  1143.   SetBounds(Left, Top, FColCount * FDefaultColWidth,
  1144.     FRowCount * FDefaultRowHeight);
  1145.   Initialize;
  1146. end;
  1147.  
  1148. destructor TCustomGrid.Destroy;
  1149. begin
  1150.   FInplaceEdit.Free;
  1151.   inherited Destroy;
  1152.   FreeMem(FColWidths);
  1153.   FreeMem(FRowHeights);
  1154.   FreeMem(FTabStops);
  1155. end;
  1156.  
  1157. procedure TCustomGrid.AdjustSize(Index, Amount: Longint; Rows: Boolean);
  1158. var
  1159.   NewCur: TGridCoord;
  1160.   OldRows, OldCols: Longint;
  1161.   MovementX, MovementY: Longint;
  1162.   MoveRect: TGridRect;
  1163.   ScrollArea: TRect;
  1164.   AbsAmount: Longint;
  1165.  
  1166.   function DoSizeAdjust(var Count: Longint; var Extents: Pointer;
  1167.     DefaultExtent: Integer; var Current: Longint): Longint;
  1168.   var
  1169.     I: Integer;
  1170.     NewCount: Longint;
  1171.   begin
  1172.     NewCount := Count + Amount;
  1173.     if NewCount < Index then InvalidOp(STooManyDeleted);
  1174.     if (Amount < 0) and Assigned(Extents) then
  1175.     begin
  1176.       Result := 0;
  1177.       for I := Index to Index - Amount - 1 do
  1178.         Inc(Result, PIntArray(Extents)^[I]);
  1179.     end
  1180.     else
  1181.       Result := Amount * DefaultExtent;
  1182.     if Extents <> nil then
  1183.       ModifyExtents(Extents, Index, Amount, DefaultExtent);
  1184.     Count := NewCount;
  1185.     if Current >= Index then
  1186.       if (Amount < 0) and (Current < Index - Amount) then Current := Index
  1187.       else Inc(Current, Amount);
  1188.   end;
  1189.  
  1190. begin
  1191.   if Amount = 0 then Exit;
  1192.   NewCur := FCurrent;
  1193.   OldCols := ColCount;
  1194.   OldRows := RowCount;
  1195.   MoveRect.Left := FixedCols;
  1196.   MoveRect.Right := ColCount - 1;
  1197.   MoveRect.Top := FixedRows;
  1198.   MoveRect.Bottom := RowCount - 1;
  1199.   MovementX := 0;
  1200.   MovementY := 0;
  1201.   AbsAmount := Amount;
  1202.   if AbsAmount < 0 then AbsAmount := -AbsAmount;
  1203.   if Rows then
  1204.   begin
  1205.     MovementY := DoSizeAdjust(FRowCount, FRowHeights, DefaultRowHeight, NewCur.Y);
  1206.     MoveRect.Top := Index;
  1207.     if Index + AbsAmount <= TopRow then MoveRect.Bottom := TopRow - 1;
  1208.   end
  1209.   else
  1210.   begin
  1211.     MovementX := DoSizeAdjust(FColCount, FColWidths, DefaultColWidth, NewCur.X);
  1212.     MoveRect.Left := Index;
  1213.     if Index + AbsAmount <= LeftCol then MoveRect.Right := LeftCol - 1;
  1214.   end;
  1215.   GridRectToScreenRect(MoveRect, ScrollArea, True);
  1216.   if not IsRectEmpty(ScrollArea) then
  1217.   begin
  1218.     ScrollWindow(Handle, MovementX, MovementY, @ScrollArea, @ScrollArea);
  1219.     UpdateWindow(Handle);
  1220.   end;
  1221.   SizeChanged(OldCols, OldRows);
  1222.   if (NewCur.X <> FCurrent.X) or (NewCur.Y <> FCurrent.Y) then
  1223.     MoveCurrent(NewCur.X, NewCur.Y, True, True);
  1224. end;
  1225.  
  1226. function TCustomGrid.BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
  1227. var
  1228.   GridRect: TGridRect;
  1229. begin
  1230.   GridRect.Left := ALeft;
  1231.   GridRect.Right := ARight;
  1232.   GridRect.Top := ATop;
  1233.   GridRect.Bottom := ABottom;
  1234.   GridRectToScreenRect(GridRect, Result, False);
  1235. end;
  1236.  
  1237. procedure TCustomGrid.DoExit;
  1238. begin
  1239.   inherited DoExit;
  1240.   if not (goAlwaysShowEditor in Options) then HideEditor;
  1241. end;
  1242.  
  1243. function TCustomGrid.CellRect(ACol, ARow: Longint): TRect;
  1244. begin
  1245.   Result := BoxRect(ACol, ARow, ACol, ARow);
  1246. end;
  1247.  
  1248. function TCustomGrid.CanEditAcceptKey(Key: Char): Boolean;
  1249. begin
  1250.   Result := True;
  1251. end;
  1252.  
  1253. function TCustomGrid.CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean;
  1254. begin
  1255.   Result := True;
  1256. end;
  1257.  
  1258. function TCustomGrid.CanEditModify: Boolean;
  1259. begin
  1260.   Result := FCanEditModify;
  1261. end;
  1262.  
  1263. function TCustomGrid.CanEditShow: Boolean;
  1264. begin
  1265.   Result := ([goRowSelect, goEditing] * Options = [goEditing]) and
  1266.     FEditorMode and not (csDesigning in ComponentState) and HandleAllocated and
  1267.     ((goAlwaysShowEditor in Options) or (ValidParentForm(Self).ActiveControl = Self));
  1268. end;
  1269.  
  1270. function TCustomGrid.GetEditMask(ACol, ARow: Longint): string;
  1271. begin
  1272.   Result := '';
  1273. end;
  1274.  
  1275. function TCustomGrid.GetEditText(ACol, ARow: Longint): string;
  1276. begin
  1277.   Result := '';
  1278. end;
  1279.  
  1280. procedure TCustomGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  1281. begin
  1282. end;
  1283.  
  1284. function TCustomGrid.GetEditLimit: Integer;
  1285. begin
  1286.   Result := 0;
  1287. end;
  1288.  
  1289. procedure TCustomGrid.HideEditor;
  1290. begin
  1291.   FEditorMode := False;
  1292.   HideEdit;
  1293. end;
  1294.  
  1295. procedure TCustomGrid.ShowEditor;
  1296. begin
  1297.   FEditorMode := True;
  1298.   UpdateEdit;
  1299. end;
  1300.  
  1301. procedure TCustomGrid.ShowEditorChar(Ch: Char);
  1302. begin
  1303.   ShowEditor;
  1304.   if FInplaceEdit <> nil then
  1305.     PostMessage(FInplaceEdit.Handle, WM_CHAR, Word(Ch), 0);
  1306. end;
  1307.  
  1308. procedure TCustomGrid.InvalidateEditor;
  1309. begin
  1310.   FInplaceCol := -1;
  1311.   FInplaceRow := -1;
  1312.   UpdateEdit;
  1313. end;
  1314.  
  1315. procedure TCustomGrid.ReadColWidths(Reader: TReader);
  1316. var
  1317.   I: Integer;
  1318. begin
  1319.   with Reader do
  1320.   begin
  1321.     ReadListBegin;
  1322.     for I := 0 to ColCount - 1 do ColWidths[I] := ReadInteger;
  1323.     ReadListEnd;
  1324.   end;
  1325. end;
  1326.  
  1327. procedure TCustomGrid.ReadRowHeights(Reader: TReader);
  1328. var
  1329.   I: Integer;
  1330. begin
  1331.   with Reader do
  1332.   begin
  1333.     ReadListBegin;
  1334.     for I := 0 to RowCount - 1 do RowHeights[I] := ReadInteger;
  1335.     ReadListEnd;
  1336.   end;
  1337. end;
  1338.  
  1339. procedure TCustomGrid.WriteColWidths(Writer: TWriter);
  1340. var
  1341.   I: Integer;
  1342. begin
  1343.   with Writer do
  1344.   begin
  1345.     WriteListBegin;
  1346.     for I := 0 to ColCount - 1 do WriteInteger(ColWidths[I]);
  1347.     WriteListEnd;
  1348.   end;
  1349. end;
  1350.  
  1351. procedure TCustomGrid.WriteRowHeights(Writer: TWriter);
  1352. var
  1353.   I: Integer;
  1354. begin
  1355.   with Writer do
  1356.   begin
  1357.     WriteListBegin;
  1358.     for I := 0 to RowCount - 1 do WriteInteger(RowHeights[I]);
  1359.     WriteListEnd;
  1360.   end;
  1361. end;
  1362.  
  1363. procedure TCustomGrid.DefineProperties(Filer: TFiler);
  1364.  
  1365.   function DoColWidths: Boolean;
  1366.   begin
  1367.     if Filer.Ancestor <> nil then
  1368.       Result := not CompareExtents(TCustomGrid(Filer.Ancestor).FColWidths, FColWidths)
  1369.     else
  1370.       Result := FColWidths <> nil;
  1371.   end;
  1372.  
  1373.   function DoRowHeights: Boolean;
  1374.   begin
  1375.     if Filer.Ancestor <> nil then
  1376.       Result := not CompareExtents(TCustomGrid(Filer.Ancestor).FRowHeights, FRowHeights)
  1377.     else
  1378.       Result := FRowHeights <> nil;
  1379.   end;
  1380.  
  1381.  
  1382. begin
  1383.   inherited DefineProperties(Filer);
  1384.   if FSaveCellExtents then
  1385.     with Filer do
  1386.     begin
  1387.       DefineProperty('ColWidths', ReadColWidths, WriteColWidths, DoColWidths);
  1388.       DefineProperty('RowHeights', ReadRowHeights, WriteRowHeights, DoRowHeights);
  1389.     end;
  1390. end;
  1391.  
  1392. procedure TCustomGrid.MoveColumn(FromIndex, ToIndex: Longint);
  1393. var
  1394.   Rect: TGridRect;
  1395. begin
  1396.   if FromIndex = ToIndex then Exit;
  1397.   if Assigned(FColWidths) then
  1398.   begin
  1399.     MoveExtent(FColWidths, FromIndex + 1, ToIndex + 1);
  1400.     MoveExtent(FTabStops, FromIndex + 1, ToIndex + 1);
  1401.   end;
  1402.   MoveAdjust(FCurrent.X, FromIndex, ToIndex);
  1403.   MoveAdjust(FAnchor.X, FromIndex, ToIndex);
  1404.   MoveAdjust(FInplaceCol, FromIndex, ToIndex);
  1405.   Rect.Top := 0;
  1406.   Rect.Bottom := VisibleRowCount;
  1407.   if FromIndex < ToIndex then
  1408.   begin
  1409.     Rect.Left := FromIndex;
  1410.     Rect.Right := ToIndex;
  1411.   end
  1412.   else
  1413.   begin
  1414.     Rect.Left := ToIndex;
  1415.     Rect.Right := FromIndex;
  1416.   end;
  1417.   InvalidateRect(Rect);
  1418.   ColumnMoved(FromIndex, ToIndex);
  1419.   if Assigned(FColWidths) then
  1420.     ColWidthsChanged;
  1421.   UpdateEdit;
  1422. end;
  1423.  
  1424. procedure TCustomGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  1425. begin
  1426. end;
  1427.  
  1428. procedure TCustomGrid.MoveRow(FromIndex, ToIndex: Longint);
  1429. begin
  1430.   if Assigned(FRowHeights) then
  1431.     MoveExtent(FRowHeights, FromIndex + 1, ToIndex + 1);
  1432.   MoveAdjust(FCurrent.Y, FromIndex, ToIndex);
  1433.   MoveAdjust(FAnchor.Y, FromIndex, ToIndex);
  1434.   MoveAdjust(FInplaceRow, FromIndex, ToIndex);
  1435.   RowMoved(FromIndex, ToIndex);
  1436.   if Assigned(FRowHeights) then
  1437.     RowHeightsChanged;
  1438.   UpdateEdit;
  1439. end;
  1440.  
  1441. procedure TCustomGrid.RowMoved(FromIndex, ToIndex: Longint);
  1442. begin
  1443. end;
  1444.  
  1445. function TCustomGrid.MouseCoord(X, Y: Integer): TGridCoord;
  1446. var
  1447.   DrawInfo: TGridDrawInfo;
  1448. begin
  1449.   CalcDrawInfo(DrawInfo);
  1450.   Result := CalcCoordFromPoint(X, Y, DrawInfo);
  1451.   if Result.X < 0 then Result.Y := -1
  1452.   else if Result.Y < 0 then Result.X := -1;
  1453. end;
  1454.  
  1455. procedure TCustomGrid.MoveColRow(ACol, ARow: Longint; MoveAnchor,
  1456.   Show: Boolean);
  1457. begin
  1458.   MoveCurrent(ACol, ARow, MoveAnchor, Show);
  1459. end;
  1460.  
  1461. function TCustomGrid.SelectCell(ACol, ARow: Longint): Boolean;
  1462. begin
  1463.   Result := True;
  1464. end;
  1465.  
  1466. procedure TCustomGrid.SizeChanged(OldColCount, OldRowCount: Longint);
  1467. begin
  1468. end;
  1469.  
  1470. function TCustomGrid.Sizing(X, Y: Integer): Boolean;
  1471. var
  1472.   FixedInfo: TGridDrawInfo;
  1473.   State: TGridState;
  1474.   Index: Longint;
  1475.   Pos, Ofs: Integer;
  1476. begin
  1477.   State := FGridState;
  1478.   if State = gsNormal then
  1479.   begin
  1480.     CalcFixedInfo(FixedInfo);
  1481.     CalcSizingState(X, Y, State, Index, Pos, Ofs, FixedInfo);
  1482.   end;
  1483.   Result := State <> gsNormal;
  1484. end;
  1485.  
  1486. procedure TCustomGrid.TopLeftChanged;
  1487. begin
  1488.   if FEditorMode and (FInplaceEdit <> nil) then FInplaceEdit.UpdateLoc(CellRect(Col, Row));
  1489. end;
  1490.  
  1491. procedure FillDWord(var Dest; Count, Value: Integer); register;
  1492. asm
  1493.   XCHG  EDX, ECX
  1494.   PUSH  EDI
  1495.   MOV   EDI, EAX
  1496.   MOV   EAX, EDX
  1497.   REP   STOSD
  1498.   POP   EDI
  1499. end;
  1500.  
  1501. { StackAlloc allocates a 'small' block of memory from the stack by
  1502.   decrementing SP.  This provides the allocation speed of a local variable,
  1503.   but the runtime size flexibility of heap allocated memory.  }
  1504. function StackAlloc(Size: Integer): Pointer; register;
  1505. asm
  1506.   POP   ECX          { return address }
  1507.   MOV   EDX, ESP
  1508.   SUB   ESP, EAX
  1509.   MOV   EAX, ESP     { function result = low memory address of block }
  1510.   PUSH  EDX          { save original SP, for cleanup }
  1511.   MOV   EDX, ESP
  1512.   SUB   EDX, 4
  1513.   PUSH  EDX          { save current SP, for sanity check  (sp = [sp]) }
  1514.   PUSH  ECX          { return to caller }
  1515. end;
  1516.  
  1517. { StackFree pops the memory allocated by StackAlloc off the stack.
  1518. - Calling StackFree is optional - SP will be restored when the calling routine
  1519.   exits, but it's a good idea to free the stack allocated memory ASAP anyway.
  1520. - StackFree must be called in the same stack context as StackAlloc - not in
  1521.   a subroutine or finally block.
  1522. - Multiple StackFree calls must occur in reverse order of their corresponding
  1523.   StackAlloc calls.
  1524. - Built-in sanity checks guarantee that an improper call to StackFree will not
  1525.   corrupt the stack. Worst case is that the stack block is not released until
  1526.   the calling routine exits. }
  1527. procedure StackFree(P: Pointer); register;
  1528. asm
  1529.   POP   ECX                     { return address }
  1530.   MOV   EDX, DWORD PTR [ESP]
  1531.   SUB   EAX, 8
  1532.   CMP   EDX, ESP                { sanity check #1 (SP = [SP]) }
  1533.   JNE   @@1
  1534.   CMP   EDX, EAX                { sanity check #2 (P = this stack block) }
  1535.   JNE   @@1
  1536.   MOV   ESP, DWORD PTR [ESP+4]  { restore previous SP  }
  1537. @@1:
  1538.   PUSH  ECX                     { return to caller }
  1539. end;
  1540.  
  1541. procedure TCustomGrid.Paint;
  1542. var
  1543.   LineColor: TColor;
  1544.   DrawInfo: TGridDrawInfo;
  1545.   Sel: TGridRect;
  1546.   UpdateRect: TRect;
  1547.   FocRect: TRect;
  1548.   PointsList: PIntArray;
  1549.   StrokeList: PIntArray;
  1550.   MaxStroke: Integer;
  1551.   FrameFlags1, FrameFlags2: DWORD;
  1552.  
  1553.   procedure DrawLines(DoHorz, DoVert: Boolean; Col, Row: Longint;
  1554.     const CellBounds: array of Integer; OnColor, OffColor: TColor);
  1555.  
  1556.   { Cellbounds is 4 integers: StartX, StartY, StopX, StopY
  1557.     Horizontal lines:  MajorIndex = 0
  1558.     Vertical lines:    MajorIndex = 1 }
  1559.  
  1560.   const
  1561.     FlatPenStyle = PS_Geometric or PS_Solid or PS_EndCap_Flat or PS_Join_Miter;
  1562.  
  1563.     procedure DrawAxisLines(const AxisInfo: TGridAxisDrawInfo;
  1564.       Cell, MajorIndex: Integer; UseOnColor: Boolean);
  1565.     var
  1566.       Line: Integer;
  1567.       LogBrush: TLOGBRUSH;
  1568.       Index: Integer;
  1569.       Points: PIntArray;
  1570.       StopMajor, StartMinor, StopMinor: Integer;
  1571.     begin
  1572.       with Canvas, AxisInfo do
  1573.       begin
  1574.         if EffectiveLineWidth <> 0 then
  1575.         begin
  1576.           Pen.Width := GridLineWidth;
  1577.           if UseOnColor then
  1578.             Pen.Color := OnColor
  1579.           else
  1580.             Pen.Color := OffColor;
  1581.           if Pen.Width > 1 then
  1582.           begin
  1583.             LogBrush.lbStyle := BS_Solid;
  1584.             LogBrush.lbColor := Pen.Color;
  1585.             LogBrush.lbHatch := 0;
  1586.             Pen.Handle := ExtCreatePen(FlatPenStyle, Pen.Width, LogBrush, 0, nil);
  1587.           end;
  1588.           Points := PointsList;
  1589.           Line := CellBounds[MajorIndex] + EffectiveLineWidth shr 1 +
  1590.             GetExtent(Cell);
  1591.           StartMinor := CellBounds[MajorIndex xor 1];
  1592.           StopMinor := CellBounds[2 + (MajorIndex xor 1)];
  1593.           StopMajor := CellBounds[2 + MajorIndex] + EffectiveLineWidth;
  1594.           Index := 0;
  1595.           repeat
  1596.             Points^[Index + MajorIndex] := Line;         { MoveTo }
  1597.             Points^[Index + (MajorIndex xor 1)] := StartMinor;
  1598.             Inc(Index, 2);
  1599.             Points^[Index + MajorIndex] := Line;         { LineTo }
  1600.             Points^[Index + (MajorIndex xor 1)] := StopMinor;
  1601.             Inc(Index, 2);
  1602.             Inc(Cell);
  1603.             Inc(Line, GetExtent(Cell) + EffectiveLineWidth);
  1604.           until Line > StopMajor;
  1605.            { 2 integers per point, 2 points per line -> Index div 4 }
  1606.           PolyPolyLine(Canvas.Handle, Points^, StrokeList^, Index shr 2);
  1607.         end;
  1608.       end;
  1609.     end;
  1610.  
  1611.   begin
  1612.     if (CellBounds[0] = CellBounds[2]) or (CellBounds[1] = CellBounds[3]) then Exit;
  1613.     if not DoHorz then
  1614.     begin
  1615.       DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
  1616.       DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
  1617.     end
  1618.     else
  1619.     begin
  1620.       DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
  1621.       DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
  1622.     end;
  1623.   end;
  1624.  
  1625.   procedure DrawCells(ACol, ARow: Longint; StartX, StartY, StopX, StopY: Integer;
  1626.     Color: TColor; IncludeDrawState: TGridDrawState);
  1627.   var
  1628.     CurCol, CurRow: Longint;
  1629.     Where, TempRect: TRect;
  1630.     DrawState: TGridDrawState;
  1631.     Focused: Boolean;
  1632.   begin
  1633.     CurRow := ARow;
  1634.     Where.Top := StartY;
  1635.     while (Where.Top < StopY) and (CurRow < RowCount) do
  1636.     begin
  1637.       CurCol := ACol;
  1638.       Where.Left := StartX;
  1639.       Where.Bottom := Where.Top + RowHeights[CurRow];
  1640.       while (Where.Left < StopX) and (CurCol < ColCount) do
  1641.       begin
  1642.         Where.Right := Where.Left + ColWidths[CurCol];
  1643.         if RectVisible(Canvas.Handle, Where) then
  1644.         begin
  1645.           DrawState := IncludeDrawState;
  1646.           Focused := ValidParentForm(Self).ActiveControl = Self;
  1647.           if Focused and (CurRow = Row) and (CurCol = Col)  then
  1648.             Include(DrawState, gdFocused);
  1649.           if PointInGridRect(CurCol, CurRow, Sel) then
  1650.             Include(DrawState, gdSelected);
  1651.           if not (gdFocused in DrawState) or not (goEditing in Options) or
  1652.             not FEditorMode or (csDesigning in ComponentState) then
  1653.           begin
  1654.             if DefaultDrawing or (csDesigning in ComponentState) then
  1655.               with Canvas do
  1656.               begin
  1657.                 Font := Self.Font;
  1658.                 if (gdSelected in DrawState) and
  1659.                   (not (gdFocused in DrawState) or
  1660.                   ([goDrawFocusSelected, goRowSelect] * Options <> [])) then
  1661.                 begin
  1662.                   Brush.Color := clHighlight;
  1663.                   Font.Color := clHighlightText;
  1664.                 end
  1665.                 else
  1666.                   Brush.Color := Color;
  1667.                 FillRect(Where);
  1668.               end;
  1669.             DrawCell(CurCol, CurRow, Where, DrawState);
  1670.             if DefaultDrawing and (gdFixed in DrawState) and Ctl3D and
  1671.               ((FrameFlags1 or FrameFlags2) <> 0) then
  1672.             begin
  1673.               TempRect := Where;
  1674.               if (FrameFlags1 and BF_RIGHT) = 0 then
  1675.                 Inc(TempRect.Right, DrawInfo.Horz.EffectiveLineWidth)
  1676.               else if (FrameFlags1 and BF_BOTTOM) = 0 then
  1677.                 Inc(TempRect.Bottom, DrawInfo.Vert.EffectiveLineWidth);
  1678.               DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags1);
  1679.               DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags2);
  1680.             end;
  1681.             if DefaultDrawing and not (csDesigning in ComponentState) and
  1682.               (gdFocused in DrawState) and
  1683.               ([goEditing, goAlwaysShowEditor] * Options <>
  1684.               [goEditing, goAlwaysShowEditor])
  1685.               and not (goRowSelect in Options) then
  1686.               DrawFocusRect(Canvas.Handle, Where);
  1687.           end;
  1688.         end;
  1689.         Where.Left := Where.Right + DrawInfo.Horz.EffectiveLineWidth;
  1690.         Inc(CurCol);
  1691.       end;
  1692.       Where.Top := Where.Bottom + DrawInfo.Vert.EffectiveLineWidth;
  1693.       Inc(CurRow);
  1694.     end;
  1695.   end;
  1696.  
  1697. begin
  1698.   UpdateRect := Canvas.ClipRect;
  1699.   CalcDrawInfo(DrawInfo);
  1700.   with DrawInfo do
  1701.   begin
  1702.     if (Horz.EffectiveLineWidth > 0) or (Vert.EffectiveLineWidth > 0) then
  1703.     begin
  1704.       { Draw the grid line in the four areas (fixed, fixed), (variable, fixed),
  1705.         (fixed, variable) and (variable, variable) }
  1706.       LineColor := clSilver;
  1707.       MaxStroke := IMax(Horz.LastFullVisibleCell - LeftCol + FixedCols,
  1708.                         Vert.LastFullVisibleCell - TopRow + FixedRows) + 3;
  1709.       PointsList := StackAlloc(MaxStroke * sizeof(TPoint) * 2);
  1710.       StrokeList := StackAlloc(MaxStroke * sizeof(Integer));
  1711.       FillDWord(StrokeList^, MaxStroke, 2);
  1712.  
  1713.       if ColorToRGB(Color) = clSilver then LineColor := clGray;
  1714.       DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1715.         0, 0, [0, 0, Horz.FixedBoundary, Vert.FixedBoundary], clBlack, FixedColor);
  1716.       DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1717.         LeftCol, 0, [Horz.FixedBoundary, 0, Horz.GridBoundary,
  1718.         Vert.FixedBoundary], clBlack, FixedColor);
  1719.       DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1720.         0, TopRow, [0, Vert.FixedBoundary, Horz.FixedBoundary,
  1721.         Vert.GridBoundary], clBlack, FixedColor);
  1722.       DrawLines(goHorzLine in Options, goVertLine in Options, LeftCol,
  1723.         TopRow, [Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridBoundary,
  1724.         Vert.GridBoundary], LineColor, Color);
  1725.  
  1726.       StackFree(StrokeList);
  1727.       StackFree(PointsList);
  1728.     end;
  1729.  
  1730.     { Draw the cells in the four areas }
  1731.     Sel := Selection;
  1732.     FrameFlags1 := 0;
  1733.     FrameFlags2 := 0;
  1734.     if goFixedVertLine in Options then
  1735.     begin
  1736.       FrameFlags1 := BF_RIGHT;
  1737.       FrameFlags2 := BF_LEFT;
  1738.     end;
  1739.     if goFixedHorzLine in Options then
  1740.     begin
  1741.       FrameFlags1 := FrameFlags1 or BF_BOTTOM;
  1742.       FrameFlags2 := FrameFlags2 or BF_TOP;
  1743.     end;
  1744.     DrawCells(0, 0, 0, 0, Horz.FixedBoundary, Vert.FixedBoundary, FixedColor,
  1745.       [gdFixed]);
  1746.     DrawCells(LeftCol, 0, Horz.FixedBoundary - FColOffset, 0, Horz.GridBoundary,
  1747.       Vert.FixedBoundary, FixedColor, [gdFixed]);
  1748.     DrawCells(0, TopRow, 0, Vert.FixedBoundary, Horz.FixedBoundary,
  1749.       Vert.GridBoundary, FixedColor, [gdFixed]);
  1750.     DrawCells(LeftCol, TopRow, Horz.FixedBoundary - FColOffset,
  1751.       Vert.FixedBoundary, Horz.GridBoundary, Vert.GridBoundary, Color, []);
  1752.  
  1753.     if not (csDesigning in ComponentState) and
  1754.       (goRowSelect in Options) and DefaultDrawing and Focused then
  1755.     begin
  1756.       GridRectToScreenRect(GetSelection, FocRect, False);
  1757.       Canvas.DrawFocusRect(FocRect);
  1758.     end;
  1759.  
  1760.     { Fill in area not occupied by cells }
  1761.     if Horz.GridBoundary < Horz.GridExtent then
  1762.     begin
  1763.       Canvas.Brush.Color := Color;
  1764.       Canvas.FillRect(Rect(Horz.GridBoundary, 0, Horz.GridExtent, Vert.GridBoundary));
  1765.     end;
  1766.     if Vert.GridBoundary < Vert.GridExtent then
  1767.     begin
  1768.       Canvas.Brush.Color := Color;
  1769.       Canvas.FillRect(Rect(0, Vert.GridBoundary, Horz.GridExtent, Vert.GridExtent));
  1770.     end;
  1771.   end;
  1772. end;
  1773.  
  1774. function TCustomGrid.CalcCoordFromPoint(X, Y: Integer;
  1775.   const DrawInfo: TGridDrawInfo): TGridCoord;
  1776.  
  1777.   function DoCalc(const AxisInfo: TGridAxisDrawInfo; N: Integer): Integer;
  1778.   var
  1779.     I, Start, Stop: Longint;
  1780.     Line: Integer;
  1781.   begin
  1782.     with AxisInfo do
  1783.     begin
  1784.       if N < FixedBoundary then
  1785.       begin
  1786.         Start := 0;
  1787.         Stop :=  FixedCellCount - 1;
  1788.         Line := 0;
  1789.       end
  1790.       else
  1791.       begin
  1792.         Start := FirstGridCell;
  1793.         Stop := GridCellCount - 1;
  1794.         Line := FixedBoundary;
  1795.       end;
  1796.       Result := -1;
  1797.       for I := Start to Stop do
  1798.       begin
  1799.         Inc(Line, GetExtent(I) + EffectiveLineWidth);
  1800.         if N < Line then
  1801.         begin
  1802.           Result := I;
  1803.           Exit;
  1804.         end;
  1805.       end;
  1806.     end;
  1807.   end;
  1808.  
  1809. begin
  1810.   Result.X := DoCalc(DrawInfo.Horz, X);
  1811.   Result.Y := DoCalc(DrawInfo.Vert, Y);
  1812. end;
  1813.  
  1814. procedure TCustomGrid.CalcDrawInfo(var DrawInfo: TGridDrawInfo);
  1815. begin
  1816.   CalcDrawInfoXY(DrawInfo, ClientWidth, ClientHeight);
  1817. end;
  1818.  
  1819. procedure TCustomGrid.CalcDrawInfoXY(var DrawInfo: TGridDrawInfo;
  1820.   UseWidth, UseHeight: Integer);
  1821.  
  1822.   procedure CalcAxis(var AxisInfo: TGridAxisDrawInfo; UseExtent: Integer);
  1823.   var
  1824.     I: Integer;
  1825.   begin
  1826.     with AxisInfo do
  1827.     begin
  1828.       GridExtent := UseExtent;
  1829.       GridBoundary := FixedBoundary;
  1830.       FullVisBoundary := FixedBoundary;
  1831.       LastFullVisibleCell := FirstGridCell;
  1832.       for I := FirstGridCell to GridCellCount - 1 do
  1833.       begin
  1834.         Inc(GridBoundary, GetExtent(I) + EffectiveLineWidth);
  1835.         if GridBoundary > GridExtent + EffectiveLineWidth then
  1836.         begin
  1837.           GridBoundary := GridExtent;
  1838.           Break;
  1839.         end;
  1840.         LastFullVisibleCell := I;
  1841.         FullVisBoundary := GridBoundary;
  1842.       end;
  1843.     end;
  1844.   end;
  1845.  
  1846. begin
  1847.   CalcFixedInfo(DrawInfo);
  1848.   CalcAxis(DrawInfo.Horz, UseWidth);
  1849.   CalcAxis(DrawInfo.Vert, UseHeight);
  1850. end;
  1851.  
  1852. procedure TCustomGrid.CalcFixedInfo(var DrawInfo: TGridDrawInfo);
  1853.  
  1854.   procedure CalcFixedAxis(var Axis: TGridAxisDrawInfo; LineOptions: TGridOptions;
  1855.     FixedCount, FirstCell, CellCount: Integer; GetExtentFunc: TGetExtentsFunc);
  1856.   var
  1857.     I: Integer;
  1858.   begin
  1859.     with Axis do
  1860.     begin
  1861.       if LineOptions * Options = [] then
  1862.         EffectiveLineWidth := 0
  1863.       else
  1864.         EffectiveLineWidth := GridLineWidth;
  1865.  
  1866.       FixedBoundary := 0;
  1867.       for I := 0 to FixedCount - 1 do
  1868.         Inc(FixedBoundary, GetExtentFunc(I) + EffectiveLineWidth);
  1869.  
  1870.       FixedCellCount := FixedCount;
  1871.       FirstGridCell := FirstCell;
  1872.       GridCellCount := CellCount;
  1873.       GetExtent := GetExtentFunc;
  1874.     end;
  1875.   end;
  1876.  
  1877. begin
  1878.   CalcFixedAxis(DrawInfo.Horz, [goFixedVertLine, goVertLine], FixedCols,
  1879.     LeftCol, ColCount, GetColWidths);
  1880.   CalcFixedAxis(DrawInfo.Vert, [goFixedHorzLine, goHorzLine], FixedRows,
  1881.     TopRow, RowCount, GetRowHeights);
  1882. end;
  1883.  
  1884. { Calculates the TopLeft that will put the given Coord in view }
  1885. function TCustomGrid.CalcMaxTopLeft(const Coord: TGridCoord;
  1886.   const DrawInfo: TGridDrawInfo): TGridCoord;
  1887.  
  1888.   function CalcMaxCell(const Axis: TGridAxisDrawInfo; Start: Integer): Integer;
  1889.   var
  1890.     Line: Integer;
  1891.     I: Longint;
  1892.   begin
  1893.     Result := Start;
  1894.     with Axis do
  1895.     begin
  1896.       Line := GridExtent + EffectiveLineWidth;
  1897.       for I := Start downto FixedCellCount do
  1898.       begin
  1899.         Dec(Line, GetExtent(I));
  1900.         Dec(Line, EffectiveLineWidth);
  1901.         if Line < FixedBoundary then Break;
  1902.         Result := I;
  1903.       end;
  1904.     end;
  1905.   end;
  1906.  
  1907. begin
  1908.   Result.X := CalcMaxCell(DrawInfo.Horz, Coord.X);
  1909.   Result.Y := CalcMaxCell(DrawInfo.Vert, Coord.Y);
  1910. end;
  1911.  
  1912. procedure TCustomGrid.CalcSizingState(X, Y: Integer; var State: TGridState;
  1913.   var Index: Longint; var SizingPos, SizingOfs: Integer;
  1914.   var FixedInfo: TGridDrawInfo);
  1915.  
  1916.   procedure CalcAxisState(const AxisInfo: TGridAxisDrawInfo; Pos: Integer;
  1917.     NewState: TGridState);
  1918.   var
  1919.     I, Line, Back, Range: Integer;
  1920.   begin
  1921.     with AxisInfo do
  1922.     begin
  1923.       Line := FixedBoundary;
  1924.       Range := EffectiveLineWidth;
  1925.       Back := 0;
  1926.       if Range < 7 then
  1927.       begin
  1928.         Range := 7;
  1929.         Back := (Range - EffectiveLineWidth) shr 1;
  1930.       end;
  1931.       for I := FirstGridCell to GridCellCount - 1 do
  1932.       begin
  1933.         Inc(Line, GetExtent(I));
  1934.         if Line > GridExtent then Break;
  1935.         if (Pos >= Line - Back) and (Pos <= Line - Back + Range) then
  1936.         begin
  1937.           State := NewState;
  1938.           SizingPos := Line;
  1939.           SizingOfs := Line - Pos;
  1940.           Index := I;
  1941.           Exit;
  1942.         end;
  1943.         Inc(Line, EffectiveLineWidth);
  1944.       end;
  1945.       if (Pos >= GridExtent - Back) and (Pos <= GridExtent) then
  1946.       begin
  1947.         State := NewState;
  1948.         SizingPos := GridExtent;
  1949.         SizingOfs := GridExtent - Pos;
  1950.         Index := I;
  1951.       end;
  1952.     end;
  1953.   end;
  1954.  
  1955. var
  1956.   EffectiveOptions: TGridOptions;
  1957. begin
  1958.   State := gsNormal;
  1959.   Index := -1;
  1960.   EffectiveOptions := Options;
  1961.   if csDesigning in ComponentState then
  1962.   begin
  1963.     Include(EffectiveOptions, goColSizing);
  1964.     Include(EffectiveOptions, goRowSizing);
  1965.   end;
  1966.   if [goColSizing, goRowSizing] * EffectiveOptions <> [] then
  1967.     with FixedInfo do
  1968.     begin
  1969.       Vert.GridExtent := ClientHeight;
  1970.       Horz.GridExtent := ClientWidth;
  1971.       if (X > Horz.FixedBoundary) and (goColSizing in EffectiveOptions) then
  1972.       begin
  1973.         if Y >= Vert.FixedBoundary then Exit;
  1974.         CalcAxisState(Horz, X, gsColSizing);
  1975.       end
  1976.       else if (Y > Vert.FixedBoundary) and (goRowSizing in EffectiveOptions) then
  1977.       begin
  1978.         if X >= Horz.FixedBoundary then Exit;
  1979.         CalcAxisState(Vert, Y, gsRowSizing);
  1980.       end;
  1981.     end;
  1982. end;
  1983.  
  1984. procedure TCustomGrid.ChangeSize(NewColCount, NewRowCount: Longint);
  1985. var
  1986.   OldColCount, OldRowCount: Longint;
  1987.   OldDrawInfo: TGridDrawInfo;
  1988.  
  1989.   procedure MinRedraw(const OldInfo, NewInfo: TGridAxisDrawInfo; Axis: Integer);
  1990.   var
  1991.     R: TRect;
  1992.     First: Integer;
  1993.   begin
  1994.     if (OldInfo.LastFullVisibleCell = NewInfo.LastFullVisibleCell) then Exit;
  1995.     First := IMin(OldInfo.LastFullVisibleCell, NewInfo.LastFullVisibleCell);
  1996.     // Get the rectangle around the leftmost or topmost cell in the target range.
  1997.     R := CellRect(First and not Axis, First and Axis);
  1998.     R.Bottom := Height;
  1999.     R.Right := Width;
  2000.     Windows.InvalidateRect(Handle, @R, False);
  2001.   end;
  2002.  
  2003.   procedure DoChange;
  2004.   var
  2005.     Coord: TGridCoord;
  2006.     NewDrawInfo: TGridDrawInfo;
  2007.   begin
  2008.     if FColWidths <> nil then
  2009.     begin
  2010.       UpdateExtents(FColWidths, ColCount, DefaultColWidth);
  2011.       UpdateExtents(FTabStops, ColCount, Integer(True));
  2012.     end;
  2013.     if FRowHeights <> nil then
  2014.       UpdateExtents(FRowHeights, RowCount, DefaultRowHeight);
  2015.     Coord := FCurrent;
  2016.     if Row >= RowCount then Coord.Y := RowCount - 1;
  2017.     if Col >= ColCount then Coord.X := ColCount - 1;
  2018.     if (FCurrent.X <> Coord.X) or (FCurrent.Y <> Coord.Y) then
  2019.       MoveCurrent(Coord.X, Coord.Y, True, True);
  2020.     if (FAnchor.X <> Coord.X) or (FAnchor.Y <> Coord.Y) then
  2021.       MoveAnchor(Coord);
  2022.     if (LeftCol <> OldDrawInfo.Horz.FirstGridCell) or
  2023.       (TopRow <> OldDrawInfo.Vert.FirstGridCell) then
  2024.       InvalidateGrid
  2025.     else if HandleAllocated then
  2026.     begin
  2027.       CalcDrawInfo(NewDrawInfo);
  2028.       MinRedraw(OldDrawInfo.Horz, NewDrawInfo.Horz, 0);
  2029.       MinRedraw(OldDrawInfo.Vert, NewDrawInfo.Vert, -1);
  2030.     end;
  2031.     UpdateScrollRange;
  2032.     SizeChanged(OldColCount, OldRowCount);
  2033.   end;
  2034.  
  2035. begin
  2036.   if HandleAllocated then
  2037.     CalcDrawInfo(OldDrawInfo);
  2038.   OldColCount := FColCount;
  2039.   OldRowCount := FRowCount;
  2040.   FColCount := NewColCount;
  2041.   FRowCount := NewRowCount;
  2042.   if FixedCols > NewColCount then FFixedCols := NewColCount - 1;
  2043.   if FixedRows > NewRowCount then FFixedRows := NewRowCount - 1;
  2044.   try
  2045.     DoChange;
  2046.   except
  2047.     { Could not change size so try to clean up by setting the size back }
  2048.     FColCount := OldColCount;
  2049.     FRowCount := OldRowCount;
  2050.     DoChange;
  2051.     InvalidateGrid;
  2052.     raise;
  2053.   end;
  2054. end;
  2055.  
  2056. { Will move TopLeft so that Coord is in view }
  2057. procedure TCustomGrid.ClampInView(const Coord: TGridCoord);
  2058. var
  2059.   DrawInfo: TGridDrawInfo;
  2060.   MaxTopLeft: TGridCoord;
  2061.   OldTopLeft: TGridCoord;
  2062. begin
  2063.   if not HandleAllocated then Exit;
  2064.   CalcDrawInfo(DrawInfo);
  2065.   with DrawInfo, Coord do
  2066.   begin
  2067.     if (X > Horz.LastFullVisibleCell) or
  2068.       (Y > Vert.LastFullVisibleCell) or (X < LeftCol) or (Y < TopRow) then
  2069.     begin
  2070.       OldTopLeft := FTopLeft;
  2071.       MaxTopLeft := CalcMaxTopLeft(Coord, DrawInfo);
  2072.       Update;
  2073.       if X < LeftCol then FTopLeft.X := X
  2074.       else if X > Horz.LastFullVisibleCell then FTopLeft.X := MaxTopLeft.X;
  2075.       if Y < TopRow then FTopLeft.Y := Y
  2076.       else if Y > Vert.LastFullVisibleCell then FTopLeft.Y := MaxTopLeft.Y;
  2077.       TopLeftMoved(OldTopLeft);
  2078.     end;
  2079.   end;
  2080. end;
  2081.  
  2082. procedure TCustomGrid.DrawSizingLine(const DrawInfo: TGridDrawInfo);
  2083. var
  2084.   OldPen: TPen;
  2085. begin
  2086.   OldPen := TPen.Create;
  2087.   try
  2088.     with Canvas, DrawInfo do
  2089.     begin
  2090.       OldPen.Assign(Pen);
  2091.       Pen.Style := psDot;
  2092.       Pen.Mode := pmXor;
  2093.       Pen.Width := 1;
  2094.       try
  2095.         if FGridState = gsRowSizing then
  2096.         begin
  2097.           MoveTo(0, FSizingPos);
  2098.           LineTo(Horz.GridBoundary, FSizingPos);
  2099.         end
  2100.         else
  2101.         begin
  2102.           MoveTo(FSizingPos, 0);
  2103.           LineTo(FSizingPos, Vert.GridBoundary);
  2104.         end;
  2105.       finally
  2106.         Pen := OldPen;
  2107.       end;
  2108.     end;
  2109.   finally
  2110.     OldPen.Free;
  2111.   end;
  2112. end;
  2113.  
  2114. procedure TCustomGrid.DrawMove;
  2115. var
  2116.   OldPen: TPen;
  2117.   Pos: Integer;
  2118.   R: TRect;
  2119. begin
  2120.   OldPen := TPen.Create;
  2121.   try
  2122.     with Canvas do
  2123.     begin
  2124.       OldPen.Assign(Pen);
  2125.       try
  2126.         Pen.Style := psDot;
  2127.         Pen.Mode := pmXor;
  2128.         Pen.Width := 5;
  2129.         if FGridState = gsRowMoving then
  2130.         begin
  2131.           R := CellRect(0, FMovePos);
  2132.           if FMovePos > FMoveIndex then
  2133.             Pos := R.Bottom else
  2134.             Pos := R.Top;
  2135.           MoveTo(0, Pos);
  2136.           LineTo(ClientWidth, Pos);
  2137.         end
  2138.         else
  2139.         begin
  2140.           R := CellRect(FMovePos, 0);
  2141.           if FMovePos > FMoveIndex then
  2142.             Pos := R.Right else
  2143.             Pos := R.Left;
  2144.           MoveTo(Pos, 0);
  2145.           LineTo(Pos, ClientHeight);
  2146.         end;
  2147.       finally
  2148.         Canvas.Pen := OldPen;
  2149.       end;
  2150.     end;
  2151.   finally
  2152.     OldPen.Free;
  2153.   end;
  2154. end;
  2155.  
  2156. procedure TCustomGrid.FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
  2157. begin
  2158.   MoveCurrent(ACol, ARow, MoveAnchor, True);
  2159.   UpdateEdit;
  2160.   Click;
  2161. end;
  2162.  
  2163. procedure TCustomGrid.GridRectToScreenRect(GridRect: TGridRect;
  2164.   var ScreenRect: TRect; IncludeLine: Boolean);
  2165.  
  2166.   function LinePos(const AxisInfo: TGridAxisDrawInfo; Line: Integer): Integer;
  2167.   var
  2168.     Start, I: Longint;
  2169.   begin
  2170.     with AxisInfo do
  2171.     begin
  2172.       Result := 0;
  2173.       if Line < FixedCellCount then
  2174.         Start := 0
  2175.       else
  2176.       begin
  2177.         if Line >= FirstGridCell then
  2178.           Result := FixedBoundary;
  2179.         Start := FirstGridCell;
  2180.       end;
  2181.       for I := Start to Line - 1 do
  2182.       begin
  2183.         Inc(Result, GetExtent(I) + EffectiveLineWidth);
  2184.         if Result > GridExtent then
  2185.         begin
  2186.           Result := 0;
  2187.           Exit;
  2188.         end;
  2189.       end;
  2190.     end;
  2191.   end;
  2192.  
  2193.   function CalcAxis(const AxisInfo: TGridAxisDrawInfo;
  2194.     GridRectMin, GridRectMax: Integer;
  2195.     var ScreenRectMin, ScreenRectMax: Integer): Boolean;
  2196.   begin
  2197.     Result := False;
  2198.     with AxisInfo do
  2199.     begin
  2200.       if (GridRectMin >= FixedCellCount) and (GridRectMin < FirstGridCell) then
  2201.         if GridRectMax < FirstGridCell then
  2202.         begin
  2203.           FillChar(ScreenRect, SizeOf(ScreenRect), 0); { erase partial results }
  2204.           Exit;
  2205.         end
  2206.         else
  2207.           GridRectMin := FirstGridCell;
  2208.       if GridRectMax > LastFullVisibleCell then
  2209.       begin
  2210.         GridRectMax := LastFullVisibleCell;
  2211.         if GridRectMax < GridCellCount - 1 then Inc(GridRectMax);
  2212.         if LinePos(AxisInfo, GridRectMax) = 0 then
  2213.           Dec(GridRectMax);
  2214.       end;
  2215.  
  2216.       ScreenRectMin := LinePos(AxisInfo, GridRectMin);
  2217.       ScreenRectMax := LinePos(AxisInfo, GridRectMax);
  2218.       if ScreenRectMax = 0 then
  2219.         ScreenRectMax := ScreenRectMin + GetExtent(GridRectMin)
  2220.       else
  2221.         Inc(ScreenRectMax, GetExtent(GridRectMax));
  2222.       if ScreenRectMax > GridExtent then
  2223.         ScreenRectMax := GridExtent;
  2224.       if IncludeLine then Inc(ScreenRectMax, EffectiveLineWidth);
  2225.     end;
  2226.     Result := True;
  2227.   end;
  2228.  
  2229. var
  2230.   DrawInfo: TGridDrawInfo;
  2231. begin
  2232.   FillChar(ScreenRect, SizeOf(ScreenRect), 0);
  2233.   if (GridRect.Left > GridRect.Right) or (GridRect.Top > GridRect.Bottom) then
  2234.     Exit;
  2235.   CalcDrawInfo(DrawInfo);
  2236.   with DrawInfo do
  2237.   begin
  2238.     if GridRect.Left > Horz.LastFullVisibleCell + 1 then Exit;
  2239.     if GridRect.Top > Vert.LastFullVisibleCell + 1 then Exit;
  2240.  
  2241.     if CalcAxis(Horz, GridRect.Left, GridRect.Right, ScreenRect.Left,
  2242.       ScreenRect.Right) then
  2243.     begin
  2244.       CalcAxis(Vert, GridRect.Top, GridRect.Bottom, ScreenRect.Top,
  2245.         ScreenRect.Bottom);
  2246.     end;
  2247.   end;
  2248. end;
  2249.  
  2250. procedure TCustomGrid.Initialize;
  2251. begin
  2252.   FTopLeft.X := FixedCols;
  2253.   FTopLeft.Y := FixedRows;
  2254.   FCurrent := FTopLeft;
  2255.   FAnchor := FCurrent;
  2256.   if goRowSelect in Options then FAnchor.X := ColCount - 1;
  2257. end;
  2258.  
  2259. procedure TCustomGrid.InvalidateCell(ACol, ARow: Longint);
  2260. var
  2261.   Rect: TGridRect;
  2262. begin
  2263.   Rect.Top := ARow;
  2264.   Rect.Left := ACol;
  2265.   Rect.Bottom := ARow;
  2266.   Rect.Right := ACol;
  2267.   InvalidateRect(Rect);
  2268. end;
  2269.  
  2270. procedure TCustomGrid.InvalidateCol(ACol: Longint);
  2271. var
  2272.   Rect: TGridRect;
  2273. begin
  2274.   if not HandleAllocated then Exit;
  2275.   Rect.Top := 0;
  2276.   Rect.Left := ACol;
  2277.   Rect.Bottom := VisibleRowCount+1;
  2278.   Rect.Right := ACol;
  2279.   InvalidateRect(Rect);
  2280. end;
  2281.  
  2282. procedure TCustomGrid.InvalidateRow(ARow: Longint);
  2283. var
  2284.   Rect: TGridRect;
  2285. begin
  2286.   if not HandleAllocated then Exit;
  2287.   Rect.Top := ARow;
  2288.   Rect.Left := 0;
  2289.   Rect.Bottom := ARow;
  2290.   Rect.Right := VisibleColCount+1;
  2291.   InvalidateRect(Rect);
  2292. end;
  2293.  
  2294. procedure TCustomGrid.InvalidateGrid;
  2295. begin
  2296.   Invalidate;
  2297. end;
  2298.  
  2299. procedure TCustomGrid.InvalidateRect(ARect: TGridRect);
  2300. var
  2301.   InvalidRect: TRect;
  2302. begin
  2303.   if not HandleAllocated then Exit;
  2304.   GridRectToScreenRect(ARect, InvalidRect, True);
  2305.   Windows.InvalidateRect(Handle, @InvalidRect, False);
  2306. end;
  2307.  
  2308. procedure TCustomGrid.InvertRect(const Rect: TRect);
  2309. begin
  2310.   with Rect do
  2311.     PatBlt(Canvas.Handle, Left, Top, Right - Left, Bottom - Top, DSTINVERT);
  2312. end;
  2313.  
  2314. procedure TCustomGrid.ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal);
  2315. var
  2316.   NewTopLeft, MaxTopLeft: TGridCoord;
  2317.   DrawInfo: TGridDrawInfo;
  2318.  
  2319.   function Min: Longint;
  2320.   begin
  2321.     if ScrollBar = SB_HORZ then Result := FixedCols
  2322.     else Result := FixedRows;
  2323.   end;
  2324.  
  2325.   function Max: Longint;
  2326.   begin
  2327.     if ScrollBar = SB_HORZ then Result := MaxTopLeft.X
  2328.     else Result := MaxTopLeft.Y;
  2329.   end;
  2330.  
  2331.   function PageUp: Longint;
  2332.   var
  2333.     MaxTopLeft: TGridCoord;
  2334.   begin
  2335.     MaxTopLeft := CalcMaxTopLeft(FTopLeft, DrawInfo);
  2336.     if ScrollBar = SB_HORZ then
  2337.       Result := FTopLeft.X - MaxTopLeft.X else
  2338.       Result := FTopLeft.Y - MaxTopLeft.Y;
  2339.     if Result < 1 then Result := 1;
  2340.   end;
  2341.  
  2342.   function PageDown: Longint;
  2343.   var
  2344.     DrawInfo: TGridDrawInfo;
  2345.   begin
  2346.     CalcDrawInfo(DrawInfo);
  2347.     with DrawInfo do
  2348.       if ScrollBar = SB_HORZ then
  2349.         Result := Horz.LastFullVisibleCell - FTopLeft.X else
  2350.         Result := Vert.LastFullVisibleCell - FTopLeft.Y;
  2351.     if Result < 1 then Result := 1;
  2352.   end;
  2353.  
  2354.   function CalcScrollBar(Value: Longint): Longint;
  2355.   begin
  2356.     Result := Value;
  2357.     case ScrollCode of
  2358.       SB_LINEUP:
  2359.         Result := Value - 1;
  2360.       SB_LINEDOWN:
  2361.         Result := Value + 1;
  2362.       SB_PAGEUP:
  2363.         Result := Value - PageUp;
  2364.       SB_PAGEDOWN:
  2365.         Result := Value + PageDown;
  2366.       SB_THUMBPOSITION, SB_THUMBTRACK:
  2367.         if (goThumbTracking in Options) or (ScrollCode = SB_THUMBPOSITION) then
  2368.           Result := Min + LongMulDiv(Pos, Max - Min, MaxShortInt);
  2369.       SB_BOTTOM:
  2370.         Result := Min;
  2371.       SB_TOP:
  2372.         Result := Min;
  2373.     end;
  2374.   end;
  2375.  
  2376.   procedure ModifyPixelScrollBar(Code, Pos: Cardinal);
  2377.   var
  2378.     NewOffset: Integer;
  2379.     OldOffset: Integer;
  2380.     R: TGridRect;
  2381.   begin
  2382.     NewOffset := FColOffset;
  2383.     case Code of
  2384.       SB_LINEUP: Dec(NewOffset, Canvas.TextWidth('0'));
  2385.       SB_LINEDOWN: Inc(NewOffset, Canvas.TextWidth('0'));
  2386.       SB_PAGEUP: Dec(NewOffset, ClientWidth);
  2387.       SB_PAGEDOWN: Inc(NewOffset, ClientWidth);
  2388.       SB_THUMBPOSITION: NewOffset := Pos;
  2389.       SB_THUMBTRACK: if goThumbTracking in Options then NewOffset := Pos;
  2390.       SB_BOTTOM: NewOffset := 0;
  2391.       SB_TOP: NewOffset := ColWidths[0] - ClientWidth;
  2392.     end;
  2393.     if NewOffset < 0 then
  2394.       NewOffset := 0
  2395.     else if NewOffset >= ColWidths[0] - ClientWidth then
  2396.       NewOffset := ColWidths[0] - ClientWidth;
  2397.     if NewOffset <> FColOffset then
  2398.     begin
  2399.       OldOffset := FColOffset;
  2400.       FColOffset := NewOffset;
  2401.       ScrollData(OldOffset - NewOffset, 0);
  2402.       FillChar(R, SizeOf(R), 0);
  2403.       R.Bottom := FixedRows;
  2404.       InvalidateRect(R);
  2405.       Update;
  2406.       UpdateScrollPos;
  2407.     end;
  2408.   end;
  2409.  
  2410. begin
  2411.   if Visible and CanFocus and TabStop and not (csDesigning in ComponentState) then
  2412.     SetFocus;
  2413.   if (ScrollBar = SB_HORZ) and (ColCount = 1) then
  2414.   begin
  2415.     ModifyPixelScrollBar(ScrollCode, Pos);
  2416.     Exit;
  2417.   end;
  2418.   CalcDrawInfo(DrawInfo);
  2419.   MaxTopLeft.X := ColCount - 1;
  2420.   MaxTopLeft.Y := RowCount - 1;
  2421.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2422.   NewTopLeft := FTopLeft;
  2423.   if ScrollBar = SB_HORZ then NewTopLeft.X := CalcScrollBar(NewTopLeft.X)
  2424.   else NewTopLeft.Y := CalcScrollBar(NewTopLeft.Y);
  2425.   if NewTopLeft.X < FixedCols then NewTopLeft.X := FixedCols
  2426.   else if NewTopLeft.X > MaxTopLeft.X then NewTopLeft.X := MaxTopLeft.X;
  2427.   if NewTopLeft.Y < FixedRows then NewTopLeft.Y := FixedRows
  2428.   else if NewTopLeft.Y > MaxTopLeft.Y then NewTopLeft.Y := MaxTopLeft.Y;
  2429.   if (NewTopLeft.X <> FTopLeft.X) or (NewTopLeft.Y <> FTopLeft.Y) then
  2430.     MoveTopLeft(NewTopLeft.X, NewTopLeft.Y);
  2431. end;
  2432.  
  2433. procedure TCustomGrid.MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
  2434. var
  2435.   Min, Max: Longint;
  2436. begin
  2437.   if CellPos = FromIndex then CellPos := ToIndex
  2438.   else
  2439.   begin
  2440.     Min := FromIndex;
  2441.     Max := ToIndex;
  2442.     if FromIndex > ToIndex then
  2443.     begin
  2444.       Min := ToIndex;
  2445.       Max := FromIndex;
  2446.     end;
  2447.     if (CellPos >= Min) and (CellPos <= Max) then
  2448.       if FromIndex > ToIndex then
  2449.         Inc(CellPos) else
  2450.         Dec(CellPos);
  2451.   end;
  2452. end;
  2453.  
  2454. procedure TCustomGrid.MoveAnchor(const NewAnchor: TGridCoord);
  2455. var
  2456.   OldSel: TGridRect;
  2457. begin
  2458.   if [goRangeSelect, goEditing] * Options = [goRangeSelect] then
  2459.   begin
  2460.     OldSel := Selection;
  2461.     FAnchor := NewAnchor;
  2462.     if goRowSelect in Options then FAnchor.X := ColCount - 1;
  2463.     ClampInView(NewAnchor);
  2464.     SelectionMoved(OldSel);
  2465.   end
  2466.   else MoveCurrent(NewAnchor.X, NewAnchor.Y, True, True);
  2467. end;
  2468.  
  2469. procedure TCustomGrid.MoveCurrent(ACol, ARow: Longint; MoveAnchor,
  2470.   Show: Boolean);
  2471. var
  2472.   OldSel: TGridRect;
  2473.   OldCurrent: TGridCoord;
  2474. begin
  2475.   if (ACol < 0) or (ARow < 0) or (ACol >= ColCount) or (ARow >= RowCount) then
  2476.     InvalidOp(SIndexOutOfRange);
  2477.   if SelectCell(ACol, ARow) then
  2478.   begin
  2479.     OldSel := Selection;
  2480.     OldCurrent := FCurrent;
  2481.     FCurrent.X := ACol;
  2482.     FCurrent.Y := ARow;
  2483.     if not (goAlwaysShowEditor in Options) then HideEditor;
  2484.     if MoveAnchor or not (goRangeSelect in Options) then
  2485.     begin
  2486.       FAnchor := FCurrent;
  2487.       if goRowSelect in Options then FAnchor.X := ColCount - 1;
  2488.     end;
  2489.     if goRowSelect in Options then FCurrent.X := FixedCols;
  2490.     if Show then ClampInView(FCurrent);
  2491.     SelectionMoved(OldSel);
  2492.     with OldCurrent do InvalidateCell(X, Y);
  2493.     with FCurrent do InvalidateCell(ACol, ARow);
  2494.   end;
  2495. end;
  2496.  
  2497. procedure TCustomGrid.MoveTopLeft(ALeft, ATop: Longint);
  2498. var
  2499.   OldTopLeft: TGridCoord;
  2500. begin
  2501.   if (ALeft = FTopLeft.X) and (ATop = FTopLeft.Y) then Exit;
  2502.   Update;
  2503.   OldTopLeft := FTopLeft;
  2504.   FTopLeft.X := ALeft;
  2505.   FTopLeft.Y := ATop;
  2506.   TopLeftMoved(OldTopLeft);
  2507. end;
  2508.  
  2509. procedure TCustomGrid.ResizeCol(Index: Longint; OldSize, NewSize: Integer);
  2510. begin
  2511.   InvalidateGrid;
  2512. end;
  2513.  
  2514. procedure TCustomGrid.ResizeRow(Index: Longint; OldSize, NewSize: Integer);
  2515. begin
  2516.   InvalidateGrid;
  2517. end;
  2518.  
  2519. procedure TCustomGrid.SelectionMoved(const OldSel: TGridRect);
  2520. var
  2521.   OldRect, NewRect: TRect;
  2522.   AXorRects: TXorRects;
  2523.   I: Integer;
  2524. begin
  2525.   if not HandleAllocated then Exit;
  2526.   GridRectToScreenRect(OldSel, OldRect, True);
  2527.   GridRectToScreenRect(Selection, NewRect, True);
  2528.   XorRects(OldRect, NewRect, AXorRects);
  2529.   for I := Low(AXorRects) to High(AXorRects) do
  2530.     Windows.InvalidateRect(Handle, @AXorRects[I], False);
  2531. end;
  2532.  
  2533. procedure TCustomGrid.ScrollDataInfo(DX, DY: Integer;
  2534.   var DrawInfo: TGridDrawInfo);
  2535. var
  2536.   ScrollArea: TRect;
  2537.   ScrollFlags: Integer;
  2538. begin
  2539.   with DrawInfo do
  2540.   begin
  2541.     ScrollFlags := SW_INVALIDATE;
  2542.     if not DefaultDrawing then
  2543.       ScrollFlags := ScrollFlags or SW_ERASE;
  2544.     { Scroll the area }
  2545.     if DY = 0 then
  2546.     begin
  2547.       { Scroll both the column titles and data area at the same time }
  2548.       ScrollArea := Rect(Horz.FixedBoundary, 0, Horz.GridExtent, Vert.GridExtent);
  2549.       ScrollWindowEx(Handle, DX, 0, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2550.     end
  2551.     else if DX = 0 then
  2552.     begin
  2553.       { Scroll both the row titles and data area at the same time }
  2554.       ScrollArea := Rect(0, Vert.FixedBoundary, Horz.GridExtent, Vert.GridExtent);
  2555.       ScrollWindowEx(Handle, 0, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2556.     end
  2557.     else
  2558.     begin
  2559.       { Scroll titles and data area separately }
  2560.       { Column titles }
  2561.       ScrollArea := Rect(Horz.FixedBoundary, 0, Horz.GridExtent, Vert.FixedBoundary);
  2562.       ScrollWindowEx(Handle, DX, 0, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2563.       { Row titles }
  2564.       ScrollArea := Rect(0, Vert.FixedBoundary, Horz.FixedBoundary, Vert.GridExtent);
  2565.       ScrollWindowEx(Handle, 0, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2566.       { Data area }
  2567.       ScrollArea := Rect(Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridExtent,
  2568.         Vert.GridExtent);
  2569.       ScrollWindowEx(Handle, DX, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2570.     end;
  2571.   end;
  2572. end;
  2573.  
  2574. procedure TCustomGrid.ScrollData(DX, DY: Integer);
  2575. var
  2576.   DrawInfo: TGridDrawInfo;
  2577. begin
  2578.   CalcDrawInfo(DrawInfo);
  2579.   ScrollDataInfo(DX, DY, DrawInfo);
  2580. end;
  2581.  
  2582. procedure TCustomGrid.TopLeftMoved(const OldTopLeft: TGridCoord);
  2583.  
  2584.   function CalcScroll(const AxisInfo: TGridAxisDrawInfo;
  2585.     OldPos, CurrentPos: Integer; var Amount: Longint): Boolean;
  2586.   var
  2587.     Start, Stop: Longint;
  2588.     I: Longint;
  2589.   begin
  2590.     Result := False;
  2591.     with AxisInfo do
  2592.     begin
  2593.       if OldPos < CurrentPos then
  2594.       begin
  2595.         Start := OldPos;
  2596.         Stop := CurrentPos;
  2597.       end
  2598.       else
  2599.       begin
  2600.         Start := CurrentPos;
  2601.         Stop := OldPos;
  2602.       end;
  2603.       Amount := 0;
  2604.       for I := Start to Stop - 1 do
  2605.       begin
  2606.         Inc(Amount, GetExtent(I) + EffectiveLineWidth);
  2607.         if Amount > (GridBoundary - FixedBoundary) then
  2608.         begin
  2609.           { Scroll amount too big, redraw the whole thing }
  2610.           InvalidateGrid;
  2611.           Exit;
  2612.         end;
  2613.       end;
  2614.       if OldPos < CurrentPos then Amount := -Amount;
  2615.     end;
  2616.     Result := True;
  2617.   end;
  2618.  
  2619. var
  2620.   DrawInfo: TGridDrawInfo;
  2621.   Delta: TGridCoord;
  2622. begin
  2623.   UpdateScrollPos;
  2624.   CalcDrawInfo(DrawInfo);
  2625.   if CalcScroll(DrawInfo.Horz, OldTopLeft.X, FTopLeft.X, Delta.X) and
  2626.     CalcScroll(DrawInfo.Vert, OldTopLeft.Y, FTopLeft.Y, Delta.Y) then
  2627.     ScrollDataInfo(Delta.X, Delta.Y, DrawInfo);
  2628.   TopLeftChanged;
  2629. end;
  2630.  
  2631. procedure TCustomGrid.UpdateScrollPos;
  2632. var
  2633.   DrawInfo: TGridDrawInfo;
  2634.   MaxTopLeft: TGridCoord;
  2635.  
  2636.   procedure SetScroll(Code: Word; Value: Integer);
  2637.   begin
  2638.     if GetScrollPos(Handle, Code) <> Value then
  2639.       SetScrollPos(Handle, Code, Value, True);
  2640.   end;
  2641.  
  2642. begin
  2643.   if (not HandleAllocated) or (ScrollBars = ssNone) then Exit;
  2644.   CalcDrawInfo(DrawInfo);
  2645.   MaxTopLeft.X := ColCount - 1;
  2646.   MaxTopLeft.Y := RowCount - 1;
  2647.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2648.   if ScrollBars in [ssHorizontal, ssBoth] then
  2649.     if ColCount = 1 then
  2650.     begin
  2651.       if (FColOffset > 0) and (ClientWidth > ColWidths[0] - FColOffset) then
  2652.         ModifyScrollbar(SB_HORZ, SB_THUMBPOSITION, ColWidths[0] - ClientWidth)
  2653.       else
  2654.         SetScroll(SB_HORZ, FColOffset)
  2655.     end
  2656.     else
  2657.       SetScroll(SB_HORZ, LongMulDiv(FTopLeft.X - FixedCols, MaxShortInt,
  2658.         MaxTopLeft.X - FixedCols));
  2659.   if ScrollBars in [ssVertical, ssBoth] then
  2660.     SetScroll(SB_VERT, LongMulDiv(FTopLeft.Y - FixedRows, MaxShortInt,
  2661.       MaxTopLeft.Y - FixedRows));
  2662. end;
  2663.  
  2664. procedure TCustomGrid.UpdateScrollRange;
  2665. var
  2666.   MaxTopLeft, OldTopLeft: TGridCoord;
  2667.   DrawInfo: TGridDrawInfo;
  2668.   OldScrollBars: TScrollStyle;
  2669.   Updated: Boolean;
  2670.  
  2671.   procedure DoUpdate;
  2672.   begin
  2673.     if not Updated then
  2674.     begin
  2675.       Update;
  2676.       Updated := True;
  2677.     end;
  2678.   end;
  2679.  
  2680.   function ScrollBarVisible(Code: Word): Boolean;
  2681.   var
  2682.     Min, Max: Integer;
  2683.   begin
  2684.     Result := False;
  2685.     if (ScrollBars = ssBoth) or
  2686.       ((Code = SB_HORZ) and (ScrollBars = ssHorizontal)) or
  2687.       ((Code = SB_VERT) and (ScrollBars = ssVertical)) then
  2688.     begin
  2689.       GetScrollRange(Handle, Code, Min, Max);
  2690.       Result := Min <> Max;
  2691.     end;
  2692.   end;
  2693.  
  2694.   procedure CalcSizeInfo;
  2695.   begin
  2696.     CalcDrawInfoXY(DrawInfo, DrawInfo.Horz.GridExtent, DrawInfo.Vert.GridExtent);
  2697.     MaxTopLeft.X := ColCount - 1;
  2698.     MaxTopLeft.Y := RowCount - 1;
  2699.     MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2700.   end;
  2701.  
  2702.   procedure SetAxisRange(var Max, Old, Current: Longint; Code: Word;
  2703.     Fixeds: Integer);
  2704.   begin
  2705.     CalcSizeInfo;
  2706.     if Fixeds < Max then
  2707.       SetScrollRange(Handle, Code, 0, MaxShortInt, True)
  2708.     else
  2709.       SetScrollRange(Handle, Code, 0, 0, True);
  2710.     if Old > Max then
  2711.     begin
  2712.       DoUpdate;
  2713.       Current := Max;
  2714.     end;
  2715.   end;
  2716.  
  2717.   procedure SetHorzRange;
  2718.   var
  2719.     Range: Integer;
  2720.   begin
  2721.     if OldScrollBars in [ssHorizontal, ssBoth] then
  2722.       if ColCount = 1 then
  2723.       begin
  2724.         Range := ColWidths[0] - ClientWidth;
  2725.         if Range < 0 then Range := 0;
  2726.         SetScrollRange(Handle, SB_HORZ, 0, Range, True);
  2727.       end
  2728.       else
  2729.         SetAxisRange(MaxTopLeft.X, OldTopLeft.X, FTopLeft.X, SB_HORZ, FixedCols);
  2730.   end;
  2731.  
  2732.   procedure SetVertRange;
  2733.   begin
  2734.     if OldScrollBars in [ssVertical, ssBoth] then
  2735.       SetAxisRange(MaxTopLeft.Y, OldTopLeft.Y, FTopLeft.Y, SB_VERT, FixedRows);
  2736.   end;
  2737.  
  2738. begin
  2739.   if (ScrollBars = ssNone) or not HandleAllocated then Exit;
  2740.   with DrawInfo do
  2741.   begin
  2742.     Horz.GridExtent := ClientWidth;
  2743.     Vert.GridExtent := ClientHeight;
  2744.     { Ignore scroll bars for initial calculation }
  2745.     if ScrollBarVisible(SB_HORZ) then
  2746.       Inc(Vert.GridExtent, GetSystemMetrics(SM_CYHSCROLL));
  2747.     if ScrollBarVisible(SB_VERT) then
  2748.       Inc(Horz.GridExtent, GetSystemMetrics(SM_CXVSCROLL));
  2749.   end;
  2750.   OldTopLeft := FTopLeft;
  2751.   { Temporarily mark us as not having scroll bars to avoid recursion }
  2752.   OldScrollBars := FScrollBars;
  2753.   FScrollBars := ssNone;
  2754.   Updated := False;
  2755.   try
  2756.     { Update scrollbars }
  2757.     SetHorzRange;
  2758.     DrawInfo.Vert.GridExtent := ClientHeight;
  2759.     SetVertRange;
  2760.     if DrawInfo.Horz.GridExtent <> ClientWidth then
  2761.     begin
  2762.       DrawInfo.Horz.GridExtent := ClientWidth;
  2763.       SetHorzRange;
  2764.     end;
  2765.   finally
  2766.     FScrollBars := OldScrollBars;
  2767.   end;
  2768.   UpdateScrollPos;
  2769.   if (FTopLeft.X <> OldTopLeft.X) or (FTopLeft.Y <> OldTopLeft.Y) then
  2770.     TopLeftMoved(OldTopLeft);
  2771. end;
  2772.  
  2773. function TCustomGrid.CreateEditor: TInplaceEdit;
  2774. begin
  2775.   Result := TInplaceEdit.Create(Self);
  2776. end;
  2777.  
  2778. procedure TCustomGrid.CreateParams(var Params: TCreateParams);
  2779. begin
  2780.   inherited CreateParams(Params);
  2781.   with Params do
  2782.   begin
  2783.     Style := Style or WS_TABSTOP;
  2784.     if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL;
  2785.     if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL;
  2786.     WindowClass.style := CS_DBLCLKS;
  2787.     if FBorderStyle = bsSingle then
  2788.       if NewStyleControls and Ctl3D then
  2789.       begin
  2790.         Style := Style and not WS_BORDER;
  2791.         ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  2792.       end
  2793.       else
  2794.         Style := Style or WS_BORDER;
  2795.   end;
  2796. end;
  2797.  
  2798. procedure TCustomGrid.KeyDown(var Key: Word; Shift: TShiftState);
  2799. var
  2800.   NewTopLeft, NewCurrent, MaxTopLeft: TGridCoord;
  2801.   DrawInfo: TGridDrawInfo;
  2802.   PageWidth, PageHeight: Integer;
  2803.  
  2804.   procedure CalcPageExtents;
  2805.   begin
  2806.     CalcDrawInfo(DrawInfo);
  2807.     PageWidth := DrawInfo.Horz.LastFullVisibleCell - LeftCol;
  2808.     if PageWidth < 1 then PageWidth := 1;
  2809.     PageHeight := DrawInfo.Vert.LastFullVisibleCell - TopRow;
  2810.     if PageHeight < 1 then PageHeight := 1;
  2811.   end;
  2812.  
  2813.   procedure Restrict(var Coord: TGridCoord; MinX, MinY, MaxX, MaxY: Longint);
  2814.   begin
  2815.     with Coord do
  2816.     begin
  2817.       if X > MaxX then X := MaxX
  2818.       else if X < MinX then X := MinX;
  2819.       if Y > MaxY then Y := MaxY
  2820.       else if Y < MinY then Y := MinY;
  2821.     end;
  2822.   end;
  2823.  
  2824. begin
  2825.   inherited KeyDown(Key, Shift);
  2826.   if not CanGridAcceptKey(Key, Shift) then Key := 0;
  2827.   NewCurrent := FCurrent;
  2828.   NewTopLeft := FTopLeft;
  2829.   CalcPageExtents;
  2830.   if ssCtrl in Shift then
  2831.     case Key of
  2832.       VK_UP: Dec(NewTopLeft.Y);
  2833.       VK_DOWN: Inc(NewTopLeft.Y);
  2834.       VK_LEFT:
  2835.         if not (goRowSelect in Options) then
  2836.         begin
  2837.           Dec(NewCurrent.X, PageWidth);
  2838.           Dec(NewTopLeft.X, PageWidth);
  2839.         end;
  2840.       VK_RIGHT:
  2841.         if not (goRowSelect in Options) then
  2842.         begin
  2843.           Inc(NewCurrent.X, PageWidth);
  2844.           Inc(NewTopLeft.X, PageWidth);
  2845.         end;
  2846.       VK_PRIOR: NewCurrent.Y := TopRow;
  2847.       VK_NEXT: NewCurrent.Y := DrawInfo.Vert.LastFullVisibleCell;
  2848.       VK_HOME:
  2849.         begin
  2850.           NewCurrent.X := FixedCols;
  2851.           NewCurrent.Y := FixedRows;
  2852.         end;
  2853.       VK_END:
  2854.         begin
  2855.           NewCurrent.X := ColCount - 1;
  2856.           NewCurrent.Y := RowCount - 1;
  2857.         end;
  2858.     end
  2859.   else
  2860.     case Key of
  2861.       VK_UP: Dec(NewCurrent.Y);
  2862.       VK_DOWN: Inc(NewCurrent.Y);
  2863.       VK_LEFT:
  2864.         if goRowSelect in Options then
  2865.           Dec(NewCurrent.Y) else
  2866.           Dec(NewCurrent.X);
  2867.       VK_RIGHT:
  2868.         if goRowSelect in Options then
  2869.           Inc(NewCurrent.Y) else
  2870.           Inc(NewCurrent.X);
  2871.       VK_NEXT:
  2872.         begin
  2873.           Inc(NewCurrent.Y, PageHeight);
  2874.           Inc(NewTopLeft.Y, PageHeight);
  2875.         end;
  2876.       VK_PRIOR:
  2877.         begin
  2878.           Dec(NewCurrent.Y, PageHeight);
  2879.           Dec(NewTopLeft.Y, PageHeight);
  2880.         end;
  2881.       VK_HOME:
  2882.         if goRowSelect in Options then
  2883.           NewCurrent.Y := FixedRows else
  2884.           NewCurrent.X := FixedCols;
  2885.       VK_END:
  2886.         if goRowSelect in Options then
  2887.           NewCurrent.Y := RowCount - 1 else
  2888.           NewCurrent.X := ColCount - 1;
  2889.       VK_TAB:
  2890.         if not (ssAlt in Shift) then
  2891.         repeat
  2892.           if ssShift in Shift then
  2893.           begin
  2894.             Dec(NewCurrent.X);
  2895.             if NewCurrent.X < FixedCols then
  2896.             begin
  2897.               NewCurrent.X := ColCount - 1;
  2898.               Dec(NewCurrent.Y);
  2899.               if NewCurrent.Y < FixedRows then NewCurrent.Y := RowCount - 1;
  2900.             end;
  2901.             Shift := [];
  2902.           end
  2903.           else
  2904.           begin
  2905.             Inc(NewCurrent.X);
  2906.             if NewCurrent.X >= ColCount then
  2907.             begin
  2908.               NewCurrent.X := FixedCols;
  2909.               Inc(NewCurrent.Y);
  2910.               if NewCurrent.Y >= RowCount then NewCurrent.Y := FixedRows;
  2911.             end;
  2912.           end;
  2913.         until TabStops[NewCurrent.X] or (NewCurrent.X = FCurrent.X);
  2914.       VK_F2: EditorMode := True;
  2915.     end;
  2916.   MaxTopLeft.X := ColCount - 1;
  2917.   MaxTopLeft.Y := RowCount - 1;
  2918.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2919.   Restrict(NewTopLeft, FixedCols, FixedRows, MaxTopLeft.X, MaxTopLeft.Y);
  2920.   if (NewTopLeft.X <> LeftCol) or (NewTopLeft.Y <> TopRow) then
  2921.     MoveTopLeft(NewTopLeft.X, NewTopLeft.Y);
  2922.   Restrict(NewCurrent, FixedCols, FixedRows, ColCount - 1, RowCount - 1);
  2923.   if (NewCurrent.X <> Col) or (NewCurrent.Y <> Row) then
  2924.     FocusCell(NewCurrent.X, NewCurrent.Y, not (ssShift in Shift));
  2925. end;
  2926.  
  2927. procedure TCustomGrid.KeyPress(var Key: Char);
  2928. begin
  2929.   inherited KeyPress(Key);
  2930.   if not (goAlwaysShowEditor in Options) and (Key = #13) then
  2931.   begin
  2932.     if FEditorMode then
  2933.       HideEditor else
  2934.       ShowEditor;
  2935.     Key := #0;
  2936.   end;
  2937. end;
  2938.  
  2939. procedure TCustomGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  2940.   X, Y: Integer);
  2941. var
  2942.   CellHit: TGridCoord;
  2943.   DrawInfo: TGridDrawInfo;
  2944.   MoveDrawn: Boolean;
  2945. begin
  2946.   MoveDrawn := False;
  2947.   HideEdit;
  2948.   if not (csDesigning in ComponentState) and CanFocus then
  2949.   begin
  2950.     SetFocus;
  2951.     if ValidParentForm(Self).ActiveControl <> Self then
  2952.     begin
  2953.       MouseCapture := False;
  2954.       Exit;
  2955.     end;
  2956.   end;
  2957.   if (Button = mbLeft) and (ssDouble in Shift) then
  2958.     DblClick
  2959.   else if Button = mbLeft then
  2960.   begin
  2961.     CalcDrawInfo(DrawInfo);
  2962.     { Check grid sizing }
  2963.     CalcSizingState(X, Y, FGridState, FSizingIndex, FSizingPos, FSizingOfs,
  2964.       DrawInfo);
  2965.     if FGridState <> gsNormal then
  2966.     begin
  2967.       DrawSizingLine(DrawInfo);
  2968.       Exit;
  2969.     end;
  2970.     CellHit := CalcCoordFromPoint(X, Y, DrawInfo);
  2971.     if (CellHit.X >= FixedCols) and (CellHit.Y >= FixedRows) then
  2972.     begin
  2973.       if goEditing in Options then
  2974.       begin
  2975.         if (CellHit.X = FCurrent.X) and (CellHit.Y = FCurrent.Y) then
  2976.           ShowEditor
  2977.         else
  2978.         begin
  2979.           MoveCurrent(CellHit.X, CellHit.Y, True, True);
  2980.           UpdateEdit;
  2981.         end;
  2982.         Click;
  2983.       end
  2984.       else
  2985.       begin
  2986.         FGridState := gsSelecting;
  2987.         SetTimer(Handle, 1, 60, nil);
  2988.         if ssShift in Shift then
  2989.           MoveAnchor(CellHit)
  2990.         else
  2991.           MoveCurrent(CellHit.X, CellHit.Y, True, True);
  2992.       end;
  2993.     end
  2994.     else if (goRowMoving in Options) and (CellHit.X >= 0) and
  2995.       (CellHit.X < FixedCols) and (CellHit.Y >= FixedRows) then
  2996.     begin
  2997.       FGridState := gsRowMoving;
  2998.       FMoveIndex := CellHit.Y;
  2999.       FMovePos := FMoveIndex;
  3000.       Update;
  3001.       DrawMove;
  3002.       MoveDrawn := True;
  3003.       SetTimer(Handle, 1, 60, nil);
  3004.     end
  3005.     else if (goColMoving in Options) and (CellHit.Y >= 0) and
  3006.       (CellHit.Y < FixedRows) and (CellHit.X >= FixedCols) then
  3007.     begin
  3008.       FGridState := gsColMoving;
  3009.       FMoveIndex := CellHit.X;
  3010.       FMovePos := FMoveIndex;
  3011.       Update;
  3012.       DrawMove;
  3013.       MoveDrawn := True;
  3014.       SetTimer(Handle, 1, 60, nil);
  3015.     end;
  3016.   end;
  3017.   try
  3018.     inherited MouseDown(Button, Shift, X, Y);
  3019.   except
  3020.     if MoveDrawn then DrawMove;
  3021.   end;
  3022. end;
  3023.  
  3024. procedure TCustomGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
  3025. var
  3026.   DrawInfo: TGridDrawInfo;
  3027.   CellHit: TGridCoord;
  3028. begin
  3029.   CalcDrawInfo(DrawInfo);
  3030.   case FGridState of
  3031.     gsSelecting, gsColMoving, gsRowMoving:
  3032.       begin
  3033.         CellHit := CalcCoordFromPoint(X, Y, DrawInfo);
  3034.         if (CellHit.X >= FixedCols) and (CellHit.Y >= FixedRows) and
  3035.           (CellHit.X <= DrawInfo.Horz.LastFullVisibleCell+1) and
  3036.           (CellHit.Y <= DrawInfo.Vert.LastFullVisibleCell+1) then
  3037.           case FGridState of
  3038.             gsSelecting:
  3039.               if ((CellHit.X <> FAnchor.X) or (CellHit.Y <> FAnchor.Y)) then
  3040.                 MoveAnchor(CellHit);
  3041.             gsColMoving:
  3042.               MoveAndScroll(X, CellHit.X, DrawInfo, DrawInfo.Horz, SB_HORZ);
  3043.             gsRowMoving:
  3044.               MoveAndScroll(Y, CellHit.Y, DrawInfo, DrawInfo.Vert, SB_VERT);
  3045.           end;
  3046.       end;
  3047.     gsRowSizing, gsColSizing:
  3048.       begin
  3049.         DrawSizingLine(DrawInfo); { XOR it out }
  3050.         if FGridState = gsRowSizing then
  3051.           FSizingPos := Y + FSizingOfs else
  3052.           FSizingPos := X + FSizingOfs;
  3053.         DrawSizingLine(DrawInfo); { XOR it back in }
  3054.       end;
  3055.   end;
  3056.   inherited MouseMove(Shift, X, Y);
  3057. end;
  3058.  
  3059. procedure TCustomGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
  3060.   X, Y: Integer);
  3061. var
  3062.   DrawInfo: TGridDrawInfo;
  3063.   NewSize: Integer;
  3064.  
  3065.   function ResizeLine(const AxisInfo: TGridAxisDrawInfo): Integer;
  3066.   var
  3067.     I: Integer;
  3068.   begin
  3069.     with AxisInfo do
  3070.     begin
  3071.       Result := FixedBoundary;
  3072.       for I := FirstGridCell to FSizingIndex - 1 do
  3073.         Inc(Result, GetExtent(I) + EffectiveLineWidth);
  3074.       Result := FSizingPos - Result;
  3075.     end;
  3076.   end;
  3077.  
  3078. begin
  3079.   try
  3080.     case FGridState of
  3081.       gsSelecting:
  3082.         begin
  3083.           MouseMove(Shift, X, Y);
  3084.           KillTimer(Handle, 1);
  3085.           UpdateEdit;
  3086.           Click;
  3087.         end;
  3088.       gsRowSizing, gsColSizing:
  3089.         begin
  3090.           CalcDrawInfo(DrawInfo);
  3091.           DrawSizingLine(DrawInfo);
  3092.           if FGridState = gsColSizing then
  3093.           begin
  3094.             NewSize := ResizeLine(DrawInfo.Horz);
  3095.             if NewSize > 1 then
  3096.             begin
  3097.               ColWidths[FSizingIndex] := NewSize;
  3098.               UpdateDesigner;
  3099.             end;
  3100.           end
  3101.           else
  3102.           begin
  3103.             NewSize := ResizeLine(DrawInfo.Vert);
  3104.             if NewSize > 1 then
  3105.             begin
  3106.               RowHeights[FSizingIndex] := NewSize;
  3107.               UpdateDesigner;
  3108.             end;
  3109.           end;
  3110.         end;
  3111.       gsColMoving, gsRowMoving:
  3112.         begin
  3113.           DrawMove;
  3114.           KillTimer(Handle, 1);
  3115.           if FMoveIndex <> FMovePos then
  3116.           begin
  3117.             if FGridState = gsColMoving then
  3118.               MoveColumn(FMoveIndex, FMovePos)
  3119.             else
  3120.               MoveRow(FMoveIndex, FMovePos);
  3121.             UpdateDesigner;
  3122.           end;
  3123.           UpdateEdit;
  3124.         end;
  3125.     else
  3126.       UpdateEdit;
  3127.     end;
  3128.     inherited MouseUp(Button, Shift, X, Y);
  3129.   finally
  3130.     FGridState := gsNormal;
  3131.   end;
  3132. end;
  3133.  
  3134. procedure TCustomGrid.MoveAndScroll(Mouse, CellHit: Integer;
  3135.   var DrawInfo: TGridDrawInfo; var Axis: TGridAxisDrawInfo; ScrollBar: Integer);
  3136. begin
  3137.   if (CellHit <> FMovePos) and
  3138.     not((FMovePos = Axis.FixedCellCount) and (Mouse < Axis.FixedBoundary)) and
  3139.     not((FMovePos = Axis.GridCellCount-1) and (Mouse > Axis.GridBoundary)) then
  3140.   begin
  3141.     DrawMove;
  3142.     if (Mouse < Axis.FixedBoundary) then
  3143.     begin
  3144.       if (FMovePos > Axis.FixedCellCount) then
  3145.       begin
  3146.         ModifyScrollbar(ScrollBar, SB_LINEUP, 0);
  3147.         Update;
  3148.         CalcDrawInfo(DrawInfo);    // this changes contents of Axis var
  3149.       end;
  3150.       CellHit := Axis.FirstGridCell;
  3151.     end
  3152.     else if (Mouse >= Axis.FullVisBoundary) then
  3153.     begin
  3154.       if (FMovePos = Axis.LastFullVisibleCell) and
  3155.         (FMovePos < Axis.GridCellCount -1) then
  3156.       begin
  3157.         ModifyScrollBar(Scrollbar, SB_LINEDOWN, 0);
  3158.         Update;
  3159.         CalcDrawInfo(DrawInfo);    // this changes contents of Axis var
  3160.       end;
  3161.       CellHit := Axis.LastFullVisibleCell;
  3162.     end
  3163.     else if CellHit < 0 then CellHit := FMovePos;
  3164.     FMovePos := CellHit;
  3165.     DrawMove;
  3166.   end;
  3167. end;
  3168.  
  3169. function TCustomGrid.GetColWidths(Index: Longint): Integer;
  3170. begin
  3171.   if (FColWidths = nil) or (Index >= ColCount) then
  3172.     Result := DefaultColWidth
  3173.   else
  3174.     Result := PIntArray(FColWidths)^[Index + 1];
  3175. end;
  3176.  
  3177. function TCustomGrid.GetRowHeights(Index: Longint): Integer;
  3178. begin
  3179.   if (FRowHeights = nil) or (Index >= RowCount) then
  3180.     Result := DefaultRowHeight
  3181.   else
  3182.     Result := PIntArray(FRowHeights)^[Index + 1];
  3183. end;
  3184.  
  3185. function TCustomGrid.GetGridWidth: Integer;
  3186. var
  3187.   DrawInfo: TGridDrawInfo;
  3188. begin
  3189.   CalcDrawInfo(DrawInfo);
  3190.   Result := DrawInfo.Horz.GridBoundary;
  3191. end;
  3192.  
  3193. function TCustomGrid.GetGridHeight: Integer;
  3194. var
  3195.   DrawInfo: TGridDrawInfo;
  3196. begin
  3197.   CalcDrawInfo(DrawInfo);
  3198.   Result := DrawInfo.Vert.GridBoundary;
  3199. end;
  3200.  
  3201. function TCustomGrid.GetSelection: TGridRect;
  3202. begin
  3203.   Result := GridRect(FCurrent, FAnchor);
  3204. end;
  3205.  
  3206. function TCustomGrid.GetTabStops(Index: Longint): Boolean;
  3207. begin
  3208.   if FTabStops = nil then Result := True
  3209.   else Result := Boolean(PIntArray(FTabStops)^[Index + 1]);
  3210. end;
  3211.  
  3212. function TCustomGrid.GetVisibleColCount: Integer;
  3213. var
  3214.   DrawInfo: TGridDrawInfo;
  3215. begin
  3216.   CalcDrawInfo(DrawInfo);
  3217.   Result := DrawInfo.Horz.LastFullVisibleCell - LeftCol + 1;
  3218. end;
  3219.  
  3220. function TCustomGrid.GetVisibleRowCount: Integer;
  3221. var
  3222.   DrawInfo: TGridDrawInfo;
  3223. begin
  3224.   CalcDrawInfo(DrawInfo);
  3225.   Result := DrawInfo.Vert.LastFullVisibleCell - TopRow + 1;
  3226. end;
  3227.  
  3228. procedure TCustomGrid.SetBorderStyle(Value: TBorderStyle);
  3229. begin
  3230.   if FBorderStyle <> Value then
  3231.   begin
  3232.     FBorderStyle := Value;
  3233.     RecreateWnd;
  3234.   end;
  3235. end;
  3236.  
  3237. procedure TCustomGrid.SetCol(Value: Longint);
  3238. begin
  3239.   if Col <> Value then FocusCell(Value, Row, True);
  3240. end;
  3241.  
  3242. procedure TCustomGrid.SetColCount(Value: Longint);
  3243. begin
  3244.   if FColCount <> Value then
  3245.   begin
  3246.     if Value < 1 then Value := 1;
  3247.     if Value <= FixedCols then FixedCols := Value - 1;
  3248.     ChangeSize(Value, RowCount);
  3249.     if goRowSelect in Options then
  3250.     begin
  3251.       FAnchor.X := ColCount - 1;
  3252.       Invalidate;
  3253.     end;
  3254.   end;
  3255. end;
  3256.  
  3257. procedure TCustomGrid.SetColWidths(Index: Longint; Value: Integer);
  3258. begin
  3259.   if FColWidths = nil then
  3260.     UpdateExtents(FColWidths, ColCount, DefaultColWidth);
  3261.   if Index >= ColCount then InvalidOp(SIndexOutOfRange);
  3262.   if Value <> PIntArray(FColWidths)^[Index + 1] then
  3263.   begin
  3264.     ResizeCol(Index, PIntArray(FColWidths)^[Index + 1], Value);
  3265.     PIntArray(FColWidths)^[Index + 1] := Value;
  3266.     ColWidthsChanged;
  3267.   end;
  3268. end;
  3269.  
  3270. procedure TCustomGrid.SetDefaultColWidth(Value: Integer);
  3271. begin
  3272.   if FColWidths <> nil then UpdateExtents(FColWidths, 0, 0);
  3273.   FDefaultColWidth := Value;
  3274.   ColWidthsChanged;
  3275.   InvalidateGrid;
  3276. end;
  3277.  
  3278. procedure TCustomGrid.SetDefaultRowHeight(Value: Integer);
  3279. begin
  3280.   if FRowHeights <> nil then UpdateExtents(FRowHeights, 0, 0);
  3281.   FDefaultRowHeight := Value;
  3282.   RowHeightsChanged;
  3283.   InvalidateGrid;
  3284. end;
  3285.  
  3286. procedure TCustomGrid.SetFixedColor(Value: TColor);
  3287. begin
  3288.   if FFixedColor <> Value then
  3289.   begin
  3290.     FFixedColor := Value;
  3291.     InvalidateGrid;
  3292.   end;
  3293. end;
  3294.  
  3295. procedure TCustomGrid.SetFixedCols(Value: Integer);
  3296. begin
  3297.   if FFixedCols <> Value then
  3298.   begin
  3299.     if Value < 0 then InvalidOp(SIndexOutOfRange);
  3300.     if Value >= ColCount then InvalidOp(SFixedColTooBig);
  3301.     FFixedCols := Value;
  3302.     Initialize;
  3303.     InvalidateGrid;
  3304.   end;
  3305. end;
  3306.  
  3307. procedure TCustomGrid.SetFixedRows(Value: Integer);
  3308. begin
  3309.   if FFixedRows <> Value then
  3310.   begin
  3311.     if Value < 0 then InvalidOp(SIndexOutOfRange);
  3312.     if Value >= RowCount then InvalidOp(SFixedRowTooBig);
  3313.     FFixedRows := Value;
  3314.     Initialize;
  3315.     InvalidateGrid;
  3316.   end;
  3317. end;
  3318.  
  3319. procedure TCustomGrid.SetEditorMode(Value: Boolean);
  3320. begin
  3321.   if not Value then
  3322.     HideEditor
  3323.   else
  3324.   begin
  3325.     ShowEditor;
  3326.     if FInplaceEdit <> nil then FInplaceEdit.Deselect;
  3327.   end;
  3328. end;
  3329.  
  3330. procedure TCustomGrid.SetGridLineWidth(Value: Integer);
  3331. begin
  3332.   if FGridLineWidth <> Value then
  3333.   begin
  3334.     FGridLineWidth := Value;
  3335.     InvalidateGrid;
  3336.   end;
  3337. end;
  3338.  
  3339. procedure TCustomGrid.SetLeftCol(Value: Longint);
  3340. begin
  3341.   if FTopLeft.X <> Value then MoveTopLeft(Value, TopRow);
  3342. end;
  3343.  
  3344. procedure TCustomGrid.SetOptions(Value: TGridOptions);
  3345. begin
  3346.   if FOptions <> Value then
  3347.   begin
  3348.     if goRowSelect in Value then
  3349.       Exclude(Value, goAlwaysShowEditor);
  3350.     FOptions := Value;
  3351.     if not FEditorMode then
  3352.       if goAlwaysShowEditor in Value then
  3353.         ShowEditor else
  3354.         HideEditor;
  3355.     if goRowSelect in Value then MoveCurrent(Col, Row,  True, False);
  3356.     InvalidateGrid;
  3357.   end;
  3358. end;
  3359.  
  3360. procedure TCustomGrid.SetRow(Value: Longint);
  3361. begin
  3362.   if Row <> Value then FocusCell(Col, Value, True);
  3363. end;
  3364.  
  3365. procedure TCustomGrid.SetRowCount(Value: Longint);
  3366. begin
  3367.   if FRowCount <> Value then
  3368.   begin
  3369.     if Value < 1 then Value := 1;
  3370.     if Value <= FixedRows then FixedRows := Value - 1;
  3371.     ChangeSize(ColCount, Value);
  3372.   end;
  3373. end;
  3374.  
  3375. procedure TCustomGrid.SetRowHeights(Index: Longint; Value: Integer);
  3376. begin
  3377.   if FRowHeights = nil then
  3378.     UpdateExtents(FRowHeights, RowCount, DefaultRowHeight);
  3379.   if Index >= RowCount then InvalidOp(SIndexOutOfRange);
  3380.   if Value <> PIntArray(FRowHeights)^[Index + 1] then
  3381.   begin
  3382.     ResizeRow(Index, PIntArray(FRowHeights)^[Index + 1], Value);
  3383.     PIntArray(FRowHeights)^[Index + 1] := Value;
  3384.     RowHeightsChanged;
  3385.   end;
  3386. end;
  3387.  
  3388. procedure TCustomGrid.SetScrollBars(Value: TScrollStyle);
  3389. begin
  3390.   if FScrollBars <> Value then
  3391.   begin
  3392.     FScrollBars := Value;
  3393.     RecreateWnd;
  3394.   end;
  3395. end;
  3396.  
  3397. procedure TCustomGrid.SetSelection(Value: TGridRect);
  3398. var
  3399.   OldSel: TGridRect;
  3400. begin
  3401.   OldSel := Selection;
  3402.   FAnchor := Value.TopLeft;
  3403.   FCurrent := Value.BottomRight;
  3404.   SelectionMoved(OldSel);
  3405. end;
  3406.  
  3407. procedure TCustomGrid.SetTabStops(Index: Longint; Value: Boolean);
  3408. begin
  3409.   if FTabStops = nil then
  3410.     UpdateExtents(FTabStops, ColCount, Integer(True));
  3411.   if Index >= ColCount then InvalidOp(SIndexOutOfRange);
  3412.   PIntArray(FTabStops)^[Index + 1] := Integer(Value);
  3413. end;
  3414.  
  3415. procedure TCustomGrid.SetTopRow(Value: Longint);
  3416. begin
  3417.   if FTopLeft.Y <> Value then MoveTopLeft(LeftCol, Value);
  3418. end;
  3419.  
  3420. procedure TCustomGrid.HideEdit;
  3421. begin
  3422.   if FInplaceEdit <> nil then
  3423.     try
  3424.       UpdateText;
  3425.     finally
  3426.       FInplaceCol := -1;
  3427.       FInplaceRow := -1;
  3428.       FInplaceEdit.Hide;
  3429.     end;
  3430. end;
  3431.  
  3432. procedure TCustomGrid.UpdateEdit;
  3433.  
  3434.   procedure UpdateEditor;
  3435.   begin
  3436.     FInplaceCol := Col;
  3437.     FInplaceRow := Row;
  3438.     FInplaceEdit.UpdateContents;
  3439.     if FInplaceEdit.MaxLength = -1 then FCanEditModify := False
  3440.     else FCanEditModify := True;
  3441.     FInplaceEdit.SelectAll;
  3442.   end;
  3443.  
  3444. begin
  3445.   if CanEditShow then
  3446.   begin
  3447.     if FInplaceEdit = nil then
  3448.     begin
  3449.       FInplaceEdit := CreateEditor;
  3450.       FInplaceEdit.SetGrid(Self);
  3451.       FInplaceEdit.Parent := Self;
  3452.       UpdateEditor;
  3453.     end
  3454.     else
  3455.     begin
  3456.       if (Col <> FInplaceCol) or (Row <> FInplaceRow) then
  3457.       begin
  3458.         HideEdit;
  3459.         UpdateEditor;
  3460.       end;
  3461.     end;
  3462.     if CanEditShow then FInplaceEdit.Move(CellRect(Col, Row));
  3463.   end;
  3464. end;
  3465.  
  3466. procedure TCustomGrid.UpdateText;
  3467. begin
  3468.   if (FInplaceCol <> -1) and (FInplaceRow <> -1) then
  3469.     SetEditText(FInplaceCol, FInplaceRow, FInplaceEdit.Text);
  3470. end;
  3471.  
  3472. procedure TCustomGrid.WMChar(var Msg: TWMChar);
  3473. begin
  3474.   if (goEditing in Options) and (Char(Msg.CharCode) in [^H, #32..#255]) then
  3475.     ShowEditorChar(Char(Msg.CharCode))
  3476.   else
  3477.     inherited;
  3478. end;
  3479.  
  3480. procedure TCustomGrid.WMCommand(var Message: TWMCommand);
  3481. begin
  3482.   with Message do
  3483.   begin
  3484.     if (FInplaceEdit <> nil) and (Ctl = FInplaceEdit.Handle) then
  3485.       case NotifyCode of
  3486.         EN_CHANGE: UpdateText;
  3487.       end;
  3488.   end;
  3489. end;
  3490.  
  3491. procedure TCustomGrid.WMGetDlgCode(var Msg: TWMGetDlgCode);
  3492. begin
  3493.   Msg.Result := DLGC_WANTARROWS;
  3494.   if goRowSelect in Options then Exit;
  3495.   if goTabs in Options then Msg.Result := Msg.Result or DLGC_WANTTAB;
  3496.   if goEditing in Options then Msg.Result := Msg.Result or DLGC_WANTCHARS;
  3497. end;
  3498.  
  3499. procedure TCustomGrid.WMKillFocus(var Msg: TWMKillFocus);
  3500. begin
  3501.   inherited;
  3502.   InvalidateRect(Selection);
  3503.   if (FInplaceEdit <> nil) and (Msg.FocusedWnd <> FInplaceEdit.Handle) then
  3504.     HideEdit;
  3505. end;
  3506.  
  3507. procedure TCustomGrid.WMLButtonDown(var Message: TMessage);
  3508. begin
  3509.   inherited;
  3510.   if FInplaceEdit <> nil then FInplaceEdit.FClickTime := GetMessageTime;
  3511. end;
  3512.  
  3513. procedure TCustomGrid.WMNCHitTest(var Msg: TWMNCHitTest);
  3514. begin
  3515.   DefaultHandler(Msg);
  3516.   FHitTest := SmallPointToPoint(Msg.Pos);
  3517. end;
  3518.  
  3519. procedure TCustomGrid.WMSetCursor(var Msg: TWMSetCursor);
  3520. var
  3521.   FixedInfo: TGridDrawInfo;
  3522.   State: TGridState;
  3523.   Index: Longint;
  3524.   Pos, Ofs: Integer;
  3525.   Cur: HCURSOR;
  3526. begin
  3527.   Cur := 0;
  3528.   with Msg do
  3529.   begin
  3530.     if HitTest = HTCLIENT then
  3531.     begin
  3532.       if FGridState = gsNormal then
  3533.       begin
  3534.         FHitTest := ScreenToClient(FHitTest);
  3535.         CalcFixedInfo(FixedInfo);
  3536.         CalcSizingState(FHitTest.X, FHitTest.Y, State, Index, Pos, Ofs,
  3537.           FixedInfo);
  3538.       end else State := FGridState;
  3539.       if State = gsRowSizing then
  3540.         Cur := Screen.Cursors[crVSplit]
  3541.       else if State = gsColSizing then
  3542.         Cur := Screen.Cursors[crHSplit]
  3543.     end;
  3544.   end;
  3545.   if Cur <> 0 then SetCursor(Cur)
  3546.   else inherited;
  3547. end;
  3548.  
  3549. procedure TCustomGrid.WMSetFocus(var Msg: TWMSetFocus);
  3550. begin
  3551.   inherited;
  3552.   if (FInplaceEdit = nil) or (Msg.FocusedWnd <> FInplaceEdit.Handle) then
  3553.   begin
  3554.     InvalidateRect(Selection);
  3555.     UpdateEdit;
  3556.   end;
  3557. end;
  3558.  
  3559. procedure TCustomGrid.WMSize(var Msg: TWMSize);
  3560. begin
  3561.   inherited;
  3562.   UpdateScrollRange;
  3563. end;
  3564.  
  3565. procedure TCustomGrid.WMVScroll(var Msg: TWMVScroll);
  3566. begin
  3567.   ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos);
  3568. end;
  3569.  
  3570. procedure TCustomGrid.WMHScroll(var Msg: TWMHScroll);
  3571. begin
  3572.   ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos);
  3573. end;
  3574.  
  3575. procedure TCustomGrid.CMCancelMode(var Msg: TMessage);
  3576. begin
  3577.   if Assigned(FInplaceEdit) then FInplaceEdit.WndProc(Msg);
  3578.   inherited;
  3579. end;
  3580.  
  3581. procedure TCustomGrid.CMFontChanged(var Message: TMessage);
  3582. begin
  3583.   if FInplaceEdit <> nil then FInplaceEdit.Font := Font;
  3584.   inherited;
  3585. end;
  3586.  
  3587. procedure TCustomGrid.CMCtl3DChanged(var Message: TMessage);
  3588. begin
  3589.   inherited;
  3590.   RecreateWnd;
  3591. end;
  3592.  
  3593. procedure TCustomGrid.CMDesignHitTest(var Msg: TCMDesignHitTest);
  3594. begin
  3595.   Msg.Result := Longint(BOOL(Sizing(Msg.Pos.X, Msg.Pos.Y)));
  3596. end;
  3597.  
  3598. procedure TCustomGrid.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
  3599. begin
  3600.   inherited;
  3601.   if (goEditing in Options) and (Char(Msg.CharCode) = #13) then Msg.Result := 1;
  3602. end;
  3603.  
  3604. procedure TCustomGrid.TimedScroll(Direction: TGridScrollDirection);
  3605. var
  3606.   MaxAnchor, NewAnchor: TGridCoord;
  3607. begin
  3608.   NewAnchor := FAnchor;
  3609.   MaxAnchor.X := ColCount - 1;
  3610.   MaxAnchor.Y := RowCount - 1;
  3611.   if (sdLeft in Direction) and (FAnchor.X > FixedCols) then Dec(NewAnchor.X);
  3612.   if (sdRight in Direction) and (FAnchor.X < MaxAnchor.X) then Inc(NewAnchor.X);
  3613.   if (sdUp in Direction) and (FAnchor.Y > FixedRows) then Dec(NewAnchor.Y);
  3614.   if (sdDown in Direction) and (FAnchor.Y < MaxAnchor.Y) then Inc(NewAnchor.Y);
  3615.   if (FAnchor.X <> NewAnchor.X) or (FAnchor.Y <> NewAnchor.Y) then
  3616.     MoveAnchor(NewAnchor);
  3617. end;
  3618.  
  3619. procedure TCustomGrid.WMTimer(var Msg: TWMTimer);
  3620. var
  3621.   Point: TPoint;
  3622.   DrawInfo: TGridDrawInfo;
  3623.   ScrollDirection: TGridScrollDirection;
  3624.   CellHit: TGridCoord;
  3625. begin
  3626.   if not (FGridState in [gsSelecting, gsRowMoving, gsColMoving]) then Exit;
  3627.   GetCursorPos(Point);
  3628.   Point := ScreenToClient(Point);
  3629.   CalcDrawInfo(DrawInfo);
  3630.   ScrollDirection := [];
  3631.   with DrawInfo do
  3632.   begin
  3633.     CellHit := CalcCoordFromPoint(Point.X, Point.Y, DrawInfo);
  3634.     case FGridState of
  3635.       gsColMoving:
  3636.         MoveAndScroll(Point.X, CellHit.X, DrawInfo, Horz, SB_HORZ);
  3637.       gsRowMoving:
  3638.         MoveAndScroll(Point.Y, CellHit.Y, DrawInfo, Vert, SB_VERT);
  3639.       gsSelecting:
  3640.       begin
  3641.         if Point.X < Horz.FixedBoundary then Include(ScrollDirection, sdLeft)
  3642.         else if Point.X > Horz.FullVisBoundary then Include(ScrollDirection, sdRight);
  3643.         if Point.Y < Vert.FixedBoundary then Include(ScrollDirection, sdUp)
  3644.         else if Point.Y > Vert.FullVisBoundary then Include(ScrollDirection, sdDown);
  3645.         if ScrollDirection <> [] then  TimedScroll(ScrollDirection);
  3646.       end;
  3647.     end;
  3648.   end;
  3649. end;
  3650.  
  3651. procedure TCustomGrid.ColWidthsChanged;
  3652. begin
  3653.   UpdateScrollRange;
  3654.   UpdateEdit;
  3655. end;
  3656.  
  3657. procedure TCustomGrid.RowHeightsChanged;
  3658. begin
  3659.   UpdateScrollRange;
  3660.   UpdateEdit;
  3661. end;
  3662.  
  3663. procedure TCustomGrid.DeleteColumn(ACol: Longint);
  3664. begin
  3665.   MoveColumn(ACol, ColCount-1);
  3666.   ColCount := ColCount - 1;
  3667. end;
  3668.  
  3669. procedure TCustomGrid.DeleteRow(ARow: Longint);
  3670. begin
  3671.   MoveRow(ARow, RowCount - 1);
  3672.   RowCount := RowCount - 1;
  3673. end;
  3674.  
  3675. procedure TCustomGrid.UpdateDesigner;
  3676. var
  3677.   ParentForm: TForm;
  3678. begin
  3679.   if (csDesigning in ComponentState) and HandleAllocated and
  3680.     not (csUpdating in ComponentState) then
  3681.   begin
  3682.     ParentForm := GetParentForm(Self);
  3683.     if Assigned(ParentForm) and Assigned(ParentForm.Designer) then
  3684.       ParentForm.Designer.Modified;
  3685.   end;
  3686. end;
  3687.  
  3688. { TDrawGrid }
  3689.  
  3690. function TDrawGrid.CellRect(ACol, ARow: Longint): TRect;
  3691. begin
  3692.   Result := inherited CellRect(ACol, ARow);
  3693. end;
  3694.  
  3695. procedure TDrawGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  3696. var
  3697.   Coord: TGridCoord;
  3698. begin
  3699.   Coord := MouseCoord(X, Y);
  3700.   ACol := Coord.X;
  3701.   ARow := Coord.Y;
  3702. end;
  3703.  
  3704. procedure TDrawGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  3705. begin
  3706.   if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
  3707. end;
  3708.  
  3709. function TDrawGrid.GetEditMask(ACol, ARow: Longint): string;
  3710. begin
  3711.   Result := '';
  3712.   if Assigned(FOnGetEditMask) then FOnGetEditMask(Self, ACol, ARow, Result);
  3713. end;
  3714.  
  3715. function TDrawGrid.GetEditText(ACol, ARow: Longint): string;
  3716. begin
  3717.   Result := '';
  3718.   if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
  3719. end;
  3720.  
  3721. procedure TDrawGrid.RowMoved(FromIndex, ToIndex: Longint);
  3722. begin
  3723.   if Assigned(FOnRowMoved) then FOnRowMoved(Self, FromIndex, ToIndex);
  3724. end;
  3725.  
  3726. function TDrawGrid.SelectCell(ACol, ARow: Longint): Boolean;
  3727. begin
  3728.   Result := True;
  3729.   if Assigned(FOnSelectCell) then FOnSelectCell(Self, ACol, ARow, Result);
  3730. end;
  3731.  
  3732. procedure TDrawGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  3733. begin
  3734.   if Assigned(FOnSetEditText) then FOnSetEditText(Self, ACol, ARow, Value);
  3735. end;
  3736.  
  3737. procedure TDrawGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  3738.   AState: TGridDrawState);
  3739. begin
  3740.   if Assigned(FOnDrawCell) then FOnDrawCell(Self, ACol, ARow, ARect, AState);
  3741. end;
  3742.  
  3743. procedure TDrawGrid.TopLeftChanged;
  3744. begin
  3745.   inherited TopLeftChanged;
  3746.   if Assigned(FOnTopLeftChanged) then FOnTopLeftChanged(Self);
  3747. end;
  3748.  
  3749. { StrItem management for TStringSparseList }
  3750.  
  3751. type
  3752.   PStrItem = ^TStrItem;
  3753.   TStrItem = record
  3754.     FObject: TObject;
  3755.     FString: string;
  3756.   end;
  3757.  
  3758. function NewStrItem(const AString: string; AObject: TObject): PStrItem;
  3759. begin
  3760.   New(Result);
  3761.   Result^.FObject := AObject;
  3762.   Result^.FString := AString;
  3763. end;
  3764.  
  3765. procedure DisposeStrItem(P: PStrItem);
  3766. begin
  3767.   Dispose(P);
  3768. end;
  3769.  
  3770. { Sparse array classes for TStringGrid }
  3771.  
  3772. type
  3773.  
  3774.   PPointer = ^Pointer;
  3775.  
  3776. { Exception classes }
  3777.  
  3778.   EStringSparseListError = class(Exception);
  3779.  
  3780. { TSparsePointerArray class}
  3781.  
  3782. { Used by TSparseList.  Based on Sparse1Array, but has Pointer elements
  3783.   and Integer index, just like TPointerList/TList, and less indirection }
  3784.  
  3785.   { Apply function for the applicator:
  3786.         TheIndex        Index of item in array
  3787.         TheItem         Value of item (i.e pointer element) in section
  3788.         Returns: 0 if success, else error code. }
  3789.   TSPAApply = function(TheIndex: Integer; TheItem: Pointer): Integer;
  3790.  
  3791.   TSecDir = array[0..4095] of Pointer;  { Enough for up to 12 bits of sec }
  3792.   PSecDir = ^TSecDir;
  3793.   TSPAQuantum = (SPASmall, SPALarge);   { Section size }
  3794.  
  3795.   TSparsePointerArray = class(TObject)
  3796.   private
  3797.     secDir: PSecDir;
  3798.     slotsInDir: Word;
  3799.     indexMask, secShift: Word;
  3800.     FHighBound: Integer;
  3801.     FSectionSize: Word;
  3802.     cachedIndex: Integer;
  3803.     cachedPointer: Pointer;
  3804.     { Return item[i], nil if slot outside defined section. }
  3805.     function  GetAt(Index: Integer): Pointer;
  3806.     { Return address of item[i], creating slot if necessary. }
  3807.     function  MakeAt(Index: Integer): PPointer;
  3808.     { Store item at item[i], creating slot if necessary. }
  3809.     procedure PutAt(Index: Integer; Item: Pointer);
  3810.   public
  3811.     constructor Create(Quantum: TSPAQuantum);
  3812.     destructor  Destroy; override;
  3813.  
  3814.     { Traverse SPA, calling apply function for each defined non-nil
  3815.       item.  The traversal terminates if the apply function returns
  3816.       a value other than 0. }
  3817.     { NOTE: must be static method so that we can take its address in
  3818.       TSparseList.ForAll }
  3819.     function  ForAll(ApplyFunction: Pointer {TSPAApply}): Integer;
  3820.  
  3821.     { Ratchet down HighBound after a deletion }
  3822.     procedure ResetHighBound;
  3823.  
  3824.     property HighBound: Integer read FHighBound;
  3825.     property SectionSize: Word read FSectionSize;
  3826.     property Items[Index: Integer]: Pointer read GetAt write PutAt; default;
  3827.   end;
  3828.  
  3829. { TSparseList class }
  3830.  
  3831.   TSparseList = class(TObject)
  3832.   private
  3833.     FList: TSparsePointerArray;
  3834.     FCount: Integer;    { 1 + HighBound, adjusted for Insert/Delete }
  3835.     FQuantum: TSPAQuantum;
  3836.     procedure NewList(Quantum: TSPAQuantum);
  3837.   protected
  3838.     procedure Error; virtual;
  3839.     function  Get(Index: Integer): Pointer;
  3840.     procedure Put(Index: Integer; Item: Pointer);
  3841.   public
  3842.     constructor Create(Quantum: TSPAQuantum);
  3843.     destructor  Destroy; override;
  3844.     function  Add(Item: Pointer): Integer;
  3845.     procedure Clear;
  3846.     procedure Delete(Index: Integer);
  3847.     procedure Exchange(Index1, Index2: Integer);
  3848.     function First: Pointer;
  3849.     function ForAll(ApplyFunction: Pointer {TSPAApply}): Integer;
  3850.     function IndexOf(Item: Pointer): Integer;
  3851.     procedure Insert(Index: Integer; Item: Pointer);
  3852.     function Last: Pointer;
  3853.     procedure Move(CurIndex, NewIndex: Integer);
  3854.     procedure Pack;
  3855.     function Remove(Item: Pointer): Integer;
  3856.     property Count: Integer read FCount;
  3857.     property Items[Index: Integer]: Pointer read Get write Put; default;
  3858.   end;
  3859.  
  3860. { TStringSparseList class }
  3861.  
  3862.   TStringSparseList = class(TStrings)
  3863.   private
  3864.     FList: TSparseList;                 { of StrItems }
  3865.     FOnChange: TNotifyEvent;
  3866.   protected
  3867.     function  Get(Index: Integer): String; override;
  3868.     function  GetCount: Integer; override;
  3869.     function  GetObject(Index: Integer): TObject; override;
  3870.     procedure Put(Index: Integer; const S: String); override;
  3871.     procedure PutObject(Index: Integer; AObject: TObject); override;
  3872.     procedure Changed; virtual;
  3873.     procedure Error; virtual;
  3874.   public
  3875.     constructor Create(Quantum: TSPAQuantum);
  3876.     destructor  Destroy; override;
  3877.     procedure ReadData(Reader: TReader);
  3878.     procedure WriteData(Writer: TWriter);
  3879.     procedure DefineProperties(Filer: TFiler); override;
  3880.     procedure Delete(Index: Integer); override;
  3881.     procedure Exchange(Index1, Index2: Integer); override;
  3882.     procedure Insert(Index: Integer; const S: String); override;
  3883.     procedure Clear; override;
  3884.     property List: TSparseList read FList;
  3885.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  3886.   end;
  3887.  
  3888. { TSparsePointerArray }
  3889.  
  3890. const
  3891.   SPAIndexMask: array[TSPAQuantum] of Byte = (15, 255);
  3892.   SPASecShift: array[TSPAQuantum] of Byte = (4, 8);
  3893.  
  3894. { Expand Section Directory to cover at least `newSlots' slots. Returns: Possibly
  3895.   updated pointer to the Section Directory. }
  3896. function  ExpandDir(secDir: PSecDir; var slotsInDir: Word;
  3897.   newSlots: Word): PSecDir;
  3898. begin
  3899.   Result := secDir;
  3900.   ReallocMem(Result, newSlots * SizeOf(Pointer));
  3901.   FillChar(Result^[slotsInDir], (newSlots - slotsInDir) * SizeOf(Pointer), 0);
  3902.   slotsInDir := newSlots;
  3903. end;
  3904.  
  3905. { Allocate a section and set all its items to nil. Returns: Pointer to start of
  3906.   section. }
  3907. function  MakeSec(SecIndex: Integer; SectionSize: Word): Pointer;
  3908. var
  3909.   SecP: Pointer;
  3910.   Size: Word;
  3911. begin
  3912.   Size := SectionSize * SizeOf(Pointer);
  3913.   GetMem(secP, size);
  3914.   FillChar(secP^, size, 0);
  3915.   MakeSec := SecP
  3916. end;
  3917.  
  3918. constructor TSparsePointerArray.Create(Quantum: TSPAQuantum);
  3919. begin
  3920.   SecDir := nil;
  3921.   SlotsInDir := 0;
  3922.   FHighBound := -1;
  3923.   FSectionSize := Word(SPAIndexMask[Quantum]) + 1;
  3924.   IndexMask := Word(SPAIndexMask[Quantum]);
  3925.   SecShift := Word(SPASecShift[Quantum]);
  3926.   CachedIndex := -1
  3927. end;
  3928.  
  3929. destructor TSparsePointerArray.Destroy;
  3930. var
  3931.   i:  Integer;
  3932.   size: Word;
  3933. begin
  3934.   { Scan section directory and free each section that exists. }
  3935.   i := 0;
  3936.   size := FSectionSize * SizeOf(Pointer);
  3937.   while i < slotsInDir do begin
  3938.     if secDir^[i] <> nil then
  3939.       FreeMem(secDir^[i], size);
  3940.     Inc(i)
  3941.   end;
  3942.  
  3943.   { Free section directory. }
  3944.   if secDir <> nil then
  3945.     FreeMem(secDir, slotsInDir * SizeOf(Pointer));
  3946. end;
  3947.  
  3948. function  TSparsePointerArray.GetAt(Index: Integer): Pointer;
  3949. var
  3950.   byteP: PChar;
  3951.   secIndex: Cardinal;
  3952. begin
  3953.   { Index into Section Directory using high order part of
  3954.     index.  Get pointer to Section. If not null, index into
  3955.     Section using low order part of index. }
  3956.   if Index = cachedIndex then
  3957.     Result := cachedPointer
  3958.   else begin
  3959.     secIndex := Index shr secShift;
  3960.     if secIndex >= slotsInDir then
  3961.       byteP := nil
  3962.     else begin
  3963.       byteP := secDir^[secIndex];
  3964.       if byteP <> nil then begin
  3965.         Inc(byteP, (Index and indexMask) * SizeOf(Pointer));
  3966.       end
  3967.     end;
  3968.     if byteP = nil then Result := nil else Result := PPointer(byteP)^;
  3969.     cachedIndex := Index;
  3970.     cachedPointer := Result
  3971.   end
  3972. end;
  3973.  
  3974. function  TSparsePointerArray.MakeAt(Index: Integer): PPointer;
  3975. var
  3976.   dirP: PSecDir;
  3977.   p: Pointer;
  3978.   byteP: PChar;
  3979.   secIndex: Word;
  3980. begin
  3981.   { Expand Section Directory if necessary. }
  3982.   secIndex := Index shr secShift;       { Unsigned shift }
  3983.   if secIndex >= slotsInDir then
  3984.     dirP := expandDir(secDir, slotsInDir, secIndex + 1)
  3985.   else
  3986.     dirP := secDir;
  3987.  
  3988.   { Index into Section Directory using high order part of
  3989.     index.  Get pointer to Section. If null, create new
  3990.     Section.  Index into Section using low order part of index. }
  3991.   secDir := dirP;
  3992.   p := dirP^[secIndex];
  3993.   if p = nil then begin
  3994.     p := makeSec(secIndex, FSectionSize);
  3995.     dirP^[secIndex] := p
  3996.   end;
  3997.   byteP := p;
  3998.   Inc(byteP, (Index and indexMask) * SizeOf(Pointer));
  3999.   if Index > FHighBound then
  4000.     FHighBound := Index;
  4001.   Result := PPointer(byteP);
  4002.   cachedIndex := -1
  4003. end;
  4004.  
  4005. procedure TSparsePointerArray.PutAt(Index: Integer; Item: Pointer);
  4006. begin
  4007.   if (Item <> nil) or (GetAt(Index) <> nil) then
  4008.   begin
  4009.     MakeAt(Index)^ := Item;
  4010.     if Item = nil then
  4011.       ResetHighBound
  4012.   end
  4013. end;
  4014.  
  4015. function  TSparsePointerArray.ForAll(ApplyFunction: Pointer {TSPAApply}):
  4016.   Integer;
  4017. var
  4018.   itemP: PChar;                         { Pointer to item in section }
  4019.   item: Pointer;
  4020.   i, callerBP: Cardinal;
  4021.   j, index: Integer;
  4022. begin
  4023.   { Scan section directory and scan each section that exists,
  4024.     calling the apply function for each non-nil item.
  4025.     The apply function must be a far local function in the scope of
  4026.     the procedure P calling ForAll.  The trick of setting up the stack
  4027.     frame (taken from TurboVision's TCollection.ForEach) allows the
  4028.     apply function access to P's arguments and local variables and,
  4029.     if P is a method, the instance variables and methods of P's class }
  4030.   Result := 0;
  4031.   i := 0;
  4032.   asm
  4033.     mov   eax,[ebp]                     { Set up stack frame for local }
  4034.     mov   callerBP,eax
  4035.   end;
  4036.   while (i < slotsInDir) and (Result = 0) do begin
  4037.     itemP := secDir^[i];
  4038.     if itemP <> nil then begin
  4039.       j := 0;
  4040.       index := i shl SecShift;
  4041.       while (j < FSectionSize) and (Result = 0) do begin
  4042.         item := PPointer(itemP)^;
  4043.         if item <> nil then
  4044.           { ret := ApplyFunction(index, item.Ptr); }
  4045.           asm
  4046.             mov   eax,index
  4047.             mov   edx,item
  4048.             push  callerBP
  4049.             call  ApplyFunction
  4050.             pop   ecx
  4051.             mov   @Result,eax
  4052.           end;
  4053.         Inc(itemP, SizeOf(Pointer));
  4054.         Inc(j);
  4055.         Inc(index)
  4056.       end
  4057.     end;
  4058.     Inc(i)
  4059.   end;
  4060. end;
  4061.  
  4062. procedure TSparsePointerArray.ResetHighBound;
  4063. var
  4064.   NewHighBound: Integer;
  4065.  
  4066.   function  Detector(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4067.   begin
  4068.     if TheIndex > FHighBound then
  4069.       Result := 1
  4070.     else
  4071.     begin
  4072.       Result := 0;
  4073.       if TheItem <> nil then NewHighBound := TheIndex
  4074.     end
  4075.   end;
  4076.  
  4077. begin
  4078.   NewHighBound := -1;
  4079.   ForAll(@Detector);
  4080.   FHighBound := NewHighBound
  4081. end;
  4082.  
  4083. { TSparseList }
  4084.  
  4085. constructor TSparseList.Create(Quantum: TSPAQuantum);
  4086. begin
  4087.   NewList(Quantum)
  4088. end;
  4089.  
  4090. destructor TSparseList.Destroy;
  4091. begin
  4092.   if FList <> nil then FList.Destroy
  4093. end;
  4094.  
  4095. function  TSparseList.Add(Item: Pointer): Integer;
  4096. begin
  4097.   Result := FCount;
  4098.   FList[Result] := Item;
  4099.   Inc(FCount)
  4100. end;
  4101.  
  4102. procedure TSparseList.Clear;
  4103. begin
  4104.   FList.Destroy;
  4105.   NewList(FQuantum);
  4106.   FCount := 0
  4107. end;
  4108.  
  4109. procedure TSparseList.Delete(Index: Integer);
  4110. var
  4111.   I: Integer;
  4112. begin
  4113.   if (Index < 0) or (Index >= FCount) then Exit;
  4114.   for I := Index to FCount - 1 do
  4115.     FList[I] := FList[I + 1];
  4116.   FList[FCount] := nil;
  4117.   Dec(FCount);
  4118. end;
  4119.  
  4120. procedure TSparseList.Error;
  4121. begin
  4122.   raise EListError.CreateRes(SListIndexError);
  4123. end;
  4124.  
  4125. procedure TSparseList.Exchange(Index1, Index2: Integer);
  4126. var
  4127.   temp: Pointer;
  4128. begin
  4129.   temp := Get(Index1);
  4130.   Put(Index1, Get(Index2));
  4131.   Put(Index2, temp);
  4132. end;
  4133.  
  4134. function  TSparseList.First: Pointer;
  4135. begin
  4136.   Result := Get(0)
  4137. end;
  4138.  
  4139. { Jump to TSparsePointerArray.ForAll so that it looks like it was called
  4140.   from our caller, so that the BP trick works. }
  4141.  
  4142. function TSparseList.ForAll(ApplyFunction: Pointer {TSPAApply}): Integer; assembler;
  4143. asm
  4144.         MOV     EAX,[EAX].TSparseList.FList
  4145.         JMP     TSparsePointerArray.ForAll
  4146. end;
  4147.  
  4148. function  TSparseList.Get(Index: Integer): Pointer;
  4149. begin
  4150.   if Index < 0 then Error;
  4151.   Result := FList[Index]
  4152. end;
  4153.  
  4154. function  TSparseList.IndexOf(Item: Pointer): Integer;
  4155. var
  4156.   MaxIndex, Index: Integer;
  4157.  
  4158.   function  IsTheItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4159.   begin
  4160.     if TheIndex > MaxIndex then
  4161.       Result := -1                      { Bail out }
  4162.     else if TheItem <> Item then
  4163.       Result := 0
  4164.     else begin
  4165.       Result := 1;                      { Found it, stop traversal }
  4166.       Index := TheIndex
  4167.     end
  4168.   end;
  4169.  
  4170. begin
  4171.   Index := -1;
  4172.   MaxIndex := FList.HighBound;
  4173.   FList.ForAll(@IsTheItem);
  4174.   Result := Index
  4175. end;
  4176.  
  4177. procedure TSparseList.Insert(Index: Integer; Item: Pointer);
  4178. var
  4179.   i: Integer;
  4180. begin
  4181.   if Index < 0 then Error;
  4182.   I := FCount;
  4183.   while I > Index do
  4184.   begin
  4185.     FList[i] := FList[i - 1];
  4186.     Dec(i)
  4187.   end;
  4188.   FList[Index] := Item;
  4189.   if Index > FCount then FCount := Index;
  4190.   Inc(FCount)
  4191. end;
  4192.  
  4193. function  TSparseList.Last: Pointer;
  4194. begin
  4195.   Result := Get(FCount - 1);
  4196. end;
  4197.  
  4198. procedure TSparseList.Move(CurIndex, NewIndex: Integer);
  4199. var
  4200.   Item: Pointer;
  4201. begin
  4202.   if CurIndex <> NewIndex then
  4203.   begin
  4204.     Item := Get(CurIndex);
  4205.     Delete(CurIndex);
  4206.     Insert(NewIndex, Item);
  4207.   end;
  4208. end;
  4209.  
  4210. procedure TSparseList.NewList(Quantum: TSPAQuantum);
  4211. begin
  4212.   FQuantum := Quantum;
  4213.   FList := TSparsePointerArray.Create(Quantum)
  4214. end;
  4215.  
  4216. procedure TSparseList.Pack;
  4217. var
  4218.   i: Integer;
  4219. begin
  4220.   for i := FCount - 1 downto 0 do if Items[i] = nil then Delete(i)
  4221. end;
  4222.  
  4223. procedure TSparseList.Put(Index: Integer; Item: Pointer);
  4224. begin
  4225.   if Index < 0 then Error;
  4226.   FList[Index] := Item;
  4227.   FCount := FList.HighBound + 1
  4228. end;
  4229.  
  4230. function  TSparseList.Remove(Item: Pointer): Integer;
  4231. begin
  4232.   Result := IndexOf(Item);
  4233.   if Result <> -1 then Delete(Result)
  4234. end;
  4235.  
  4236. { TStringSparseList }
  4237.  
  4238. constructor TStringSparseList.Create(Quantum: TSPAQuantum);
  4239. begin
  4240.   FList := TSparseList.Create(Quantum)
  4241. end;
  4242.  
  4243. destructor  TStringSparseList.Destroy;
  4244. begin
  4245.   if FList <> nil then begin
  4246.     Clear;
  4247.     FList.Destroy
  4248.   end
  4249. end;
  4250.  
  4251. procedure TStringSparseList.ReadData(Reader: TReader);
  4252. var
  4253.   i: Integer;
  4254. begin
  4255.   with Reader do begin
  4256.     i := Integer(ReadInteger);
  4257.     while i > 0 do begin
  4258.       InsertObject(Integer(ReadInteger), ReadString, nil);
  4259.       Dec(i)
  4260.     end
  4261.   end
  4262. end;
  4263.  
  4264. procedure TStringSparseList.WriteData(Writer: TWriter);
  4265. var
  4266.   itemCount: Integer;
  4267.  
  4268.   function  CountItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4269.   begin
  4270.     Inc(itemCount);
  4271.     Result := 0
  4272.   end;
  4273.  
  4274.   function  StoreItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4275.   begin
  4276.     with Writer do
  4277.     begin
  4278.       WriteInteger(TheIndex);           { Item index }
  4279.       WriteString(PStrItem(TheItem)^.FString);
  4280.     end;
  4281.     Result := 0
  4282.   end;
  4283.  
  4284. begin
  4285.   with Writer do
  4286.   begin
  4287.     itemCount := 0;
  4288.     FList.ForAll(@CountItem);
  4289.     WriteInteger(itemCount);
  4290.     FList.ForAll(@StoreItem);
  4291.   end
  4292. end;
  4293.  
  4294. procedure TStringSparseList.DefineProperties(Filer: TFiler);
  4295. begin
  4296.   Filer.DefineProperty('List', ReadData, WriteData, True);
  4297. end;
  4298.  
  4299. function  TStringSparseList.Get(Index: Integer): String;
  4300. var
  4301.   p: PStrItem;
  4302. begin
  4303.   p := PStrItem(FList[Index]);
  4304.   if p = nil then Result := '' else Result := p^.FString
  4305. end;
  4306.  
  4307. function  TStringSparseList.GetCount: Integer;
  4308. begin
  4309.   Result := FList.Count
  4310. end;
  4311.  
  4312. function  TStringSparseList.GetObject(Index: Integer): TObject;
  4313. var
  4314.   p: PStrItem;
  4315. begin
  4316.   p := PStrItem(FList[Index]);
  4317.   if p = nil then Result := nil else Result := p^.FObject
  4318. end;
  4319.  
  4320. procedure TStringSparseList.Put(Index: Integer; const S: String);
  4321. var
  4322.   p: PStrItem;
  4323.   obj: TObject;
  4324. begin
  4325.   p := PStrItem(FList[Index]);
  4326.   if p = nil then obj := nil else obj := p^.FObject;
  4327.   if (S = '') and (obj = nil) then   { Nothing left to store }
  4328.     FList[Index] := nil
  4329.   else
  4330.     FList[Index] := NewStrItem(S, obj);
  4331.   if p <> nil then DisposeStrItem(p);
  4332.   Changed
  4333. end;
  4334.  
  4335. procedure TStringSparseList.PutObject(Index: Integer; AObject: TObject);
  4336. var
  4337.   p: PStrItem;
  4338. begin
  4339.   p := PStrItem(FList[Index]);
  4340.   if p <> nil then
  4341.     p^.FObject := AObject
  4342.   else if AObject <> nil then
  4343.     Error;
  4344.   Changed
  4345. end;
  4346.  
  4347. procedure TStringSparseList.Changed;
  4348. begin
  4349.   if Assigned(FOnChange) then FOnChange(Self)
  4350. end;
  4351.  
  4352. procedure TStringSparseList.Error;
  4353. begin
  4354.   raise EStringSparseListError.CreateRes(SPutObjectError);
  4355. end;
  4356.  
  4357. procedure TStringSparseList.Delete(Index: Integer);
  4358. var
  4359.   p: PStrItem;
  4360. begin
  4361.   p := PStrItem(FList[Index]);
  4362.   if p <> nil then DisposeStrItem(p);
  4363.   FList.Delete(Index);
  4364.   Changed
  4365. end;
  4366.  
  4367. procedure TStringSparseList.Exchange(Index1, Index2: Integer);
  4368. begin
  4369.   FList.Exchange(Index1, Index2);
  4370. end;
  4371.  
  4372. procedure TStringSparseList.Insert(Index: Integer; const S: String);
  4373. begin
  4374.   FList.Insert(Index, NewStrItem(S, nil));
  4375.   Changed
  4376. end;
  4377.  
  4378. procedure TStringSparseList.Clear;
  4379.  
  4380.   function  ClearItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4381.   begin
  4382.     DisposeStrItem(PStrItem(TheItem));    { Item guaranteed non-nil }
  4383.     Result := 0
  4384.   end;
  4385.  
  4386. begin
  4387.   FList.ForAll(@ClearItem);
  4388.   FList.Clear;
  4389.   Changed
  4390. end;
  4391.  
  4392. { TStringGridStrings }
  4393.  
  4394. { AIndex < 0 is a column (for column -AIndex - 1)
  4395.   AIndex > 0 is a row (for row AIndex - 1)
  4396.   AIndex = 0 denotes an empty row or column }
  4397.  
  4398. constructor TStringGridStrings.Create(AGrid: TStringGrid; AIndex: Longint);
  4399. begin
  4400.   inherited Create;
  4401.   FGrid := AGrid;
  4402.   FIndex := AIndex;
  4403. end;
  4404.  
  4405. procedure TStringGridStrings.Assign(Source: TPersistent);
  4406. var
  4407.   I, Max: Integer;
  4408. begin
  4409.   if Source is TStrings then
  4410.   begin
  4411.     BeginUpdate;
  4412.     Max := TStrings(Source).Count - 1;
  4413.     if Max >= Count then Max := Count - 1;
  4414.     try
  4415.       for I := 0 to Max do
  4416.       begin
  4417.         Put(I, TStrings(Source).Strings[I]);
  4418.         PutObject(I, TStrings(Source).Objects[I]);
  4419.       end;
  4420.     finally
  4421.       EndUpdate;
  4422.     end;
  4423.     Exit;
  4424.   end;
  4425.   inherited Assign(Source);
  4426. end;
  4427.  
  4428. procedure TStringGridStrings.CalcXY(Index: Integer; var X, Y: Integer);
  4429. begin
  4430.   if FIndex = 0 then
  4431.   begin
  4432.     X := -1; Y := -1;
  4433.   end else if FIndex > 0 then
  4434.   begin
  4435.     X := Index;
  4436.     Y := FIndex - 1;
  4437.   end else
  4438.   begin
  4439.     X := -FIndex - 1;
  4440.     Y := Index;
  4441.   end;
  4442. end;
  4443.  
  4444. { Changes the meaning of Add to mean copy to the first empty string }
  4445. function TStringGridStrings.Add(const S: string): Integer;
  4446. var
  4447.   I: Integer;
  4448. begin
  4449.   for I := 0 to Count - 1 do
  4450.     if Strings[I] = '' then
  4451.     begin
  4452.       Strings[I] := S;
  4453.       Result := I;
  4454.       Exit;
  4455.     end;
  4456.   Result := -1;
  4457. end;
  4458.  
  4459. procedure TStringGridStrings.Clear;
  4460. var
  4461.   SSList: TStringSparseList;
  4462.   I: Integer;
  4463.  
  4464.   function BlankStr(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4465.   begin
  4466.     Objects[TheIndex] := nil;
  4467.     Strings[TheIndex] := '';
  4468.     Result := 0;
  4469.   end;
  4470.  
  4471. begin
  4472.   if FIndex > 0 then
  4473.   begin
  4474.     SSList := TStringSparseList(TSparseList(FGrid.FData)[FIndex - 1]);
  4475.     if SSList <> nil then SSList.List.ForAll(@BlankStr);
  4476.   end
  4477.   else if FIndex < 0 then
  4478.     for I := Count - 1 downto 0 do
  4479.     begin
  4480.       Objects[I] := nil;
  4481.       Strings[I] := '';
  4482.     end;
  4483. end;
  4484.  
  4485. function TStringGridStrings.Get(Index: Integer): string;
  4486. var
  4487.   X, Y: Integer;
  4488. begin
  4489.   CalcXY(Index, X, Y);
  4490.   if X < 0 then Result := '' else Result := FGrid.Cells[X, Y];
  4491. end;
  4492.  
  4493. function TStringGridStrings.GetCount: Integer;
  4494. begin
  4495.   { Count of a row is the column count, and vice versa }
  4496.   if FIndex = 0 then Result := 0
  4497.   else if FIndex > 0 then Result := Integer(FGrid.ColCount)
  4498.   else Result := Integer(FGrid.RowCount);
  4499. end;
  4500.  
  4501. function TStringGridStrings.GetObject(Index: Integer): TObject;
  4502. var
  4503.   X, Y: Integer;
  4504. begin
  4505.   CalcXY(Index, X, Y);
  4506.   if X < 0 then Result := nil else Result := FGrid.Objects[X, Y];
  4507. end;
  4508.  
  4509. procedure TStringGridStrings.Put(Index: Integer; const S: string);
  4510. var
  4511.   X, Y: Integer;
  4512. begin
  4513.   CalcXY(Index, X, Y);
  4514.   FGrid.Cells[X, Y] := S;
  4515. end;
  4516.  
  4517. procedure TStringGridStrings.PutObject(Index: Integer; AObject: TObject);
  4518. var
  4519.   X, Y: Integer;
  4520. begin
  4521.   CalcXY(Index, X, Y);
  4522.   FGrid.Objects[X, Y] := AObject;
  4523. end;
  4524.  
  4525. procedure TStringGridStrings.SetUpdateState(Updating: Boolean);
  4526. begin
  4527.   FGrid.SetUpdateState(Updating);
  4528. end;
  4529.  
  4530. { TStringGrid }
  4531.  
  4532. constructor TStringGrid.Create(AOwner: TComponent);
  4533. begin
  4534.   inherited Create(AOwner);
  4535.   Initialize;
  4536. end;
  4537.  
  4538. destructor TStringGrid.Destroy;
  4539.   function FreeItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4540.   begin
  4541.     TObject(TheItem).Free;
  4542.     Result := 0;
  4543.   end;
  4544.  
  4545. begin
  4546.   if FRows <> nil then
  4547.   begin
  4548.     TSparseList(FRows).ForAll(@FreeItem);
  4549.     TSparseList(FRows).Free;
  4550.   end;
  4551.   if FCols <> nil then
  4552.   begin
  4553.     TSparseList(FCols).ForAll(@FreeItem);
  4554.     TSparseList(FCols).Free;
  4555.   end;
  4556.   if FData <> nil then
  4557.   begin
  4558.     TSparseList(FData).ForAll(@FreeItem);
  4559.     TSparseList(FData).Free;
  4560.   end;
  4561.   inherited Destroy;
  4562. end;
  4563.  
  4564. procedure TStringGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  4565.  
  4566.   function MoveColData(Index: Integer; ARow: TStringSparseList): Integer; far;
  4567.   begin
  4568.     ARow.Move(FromIndex, ToIndex);
  4569.     Result := 0;
  4570.   end;
  4571.  
  4572. begin
  4573.   TSparseList(FData).ForAll(@MoveColData);
  4574.   Invalidate;
  4575.   inherited ColumnMoved(FromIndex, ToIndex);
  4576. end;
  4577.  
  4578. procedure TStringGrid.RowMoved(FromIndex, ToIndex: Longint);
  4579. begin
  4580.   TSparseList(FData).Move(FromIndex, ToIndex);
  4581.   Invalidate;
  4582.   inherited RowMoved(FromIndex, ToIndex);
  4583. end;
  4584.  
  4585. function TStringGrid.GetEditText(ACol, ARow: Longint): string;
  4586. begin
  4587.   Result := Cells[ACol, ARow];
  4588.   if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
  4589. end;
  4590.  
  4591. procedure TStringGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  4592. begin
  4593.   DisableEditUpdate;
  4594.   try
  4595.     if Value <> Cells[ACol, ARow] then Cells[ACol, ARow] := Value;
  4596.   finally
  4597.     EnableEditUpdate;
  4598.   end;
  4599.   inherited SetEditText(ACol, ARow, Value);
  4600. end;
  4601.  
  4602. procedure TStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  4603.   AState: TGridDrawState);
  4604.  
  4605.   procedure DrawCellText;
  4606.   var
  4607.     S: string;
  4608.   begin
  4609.     S := Cells[ACol, ARow];
  4610.     ExtTextOut(Canvas.Handle, ARect.Left + 2, ARect.Top + 2, ETO_CLIPPED or
  4611.       ETO_OPAQUE, @ARect, PChar(S), Length(S), nil);
  4612.   end;
  4613.  
  4614. begin
  4615.   if DefaultDrawing then DrawCellText;
  4616.   inherited DrawCell(ACol, ARow, ARect, AState);
  4617. end;
  4618.  
  4619. procedure TStringGrid.DisableEditUpdate;
  4620. begin
  4621.   Inc(FEditUpdate);
  4622. end;
  4623.  
  4624. procedure TStringGrid.EnableEditUpdate;
  4625. begin
  4626.   Dec(FEditUpdate);
  4627. end;
  4628.  
  4629. procedure TStringGrid.Initialize;
  4630. var
  4631.   quantum: TSPAQuantum;
  4632. begin
  4633.   if FCols = nil then
  4634.   begin
  4635.     if ColCount > 512 then quantum := SPALarge else quantum := SPASmall;
  4636.     FCols := TSparseList.Create(quantum);
  4637.   end;
  4638.   if RowCount > 256 then quantum := SPALarge else quantum := SPASmall;
  4639.   if FRows = nil then FRows := TSparseList.Create(quantum);
  4640.   if FData = nil then FData := TSparseList.Create(quantum);
  4641. end;
  4642.  
  4643. procedure TStringGrid.SetUpdateState(Updating: Boolean);
  4644. begin
  4645.   FUpdating := Updating;
  4646.   if not Updating and FNeedsUpdating then
  4647.   begin
  4648.     InvalidateGrid;
  4649.     FNeedsUpdating := False;
  4650.   end;
  4651. end;
  4652.  
  4653. procedure TStringGrid.Update(ACol, ARow: Integer);
  4654. begin
  4655.   if not FUpdating then InvalidateCell(ACol, ARow)
  4656.   else FNeedsUpdating := True;
  4657.   if (ACol = Col) and (ARow = Row) and (FEditUpdate = 0) then InvalidateEditor;
  4658. end;
  4659.  
  4660. function  TStringGrid.EnsureColRow(Index: Integer; IsCol: Boolean):
  4661.   TStringGridStrings;
  4662. var
  4663.   RCIndex: Integer;
  4664.   PList: ^TSparseList;
  4665. begin
  4666.   if IsCol then PList := @FCols else PList := @FRows;
  4667.   Result := TStringGridStrings(PList^[Index]);
  4668.   if Result = nil then
  4669.   begin
  4670.     if IsCol then RCIndex := -Index - 1 else RCIndex := Index + 1;
  4671.     Result := TStringGridStrings.Create(Self, RCIndex);
  4672.     PList^[Index] := Result;
  4673.   end;
  4674. end;
  4675.  
  4676. function  TStringGrid.EnsureDataRow(ARow: Integer): Pointer;
  4677. var
  4678.   quantum: TSPAQuantum;
  4679. begin
  4680.   Result := TStringSparseList(TSparseList(FData)[ARow]);
  4681.   if Result = nil then
  4682.   begin
  4683.     if ColCount > 512 then quantum := SPALarge else quantum := SPASmall;
  4684.     Result := TStringSparseList.Create(quantum);
  4685.     TSparseList(FData)[ARow] := Result;
  4686.   end;
  4687. end;
  4688.  
  4689. function TStringGrid.GetCells(ACol, ARow: Integer): string;
  4690. var
  4691.   ssl: TStringSparseList;
  4692. begin
  4693.   ssl := TStringSparseList(TSparseList(FData)[ARow]);
  4694.   if ssl = nil then Result := '' else Result := ssl[ACol];
  4695. end;
  4696.  
  4697. function TStringGrid.GetCols(Index: Integer): TStrings;
  4698. begin
  4699.   Result := EnsureColRow(Index, True);
  4700. end;
  4701.  
  4702. function TStringGrid.GetObjects(ACol, ARow: Integer): TObject;
  4703. var
  4704.   ssl: TStringSparseList;
  4705. begin
  4706.   ssl := TStringSparseList(TSparseList(FData)[ARow]);
  4707.   if ssl = nil then Result := nil else Result := ssl.Objects[ACol];
  4708. end;
  4709.  
  4710. function TStringGrid.GetRows(Index: Integer): TStrings;
  4711. begin
  4712.   Result := EnsureColRow(Index, False);
  4713. end;
  4714.  
  4715. procedure TStringGrid.SetCells(ACol, ARow: Integer; const Value: string);
  4716. begin
  4717.   TStringGridStrings(EnsureDataRow(ARow))[ACol] := Value;
  4718.   EnsureColRow(ACol, True);
  4719.   EnsureColRow(ARow, False);
  4720.   Update(ACol, ARow);
  4721. end;
  4722.  
  4723. procedure TStringGrid.SetCols(Index: Integer; Value: TStrings);
  4724. begin
  4725.   EnsureColRow(Index, True).Assign(Value);
  4726. end;
  4727.  
  4728. procedure TStringGrid.SetObjects(ACol, ARow: Integer; Value: TObject);
  4729. begin
  4730.   TStringGridStrings(EnsureDataRow(ARow)).Objects[ACol] := Value;
  4731.   EnsureColRow(ACol, True);
  4732.   EnsureColRow(ARow, False);
  4733.   Update(ACol, ARow);
  4734. end;
  4735.  
  4736. procedure TStringGrid.SetRows(Index: Integer; Value: TStrings);
  4737. begin
  4738.   EnsureColRow(Index, False).Assign(Value);
  4739. end;
  4740.  
  4741. end.
  4742.  
  4743.  
  4744.