home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / SOURCE / VCL / GRIDS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-03  |  136.7 KB  |  4,735 lines

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