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