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