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