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