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