home *** CD-ROM | disk | FTP | other *** search
-
- {*******************************************************}
- { }
- { Borland Delphi Visual Component Library }
- { }
- { Copyright (c) 1995,99 Inprise Corporation }
- { }
- {*******************************************************}
-
- unit Grids;
-
- {$R-,T-,H+,X+}
-
- interface
-
- uses Messages, Windows, SysUtils, Classes, Graphics, Menus, Controls, Forms,
- StdCtrls, Mask;
-
- const
- MaxCustomExtents = MaxListSize;
- MaxShortInt = High(ShortInt);
-
- type
- EInvalidGridOperation = class(Exception);
-
- { Internal grid types }
- TGetExtentsFunc = function(Index: Longint): Integer of object;
-
- TGridAxisDrawInfo = record
- EffectiveLineWidth: Integer;
- FixedBoundary: Integer;
- GridBoundary: Integer;
- GridExtent: Integer;
- LastFullVisibleCell: Longint;
- FullVisBoundary: Integer;
- FixedCellCount: Integer;
- FirstGridCell: Integer;
- GridCellCount: Integer;
- GetExtent: TGetExtentsFunc;
- end;
-
- TGridDrawInfo = record
- Horz, Vert: TGridAxisDrawInfo;
- end;
-
- TGridState = (gsNormal, gsSelecting, gsRowSizing, gsColSizing,
- gsRowMoving, gsColMoving);
- TGridMovement = gsRowMoving..gsColMoving;
-
- { TInplaceEdit }
- { The inplace editor is not intended to be used outside the grid }
-
- TCustomGrid = class;
-
- TInplaceEdit = class(TCustomMaskEdit)
- protected
- procedure CreateParams(var Params: TCreateParams); override;
- procedure DblClick; override;
- function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
- MousePos: TPoint): Boolean; override;
- function EditCanModify: Boolean; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure KeyUp(var Key: Word; Shift: TShiftState); override;
- procedure BoundsChanged; virtual;
- procedure UpdateContents; virtual;
- procedure WndProc(var Message: TMessage); override;
- property Grid: TCustomGrid;
- public
- constructor Create(AOwner: TComponent); override;
- procedure Deselect;
- procedure Hide;
- procedure Invalidate; reintroduce;
- procedure Move(const Loc: TRect);
- function PosEqual(const Rect: TRect): Boolean;
- procedure SetFocus; reintroduce;
- procedure UpdateLoc(const Loc: TRect);
- function Visible: Boolean;
- end;
-
- { TCustomGrid }
-
- { TCustomGrid is an abstract base class that can be used to implement
- general purpose grid style controls. The control will call DrawCell for
- each of the cells allowing the derived class to fill in the contents of
- the cell. The base class handles scrolling, selection, cursor keys, and
- scrollbars.
- DrawCell
- Called by Paint. If DefaultDrawing is true the font and brush are
- intialized to the control font and cell color. The cell is prepainted
- in the cell color and a focus rect is drawn in the focused cell after
- DrawCell returns. The state passed will reflect whether the cell is
- a fixed cell, the focused cell or in the selection.
- SizeChanged
- Called when the size of the grid has changed.
- BorderStyle
- Allows a single line border to be drawn around the control.
- Col
- The current column of the focused cell (runtime only).
- ColCount
- The number of columns in the grid.
- ColWidths
- The width of each column (up to a maximum MaxCustomExtents, runtime
- only).
- DefaultColWidth
- The default column width. Changing this value will throw away any
- customization done either visually or through ColWidths.
- DefaultDrawing
- Indicates whether the Paint should do the drawing talked about above in
- DrawCell.
- DefaultRowHeight
- The default row height. Changing this value will throw away any
- customization done either visually or through RowHeights.
- FixedCols
- The number of non-scrolling columns. This value must be at least one
- below ColCount.
- FixedRows
- The number of non-scrolling rows. This value must be at least one
- below RowCount.
- GridLineWidth
- The width of the lines drawn between the cells.
- LeftCol
- The index of the left most displayed column (runtime only).
- Options
- The following options are available:
- goFixedHorzLine: Draw horizontal grid lines in the fixed cell area.
- goFixedVertLine: Draw veritical grid lines in the fixed cell area.
- goHorzLine: Draw horizontal lines between cells.
- goVertLine: Draw vertical lines between cells.
- goRangeSelect: Allow a range of cells to be selected.
- goDrawFocusSelected: Draw the focused cell in the selected color.
- goRowSizing: Allows rows to be individually resized.
- goColSizing: Allows columns to be individually resized.
- goRowMoving: Allows rows to be moved with the mouse
- goColMoving: Allows columns to be moved with the mouse.
- goEditing: Places an edit control over the focused cell.
- goAlwaysShowEditor: Always shows the editor in place instead of
- waiting for a keypress or F2 to display it.
- goTabs: Enables the tabbing between columns.
- goRowSelect: Selection and movement is done a row at a time.
- Row
- The row of the focused cell (runtime only).
- RowCount
- The number of rows in the grid.
- RowHeights
- The hieght of each row (up to a maximum MaxCustomExtents, runtime
- only).
- ScrollBars
- Determines whether the control has scrollbars.
- Selection
- A TGridRect of the current selection.
- TopLeftChanged
- Called when the TopRow or LeftCol change.
- TopRow
- The index of the top most row displayed (runtime only)
- VisibleColCount
- The number of columns fully displayed. There could be one more column
- partially displayed.
- VisibleRowCount
- The number of rows fully displayed. There could be one more row
- partially displayed.
-
- Protected members, for implementors of TCustomGrid descendents
- DesignOptionBoost
- Options mixed in only at design time to aid design-time editing.
- Default = [goColSizing, goRowSizing], which makes grid cols and rows
- resizeable at design time, regardless of the Options settings.
- VirtualView
- Controls the use of maximum screen clipping optimizations when the
- grid window changes size. Default = False, which means only the
- area exposed by the size change will be redrawn, for less flicker.
- VirtualView = True means the entire data area of the grid is redrawn
- when the size changes. This is required when the data displayed in
- the grid is not bound to the number of rows or columns in the grid,
- such as the dbgrid (a few grid rows displaying a view onto a million
- row table).
- }
-
- TGridOption = (goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
- goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing, goRowMoving,
- goColMoving, goEditing, goTabs, goRowSelect,
- goAlwaysShowEditor, goThumbTracking);
- TGridOptions = set of TGridOption;
- TGridDrawState = set of (gdSelected, gdFocused, gdFixed);
- TGridScrollDirection = set of (sdLeft, sdRight, sdUp, sdDown);
-
- TGridCoord = record
- X: Longint;
- Y: Longint;
- end;
-
- TGridRect = record
- case Integer of
- 0: (Left, Top, Right, Bottom: Longint);
- 1: (TopLeft, BottomRight: TGridCoord);
- end;
-
- TSelectCellEvent = procedure (Sender: TObject; ACol, ARow: Longint;
- var CanSelect: Boolean) of object;
- TDrawCellEvent = procedure (Sender: TObject; ACol, ARow: Longint;
- Rect: TRect; State: TGridDrawState) of object;
-
- TCustomGrid = class(TCustomControl)
- protected
- FGridState: TGridState;
- FSaveCellExtents: Boolean;
- DesignOptionsBoost: TGridOptions;
- VirtualView: Boolean;
- procedure CalcDrawInfo(var DrawInfo: TGridDrawInfo);
- procedure CalcFixedInfo(var DrawInfo: TGridDrawInfo);
- procedure CalcSizingState(X, Y: Integer; var State: TGridState;
- var Index: Longint; var SizingPos, SizingOfs: Integer;
- var FixedInfo: TGridDrawInfo); virtual;
- function CreateEditor: TInplaceEdit; virtual;
- procedure CreateParams(var Params: TCreateParams); override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer); override;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer); override;
- procedure AdjustSize(Index, Amount: Longint; Rows: Boolean); reintroduce; dynamic;
- function BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
- procedure DoExit; override;
- function CellRect(ACol, ARow: Longint): TRect;
- function CanEditAcceptKey(Key: Char): Boolean; dynamic;
- function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; dynamic;
- function CanEditModify: Boolean; dynamic;
- function CanEditShow: Boolean; virtual;
- function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
- function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
- function GetEditText(ACol, ARow: Longint): string; dynamic;
- procedure SetEditText(ACol, ARow: Longint; const Value: string); dynamic;
- function GetEditMask(ACol, ARow: Longint): string; dynamic;
- function GetEditLimit: Integer; dynamic;
- function GetGridWidth: Integer;
- function GetGridHeight: Integer;
- procedure HideEditor;
- procedure ShowEditor;
- procedure ShowEditorChar(Ch: Char);
- procedure InvalidateEditor;
- procedure MoveColumn(FromIndex, ToIndex: Longint);
- procedure ColumnMoved(FromIndex, ToIndex: Longint); dynamic;
- procedure MoveRow(FromIndex, ToIndex: Longint);
- procedure RowMoved(FromIndex, ToIndex: Longint); dynamic;
- procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
- AState: TGridDrawState); virtual; abstract;
- procedure DefineProperties(Filer: TFiler); override;
- procedure MoveColRow(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
- function SelectCell(ACol, ARow: Longint): Boolean; virtual;
- procedure SizeChanged(OldColCount, OldRowCount: Longint); dynamic;
- function Sizing(X, Y: Integer): Boolean;
- procedure ScrollData(DX, DY: Integer);
- procedure InvalidateCell(ACol, ARow: Longint);
- procedure InvalidateCol(ACol: Longint);
- procedure InvalidateRow(ARow: Longint);
- procedure TopLeftChanged; dynamic;
- procedure TimedScroll(Direction: TGridScrollDirection); dynamic;
- procedure Paint; override;
- procedure ColWidthsChanged; dynamic;
- procedure RowHeightsChanged; dynamic;
- procedure DeleteColumn(ACol: Longint); virtual;
- procedure DeleteRow(ARow: Longint); virtual;
- procedure UpdateDesigner;
- function BeginColumnDrag(var Origin, Destination: Integer;
- const MousePt: TPoint): Boolean; dynamic;
- function BeginRowDrag(var Origin, Destination: Integer;
- const MousePt: TPoint): Boolean; dynamic;
- function CheckColumnDrag(var Origin, Destination: Integer;
- const MousePt: TPoint): Boolean; dynamic;
- function CheckRowDrag(var Origin, Destination: Integer;
- const MousePt: TPoint): Boolean; dynamic;
- function EndColumnDrag(var Origin, Destination: Integer;
- const MousePt: TPoint): Boolean; dynamic;
- function EndRowDrag(var Origin, Destination: Integer;
- const MousePt: TPoint): Boolean; dynamic;
- property BorderStyle: TBorderStyle default bsSingle;
- property Col: Longint;
- property Color default clWindow;
- property ColCount: Longint default 5;
- property ColWidths[Index: Longint]: Integer;
- property DefaultColWidth: Integer default 64;
- property DefaultDrawing: Boolean default True;
- property DefaultRowHeight: Integer default 24;
- property EditorMode: Boolean;
- property FixedColor: TColor default clBtnFace;
- property FixedCols: Integer default 1;
- property FixedRows: Integer default 1;
- property GridHeight: Integer;
- property GridLineWidth: Integer default 1;
- property GridWidth: Integer;
- property HitTest: TPoint;
- property InplaceEditor: TInplaceEdit;
- property LeftCol: Longint;
- property Options: TGridOptions default [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect];
- property ParentColor default False;
- property Row: Longint;
- property RowCount: Longint default 5;
- property RowHeights[Index: Longint]: Integer;
- property ScrollBars: TScrollStyle default ssBoth;
- property Selection: TGridRect;
- property TabStops[Index: Longint]: Boolean;
- property TopRow: Longint;
- property VisibleColCount: Integer;
- property VisibleRowCount: Integer;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function MouseCoord(X, Y: Integer): TGridCoord;
- published
- property TabStop default True;
- end;
-
- { TDrawGrid }
-
- { A grid relies on the OnDrawCell event to display the cells.
- CellRect
- This method returns control relative screen coordinates of the cell or
- an empty rectangle if the cell is not visible.
- EditorMode
- Setting to true shows the editor, as if the F2 key was pressed, when
- goEditing is turned on and goAlwaysShowEditor is turned off.
- MouseToCell
- Takes control relative screen X, Y location and fills in the column and
- row that contain that point.
- OnColumnMoved
- Called when the user request to move a column with the mouse when
- the goColMoving option is on.
- OnDrawCell
- This event is passed the same information as the DrawCell method
- discussed above.
- OnGetEditMask
- Called to retrieve edit mask in the inplace editor when goEditing is
- turned on.
- OnGetEditText
- Called to retrieve text to edit when goEditing is turned on.
- OnRowMoved
- Called when the user request to move a row with the mouse when
- the goRowMoving option is on.
- OnSetEditText
- Called when goEditing is turned on to reflect changes to the text
- made by the editor.
- OnTopLeftChanged
- Invoked when TopRow or LeftCol change. }
-
- TGetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; var Value: string) of object;
- TSetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; const Value: string) of object;
- TMovedEvent = procedure (Sender: TObject; FromIndex, ToIndex: Longint) of object;
-
- TDrawGrid = class(TCustomGrid)
- protected
- procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
- procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
- AState: TGridDrawState); override;
- function GetEditMask(ACol, ARow: Longint): string; override;
- function GetEditText(ACol, ARow: Longint): string; override;
- procedure RowMoved(FromIndex, ToIndex: Longint); override;
- function SelectCell(ACol, ARow: Longint): Boolean; override;
- procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
- procedure TopLeftChanged; override;
- public
- function CellRect(ACol, ARow: Longint): TRect;
- procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
- property Canvas;
- property Col;
- property ColWidths;
- property EditorMode;
- property GridHeight;
- property GridWidth;
- property LeftCol;
- property Selection;
- property Row;
- property RowHeights;
- property TabStops;
- property TopRow;
- published
- property Align;
- property Anchors;
- property BiDiMode;
- property BorderStyle;
- property Color;
- property ColCount;
- property Constraints;
- property Ctl3D;
- property DefaultColWidth;
- property DefaultRowHeight;
- property DefaultDrawing;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property FixedColor;
- property FixedCols;
- property RowCount;
- property FixedRows;
- property Font;
- property GridLineWidth;
- property Options;
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ScrollBars;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
- property VisibleColCount;
- property VisibleRowCount;
- property OnClick;
- property OnColumnMoved: TMovedEvent;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnDrawCell: TDrawCellEvent;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetEditMask: TGetEditEvent;
- property OnGetEditText: TGetEditEvent;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheelDown;
- property OnMouseWheelUp;
- property OnRowMoved: TMovedEvent;
- property OnSelectCell: TSelectCellEvent;
- property OnSetEditText: TSetEditEvent;
- property OnStartDock;
- property OnStartDrag;
- property OnTopLeftChanged: TNotifyEvent;
- end;
-
- { TStringGrid }
-
- { TStringGrid adds to TDrawGrid the ability to save a string and associated
- object (much like TListBox). It also adds to the DefaultDrawing the drawing
- of the string associated with the current cell.
- Cells
- A ColCount by RowCount array of strings which are associated with each
- cell. By default, the string is drawn into the cell before OnDrawCell
- is called. This can be turned off (along with all the other default
- drawing) by setting DefaultDrawing to false.
- Cols
- A TStrings object that contains the strings and objects in the column
- indicated by Index. The TStrings will always have a count of RowCount.
- If a another TStrings is assigned to it, the strings and objects beyond
- RowCount are ignored.
- Objects
- A ColCount by Rowcount array of TObject's associated with each cell.
- Object put into this array will *not* be destroyed automatically when
- the grid is destroyed.
- Rows
- A TStrings object that contains the strings and objects in the row
- indicated by Index. The TStrings will always have a count of ColCount.
- If a another TStrings is assigned to it, the strings and objects beyond
- ColCount are ignored. }
-
- TStringGrid = class;
-
- TStringGridStrings = class(TStrings)
- protected
- function Get(Index: Integer): string; override;
- function GetCount: Integer; override;
- function GetObject(Index: Integer): TObject; override;
- procedure Put(Index: Integer; const S: string); override;
- procedure PutObject(Index: Integer; AObject: TObject); override;
- procedure SetUpdateState(Updating: Boolean); override;
- public
- constructor Create(AGrid: TStringGrid; AIndex: Longint);
- function Add(const S: string): Integer; override;
- procedure Assign(Source: TPersistent); override;
- procedure Clear; override;
- procedure Delete(Index: Integer); override;
- procedure Insert(Index: Integer; const S: string); override;
- end;
-
-
- TStringGrid = class(TDrawGrid)
- protected
- procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
- procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
- AState: TGridDrawState); override;
- function GetEditText(ACol, ARow: Longint): string; override;
- procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
- procedure RowMoved(FromIndex, ToIndex: Longint); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- property Cells[ACol, ARow: Integer]: string;
- property Cols[Index: Integer]: TStrings;
- property Objects[ACol, ARow: Integer]: TObject;
- property Rows[Index: Integer]: TStrings;
- end;
-
- implementation
-