1 |
|
---|
2 | {ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
3 | º º
|
---|
4 | º Sibyl Portable Component Classes º
|
---|
5 | º º
|
---|
6 | º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
|
---|
7 | º º
|
---|
8 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
|
---|
9 |
|
---|
10 | Unit Grids;
|
---|
11 |
|
---|
12 |
|
---|
13 | Interface
|
---|
14 |
|
---|
15 | {$IFDEF OS2}
|
---|
16 | Uses Os2Def,BseDos,PmWin,PmGpi,PmDev,PmStdDlg;
|
---|
17 | {$ENDIF}
|
---|
18 |
|
---|
19 | {$IFDEF Win95}
|
---|
20 | Uses WinDef,WinBase,WinNt,WinUser,WinGDI,CommCtrl;
|
---|
21 | {$ENDIF}
|
---|
22 |
|
---|
23 | Uses Dos,Classes,Forms,Graphics,Buttons,StdCtrls,DBBase,Dialogs,Mask;
|
---|
24 |
|
---|
25 |
|
---|
26 | Type
|
---|
27 | {$M+}
|
---|
28 | TGridOptions=Set Of (goBorder,goRowSizing,goColSizing,goEditing,
|
---|
29 | goAlwaysShowEditor,goShowSelection,goAlwaysShowSelection,
|
---|
30 | goMouseSelect);
|
---|
31 |
|
---|
32 | TSelectCell=Procedure(Sender:TObject;Col,Row:LongInt) Of Object;
|
---|
33 | {$M-}
|
---|
34 |
|
---|
35 | PGridWidthArray=^TGridWidthArray;
|
---|
36 | TGridWidthArray=Array[0..$0FFFFFFF] Of LongInt;
|
---|
37 |
|
---|
38 |
|
---|
39 | TGridDrawState=Set Of (gdSelected,gdFocused,gdFixed);
|
---|
40 |
|
---|
41 | TGridCoord=Record
|
---|
42 | X:LongInt;
|
---|
43 | Y:LongInt;
|
---|
44 | End;
|
---|
45 |
|
---|
46 | TGridRect=Record
|
---|
47 | Case Integer Of
|
---|
48 | 0:(Left, Top, Right, Bottom:LongInt);
|
---|
49 | 1:(TopLeft, BottomRight:TGridCoord);
|
---|
50 | End;
|
---|
51 |
|
---|
52 | {custom Grid}
|
---|
53 | TGrid=Class(TControl)
|
---|
54 | Private
|
---|
55 | FUpdateLocked:Boolean;
|
---|
56 | FFixedColor:TColor;
|
---|
57 | FFixedRows:LongInt;
|
---|
58 | FFixedCols:LongInt;
|
---|
59 | FDefaultColWidth:LongInt;
|
---|
60 | FDefaultRowHeight:LongInt;
|
---|
61 | FColCount:LongInt;
|
---|
62 | FRowCount:LongInt;
|
---|
63 | FColWidths:PGridWidthArray;
|
---|
64 | FRowHeights:PGridWidthArray;
|
---|
65 | FColList:TList; {List Of TColEntry}
|
---|
66 | FScrollBars:TScrollStyle;
|
---|
67 | FSizeCol:LongInt;
|
---|
68 | FSizeRow:LongInt;
|
---|
69 | FSizeShape:TCursor;
|
---|
70 | FSizeStartX,FSizeStartY,FSizeX,FSizeY:LongInt;
|
---|
71 | FOptions:TGridOptions;
|
---|
72 | FEntryColor:TColor;
|
---|
73 | FGridUpdateLocked:Boolean;
|
---|
74 | FSelectCol,FSelectRow:LongInt;
|
---|
75 | FOnSelectCell:TSelectCell;
|
---|
76 | FVertScrollBar:TScrollBar;
|
---|
77 | FHorzScrollBar:TScrollBar;
|
---|
78 | Protected
|
---|
79 | FLeftExtent,FUpExtent:LongInt;
|
---|
80 | FLeftScrolled,FUpScrolled:LongInt;
|
---|
81 | Private
|
---|
82 | Procedure SetFixedColor(NewColor:TColor);
|
---|
83 | Procedure SetFixedRows(NewRows:LongInt);
|
---|
84 | Procedure SetFixedCols(NewCols:LongInt);
|
---|
85 | Procedure SetDefaultColWidth(NewWidth:LongInt);
|
---|
86 | Procedure SetDefaultRowHeight(NewHeight:LongInt);
|
---|
87 | Procedure SetColCount(NewCount:LongInt);
|
---|
88 | Procedure SetRowCount(NewCount:LongInt);
|
---|
89 | Procedure SetScrollBars(NewValue:TScrollStyle);
|
---|
90 | Procedure CreateHScrollBar;
|
---|
91 | Procedure CreateVScrollBar;
|
---|
92 | Procedure UpdateScrollBars;
|
---|
93 | Function GetSizeItem(Const pt:TPoint;Var Col,Row:LongInt):TCursor;
|
---|
94 | Procedure SetOptions(NewOptions:TGridOptions);
|
---|
95 | Procedure SetEntryColor(NewColor:TColor);
|
---|
96 | Procedure SetColWidth(Col:LongInt;NewWidth:LongInt);
|
---|
97 | Function GetColWidth(Col:LongInt):LongInt;
|
---|
98 | Procedure SetRowHeight(Row:LongInt;NewHeight:LongInt);
|
---|
99 | Function GetRowHeight(Row:LongInt):LongInt;
|
---|
100 | Procedure SetUpdateLocked(NewValue:Boolean);
|
---|
101 | Procedure GetGridExtent(Var CX,CY:LongInt);
|
---|
102 | Procedure ClearFocus;Virtual;
|
---|
103 | Function GetVisibleRowCount:LongInt;
|
---|
104 | Function GetVisibleColCount:LongInt;
|
---|
105 | Procedure SetTopRow(NewValue:LongInt);
|
---|
106 | Procedure SetLeftCol(NewValue:LongInt);
|
---|
107 | Function GetGridWidth:LongInt;
|
---|
108 | Function GetGridHeight:LongInt;
|
---|
109 | Procedure SetCol(NewValue:LongInt);
|
---|
110 | Procedure SetRow(NewValue:LongInt);
|
---|
111 | Procedure SetCellColors(Col,Row:LongInt;AState:TGridDrawState);
|
---|
112 | Function GetSelection:TGridRect;
|
---|
113 | Procedure SetSelection(NewValue:TGridRect);
|
---|
114 | Function ScrollHorzTrack(ScrollBar:TScrollBar;NewPosition:LongInt):LongInt;
|
---|
115 | Function ScrollVertTrack(ScrollBar:TScrollBar;NewPosition:LongInt):LongInt;
|
---|
116 | Procedure SetScrollBar(ScrollBar:TScrollBar;NewValue:LongInt);Virtual;
|
---|
117 | Protected
|
---|
118 | Procedure SetupComponent;Override;
|
---|
119 | Procedure Resize;Override;
|
---|
120 | Procedure Scroll(ScrollBar:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);Override;
|
---|
121 | Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
|
---|
122 | Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
|
---|
123 | Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
|
---|
124 | Procedure KillFocus;Override;
|
---|
125 | Procedure SetFocus;Override;
|
---|
126 | Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
|
---|
127 | Function SelectCell(Col,Row:LongInt):Boolean;Virtual;
|
---|
128 | Function CellRect(Col,Row:LongInt):TRect;
|
---|
129 | Procedure UpdateGridContents(NewCols,NewRows:LongInt);Virtual;
|
---|
130 | Procedure DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);Virtual;
|
---|
131 | Procedure SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);Virtual;
|
---|
132 | Procedure RowHeightChanged(Row:LongInt);Virtual;
|
---|
133 | Procedure ColWidthChanged(Col:LongInt);Virtual;
|
---|
134 | Public
|
---|
135 | Procedure Redraw(Const rec:TRect);Override;
|
---|
136 | Destructor Destroy;Override;
|
---|
137 | Procedure Show;Override;
|
---|
138 | Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
|
---|
139 | Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
|
---|
140 | Procedure BeginUpdate;
|
---|
141 | Procedure EndUpdate;
|
---|
142 | Public
|
---|
143 | Property GridRects[Col,Row:LongInt]:TRect Read CellRect;
|
---|
144 | Property ColWidths[Col:LongInt]:LongInt Read GetColWidth Write SetColWidth;
|
---|
145 | Property RowHeights[Row:LongInt]:LongInt Read GetRowHeight Write SetRowHeight;
|
---|
146 | Property GridUpdateLocked:Boolean Read FGridUpdateLocked Write SetUpdateLocked;
|
---|
147 | Property Col:LongInt Read FSelectCol Write SetCol;
|
---|
148 | Property Row:LongInt Read FSelectRow Write SetRow;
|
---|
149 | Property Selection:TGridRect Read GetSelection Write SetSelection;
|
---|
150 | Property VisibleRowCount:LongInt Read GetVisibleRowCount;
|
---|
151 | Property VisibleColCount:LongInt Read GetVisibleColCount;
|
---|
152 | Property TopRow:LongInt Read FUpScrolled Write SetTopRow;
|
---|
153 | Property LeftCol:LongInt Read FLeftScrolled Write SetLeftCol;
|
---|
154 | Property GridWidth:LongInt Read GetGridWidth;
|
---|
155 | Property GridHeight:LongInt Read GetGridHeight;
|
---|
156 | Property FixedColor:TColor Read FFixedColor Write SetFixedColor;
|
---|
157 | Property FixedRows:LongInt Read FFixedRows Write SetFixedRows;
|
---|
158 | Property FixedCols:LongInt Read FFixedCols Write SetFixedCols;
|
---|
159 | Property DefaultColWidth:LongInt Read FDefaultColWidth Write SetDefaultColWidth;
|
---|
160 | Property DefaultRowHeight:LongInt Read FDefaultRowHeight Write SetDefaultRowHeight;
|
---|
161 | Property ColCount:LongInt Read FColCount Write SetColCount;
|
---|
162 | Property RowCount:LongInt Read FRowCount Write SetRowCount;
|
---|
163 | Property ScrollBars:TScrollStyle Read FScrollBars Write SetScrollBars;
|
---|
164 | Property Options:TGridOptions Read FOptions Write SetOptions;
|
---|
165 | Property EntryColor:TColor Read FEntryColor Write SetEntryColor;
|
---|
166 | Property VertScrollBar:TScrollBar Read FVertScrollBar;
|
---|
167 | Property HorzScrollBar:TScrollBar Read FHorzScrollBar;
|
---|
168 |
|
---|
169 | Property OnSelectCell:TSelectCell Read FOnSelectCell Write FOnSelectCell;
|
---|
170 | Property OnClick;
|
---|
171 | Published
|
---|
172 | Property PopupMenu;
|
---|
173 | End;
|
---|
174 |
|
---|
175 |
|
---|
176 | TStringGridData=Class
|
---|
177 | Data:PString;
|
---|
178 | End;
|
---|
179 |
|
---|
180 | TStringGrid=Class;
|
---|
181 |
|
---|
182 | {$M+}
|
---|
183 | TGetCellEvent=Procedure(Grid:TStringGrid;Col,Row:LongInt;Var Result:String) Of Object;
|
---|
184 | TSetCellEvent=Procedure(Grid:TStringGrid;Col,Row:LongInt;Var NewContent:String) Of Object;
|
---|
185 | TCanEditEvent=Procedure(Grid:TStringGrid;Col,Row:LongInt;Var AllowEdit:Boolean) Of Object;
|
---|
186 | {$M-}
|
---|
187 |
|
---|
188 | TInplaceEdit=Class
|
---|
189 | Private
|
---|
190 | Procedure SetInternalText(Const NewValue:String);
|
---|
191 | Function GetInternalControl:TControl;
|
---|
192 | Constructor Create(Grid:TGrid;Col,Row:LongInt);Virtual;
|
---|
193 | Private
|
---|
194 | FGrid:TGrid;
|
---|
195 | FCol,FRow:LongInt;
|
---|
196 | Protected
|
---|
197 | Function GetText:String;Virtual;Abstract;
|
---|
198 | Procedure SetText(Const NewValue:String);Virtual;Abstract;
|
---|
199 | Function GetControl:TControl;Virtual;Abstract;
|
---|
200 | Procedure SetWindowPos(X,Y,W,H:LongInt);Virtual;Abstract;
|
---|
201 | Procedure Show;Virtual;Abstract;
|
---|
202 | Procedure Hide;Virtual;Abstract;
|
---|
203 | Public
|
---|
204 | Procedure SetupEdit(Grid:TGrid);Virtual;Abstract;
|
---|
205 | Destructor Destroy;Virtual;
|
---|
206 | Public
|
---|
207 | Property Text:String read GetText write SetInternalText;
|
---|
208 | Property Control:TControl read GetInternalControl;
|
---|
209 | Property Grid:TGrid read FGrid;
|
---|
210 | Property Col:LongInt read FCol;
|
---|
211 | Property Row:LongInt read FRow;
|
---|
212 | End;
|
---|
213 | TInplaceEditClass=Class Of TInplaceEdit;
|
---|
214 |
|
---|
215 | {$M+}
|
---|
216 | TOnShowEditor=Function(Sender:TGrid;Col,Row:LongInt):TInplaceEditClass Of Object;
|
---|
217 |
|
---|
218 | TGetEditEvent=Procedure(Sender:TObject;ACol,ARow:Longint;Var Value:String) Of Object;
|
---|
219 | TSetEditEvent=Procedure(Sender:TObject;ACol,ARow:Longint;Const Value:String) Of Object;
|
---|
220 | {$M-}
|
---|
221 |
|
---|
222 | TStringGrid=Class(TGrid)
|
---|
223 | Private
|
---|
224 | FEdit:TInplaceEdit;
|
---|
225 | FColumns:TList;
|
---|
226 | FOnGetCell:TGetCellEvent;
|
---|
227 | FOnSetCell:TSetCellEvent;
|
---|
228 | FOnCanEdit:TCanEditEvent;
|
---|
229 | FEditorMode:Boolean;
|
---|
230 | FOnShowEditor:TOnShowEditor;
|
---|
231 | FOnGetEditMask:TGetEditEvent;
|
---|
232 | FOnGetEditText:TGetEditEvent;
|
---|
233 | FOnSetEditText:TSetEditEvent;
|
---|
234 | Procedure EvEntryKillFocus(Sender:TObject);
|
---|
235 | Procedure ShowEntry(S:String);
|
---|
236 | Procedure ClearFocus;Override;
|
---|
237 | Procedure ShowEditorIntern;
|
---|
238 | Procedure HideEditorIntern;
|
---|
239 | Procedure SetEditorMode(NewValue:Boolean);
|
---|
240 | Protected
|
---|
241 | Procedure SetupComponent;Override;
|
---|
242 | Function GetCell(Col,Row:LongInt):String;Virtual;
|
---|
243 | Procedure SetCell(Col,Row:LongInt;Const NewContent:String);Virtual;
|
---|
244 | Procedure DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);Override;
|
---|
245 | Procedure SetupCellDrawing(Col,Row:LongInt;AState:TGridDrawState;
|
---|
246 | Var Alignment:TAlignment;Var Font:TFont);Virtual;
|
---|
247 | Function SelectCell(Col,Row:LongInt):Boolean;Override;
|
---|
248 | Procedure CharEvent(Var key:Char;RepeatCount:Byte);Override;
|
---|
249 | Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
|
---|
250 | Procedure Resize;Override;
|
---|
251 | Function ShowEditor(Col,Row:LongInt):TInplaceEditClass;Virtual;
|
---|
252 | Public
|
---|
253 | Destructor Destroy;Override;
|
---|
254 | Property Cells[Col,Row:LongInt]:String Read GetCell Write SetCell;
|
---|
255 | Property XAlign;
|
---|
256 | Property XStretch;
|
---|
257 | Property YAlign;
|
---|
258 | Property YStretch;
|
---|
259 | Property EditorMode:Boolean Read FEditorMode Write SetEditorMode;
|
---|
260 | Property InplaceEdit:TInplaceEdit read FEdit;
|
---|
261 | Published
|
---|
262 | Property Align;
|
---|
263 | Property Color;
|
---|
264 | Property ColCount;
|
---|
265 | Property PenColor;
|
---|
266 | Property DefaultColWidth;
|
---|
267 | Property DefaultRowHeight;
|
---|
268 | Property DragCursor;
|
---|
269 | Property DragMode;
|
---|
270 | Property Enabled;
|
---|
271 | Property EntryColor;
|
---|
272 | Property Font;
|
---|
273 | Property FixedColor;
|
---|
274 | Property FixedCols;
|
---|
275 | Property FixedRows;
|
---|
276 | Property Options;
|
---|
277 | Property ParentColor;
|
---|
278 | Property ParentPenColor;
|
---|
279 | Property ParentFont;
|
---|
280 | Property ParentShowHint;
|
---|
281 | Property RowCount;
|
---|
282 | Property ScrollBars;
|
---|
283 | Property ShowHint;
|
---|
284 | Property TabOrder;
|
---|
285 | Property TabStop;
|
---|
286 | Property Visible;
|
---|
287 | Property ZOrder;
|
---|
288 |
|
---|
289 | Property OnCanDrag;
|
---|
290 | Property OnCanEdit:TCanEditEvent Read FOnCanEdit Write FOnCanEdit;
|
---|
291 | Property OnCommand;
|
---|
292 | Property OnDragDrop;
|
---|
293 | Property OnDragOver;
|
---|
294 | Property OnEndDrag;
|
---|
295 | Property OnEnter;
|
---|
296 | Property OnExit;
|
---|
297 | Property OnFontChange;
|
---|
298 | Property OnGetCell:TGetCellEvent Read FOnGetCell Write FOnGetCell;
|
---|
299 | Property OnSetCell:TSetCellEvent Read FOnSetCell Write FOnSetCell;
|
---|
300 | Property OnKeyPress;
|
---|
301 | Property OnMouseClick;
|
---|
302 | Property OnMouseDblClick;
|
---|
303 | Property OnMouseDown;
|
---|
304 | Property OnMouseMove;
|
---|
305 | Property OnMouseUp;
|
---|
306 | Property OnResize;
|
---|
307 | Property OnScan;
|
---|
308 | Property OnSelectCell;
|
---|
309 | Property OnSetupShow;
|
---|
310 | Property OnStartDrag;
|
---|
311 | Property OnShowEditor:TOnShowEditor read FOnShowEditor write FOnShowEditor;
|
---|
312 | Property OnGetEditMask:TGetEditEvent read FOnGetEditMask write FOnGetEditMask;
|
---|
313 | Property OnGetEditText:TGetEditEvent read FOnGetEditText write FOnGetEditText;
|
---|
314 | Property OnSetEditText:TSetEditEvent read FOnSetEditText write FOnSetEditText;
|
---|
315 | End;
|
---|
316 |
|
---|
317 | {$M+}
|
---|
318 | TDrawCellEvent=Procedure(Sender:TObject;ACol,ARow:LongInt;
|
---|
319 | rc:TRect;State:TGridDrawState) Of Object;
|
---|
320 | TOpenEditorEvent=Procedure(Sender:TObject;ACol,ARow:LongInt) Of Object;
|
---|
321 | {$M-}
|
---|
322 |
|
---|
323 | TDrawGrid=Class(TGrid)
|
---|
324 | Private
|
---|
325 | FOnDrawCell:TDrawCellEvent;
|
---|
326 | FDefaultDrawing:Boolean;
|
---|
327 | FEditorMode:Boolean;
|
---|
328 | FOnOpenEditor:TOpenEditorEvent;
|
---|
329 | FOnCloseEditor:TNotifyEvent;
|
---|
330 | Private
|
---|
331 | Procedure SetDefaultDrawing(NewValue:Boolean);
|
---|
332 | Procedure SetEditorMode(NewValue:Boolean);
|
---|
333 | Procedure ShowEditor;
|
---|
334 | Procedure HideEditor;
|
---|
335 | Protected
|
---|
336 | Procedure SetupComponent;Override;
|
---|
337 | Procedure DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);Override;
|
---|
338 | Function SelectCell(Col,Row:LongInt):Boolean;Override;
|
---|
339 | Procedure CloseEditor;Virtual;
|
---|
340 | Procedure OpenEditor(Col,Row:LongInt);Virtual;
|
---|
341 | Public
|
---|
342 | Procedure SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);Override;
|
---|
343 | Procedure MouseToCell(X,Y:LongInt;Var ACol,ARow:LongInt);
|
---|
344 | Public
|
---|
345 | Property EditorMode:Boolean Read FEditorMode Write SetEditorMode;
|
---|
346 | Published
|
---|
347 | Property FixedColor;
|
---|
348 | Property FixedRows;
|
---|
349 | Property FixedCols;
|
---|
350 | Property DefaultColWidth;
|
---|
351 | Property DefaultRowHeight;
|
---|
352 | Property ColCount;
|
---|
353 | Property RowCount;
|
---|
354 | Property ScrollBars;
|
---|
355 | Property Options;
|
---|
356 | Property EntryColor;
|
---|
357 |
|
---|
358 | Property OnSelectCell;
|
---|
359 | Property OnClick;
|
---|
360 | Property OnDrawCell:TDrawCellEvent Read FOnDrawCell Write FOnDrawCell;
|
---|
361 | Property OnOpenEditor:TOpenEditorEvent Read FOnOpenEditor Write FOnOpenEditor;
|
---|
362 | Property OnCloseEditor:TNotifyEvent Read FOnCloseEditor Write FOnCloseEditor;
|
---|
363 | Property DefaultDrawing:Boolean Read FDefaultDrawing Write SetDefaultDrawing;
|
---|
364 | End;
|
---|
365 |
|
---|
366 | Implementation
|
---|
367 |
|
---|
368 | {
|
---|
369 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
370 | º º
|
---|
371 | º Speed-Pascal/2 Version 2.0 º
|
---|
372 | º º
|
---|
373 | º Speed-Pascal Component Classes (SPCC) º
|
---|
374 | º º
|
---|
375 | º This section: TInplaceEdit Class Implementation º
|
---|
376 | º º
|
---|
377 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
378 | º º
|
---|
379 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
380 | }
|
---|
381 |
|
---|
382 | Constructor TInplaceEdit.Create(Grid:TGrid;Col,Row:LongInt);
|
---|
383 | Begin
|
---|
384 | Inherited Create;
|
---|
385 | FGrid:=Grid;
|
---|
386 | FCol:=Col;
|
---|
387 | FRow:=Row;
|
---|
388 | SetupEdit(Grid);
|
---|
389 | End;
|
---|
390 |
|
---|
391 | Destructor TInplaceEdit.Destroy;
|
---|
392 | Begin
|
---|
393 | FGrid:=Nil;
|
---|
394 | Inherited Destroy;
|
---|
395 | End;
|
---|
396 |
|
---|
397 | Procedure TInplaceEdit.SetInternalText(Const NewValue:String);
|
---|
398 | Begin
|
---|
399 | SetText(NewValue);
|
---|
400 | End;
|
---|
401 |
|
---|
402 | Function TInplaceEdit.GetInternalControl:TControl;
|
---|
403 | Begin
|
---|
404 | Result:=GetControl;
|
---|
405 | End;
|
---|
406 |
|
---|
407 | {
|
---|
408 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
409 | º º
|
---|
410 | º Speed-Pascal/2 Version 2.0 º
|
---|
411 | º º
|
---|
412 | º Speed-Pascal Component Classes (SPCC) º
|
---|
413 | º º
|
---|
414 | º This section: TDefaultEdit Class Implementation º
|
---|
415 | º º
|
---|
416 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
417 | º º
|
---|
418 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
419 | }
|
---|
420 |
|
---|
421 |
|
---|
422 | Type
|
---|
423 | TDefaultEdit=Class(TInplaceEdit)
|
---|
424 | Protected
|
---|
425 | FEdit:TEdit;
|
---|
426 | FEditMask:String;
|
---|
427 | Protected
|
---|
428 | Function GetText:String;Override;
|
---|
429 | Function GetControl:TComponent;Override;
|
---|
430 | Procedure SetText(Const NewValue:String);Override;
|
---|
431 | Procedure SetWindowPos(X,Y,W,H:LongInt);Override;
|
---|
432 | Procedure SetupEdit(Grid:TGrid);Override;
|
---|
433 | Destructor Destroy;Override;
|
---|
434 | Procedure Show;Override;
|
---|
435 | Procedure Hide;Override;
|
---|
436 | End;
|
---|
437 |
|
---|
438 | Function TDefaultEdit.GetText:String;
|
---|
439 | Begin
|
---|
440 | Result:=FEdit.Text;
|
---|
441 | End;
|
---|
442 |
|
---|
443 | Function TDefaultEdit.GetControl:TControl;
|
---|
444 | Begin
|
---|
445 | Result:=FEdit;
|
---|
446 | End;
|
---|
447 |
|
---|
448 | Procedure TDefaultEdit.SetText(Const NewValue:String);
|
---|
449 | Begin
|
---|
450 | FEdit.Text:=NewValue;
|
---|
451 | End;
|
---|
452 |
|
---|
453 | Procedure TDefaultEdit.SetWindowPos(X,Y,W,H:LongInt);
|
---|
454 | Begin
|
---|
455 | FEdit.SetWindowPos(X,Y,W,H);
|
---|
456 | End;
|
---|
457 |
|
---|
458 | Procedure TDefaultEdit.SetupEdit(Grid:TGrid);
|
---|
459 | Var EditMask:String;
|
---|
460 | Begin
|
---|
461 | EditMask:='';
|
---|
462 | If TStringGrid(Grid).OnGetEditMask<>Nil Then TStringGrid(Grid).OnGetEditMask(Self,Col,Row,EditMask);
|
---|
463 |
|
---|
464 | If FEdit=Nil Then
|
---|
465 | Begin
|
---|
466 | If EditMask<>'' Then
|
---|
467 | Begin
|
---|
468 | FEdit:=TMaskEdit.Create(Grid);
|
---|
469 | TMaskEdit(FEdit).EditMask:=EditMask;
|
---|
470 | End
|
---|
471 | Else FEdit.Create(Grid);
|
---|
472 | FEdit.BorderStyle:=bsNone;
|
---|
473 | End
|
---|
474 | Else If ((EditMask<>'')And(not (FEdit Is TMaskEdit))) Then
|
---|
475 | Begin
|
---|
476 | FEdit.Destroy;
|
---|
477 | FEdit:=TMaskEdit.Create(Grid);
|
---|
478 | TMaskEdit(FEdit).EditMask:=EditMask;
|
---|
479 | End
|
---|
480 | Else If ((FEditMask='')And(FEdit Is TMaskEdit)) Then
|
---|
481 | Begin
|
---|
482 | FEdit.Destroy;
|
---|
483 | FEdit.Create(Nil);
|
---|
484 | End;
|
---|
485 | End;
|
---|
486 |
|
---|
487 | Destructor TDefaultEdit.Destroy;
|
---|
488 | Begin
|
---|
489 | FEdit.Destroy;
|
---|
490 | Inherited Destroy;
|
---|
491 | End;
|
---|
492 |
|
---|
493 | Procedure TDefaultEdit.Show;
|
---|
494 | Begin
|
---|
495 | FEdit.SelLength := 0; // clear selection
|
---|
496 | FEdit.SelStart:=0;
|
---|
497 | FEdit.Show;
|
---|
498 | End;
|
---|
499 |
|
---|
500 | Procedure TDefaultEdit.Hide;
|
---|
501 | Begin
|
---|
502 | FEdit.Hide;
|
---|
503 | End;
|
---|
504 |
|
---|
505 | {
|
---|
506 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
507 | º º
|
---|
508 | º Speed-Pascal/2 Version 2.0 º
|
---|
509 | º º
|
---|
510 | º Speed-Pascal Component Classes (SPCC) º
|
---|
511 | º º
|
---|
512 | º This section: TGrid Class Implementation º
|
---|
513 | º º
|
---|
514 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
515 | º º
|
---|
516 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
517 | }
|
---|
518 |
|
---|
519 | Procedure TGrid.BeginUpdate;
|
---|
520 | Begin
|
---|
521 | FUpdateLocked:=True;
|
---|
522 | End;
|
---|
523 |
|
---|
524 | Procedure TGrid.EndUpdate;
|
---|
525 | Begin
|
---|
526 | FUpdateLocked:=False;
|
---|
527 | Invalidate;
|
---|
528 | End;
|
---|
529 |
|
---|
530 | Procedure TGrid.ClearFocus;
|
---|
531 | Var rc:TRect;
|
---|
532 | Begin
|
---|
533 | If ((FSelectCol>=0)And(FSelectRow>=0)) Then
|
---|
534 | Begin
|
---|
535 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
536 | FSelectCol:=-1;
|
---|
537 | FSelectRow:=-1;
|
---|
538 | InvalidateRect(rc);
|
---|
539 | Update;
|
---|
540 | End;
|
---|
541 | End;
|
---|
542 |
|
---|
543 | Procedure TGrid.KillFocus;
|
---|
544 | Var rc:TRect;
|
---|
545 | Begin
|
---|
546 | If ((FSelectCol>=0)And(FSelectRow>=0)) Then
|
---|
547 | Begin
|
---|
548 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
549 | InvalidateRect(rc);
|
---|
550 | Update;
|
---|
551 | End;
|
---|
552 | Inherited KillFocus;
|
---|
553 | End;
|
---|
554 |
|
---|
555 | Procedure TGrid.SetFocus;
|
---|
556 | Var rc:TRect;
|
---|
557 | Begin
|
---|
558 | If ((FSelectCol>=0)And(FSelectRow>=0)) Then
|
---|
559 | Begin
|
---|
560 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
561 | InvalidateRect(rc);
|
---|
562 | Update;
|
---|
563 | End;
|
---|
564 | Inherited SetFocus;
|
---|
565 | End;
|
---|
566 |
|
---|
567 |
|
---|
568 | Procedure TGrid.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
|
---|
569 | Type PGridSizes=^TGridSizes;
|
---|
570 | TGridSizes=Record
|
---|
571 | EntryType:Byte;
|
---|
572 | Index:LongInt;
|
---|
573 | Value:LongInt;
|
---|
574 | End;
|
---|
575 | Var sizes:PGridSizes;
|
---|
576 | T:LongInt;
|
---|
577 | Begin
|
---|
578 | If ResName = rnGridSizes Then
|
---|
579 | Begin
|
---|
580 | sizes:=@Data;
|
---|
581 | T:=0;
|
---|
582 | While T<DataLen Do
|
---|
583 | Begin
|
---|
584 | If sizes^.EntryType=1
|
---|
585 | Then ColWidths[sizes^.Index]:=sizes^.Value {Col entry}
|
---|
586 | Else RowHeights[sizes^.Index]:=sizes^.Value;
|
---|
587 | Inc(T,SizeOf(TGridSizes));
|
---|
588 | Inc(sizes,SizeOf(TGridSizes));
|
---|
589 | End;
|
---|
590 | End
|
---|
591 | Else Inherited ReadSCUResource(ResName,Data,DataLen);
|
---|
592 | End;
|
---|
593 |
|
---|
594 |
|
---|
595 | Function TGrid.WriteSCUResource(Stream:TResourceStream):Boolean;
|
---|
596 | Const
|
---|
597 | ColEntry:Byte=1;
|
---|
598 | RowEntry:Byte=0;
|
---|
599 | Var MemStream:TMemoryStream;
|
---|
600 | T,t1:LongInt;
|
---|
601 | Col:LongInt;
|
---|
602 | Row:LongInt;
|
---|
603 | Begin
|
---|
604 | Result := Inherited WriteSCUResource(Stream);
|
---|
605 | If Not Result Then Exit;
|
---|
606 |
|
---|
607 | MemStream.Create;
|
---|
608 | For T:=0 To FColCount-1 Do
|
---|
609 | Begin
|
---|
610 | Col:=FColWidths^[T];
|
---|
611 | If Col<>FDefaultColWidth Then
|
---|
612 | Begin
|
---|
613 | MemStream.Write(ColEntry,1);
|
---|
614 | MemStream.Write(T,4);
|
---|
615 | MemStream.Write(Col,4);
|
---|
616 | End;
|
---|
617 | End;
|
---|
618 | For t1:=0 To FRowCount-1 Do
|
---|
619 | Begin
|
---|
620 | Row:=FRowHeights^[t1];
|
---|
621 | If Row<>FDefaultRowHeight Then
|
---|
622 | Begin
|
---|
623 | MemStream.Write(RowEntry,1);
|
---|
624 | MemStream.Write(t1,4);
|
---|
625 | MemStream.Write(Row,4);
|
---|
626 | End;
|
---|
627 | End;
|
---|
628 | If MemStream.Size>0
|
---|
629 | Then Result:=Stream.NewResourceEntry(rnGridSizes,
|
---|
630 | MemStream.Memory^,MemStream.Size);
|
---|
631 | MemStream.Destroy;
|
---|
632 | End;
|
---|
633 |
|
---|
634 | Procedure TGrid.SetColWidth(Col:LongInt;NewWidth:LongInt);
|
---|
635 | Begin
|
---|
636 | If ((Col<0)Or(Col>=FColCount)) Then Exit;
|
---|
637 | If NewWidth<=0 Then NewWidth:=FDefaultColWidth;
|
---|
638 | If FColWidths^[Col]=NewWidth Then Exit;
|
---|
639 | FColWidths^[Col]:=NewWidth;
|
---|
640 | //ClearFocus;
|
---|
641 | If Not FUpdateLocked Then Invalidate;
|
---|
642 | End;
|
---|
643 |
|
---|
644 | Function TGrid.GetColWidth(Col:LongInt):LongInt;
|
---|
645 | Begin
|
---|
646 | Result:=0;
|
---|
647 | If ((Col<0)Or(Col>=FColCount)) Then Exit;
|
---|
648 | Result:=FColWidths^[Col];
|
---|
649 | End;
|
---|
650 |
|
---|
651 | Procedure TGrid.SetRowHeight(Row:LongInt;NewHeight:LongInt);
|
---|
652 | Begin
|
---|
653 | If ((Row<0)Or(Row>=FRowCount)) Then Exit;
|
---|
654 | If NewHeight<=0 Then NewHeight:=FDefaultRowHeight;
|
---|
655 | If FRowHeights^[Row]=NewHeight Then Exit;
|
---|
656 | FRowHeights^[Row]:=NewHeight;
|
---|
657 | //ClearFocus;
|
---|
658 | If Not FUpdateLocked Then Invalidate;
|
---|
659 | End;
|
---|
660 |
|
---|
661 | Function TGrid.GetRowHeight(Row:LongInt):LongInt;
|
---|
662 | Begin
|
---|
663 | Result:=0;
|
---|
664 | If ((Row<0)Or(Row>=FRowCount)) Then Exit;
|
---|
665 | Result:=FRowHeights^[Row];
|
---|
666 | End;
|
---|
667 |
|
---|
668 | Procedure TGrid.SetEntryColor(NewColor:TColor);
|
---|
669 | Begin
|
---|
670 | FEntryColor:=NewColor;
|
---|
671 | //ClearFocus;
|
---|
672 | If Not FUpdateLocked Then Invalidate;
|
---|
673 | End;
|
---|
674 |
|
---|
675 | Procedure TGrid.SetFixedColor(NewColor:TColor);
|
---|
676 | Begin
|
---|
677 | FFixedColor:=NewColor;
|
---|
678 | If Not FUpdateLocked Then Invalidate;
|
---|
679 | End;
|
---|
680 |
|
---|
681 | Procedure TGrid.SetFixedRows(NewRows:LongInt);
|
---|
682 | Begin
|
---|
683 | If ((NewRows<0)Or(NewRows>=FRowCount)) Then Exit;
|
---|
684 | FFixedRows:=NewRows;
|
---|
685 | If FSelectRow=-1 Then If FFixedRows<FRowCount Then FSelectRow:=FFixedRows
|
---|
686 | Else FSelectRow:=-1;
|
---|
687 | //ClearFocus;
|
---|
688 | If Not FUpdateLocked Then Invalidate;
|
---|
689 | End;
|
---|
690 |
|
---|
691 | Procedure TGrid.SetFixedCols(NewCols:LongInt);
|
---|
692 | Begin
|
---|
693 | If ((NewCols<0)Or(NewCols>=FColCount)) Then Exit;
|
---|
694 | FFixedCols:=NewCols;
|
---|
695 | If FSelectCol=-1 Then If FFixedCols<FColCount Then FSelectCol:=FFixedCols
|
---|
696 | Else FSelectCol:=-1;
|
---|
697 | //ClearFocus;
|
---|
698 | If Not FUpdateLocked Then Invalidate;
|
---|
699 | End;
|
---|
700 |
|
---|
701 | Procedure TGrid.SetDefaultColWidth(NewWidth:LongInt);
|
---|
702 | Var T:LongInt;
|
---|
703 | P:Pointer;
|
---|
704 | Begin
|
---|
705 | If NewWidth<1 Then Exit;
|
---|
706 | P:=FColWidths;
|
---|
707 | T:=FColCount;
|
---|
708 | Asm
|
---|
709 | MOV EDI,P
|
---|
710 | MOV ECX,T
|
---|
711 | MOV EAX,NewWidth
|
---|
712 | REP STOSD
|
---|
713 | End;
|
---|
714 | //ClearFocus;
|
---|
715 | FDefaultColWidth:=NewWidth;
|
---|
716 | If Not FUpdateLocked Then Invalidate;
|
---|
717 | End;
|
---|
718 |
|
---|
719 | Procedure TGrid.SetOptions(NewOptions:TGridOptions);
|
---|
720 | Begin
|
---|
721 | FOptions:=NewOptions;
|
---|
722 | If Not FUpdateLocked Then Invalidate;
|
---|
723 | End;
|
---|
724 |
|
---|
725 | Procedure TGrid.SetDefaultRowHeight(NewHeight:LongInt);
|
---|
726 | Var T:LongInt;
|
---|
727 | P:Pointer;
|
---|
728 | Begin
|
---|
729 | If NewHeight<1 Then Exit;
|
---|
730 | P:=FRowHeights;
|
---|
731 | T:=FRowCount;
|
---|
732 | Asm
|
---|
733 | MOV EDI,P
|
---|
734 | MOV ECX,T
|
---|
735 | MOV EAX,NewHeight
|
---|
736 | CLD
|
---|
737 | REP STOSD
|
---|
738 | End;
|
---|
739 | FDefaultRowHeight:=NewHeight;
|
---|
740 | //ClearFocus;
|
---|
741 | If Not FUpdateLocked Then Invalidate;
|
---|
742 | End;
|
---|
743 |
|
---|
744 | Procedure TGrid.SetColCount(NewCount:LongInt);
|
---|
745 | Begin
|
---|
746 | If ((NewCount<1)Or(NewCount<FFixedCols)) Then Exit;
|
---|
747 | If NewCount=FColCount Then Exit;
|
---|
748 | FLeftScrolled:=0;
|
---|
749 | FUpScrolled:=0;
|
---|
750 | FLeftExtent:=0;
|
---|
751 | FUpExtent:=0;
|
---|
752 | UpdateGridContents(NewCount,FRowCount);
|
---|
753 | End;
|
---|
754 |
|
---|
755 | Procedure TGrid.SetRowCount(NewCount:LongInt);
|
---|
756 | Begin
|
---|
757 | If ((NewCount<1)Or(NewCount<FFixedRows)) Then Exit;
|
---|
758 | If NewCount=FRowCount Then Exit;
|
---|
759 | FLeftScrolled:=0;
|
---|
760 | FUpScrolled:=0;
|
---|
761 | FLeftExtent:=0;
|
---|
762 | FUpExtent:=0;
|
---|
763 | UpdateGridContents(FColCount,NewCount);
|
---|
764 | End;
|
---|
765 |
|
---|
766 | Procedure TGrid.UpdateScrollBars;
|
---|
767 | Var MaxWidth,MaxHeight:LongInt;
|
---|
768 | viewarea:LongInt;
|
---|
769 | Begin
|
---|
770 | GetGridExtent(MaxWidth,MaxHeight);
|
---|
771 |
|
---|
772 | If ((FVertScrollBar<>Nil)And(FHorzScrollBar<>Nil)) Then
|
---|
773 | Begin
|
---|
774 | If MaxWidth>Width Then
|
---|
775 | Begin
|
---|
776 | Inc(MaxHeight,FHorzScrollBar.Height);
|
---|
777 | If MaxHeight>Height Then Inc(MaxWidth,FVertScrollBar.Width);
|
---|
778 | End
|
---|
779 | Else If MaxHeight>Height Then
|
---|
780 | Begin
|
---|
781 | Inc(MaxWidth,FVertScrollBar.Width);
|
---|
782 | If MaxWidth>Width Then Inc(MaxHeight,FHorzScrollBar.Height);
|
---|
783 | End;
|
---|
784 | End;
|
---|
785 |
|
---|
786 | If FHorzScrollBar<>Nil Then
|
---|
787 | Begin
|
---|
788 | If MaxWidth>Width Then
|
---|
789 | Begin
|
---|
790 | viewarea:=Width;
|
---|
791 | If FVertScrollBar<>Nil Then If MaxHeight>Height Then Dec(viewarea,FVertScrollBar.Width);
|
---|
792 | FHorzScrollBar.SetScrollRange(0,MaxWidth,viewarea);
|
---|
793 | FHorzScrollBar.Position:=FLeftExtent;
|
---|
794 | If FVertScrollBar<>Nil Then
|
---|
795 | Begin
|
---|
796 | If MaxHeight>Height Then FHorzScrollBar.Width:=Width-FVertScrollBar.Width
|
---|
797 | Else FHorzScrollBar.Width:=Width;
|
---|
798 | End
|
---|
799 | Else FHorzScrollBar.Width:=Width;
|
---|
800 | If FHorzScrollBar.Handle<>0 Then FHorzScrollBar.Show
|
---|
801 | Else FHorzScrollBar.Visible:=True;
|
---|
802 | End
|
---|
803 | Else FHorzScrollBar.Hide;
|
---|
804 | End;
|
---|
805 |
|
---|
806 | If FVertScrollBar<>Nil Then
|
---|
807 | Begin
|
---|
808 | If MaxHeight>Height Then
|
---|
809 | Begin
|
---|
810 | viewarea:=Height;
|
---|
811 | If FHorzScrollBar<>Nil Then If MaxWidth>Width Then Dec(viewarea,FHorzScrollBar.Height);
|
---|
812 | FVertScrollBar.SetScrollRange(0,MaxHeight,viewarea);
|
---|
813 | FVertScrollBar.Position:=FUpExtent;
|
---|
814 | If FHorzScrollBar<>Nil Then
|
---|
815 | Begin
|
---|
816 | If MaxWidth>Width Then FVertScrollBar.Height:=Height-FHorzScrollBar.Height
|
---|
817 | Else FVertScrollBar.Height:=Height;
|
---|
818 | End
|
---|
819 | Else FVertScrollBar.Height:=Height;
|
---|
820 | If FVertScrollBar.Handle<>0 Then FVertScrollBar.Show
|
---|
821 | Else FVertScrollBar.Visible:=True;
|
---|
822 | End
|
---|
823 | Else FVertScrollBar.Hide;
|
---|
824 | End;
|
---|
825 | //ClearFocus;
|
---|
826 | End;
|
---|
827 |
|
---|
828 |
|
---|
829 |
|
---|
830 | Procedure TGrid.Show;
|
---|
831 | Begin
|
---|
832 | Inherited Show;
|
---|
833 |
|
---|
834 | UpdateScrollBars;
|
---|
835 | End;
|
---|
836 |
|
---|
837 | Procedure TGrid.Resize;
|
---|
838 | Begin
|
---|
839 | Inherited Resize;
|
---|
840 |
|
---|
841 | If FHorzScrollBar<>Nil Then
|
---|
842 | Begin
|
---|
843 | If FVertScrollBar<>Nil
|
---|
844 | Then FHorzScrollBar.Width:=Width-FHorzScrollBar.Height
|
---|
845 | Else FHorzScrollBar.Width:=Width;
|
---|
846 | End;
|
---|
847 |
|
---|
848 | If FVertScrollBar<>Nil Then
|
---|
849 | Begin
|
---|
850 | If FHorzScrollBar<>Nil
|
---|
851 | Then FVertScrollBar.Height:=Height-FVertScrollBar.Width
|
---|
852 | Else FVertScrollBar.Height:=Height;
|
---|
853 | End;
|
---|
854 |
|
---|
855 | FLeftScrolled:=0;
|
---|
856 | FUpScrolled:=0;
|
---|
857 | FLeftExtent:=0;
|
---|
858 | FUpExtent:=0;
|
---|
859 |
|
---|
860 | UpdateScrollBars;
|
---|
861 | End;
|
---|
862 |
|
---|
863 |
|
---|
864 | Procedure TGrid.CreateHScrollBar;
|
---|
865 | Begin
|
---|
866 | If FHorzScrollBar<>Nil Then Exit;
|
---|
867 |
|
---|
868 | FHorzScrollBar.Create(Nil);
|
---|
869 | FHorzScrollBar.Hide;
|
---|
870 | InsertControl(FHorzScrollBar);
|
---|
871 | FHorzScrollBar.Kind:=sbHorizontal;
|
---|
872 | FHorzScrollBar.SetWindowPos(0,0,Width-FHorzScrollBar.Height,FHorzScrollBar.Height);
|
---|
873 | FHorzScrollBar.XAlign:=xaLeft;
|
---|
874 | FHorzScrollBar.YAlign:=yaBottom;
|
---|
875 | Include(FHorzScrollBar.ComponentState, csDetail);
|
---|
876 | FHorzScrollBar.HandlesDesignMouse:=True;
|
---|
877 | FHorzScrollBar.SetDesigning(False); {!}
|
---|
878 | End;
|
---|
879 |
|
---|
880 |
|
---|
881 | Procedure TGrid.CreateVScrollBar;
|
---|
882 | Begin
|
---|
883 | If FVertScrollBar<>Nil Then Exit;
|
---|
884 |
|
---|
885 | FVertScrollBar.Create(Nil);
|
---|
886 | FVertScrollBar.Hide;
|
---|
887 | InsertControl(FVertScrollBar);
|
---|
888 | FVertScrollBar.Kind:=sbVertical;
|
---|
889 | FVertScrollBar.SetWindowPos(Width-FVertScrollBar.Width,FVertScrollBar.Width,
|
---|
890 | FVertScrollBar.Width,Height-FVertScrollBar.Width);
|
---|
891 | FVertScrollBar.XAlign:=xaRight;
|
---|
892 | FVertScrollBar.YAlign:=yaTop;
|
---|
893 | Include(FVertScrollBar.ComponentState, csDetail);
|
---|
894 | FVertScrollBar.HandlesDesignMouse:=True;
|
---|
895 | FVertScrollBar.SetDesigning(False); {!}
|
---|
896 | End;
|
---|
897 |
|
---|
898 |
|
---|
899 | Procedure TGrid.SetScrollBars(NewValue:TScrollStyle);
|
---|
900 | Begin
|
---|
901 | FScrollBars:=NewValue;
|
---|
902 | Case NewValue Of
|
---|
903 | ssBoth:
|
---|
904 | Begin
|
---|
905 | CreateHScrollBar;
|
---|
906 | CreateVScrollBar;
|
---|
907 | End;
|
---|
908 | ssHorizontal:
|
---|
909 | Begin
|
---|
910 | CreateHScrollBar;
|
---|
911 | If FVertScrollBar<>Nil Then FVertScrollBar.Destroy;
|
---|
912 | FVertScrollBar:=Nil;
|
---|
913 | FHorzScrollBar.Width:=FHorzScrollBar.Width+FHorzScrollBar.Height;
|
---|
914 | If FLeftScrolled>0 Then
|
---|
915 | Begin
|
---|
916 | FLeftScrolled:=0;
|
---|
917 | FLeftExtent:=0;
|
---|
918 | Invalidate;
|
---|
919 | End;
|
---|
920 | End;
|
---|
921 | ssVertical:
|
---|
922 | Begin
|
---|
923 | CreateVScrollBar;
|
---|
924 | If FHorzScrollBar<>Nil Then FHorzScrollBar.Destroy;
|
---|
925 | FHorzScrollBar:=Nil;
|
---|
926 | FVertScrollBar.Height:=FVertScrollBar.Height+FVertScrollBar.Width;
|
---|
927 | If FUpScrolled>0 Then
|
---|
928 | Begin
|
---|
929 | FUpScrolled:=0;
|
---|
930 | FUpExtent:=0;
|
---|
931 | Invalidate;
|
---|
932 | End;
|
---|
933 | End;
|
---|
934 | ssNone:
|
---|
935 | Begin
|
---|
936 | If FVertScrollBar<>Nil Then FVertScrollBar.Destroy;
|
---|
937 | FVertScrollBar:=Nil;
|
---|
938 | If FHorzScrollBar<>Nil Then FHorzScrollBar.Destroy;
|
---|
939 | FHorzScrollBar:=Nil;
|
---|
940 | If ((FLeftScrolled>0)Or(FUpScrolled>0)) Then
|
---|
941 | Begin
|
---|
942 | FLeftScrolled:=0;
|
---|
943 | FUpScrolled:=0;
|
---|
944 | FLeftExtent:=0;
|
---|
945 | FUpExtent:=0;
|
---|
946 | Invalidate;
|
---|
947 | End;
|
---|
948 | End;
|
---|
949 | End; {Case}
|
---|
950 | UpdateScrollBars;
|
---|
951 | End;
|
---|
952 |
|
---|
953 | {$HINTS OFF}
|
---|
954 | Procedure TGrid.SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);
|
---|
955 | Begin
|
---|
956 | ForeGround:=PenColor;
|
---|
957 |
|
---|
958 | If AState*[gdFixed]<>[] Then
|
---|
959 | Begin
|
---|
960 | background:=FFixedColor;
|
---|
961 | End
|
---|
962 | Else
|
---|
963 | Begin
|
---|
964 | background:=FEntryColor;
|
---|
965 |
|
---|
966 | If AState*[gdSelected]<>[] Then If Options*[goShowSelection,goEditing]<>[] Then
|
---|
967 | Begin
|
---|
968 | If AState*[gdFocused]=[] Then
|
---|
969 | Begin
|
---|
970 | If Options*[goAlwaysShowSelection]<>[] Then
|
---|
971 | Begin
|
---|
972 | background:=clHighlight;
|
---|
973 | ForeGround:=clHighlightText;
|
---|
974 | End;
|
---|
975 | End
|
---|
976 | Else
|
---|
977 | Begin
|
---|
978 | If Options*[goAlwaysShowEditor]=[] Then
|
---|
979 | Begin
|
---|
980 | background:=clHighlight;
|
---|
981 | ForeGround:=clHighlightText;
|
---|
982 | End;
|
---|
983 | End;
|
---|
984 | End;
|
---|
985 | End;
|
---|
986 | End;
|
---|
987 | {$HINTS ON}
|
---|
988 |
|
---|
989 | Procedure TGrid.SetCellColors(Col,Row:LongInt;AState:TGridDrawState);
|
---|
990 | Var back,Fore:TColor;
|
---|
991 | Begin
|
---|
992 | SetupCellColors(Col,Row,AState,back,Fore);
|
---|
993 | Canvas.Brush.color:=back;
|
---|
994 | Canvas.Pen.color:=Fore;
|
---|
995 | End;
|
---|
996 |
|
---|
997 | {$HINTS OFF}
|
---|
998 | Procedure TGrid.DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);
|
---|
999 | Var rc:TRect;
|
---|
1000 | Begin
|
---|
1001 | If Canvas=Nil Then Exit;
|
---|
1002 |
|
---|
1003 | SetCellColors(Col,Row,AState);
|
---|
1004 |
|
---|
1005 | If AState*[gdFixed]<>[] Then
|
---|
1006 | Begin
|
---|
1007 | Dec(rec.Top);
|
---|
1008 | If Col>0 Then Inc(rec.Left);
|
---|
1009 | {??????+-1}
|
---|
1010 | Dec(rec.Right);
|
---|
1011 | Dec(rec.Top);
|
---|
1012 | Canvas.FillRect(rec,Canvas.Brush.color);
|
---|
1013 | rc:=Canvas.ClipRect;
|
---|
1014 | Dec(rc.Bottom);
|
---|
1015 | If Col=0 Then Dec(rc.Left);
|
---|
1016 | Canvas.ClipRect:=rc;
|
---|
1017 |
|
---|
1018 | Dec(rec.Bottom);
|
---|
1019 | Dec(rec.Left);
|
---|
1020 | Canvas.ShadowedBorder(rec,clWhite,clDkGray);
|
---|
1021 |
|
---|
1022 | Inc(rc.Bottom);
|
---|
1023 | Inc(rc.Left);
|
---|
1024 | Canvas.ClipRect:=rc;
|
---|
1025 | End
|
---|
1026 | Else
|
---|
1027 | Begin
|
---|
1028 | {??????+-1}
|
---|
1029 | Dec(rec.Right);
|
---|
1030 | Dec(rec.Top);
|
---|
1031 | Canvas.FillRect(rec,Canvas.Brush.color);
|
---|
1032 | If AState*[gdFocused]<>[] Then
|
---|
1033 | Begin
|
---|
1034 | //InflateRect(rec,-1,-1);
|
---|
1035 | Dec(rec.Right);
|
---|
1036 | Dec(rec.Top);
|
---|
1037 | Canvas.DrawFocusRect(rec);
|
---|
1038 | End;
|
---|
1039 | End;
|
---|
1040 | End;
|
---|
1041 | {$HINTS ON}
|
---|
1042 |
|
---|
1043 | Procedure TGrid.Redraw(Const rec:TRect);
|
---|
1044 | Var T,t1:LongInt;
|
---|
1045 | X,Y:LongInt;
|
---|
1046 | RowHeight:LongInt;
|
---|
1047 | ColWidth:LongInt;
|
---|
1048 | rc1,rc2,rec1,rcSave:TRect;
|
---|
1049 | MaxWidth,MaxHeight:LongInt;
|
---|
1050 | LeftCount,UpCount:LongInt;
|
---|
1051 | DrawIt:Boolean;
|
---|
1052 | AState:TGridDrawState;
|
---|
1053 | Label Ende;
|
---|
1054 | Begin
|
---|
1055 | If Canvas=Nil Then Exit;
|
---|
1056 | If FGridUpdateLocked Then Exit;
|
---|
1057 | Dec(rec.Left);
|
---|
1058 | Inc(rec.Top);
|
---|
1059 | rec1:=rec;
|
---|
1060 | If Options*[goBorder]<>[] Then If rec1.Right>Width-1 Then rec1.Right:=Width-1;
|
---|
1061 | If ((FHorzScrollBar<>Nil)And(FHorzScrollBar.Visible)) Then
|
---|
1062 | If rec1.Bottom<FHorzScrollBar.Height Then rec1.Bottom:=FHorzScrollBar.Height;
|
---|
1063 | If ((FVertScrollBar<>Nil)And(FVertScrollBar.Visible)) Then
|
---|
1064 | If rec1.Right>Width-FVertScrollBar.Width Then rec1.Right:=Width-FVertScrollBar.Width;
|
---|
1065 | Canvas.SetClipRegion([rec1]);
|
---|
1066 |
|
---|
1067 | {Draw contents}
|
---|
1068 | If Options*[goBorder]<>[] Then X:=1
|
---|
1069 | Else X:=0;
|
---|
1070 | MaxWidth:=0;
|
---|
1071 | MaxHeight:=0;
|
---|
1072 | LeftCount:=1;
|
---|
1073 | For T:=0 To FColCount-1 Do
|
---|
1074 | Begin
|
---|
1075 | If Options*[goBorder]<>[] Then Y:=Height-1
|
---|
1076 | Else Y:=Height;
|
---|
1077 | ColWidth:=FColWidths^[T];
|
---|
1078 | UpCount:=1;
|
---|
1079 | For t1:=0 To FRowCount-1 Do
|
---|
1080 | Begin
|
---|
1081 | If Y>0 Then
|
---|
1082 | Begin
|
---|
1083 | If ((T+1<=FFixedCols)And(t1+1<=FFixedRows)) Then DrawIt:=True {Ecke(N) links oben}
|
---|
1084 | Else
|
---|
1085 | Begin
|
---|
1086 | If ((T+1<=FFixedCols)And(UpCount>FUpScrolled)) Then DrawIt:=True
|
---|
1087 | Else If ((t1+1<=FFixedRows)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
|
---|
1088 | Else If ((UpCount>FUpScrolled)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
|
---|
1089 | Else DrawIt:=False;
|
---|
1090 | End;
|
---|
1091 |
|
---|
1092 | If DrawIt Then
|
---|
1093 | Begin
|
---|
1094 | RowHeight:=FRowHeights^[t1];
|
---|
1095 | rc1.Left:=X;
|
---|
1096 | rc1.Right:=X+ColWidth;
|
---|
1097 | If Options*[goBorder]<>[] Then If rc1.Right>=Width Then rc1.Right:=Width-1;
|
---|
1098 | rc1.Top:=Y;
|
---|
1099 | If t1=0 Then Inc(rc1.Top);
|
---|
1100 | rc1.Bottom:=(Y-RowHeight);
|
---|
1101 |
|
---|
1102 | rc2:=IntersectRect(rc1,rec1);
|
---|
1103 | If Not IsRectEmpty(rc2) Then
|
---|
1104 | Begin
|
---|
1105 | If rc2.Bottom>0 Then Dec(rc2.Bottom);
|
---|
1106 | If Options*[goBorder]<>[] Then If rc2.Bottom<=0 Then rc2.Bottom:=1;
|
---|
1107 | Dec(rc2.Right);
|
---|
1108 | Dec(rc2.Top);
|
---|
1109 | If Options*[goBorder]<>[] Then If rc2.Right>=Width-1 Then rc2.Right:=Width-2;
|
---|
1110 | rcSave:=Canvas.ClipRect;
|
---|
1111 | Canvas.ClipRect:=rc2;
|
---|
1112 | If Options*[goBorder]<>[] Then
|
---|
1113 | Begin
|
---|
1114 | If t1=0 Then Inc(rc1.Left)
|
---|
1115 | Else If ((rc1.Left>0)And(((FixedCols>0)Or(T>0)))) Then Inc(rc1.Left);
|
---|
1116 | End
|
---|
1117 | Else
|
---|
1118 | Begin
|
---|
1119 | If ((FixedCols>0)Or(T>0)) Then Inc(rc1.Left);
|
---|
1120 | End;
|
---|
1121 | Inc(rc1.Bottom);
|
---|
1122 | If Options*[goBorder]<>[] Then If rc1.Bottom<=0 Then rc1.Bottom:=1;
|
---|
1123 | Canvas.Brush.color:=FEntryColor;
|
---|
1124 | Canvas.Pen.color:=PenColor;
|
---|
1125 | AState:=[];
|
---|
1126 | If ((T+1<=FFixedCols)Or(t1+1<=FFixedRows)) Then Include(AState,gdFixed);
|
---|
1127 | If ((T=FSelectCol)And(t1=FSelectRow)) Then
|
---|
1128 | Begin
|
---|
1129 | Include(AState,gdSelected);
|
---|
1130 | If HasFocus Then Include(AState,gdFocused);
|
---|
1131 | End;
|
---|
1132 | DrawCell(T,t1,rc1,AState);
|
---|
1133 | Canvas.ClipRect:=rcSave;
|
---|
1134 | End;
|
---|
1135 | Dec(Y,RowHeight);
|
---|
1136 | End;
|
---|
1137 | End;
|
---|
1138 | If t1+1>FFixedRows Then Inc(UpCount); {Next Row}
|
---|
1139 | End;
|
---|
1140 | If ((T+1<=FFixedCols)Or(LeftCount>FLeftScrolled)) Then Inc(X,ColWidth);
|
---|
1141 | If X>Width Then Goto Ende; {invisible}
|
---|
1142 | If T+1>FFixedCols Then Inc(LeftCount); {Next Column}
|
---|
1143 | End;
|
---|
1144 |
|
---|
1145 | Ende:
|
---|
1146 | MaxWidth:=X;
|
---|
1147 | MaxHeight:=Y;
|
---|
1148 |
|
---|
1149 | Canvas.DeleteClipRegion;
|
---|
1150 |
|
---|
1151 | {Draw Grid}
|
---|
1152 | If Options*[goBorder]<>[] Then
|
---|
1153 | Begin
|
---|
1154 | Y:=Height-1;
|
---|
1155 | X:=1;
|
---|
1156 | End
|
---|
1157 | Else
|
---|
1158 | Begin
|
---|
1159 | Y:=Height;
|
---|
1160 | X:=0;
|
---|
1161 | End;
|
---|
1162 |
|
---|
1163 | For T:=0 To FFixedRows-1 Do Dec(Y,FRowHeights^[T]);
|
---|
1164 | Canvas.Pen.color:=clDkGray;
|
---|
1165 | LeftCount:=1;
|
---|
1166 | For T:=0 To FColCount-1 Do
|
---|
1167 | Begin
|
---|
1168 | ColWidth:=FColWidths^[T];
|
---|
1169 | If ((T+1<=FFixedCols)Or(LeftCount>FLeftScrolled)) Then
|
---|
1170 | Begin
|
---|
1171 | Canvas.Line(X+ColWidth,Height,X+ColWidth,MaxHeight);
|
---|
1172 |
|
---|
1173 | Canvas.Pen.color:=clWhite;
|
---|
1174 | Canvas.Line(X+ColWidth+1,Y,X+ColWidth+1,Height);
|
---|
1175 | Canvas.Pen.color:=clDkGray;
|
---|
1176 |
|
---|
1177 | Inc(X,ColWidth);
|
---|
1178 | End;
|
---|
1179 | If T+1>FFixedCols Then Inc(LeftCount); {Next Row}
|
---|
1180 | If X>MaxWidth Then break;
|
---|
1181 | End;
|
---|
1182 |
|
---|
1183 | UpCount:=1;
|
---|
1184 | Canvas.Pen.color:=clDkGray;
|
---|
1185 | If Options*[goBorder]<>[] Then
|
---|
1186 | Begin
|
---|
1187 | Y:=Height-1;
|
---|
1188 | X:=1;
|
---|
1189 | End
|
---|
1190 | Else
|
---|
1191 | Begin
|
---|
1192 | Y:=Height;
|
---|
1193 | X:=0;
|
---|
1194 | End;
|
---|
1195 |
|
---|
1196 | For T:=0 To FFixedCols-1 Do Inc(X,FColWidths^[T]);
|
---|
1197 | For T:=0 To FRowCount-1 Do
|
---|
1198 | Begin
|
---|
1199 | RowHeight:=FRowHeights^[T];
|
---|
1200 | If ((T+1<=FFixedRows)Or(UpCount>FUpScrolled)) Then
|
---|
1201 | Begin
|
---|
1202 | Canvas.Line(X,Y-RowHeight,MaxWidth,Y-RowHeight);
|
---|
1203 |
|
---|
1204 | Canvas.Pen.color:=clWhite;
|
---|
1205 | Canvas.Line(0,Y-RowHeight-1,X,Y-RowHeight-1);
|
---|
1206 | Canvas.Pen.color:=clDkGray;
|
---|
1207 |
|
---|
1208 | Dec(Y,RowHeight);
|
---|
1209 | End;
|
---|
1210 | If T+1>FFixedRows Then Inc(UpCount);
|
---|
1211 | If Y<0 Then break;
|
---|
1212 | End;
|
---|
1213 |
|
---|
1214 | If MaxHeight>0 Then
|
---|
1215 | Begin
|
---|
1216 | rc1.Left:=0;
|
---|
1217 | If Options*[goBorder]<>[] Then Inc(rc1.Left);
|
---|
1218 | rc1.Right:=Width-1;
|
---|
1219 | If Options*[goBorder]<>[] Then Dec(rc1.Right);
|
---|
1220 | rc1.Bottom:=0;
|
---|
1221 | If Options*[goBorder]<>[] Then Inc(rc1.Bottom);
|
---|
1222 | rc1.Top:=MaxHeight-1;
|
---|
1223 | Canvas.FillRect(rc1,color);
|
---|
1224 | End;
|
---|
1225 |
|
---|
1226 | If MaxWidth<Width Then
|
---|
1227 | Begin
|
---|
1228 | rc1.Left:=MaxWidth+1;
|
---|
1229 | rc1.Right:=Width-1;
|
---|
1230 | If Options*[goBorder]<>[] Then Dec(rc1.Right);
|
---|
1231 | rc1.Bottom:=MaxHeight;
|
---|
1232 | rc1.Top:=Height-1;
|
---|
1233 | If Options*[goBorder]<>[] Then Dec(rc1.Top);
|
---|
1234 | Canvas.FillRect(rc1,color);
|
---|
1235 | End;
|
---|
1236 |
|
---|
1237 | Canvas.DeleteClipRegion;
|
---|
1238 |
|
---|
1239 | If Options*[goBorder]<>[] Then
|
---|
1240 | Begin
|
---|
1241 | rc1.Left:=0;
|
---|
1242 | rc1.Right:=Width-1;
|
---|
1243 | rc1.Bottom:=0;
|
---|
1244 | rc1.Top:=Height-1;
|
---|
1245 | Canvas.Pen.color:=clBlack;
|
---|
1246 | Canvas.Rectangle(rc1);
|
---|
1247 | End;
|
---|
1248 |
|
---|
1249 | If ((FVertScrollBar<>Nil)And(FHorzScrollBar<>Nil)And(FVertScrollBar.Visible)And
|
---|
1250 | (FHorzScrollBar.Visible)) Then
|
---|
1251 | Begin
|
---|
1252 | rc1.Left:=FHorzScrollBar.Width;
|
---|
1253 | rc1.Right:=Width-1;
|
---|
1254 | rc1.Bottom:=0;
|
---|
1255 | rc1.Top:=FHorzScrollBar.Height-1;
|
---|
1256 | Canvas.FillRect(rc1,color);
|
---|
1257 | End;
|
---|
1258 | End;
|
---|
1259 |
|
---|
1260 | Procedure TGrid.UpdateGridContents(NewCols,NewRows:LongInt);
|
---|
1261 | Var T:LongInt;
|
---|
1262 | P:Pointer;
|
---|
1263 | Def:LongInt;
|
---|
1264 | Begin
|
---|
1265 | If FColWidths=Nil Then
|
---|
1266 | Begin
|
---|
1267 | {no List was previously Active}
|
---|
1268 | GetMem(FColWidths,NewCols*4);
|
---|
1269 | P:=FColWidths;
|
---|
1270 | Def:=FDefaultColWidth;
|
---|
1271 | Asm
|
---|
1272 | MOV EDI,p
|
---|
1273 | MOV ECX,NewCols
|
---|
1274 | MOV EAX,Def
|
---|
1275 | CLD
|
---|
1276 | REP
|
---|
1277 | STOSD
|
---|
1278 | End;
|
---|
1279 | GetMem(FRowHeights,NewRows*4);
|
---|
1280 | P:=FRowHeights;
|
---|
1281 | Def:=FDefaultRowHeight;
|
---|
1282 | Asm
|
---|
1283 | MOV EDI,p
|
---|
1284 | MOV ECX,NewRows
|
---|
1285 | MOV EAX,Def
|
---|
1286 | CLD
|
---|
1287 | REP
|
---|
1288 | STOSD
|
---|
1289 | End;
|
---|
1290 | FColCount:=NewCols;
|
---|
1291 | FRowCount:=NewRows;
|
---|
1292 | End
|
---|
1293 | Else
|
---|
1294 | Begin
|
---|
1295 | If NewCols<FColCount Then
|
---|
1296 | Begin
|
---|
1297 | {Delete Columns}
|
---|
1298 | GetMem(P,NewCols*4);
|
---|
1299 | System.Move(FColWidths^,P^,NewCols*4);
|
---|
1300 | FreeMem(FColWidths,FColCount*4);
|
---|
1301 | FColWidths:=P;
|
---|
1302 | End
|
---|
1303 | Else If NewCols>FColCount Then
|
---|
1304 | Begin
|
---|
1305 | {Add Columns}
|
---|
1306 | GetMem(P,NewCols*4);
|
---|
1307 | System.Move(FColWidths^,P^,FColCount*4);
|
---|
1308 | FreeMem(FColWidths,FColCount*4);
|
---|
1309 | FColWidths:=P;
|
---|
1310 | Inc(P,FColCount*4);
|
---|
1311 | T:=NewCols-FColCount;
|
---|
1312 | Def:=FDefaultColWidth;
|
---|
1313 | Asm
|
---|
1314 | MOV EDI,p
|
---|
1315 | MOV ECX,t
|
---|
1316 | MOV EAX,Def
|
---|
1317 | CLD
|
---|
1318 | REP
|
---|
1319 | STOSD
|
---|
1320 | End;
|
---|
1321 | End;
|
---|
1322 | FColCount:=NewCols;
|
---|
1323 |
|
---|
1324 | If NewRows<FRowCount Then
|
---|
1325 | Begin
|
---|
1326 | {Delete Rows}
|
---|
1327 | GetMem(P,NewRows*4);
|
---|
1328 | System.Move(FRowHeights^,P^,NewRows*4);
|
---|
1329 | FreeMem(FRowHeights,FRowCount*4);
|
---|
1330 | FRowHeights:=P;
|
---|
1331 | End
|
---|
1332 | Else If NewRows>FRowCount Then
|
---|
1333 | Begin
|
---|
1334 | {Add Rows}
|
---|
1335 | GetMem(P,NewRows*4);
|
---|
1336 | System.Move(FRowHeights^,P^,FRowCount*4);
|
---|
1337 | FreeMem(FRowHeights,FRowCount*4);
|
---|
1338 | FRowHeights:=P;
|
---|
1339 | Inc(P,FRowCount*4);
|
---|
1340 | T:=NewRows-FRowCount;
|
---|
1341 | Def:=FDefaultRowHeight;
|
---|
1342 | Asm
|
---|
1343 | MOV EDI,p
|
---|
1344 | MOV ECX,t
|
---|
1345 | MOV EAX,Def
|
---|
1346 | CLD
|
---|
1347 | REP
|
---|
1348 | STOSD
|
---|
1349 | End;
|
---|
1350 | End;
|
---|
1351 | FRowCount:=NewRows;
|
---|
1352 | End;
|
---|
1353 |
|
---|
1354 | If Not FUpdateLocked Then Invalidate;
|
---|
1355 | UpdateScrollBars;
|
---|
1356 | End;
|
---|
1357 |
|
---|
1358 | Destructor TGrid.Destroy;
|
---|
1359 | Begin
|
---|
1360 | ScrollBars:=ssNone; {Destroy the ScrollBars}
|
---|
1361 |
|
---|
1362 | If FColCount>0 Then FreeMem(FColWidths,FColCount*4);
|
---|
1363 | FColWidths:=Nil;
|
---|
1364 | If FRowCount>0 Then FreeMem(FRowHeights,FRowCount*4);
|
---|
1365 | FRowHeights:=Nil;
|
---|
1366 |
|
---|
1367 | Inherited Destroy;
|
---|
1368 | End;
|
---|
1369 |
|
---|
1370 | Procedure TGrid.SetupComponent;
|
---|
1371 | Begin
|
---|
1372 | Inherited SetupComponent;
|
---|
1373 |
|
---|
1374 | Name:='Grid';
|
---|
1375 | Width:=200;
|
---|
1376 | Height:=200;
|
---|
1377 | ParentPenColor:=True;
|
---|
1378 | ParentColor:=True;
|
---|
1379 | HandlesDesignMouse:=True;
|
---|
1380 | FSelectCol:=-1;
|
---|
1381 | FSelectRow:=-1;
|
---|
1382 |
|
---|
1383 | FFixedColor:=clLtGray;
|
---|
1384 | FEntryColor:=clWhite;
|
---|
1385 | FFixedRows:=1;
|
---|
1386 | FFixedCols:=1;
|
---|
1387 | FDefaultRowHeight:=24; //40;
|
---|
1388 | FDefaultColWidth:=64; //50;
|
---|
1389 | FRowCount:=4;
|
---|
1390 | FColCount:=5;
|
---|
1391 | UpdateGridContents(FColCount,FRowCount);
|
---|
1392 | ScrollBars:=ssBoth;
|
---|
1393 | FSizeShape:=crDefault;
|
---|
1394 | FOptions:=[goBorder,goShowSelection,goMouseSelect];
|
---|
1395 | If not Designed Then Include(ComponentState,csAcceptsControls);
|
---|
1396 | End;
|
---|
1397 |
|
---|
1398 | Procedure TGrid.SetScrollBar(ScrollBar:TScrollBar;NewValue:LongInt);
|
---|
1399 | Begin
|
---|
1400 | ScrollBar.Position:=NewValue;
|
---|
1401 | //ClearFocus;
|
---|
1402 | If Not FUpdateLocked Then Invalidate;
|
---|
1403 | End;
|
---|
1404 |
|
---|
1405 | Procedure TGrid.SetTopRow(NewValue:LongInt);
|
---|
1406 | Begin
|
---|
1407 | FVertScrollBar.Position:=NewValue;
|
---|
1408 | End;
|
---|
1409 |
|
---|
1410 | Procedure TGrid.SetLeftCol(NewValue:LongInt);
|
---|
1411 | Begin
|
---|
1412 | FHorzScrollBar.Position:=NewValue;
|
---|
1413 | End;
|
---|
1414 |
|
---|
1415 | Procedure TGrid.Scroll(ScrollBar:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);
|
---|
1416 | Begin
|
---|
1417 | Case ScrollCode Of
|
---|
1418 | scLineUp: ScrollPos:=ScrollVertTrack(ScrollBar,FUpExtent-FRowHeights^[FFixedRows+FUpScrolled]);
|
---|
1419 | scLineDown: ScrollPos:=ScrollVertTrack(ScrollBar,FUpExtent+FRowHeights^[FFixedRows+FUpScrolled]);
|
---|
1420 | scPageUp: ScrollPos:=ScrollVertTrack(ScrollBar,FUpExtent-Height);
|
---|
1421 | scPageDown: ScrollPos:=ScrollVertTrack(ScrollBar,FUpExtent+Height);
|
---|
1422 | scVertTrack: ScrollPos:=ScrollVertTrack(ScrollBar,ScrollPos);
|
---|
1423 | scVertPosition: ScrollPos:=ScrollVertTrack(ScrollBar,ScrollPos);
|
---|
1424 | scColumnLeft: ScrollPos:=ScrollHorzTrack(ScrollBar,FLeftExtent-FColWidths^[FFixedCols+FLeftScrolled-1]);
|
---|
1425 | scColumnRight: ScrollPos:=ScrollHorzTrack(ScrollBar,FLeftExtent+FColWidths^[FFixedCols+FLeftScrolled]);
|
---|
1426 | scPageLeft: ScrollPos:=ScrollHorzTrack(ScrollBar,FLeftExtent-Width);
|
---|
1427 | scPageRight: ScrollPos:=ScrollHorzTrack(ScrollBar,FLeftExtent+Width);
|
---|
1428 | scHorzTrack: ScrollPos:=ScrollHorzTrack(ScrollBar,ScrollPos);
|
---|
1429 | scHorzPosition: ScrollPos:=ScrollHorzTrack(ScrollBar,ScrollPos);
|
---|
1430 | End;
|
---|
1431 | ScrollBar.Update;
|
---|
1432 | Invalidate;
|
---|
1433 | End;
|
---|
1434 |
|
---|
1435 | Procedure TGrid.GetGridExtent(Var CX,CY:LongInt);
|
---|
1436 | Var T:LongInt;
|
---|
1437 | Begin
|
---|
1438 | CX:=0;
|
---|
1439 | CY:=0;
|
---|
1440 | For T:=0 To FColCount-1 Do Inc(CX,FColWidths^[T]);
|
---|
1441 | For T:=0 To FRowCount-1 Do Inc(CY,FRowHeights^[T]);
|
---|
1442 | End;
|
---|
1443 |
|
---|
1444 | Function TGrid.GetVisibleRowCount:LongInt;
|
---|
1445 | Var T,H,MinHeight:LongInt;
|
---|
1446 | Begin
|
---|
1447 | Result:=0;
|
---|
1448 | H:=Height;
|
---|
1449 |
|
---|
1450 | MinHeight:=0;
|
---|
1451 | If FHorzScrollBar<>Nil Then
|
---|
1452 | If FHorzScrollBar.Visible Then Inc(MinHeight,FHorzScrollBar.Height);
|
---|
1453 |
|
---|
1454 | For T:=0 To FFixedRows-1 Do
|
---|
1455 | Begin
|
---|
1456 | Dec(H,FRowHeights^[T]);
|
---|
1457 | Inc(Result);
|
---|
1458 | If H<=MinHeight Then Exit;
|
---|
1459 | End;
|
---|
1460 |
|
---|
1461 | For T:=FUpScrolled+FFixedRows To FRowCount-1 Do
|
---|
1462 | Begin
|
---|
1463 | Dec(H,FRowHeights^[T]);
|
---|
1464 | Inc(Result);
|
---|
1465 | If H<=MinHeight Then Exit;
|
---|
1466 | End;
|
---|
1467 | End;
|
---|
1468 |
|
---|
1469 | Function TGrid.GetVisibleColCount:LongInt;
|
---|
1470 | Var T,W,MaxWidth:LongInt;
|
---|
1471 | Begin
|
---|
1472 | Result:=0;
|
---|
1473 | W:=0;
|
---|
1474 |
|
---|
1475 | MaxWidth:=Width;
|
---|
1476 | If FVertScrollBar<>Nil Then
|
---|
1477 | If FVertScrollBar.Visible Then Dec(MaxWidth,FVertScrollBar.Width);
|
---|
1478 |
|
---|
1479 | For T:=0 To FFixedCols-1 Do
|
---|
1480 | Begin
|
---|
1481 | Inc(W,FColWidths^[T]);
|
---|
1482 | Inc(Result);
|
---|
1483 | If W>=MaxWidth Then Exit;
|
---|
1484 | End;
|
---|
1485 |
|
---|
1486 | For T:=FLeftScrolled+FFixedCols To FColCount-1 Do
|
---|
1487 | Begin
|
---|
1488 | Inc(W,FColWidths^[T]);
|
---|
1489 | Inc(Result);
|
---|
1490 | If W>=MaxWidth Then Exit;
|
---|
1491 | End;
|
---|
1492 | End;
|
---|
1493 |
|
---|
1494 | Function TGrid.GetGridWidth:LongInt;
|
---|
1495 | Var T:LongInt;
|
---|
1496 | Begin
|
---|
1497 | Result:=0;
|
---|
1498 | For T:=0 To FColCount-1 Do Inc(Result,FColWidths^[T]);
|
---|
1499 | End;
|
---|
1500 |
|
---|
1501 | Function TGrid.GetGridHeight:LongInt;
|
---|
1502 | Var T:LongInt;
|
---|
1503 | Begin
|
---|
1504 | Result:=0;
|
---|
1505 | For T:=0 To FRowCount-1 Do Inc(Result,FRowHeights^[T]);
|
---|
1506 | End;
|
---|
1507 |
|
---|
1508 | {$HINTS OFF}
|
---|
1509 | Function TGrid.ScrollHorzTrack(ScrollBar:TScrollBar;NewPosition:LongInt):LongInt;
|
---|
1510 | Var MaxWidth,MaxHeight,Value:LongInt;
|
---|
1511 | T:LongInt;
|
---|
1512 | Begin
|
---|
1513 | If NewPosition<0 Then NewPosition:=0;
|
---|
1514 | GetGridExtent(MaxWidth,MaxHeight);
|
---|
1515 | If NewPosition>MaxWidth Then NewPosition:=MaxWidth;
|
---|
1516 | Value:=Width;
|
---|
1517 | If FVertScrollBar<>Nil Then If FVertScrollBar.Visible Then Dec(Value,FVertScrollBar.Width);
|
---|
1518 |
|
---|
1519 | FLeftScrolled:=0;
|
---|
1520 | FLeftExtent:=0;
|
---|
1521 | For T:=FFixedCols To FColCount-1 Do
|
---|
1522 | Begin
|
---|
1523 | If FLeftExtent>=NewPosition Then break;
|
---|
1524 | If FLeftExtent+Value>=MaxWidth Then break; {rest fits In Window}
|
---|
1525 | Inc(FLeftExtent,FColWidths^[T]);
|
---|
1526 | Inc(FLeftScrolled);
|
---|
1527 | End;
|
---|
1528 |
|
---|
1529 | Result:=FLeftExtent;
|
---|
1530 | End;
|
---|
1531 |
|
---|
1532 | Function TGrid.ScrollVertTrack(ScrollBar:TScrollBar;NewPosition:LongInt):LongInt;
|
---|
1533 | Var MaxWidth,MaxHeight,Value:LongInt;
|
---|
1534 | T:LongInt;
|
---|
1535 | Begin
|
---|
1536 | If NewPosition<0 Then NewPosition:=0;
|
---|
1537 | GetGridExtent(MaxWidth,MaxHeight);
|
---|
1538 | If NewPosition>MaxHeight Then NewPosition:=MaxHeight;
|
---|
1539 | Value:=Height;
|
---|
1540 | If FHorzScrollBar<>Nil Then If FHorzScrollBar.Visible Then Dec(Value,FHorzScrollBar.Height);
|
---|
1541 |
|
---|
1542 | FUpScrolled:=0;
|
---|
1543 | FUpExtent:=0;
|
---|
1544 | For T:=FFixedRows To FRowCount-1 Do
|
---|
1545 | Begin
|
---|
1546 | If FUpExtent>=NewPosition Then break;
|
---|
1547 | If FUpExtent+Value>=MaxHeight Then break; {rest fits In Window}
|
---|
1548 | Inc(FUpExtent,FRowHeights^[T]);
|
---|
1549 | Inc(FUpScrolled);
|
---|
1550 | End;
|
---|
1551 |
|
---|
1552 | Result:=FUpExtent;
|
---|
1553 | End;
|
---|
1554 | {$HINTS ON}
|
---|
1555 |
|
---|
1556 | Function TGrid.CellRect(Col,Row:LongInt):TRect;
|
---|
1557 | Var X,Y:LongInt;
|
---|
1558 | LeftCount,UpCount:LongInt;
|
---|
1559 | T,t1:LongInt;
|
---|
1560 | TheRowHeight:LongInt;
|
---|
1561 | TheColWidth:LongInt;
|
---|
1562 | DrawIt:Boolean;
|
---|
1563 | Begin
|
---|
1564 | FillChar(Result,SizeOf(TRect),0);
|
---|
1565 | If ((Row<0)Or(Row>FRowCount-1)Or(Col<0)Or(Col>FColCount-1)) Then Exit;
|
---|
1566 |
|
---|
1567 | If Options*[goBorder]<>[] Then X:=1
|
---|
1568 | Else X:=0;
|
---|
1569 | LeftCount:=1;
|
---|
1570 | For T:=0 To FColCount-1 Do
|
---|
1571 | Begin
|
---|
1572 | If Options*[goBorder]<>[] Then Y:=Height-1
|
---|
1573 | Else Y:=Height;
|
---|
1574 | TheColWidth:=FColWidths^[T];
|
---|
1575 | UpCount:=1;
|
---|
1576 | For t1:=0 To FRowCount-1 Do
|
---|
1577 | Begin
|
---|
1578 | If Y>0 Then
|
---|
1579 | Begin
|
---|
1580 | If ((T+1<=FFixedCols)And(t1+1<=FFixedRows)) Then DrawIt:=True {Ecke(N) links oben}
|
---|
1581 | Else
|
---|
1582 | Begin
|
---|
1583 | If ((T+1<=FFixedCols)And(UpCount>FUpScrolled)) Then DrawIt:=True
|
---|
1584 | Else If ((t1+1<=FFixedRows)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
|
---|
1585 | Else If ((UpCount>FUpScrolled)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
|
---|
1586 | Else DrawIt:=False;
|
---|
1587 | End;
|
---|
1588 |
|
---|
1589 | If DrawIt Then
|
---|
1590 | Begin
|
---|
1591 | TheRowHeight:=FRowHeights^[t1];
|
---|
1592 | If T=Col Then If t1=Row Then
|
---|
1593 | Begin
|
---|
1594 | Result.Left:=X+1;
|
---|
1595 | Result.Right:=X+TheColWidth;
|
---|
1596 | Result.Top:=Y;
|
---|
1597 | Result.Bottom:=(Y-TheRowHeight)+1;
|
---|
1598 | Exit;
|
---|
1599 | End;
|
---|
1600 | Dec(Y,TheRowHeight);
|
---|
1601 | End;
|
---|
1602 | End;
|
---|
1603 | If t1+1>FFixedRows Then Inc(UpCount); {Next Column}
|
---|
1604 | End;
|
---|
1605 | If ((T+1<=FFixedCols)Or(LeftCount>FLeftScrolled)) Then Inc(X,TheColWidth);
|
---|
1606 | If T+1>FFixedCols Then Inc(LeftCount); {Next Row}
|
---|
1607 | End;
|
---|
1608 | End;
|
---|
1609 |
|
---|
1610 |
|
---|
1611 | Function TGrid.GetSizeItem(Const pt:TPoint;Var Col,Row:LongInt):TCursor;
|
---|
1612 | Var T,t1:LongInt;
|
---|
1613 | LeftCount,UpCount:LongInt;
|
---|
1614 | DrawIt:Boolean;
|
---|
1615 | ColWidth,RowHeight:LongInt;
|
---|
1616 | X,Y:LongInt;
|
---|
1617 | Begin
|
---|
1618 | Result:=crDefault;
|
---|
1619 | If Options*[goBorder]<>[] Then X:=1
|
---|
1620 | Else X:=0;
|
---|
1621 | Col:=-1;
|
---|
1622 | Row:=-1;
|
---|
1623 |
|
---|
1624 | LeftCount:=1;
|
---|
1625 | For T:=0 To FColCount-1 Do
|
---|
1626 | Begin
|
---|
1627 | Col:=T;
|
---|
1628 | ColWidth:=FColWidths^[T];
|
---|
1629 | If Options*[goBorder]<>[] Then Y:=Height-1
|
---|
1630 | Else Y:=Height;
|
---|
1631 | UpCount:=1;
|
---|
1632 | If ((T+1<=FFixedCols)Or(LeftCount>FLeftScrolled)) Then Inc(X,ColWidth);
|
---|
1633 | If T+1>FFixedCols Then Inc(LeftCount); {Next Row}
|
---|
1634 | For t1:=0 To FRowCount-1 Do
|
---|
1635 | Begin
|
---|
1636 | If Y>0 Then
|
---|
1637 | Begin
|
---|
1638 | If ((T+1<=FFixedCols)And(t1+1<=FFixedRows)) Then DrawIt:=True {Ecke(N) links oben}
|
---|
1639 | Else
|
---|
1640 | Begin
|
---|
1641 | If ((T+1<=FFixedCols)And(UpCount>FUpScrolled)) Then DrawIt:=True
|
---|
1642 | Else If ((t1+1<=FFixedRows)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
|
---|
1643 | Else If ((UpCount>FUpScrolled)And(LeftCount>FLeftScrolled)) Then DrawIt:=True
|
---|
1644 | Else DrawIt:=False;
|
---|
1645 | End;
|
---|
1646 |
|
---|
1647 | If DrawIt Then
|
---|
1648 | Begin
|
---|
1649 | Row:=t1;
|
---|
1650 | RowHeight:=FRowHeights^[t1];
|
---|
1651 | Dec(Y,RowHeight);
|
---|
1652 |
|
---|
1653 | If ((Options*[goRowSizing]<>[])Or(Designed)) Then
|
---|
1654 | Begin
|
---|
1655 | If ((pt.Y>=Y-1)And(pt.Y<=Y+1)And(pt.X<X)And(pt.X>X-ColWidth)And
|
---|
1656 | (T+1<=FFixedCols)) Then
|
---|
1657 | Begin
|
---|
1658 | Result:=crVSplit;
|
---|
1659 | Exit;
|
---|
1660 | End;
|
---|
1661 | End;
|
---|
1662 |
|
---|
1663 | If ((Options*[goColSizing]<>[])Or(Designed)) Then
|
---|
1664 | Begin
|
---|
1665 | If ((pt.X>=X-1)And(pt.X<=X+1)And(pt.Y>Y)And(pt.Y<Y+RowHeight)And
|
---|
1666 | (t1+1<=FFixedRows)) Then
|
---|
1667 | Begin
|
---|
1668 | Result:=crHSplit;
|
---|
1669 | Inc(Y,RowHeight);
|
---|
1670 | Exit;
|
---|
1671 | End;
|
---|
1672 | End;
|
---|
1673 |
|
---|
1674 | If ((pt.Y>=Y+1)And(pt.Y<=Y+(RowHeight-1))And(pt.X>=X-(ColWidth-1))And(pt.X<=X-1)) Then
|
---|
1675 | If ((T+1>FFixedCols)And(t1+1>FFixedRows)) Then {FIXED entries cannot be Selected}
|
---|
1676 | Begin
|
---|
1677 | {entry Focused}
|
---|
1678 | Exit;
|
---|
1679 | End;
|
---|
1680 | End; {If DrawIt}
|
---|
1681 | If t1+1>FFixedRows Then Inc(UpCount); {Next Column}
|
---|
1682 | End;
|
---|
1683 | End;
|
---|
1684 | End;
|
---|
1685 |
|
---|
1686 | Col:=-1;
|
---|
1687 | Row:=-1;
|
---|
1688 | End;
|
---|
1689 |
|
---|
1690 |
|
---|
1691 | {$HINTS OFF}
|
---|
1692 | Procedure TGrid.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
|
---|
1693 | Var
|
---|
1694 | Row:LongInt;
|
---|
1695 | Col:LongInt;
|
---|
1696 | Shape:TCursor;
|
---|
1697 | X1,y1:LongInt;
|
---|
1698 | Begin
|
---|
1699 | Inherited MouseMove(ShiftState,X,Y);
|
---|
1700 |
|
---|
1701 | If FSizeShape<>crDefault Then {Sizing}
|
---|
1702 | Begin
|
---|
1703 | LastMsg.Handled:=True;
|
---|
1704 | Canvas.Pen.Mode:=pmNot;
|
---|
1705 | Canvas.Pen.color:=clBlack;
|
---|
1706 | {Delete old rubberline}
|
---|
1707 | If FSizeShape=crVSplit Then Canvas.Line(0,FSizeY,Width,FSizeY)
|
---|
1708 | Else Canvas.Line(FSizeX,0,FSizeX,Height);
|
---|
1709 | {Draw New Line}
|
---|
1710 | FSizeX:=X;
|
---|
1711 | If FSizeX<=FSizeStartX+5 Then FSizeX:=FSizeStartX+5;
|
---|
1712 | If FSizeX>=Width-5 Then FSizeX:=Width-5;
|
---|
1713 | FSizeY:=Y;
|
---|
1714 | If FSizeY>=FSizeStartY-5 Then FSizeY:=FSizeStartY-5;
|
---|
1715 | If FSizeY<=5 Then FSizeY:=5;
|
---|
1716 | If FSizeShape=crVSplit Then Canvas.Line(0,FSizeY,Width,FSizeY)
|
---|
1717 | Else Canvas.Line(FSizeX,0,FSizeX,Height);
|
---|
1718 | Canvas.Pen.Mode:=pmCopy;
|
---|
1719 | Exit;
|
---|
1720 | End;
|
---|
1721 |
|
---|
1722 | Shape:=GetSizeItem(Point(X,Y),Col,Row);
|
---|
1723 | {$IFDEF OS2}
|
---|
1724 | WinSetPointer(HWND_DESKTOP,Screen.Cursors[Shape]);
|
---|
1725 | {$ENDIF}
|
---|
1726 | {$IFDEF Win95}
|
---|
1727 | SetClassWord(Handle,-12{GCW_HCURSOR},0);
|
---|
1728 | SetCursor(Screen.Cursors[Shape]);
|
---|
1729 | {$ENDIF}
|
---|
1730 | If Shape<>crDefault Then LastMsg.Handled:=True; {dont pass To Form Editor}
|
---|
1731 | End;
|
---|
1732 |
|
---|
1733 | Procedure TGrid.RowHeightChanged(Row:LongInt);
|
---|
1734 | Begin
|
---|
1735 | End;
|
---|
1736 |
|
---|
1737 | Procedure TGrid.ColWidthChanged(Col:LongInt);
|
---|
1738 | Begin
|
---|
1739 | End;
|
---|
1740 |
|
---|
1741 | Procedure TGrid.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
|
---|
1742 | Var Row:LongInt;
|
---|
1743 | Col:LongInt;
|
---|
1744 | Shape:TCursor;
|
---|
1745 | Begin
|
---|
1746 | Inherited MouseDown(Button,ShiftState,X,Y);
|
---|
1747 |
|
---|
1748 | If Button <> mbLeft Then Exit;
|
---|
1749 | Focus;
|
---|
1750 |
|
---|
1751 | Shape:=GetSizeItem(Point(X,Y),Col,Row);
|
---|
1752 | {$IFDEF OS2}
|
---|
1753 | WinSetPointer(HWND_DESKTOP,Screen.Cursors[Shape]);
|
---|
1754 | {$ENDIF}
|
---|
1755 | {$IFDEF Win95}
|
---|
1756 | SetClassWord(Handle,-12{GCW_HCURSOR},0);
|
---|
1757 | SetCursor(Screen.Cursors[Shape]);
|
---|
1758 | {$ENDIF}
|
---|
1759 | If Shape<>crDefault Then
|
---|
1760 | Begin
|
---|
1761 | LastMsg.Handled:=True; {dont pass To Form Editor}
|
---|
1762 | Canvas.Pen.Mode:=pmNot;
|
---|
1763 | Canvas.Pen.color:=clBlack;
|
---|
1764 | FSizeCol:=Col;
|
---|
1765 | FSizeRow:=Row;
|
---|
1766 | FSizeShape:=Shape;
|
---|
1767 | FSizeStartX:=X-FColWidths^[Col];
|
---|
1768 | FSizeStartY:=Y+FRowHeights^[Row];
|
---|
1769 | FSizeX:=X;
|
---|
1770 | FSizeY:=Y;
|
---|
1771 | If FSizeShape=crVSplit Then Canvas.Line(0,FSizeY,Width,FSizeY)
|
---|
1772 | Else Canvas.Line(FSizeX,0,FSizeX,Height);
|
---|
1773 | MouseCapture:=True;
|
---|
1774 | Canvas.Pen.Mode:=pmCopy;
|
---|
1775 | //ClearFocus;
|
---|
1776 | End
|
---|
1777 | Else
|
---|
1778 | Begin
|
---|
1779 | If Designed Then Exit;
|
---|
1780 |
|
---|
1781 | If ((Row<>-1)And(Col<>-1)) Then
|
---|
1782 | If Options*[goMouseSelect]<>[] Then
|
---|
1783 | Begin
|
---|
1784 | {entry Focused}
|
---|
1785 | If Not SelectCell(Col,Row) Then Exit;
|
---|
1786 | If OnSelectCell<>Nil Then OnSelectCell(Self,Col,Row);
|
---|
1787 | End;
|
---|
1788 | //Else ClearFocus;
|
---|
1789 | End;
|
---|
1790 | End;
|
---|
1791 |
|
---|
1792 | Procedure TGrid.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
|
---|
1793 | Var T:LongInt;
|
---|
1794 | Col:LongInt;
|
---|
1795 | Row:LongInt;
|
---|
1796 | DNS:TDesignerNotifyStruct;
|
---|
1797 | Begin
|
---|
1798 | Inherited MouseUp(Button,ShiftState,X,Y);
|
---|
1799 |
|
---|
1800 | If Button <> mbLeft Then Exit;
|
---|
1801 |
|
---|
1802 | If FSizeShape<>crDefault Then
|
---|
1803 | Begin
|
---|
1804 | LastMsg.Handled:=True; {dont pass To Form Editor}
|
---|
1805 | Canvas.Pen.Mode:=pmNot;
|
---|
1806 | Canvas.Pen.color:=clBlack;
|
---|
1807 | {Delete old rubberline}
|
---|
1808 | If FSizeShape=crVSplit Then Canvas.Line(0,FSizeY,Width,FSizeY)
|
---|
1809 | Else Canvas.Line(FSizeX,0,FSizeX,Height);
|
---|
1810 | MouseCapture:=False;
|
---|
1811 | Canvas.Pen.Mode:=pmCopy;
|
---|
1812 |
|
---|
1813 | If FSizeX<=FSizeStartX+5 Then FSizeX:=FSizeStartX+5;
|
---|
1814 | If FSizeY>=FSizeStartY-5 Then FSizeY:=FSizeStartY-5;
|
---|
1815 |
|
---|
1816 | FSizeX:=FSizeX-FSizeStartX;
|
---|
1817 | FSizeY:=FSizeStartY-FSizeY;
|
---|
1818 |
|
---|
1819 | If FSizeShape=crVSplit Then
|
---|
1820 | Begin
|
---|
1821 | {Row Height Sizing}
|
---|
1822 | FRowHeights^[FSizeRow]:=FSizeY;
|
---|
1823 | RowHeightChanged(FSizeRow);
|
---|
1824 | End
|
---|
1825 | Else
|
---|
1826 | Begin
|
---|
1827 | {Column Width Sizing}
|
---|
1828 | FColWidths^[FSizeCol]:=FSizeX;
|
---|
1829 | ColWidthChanged(FSizeCol);
|
---|
1830 | End;
|
---|
1831 |
|
---|
1832 | DNS.Sender := Self;
|
---|
1833 | DNS.Code := dncSCUModified;
|
---|
1834 | DNS.return := 0;
|
---|
1835 | DesignerNotification(DNS);
|
---|
1836 |
|
---|
1837 | FSizeShape:=crDefault;
|
---|
1838 | UpdateScrollBars;
|
---|
1839 | Invalidate;
|
---|
1840 | End;
|
---|
1841 | End;
|
---|
1842 |
|
---|
1843 | Function TGrid.GetSelection:TGridRect;
|
---|
1844 | Begin
|
---|
1845 | Result.Left:=Col;
|
---|
1846 | Result.Top:=Row;
|
---|
1847 |
|
---|
1848 | //we only Do support Single Selection For now...
|
---|
1849 | Result.Right:=Result.Left;
|
---|
1850 | Result.Bottom:=Result.Top;
|
---|
1851 | End;
|
---|
1852 |
|
---|
1853 | Procedure TGrid.SetSelection(NewValue:TGridRect);
|
---|
1854 | Begin
|
---|
1855 | //we only Do support Single Selection For now...
|
---|
1856 | SelectCell(NewValue.Left,NewValue.Top);
|
---|
1857 | End;
|
---|
1858 |
|
---|
1859 | Function TGrid.SelectCell(Col,Row:LongInt):Boolean;
|
---|
1860 | Var rc:TRect;
|
---|
1861 | T:LongInt;
|
---|
1862 | Count:LongInt;
|
---|
1863 | ActualCol,ActualRow:LongInt;
|
---|
1864 | DoRefresh:Boolean;
|
---|
1865 |
|
---|
1866 | Function ColMatch:Boolean;
|
---|
1867 | Var T:LongInt;
|
---|
1868 | X:LongInt;
|
---|
1869 | MaxWidth:LongInt;
|
---|
1870 | Begin
|
---|
1871 | Result:=False;
|
---|
1872 | X:=0;
|
---|
1873 | MaxWidth:=Width;
|
---|
1874 | If FVertScrollBar<>Nil Then
|
---|
1875 | If FVertScrollBar.Visible Then Dec(MaxWidth,FVertScrollBar.Width);
|
---|
1876 | For T:=0 To FFixedCols-1 Do Inc(X,FColWidths^[T]);
|
---|
1877 | For T:=Count To Col Do
|
---|
1878 | Begin
|
---|
1879 | Inc(X,FColWidths^[T]);
|
---|
1880 | If X>=MaxWidth Then If T<>Col Then Exit;
|
---|
1881 | End;
|
---|
1882 | Result:=True;
|
---|
1883 | End;
|
---|
1884 |
|
---|
1885 | Function RowMatch:Boolean;
|
---|
1886 | Var T:LongInt;
|
---|
1887 | Y:LongInt;
|
---|
1888 | MinHeight:LongInt;
|
---|
1889 | Begin
|
---|
1890 | Result:=False;
|
---|
1891 | Y:=Height;
|
---|
1892 | MinHeight:=0;
|
---|
1893 | If FHorzScrollBar<>Nil Then
|
---|
1894 | If FHorzScrollBar.Visible Then Inc(MinHeight,FHorzScrollBar.Height);
|
---|
1895 | For T:=0 To FFixedRows-1 Do Dec(Y,FRowHeights^[T]);
|
---|
1896 | For T:=Count To Row Do
|
---|
1897 | Begin
|
---|
1898 | Dec(Y,FRowHeights^[T]);
|
---|
1899 | If Y<=MinHeight Then If T<>Row Then Exit;
|
---|
1900 | End;
|
---|
1901 | Result:=True;
|
---|
1902 | End;
|
---|
1903 |
|
---|
1904 | Begin
|
---|
1905 | Result:=True;
|
---|
1906 | If ((Col<0)Or(Col>FColCount)Or(Col<FFixedCols)Or
|
---|
1907 | (Row<0)Or(Row>FRowCount)Or(Row<FFixedRows)) Then Exit;
|
---|
1908 |
|
---|
1909 | If ((Col=FSelectCol)And(Row=FSelectRow)) Then Exit;
|
---|
1910 |
|
---|
1911 | If ((FSelectCol>=0)And(FSelectRow>=0)) Then
|
---|
1912 | Begin
|
---|
1913 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
1914 | If Options*[goShowSelection]<>[] Then InvalidateRect(rc);
|
---|
1915 | End;
|
---|
1916 |
|
---|
1917 | FSelectCol:=Col;
|
---|
1918 | FSelectRow:=Row;
|
---|
1919 | DoRefresh:=False;
|
---|
1920 |
|
---|
1921 | If Col>FLeftScrolled+VisibleColCount-FFixedCols Then
|
---|
1922 | Begin
|
---|
1923 | T:=FLeftExtent;
|
---|
1924 | Count:=FLeftScrolled+FFixedCols;
|
---|
1925 | Repeat
|
---|
1926 | Inc(T,FColWidths^[Count]);
|
---|
1927 | Inc(Count);
|
---|
1928 | Until ColMatch;
|
---|
1929 |
|
---|
1930 | If FHorzScrollBar<>Nil Then
|
---|
1931 | Begin
|
---|
1932 | FHorzScrollBar.Position:=ScrollHorzTrack(FHorzScrollBar,T);
|
---|
1933 | FHorzScrollBar.Update;
|
---|
1934 | End;
|
---|
1935 | DoRefresh:=True;
|
---|
1936 | End
|
---|
1937 | Else If Col<FLeftScrolled+FFixedCols Then
|
---|
1938 | Begin
|
---|
1939 | T:=FLeftExtent;
|
---|
1940 | Count:=FLeftScrolled;
|
---|
1941 | While Count>Col-FFixedCols Do
|
---|
1942 | Begin
|
---|
1943 | Dec(T,FColWidths^[Count+FFixedCols-1]);
|
---|
1944 | Dec(Count);
|
---|
1945 | End;
|
---|
1946 |
|
---|
1947 | If FHorzScrollBar<>Nil Then
|
---|
1948 | Begin
|
---|
1949 | FHorzScrollBar.Position:=ScrollHorzTrack(FHorzScrollBar,T);
|
---|
1950 | FHorzScrollBar.Update;
|
---|
1951 | End;
|
---|
1952 | DoRefresh:=True;
|
---|
1953 | End;
|
---|
1954 |
|
---|
1955 | If Row>FUpScrolled+VisibleRowCount-FFixedRows Then
|
---|
1956 | Begin
|
---|
1957 | T:=FUpExtent;
|
---|
1958 | Count:=FUpScrolled+FFixedRows;
|
---|
1959 | Repeat
|
---|
1960 | Inc(T,FRowHeights^[Count]);
|
---|
1961 | Inc(Count);
|
---|
1962 | Until RowMatch;
|
---|
1963 |
|
---|
1964 | If FVertScrollBar<>Nil Then
|
---|
1965 | Begin
|
---|
1966 | FVertScrollBar.Position:=ScrollVertTrack(FVertScrollBar,T);
|
---|
1967 | FVertScrollBar.Update;
|
---|
1968 | End;
|
---|
1969 | DoRefresh:=True;
|
---|
1970 | End
|
---|
1971 | Else If Row<FUpScrolled+FFixedRows Then
|
---|
1972 | Begin
|
---|
1973 | T:=FUpExtent;
|
---|
1974 | Count:=FUpScrolled;
|
---|
1975 | While Count>Row-FFixedRows Do
|
---|
1976 | Begin
|
---|
1977 | Dec(T,FRowHeights^[Count+FFixedRows-1]);
|
---|
1978 | Dec(Count);
|
---|
1979 | End;
|
---|
1980 |
|
---|
1981 | If FVertScrollBar<>Nil Then
|
---|
1982 | Begin
|
---|
1983 | FVertScrollBar.Position:=ScrollVertTrack(FVertScrollBar,T);
|
---|
1984 | FVertScrollBar.Update;
|
---|
1985 | End;
|
---|
1986 | DoRefresh:=True;
|
---|
1987 | End;
|
---|
1988 |
|
---|
1989 | If ((FSelectCol>=0)And(FSelectRow>=0)) Then
|
---|
1990 | Begin
|
---|
1991 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
1992 | If Options*[goShowSelection]<>[] Then InvalidateRect(rc);
|
---|
1993 | End;
|
---|
1994 |
|
---|
1995 | If DoRefresh Then Refresh
|
---|
1996 | Else Update;
|
---|
1997 | End;
|
---|
1998 |
|
---|
1999 | Procedure TGrid.SetUpdateLocked(NewValue:Boolean);
|
---|
2000 | Begin
|
---|
2001 | If NewValue=FGridUpdateLocked Then Exit;
|
---|
2002 | FGridUpdateLocked:=NewValue;
|
---|
2003 | If Not FGridUpdateLocked Then If Handle<>0 Then Invalidate;
|
---|
2004 | End;
|
---|
2005 |
|
---|
2006 | Procedure TGrid.SetCol(NewValue:LongInt);
|
---|
2007 | Begin
|
---|
2008 | If ((NewValue>=0)And(NewValue<FColCount)And(NewValue<>FSelectCol)) Then
|
---|
2009 | Begin
|
---|
2010 | If ((FSelectRow>=0)And(FSelectRow<FRowCount)) Then
|
---|
2011 | Begin
|
---|
2012 | If Not SelectCell(NewValue,FSelectRow) Then Exit;
|
---|
2013 | If OnSelectCell<>Nil Then OnSelectCell(Self,NewValue,FSelectRow);
|
---|
2014 | End
|
---|
2015 | Else FSelectCol:=NewValue;
|
---|
2016 | End;
|
---|
2017 | End;
|
---|
2018 |
|
---|
2019 | Procedure TGrid.SetRow(NewValue:LongInt);
|
---|
2020 | Begin
|
---|
2021 | If ((NewValue>=0)And(NewValue<FRowCount)And(NewValue<>FSelectRow)) Then
|
---|
2022 | Begin
|
---|
2023 | If ((FSelectCol>=0)And(FSelectCol<FColCount)) Then
|
---|
2024 | Begin
|
---|
2025 | If Not SelectCell(FSelectCol,NewValue) Then Exit;
|
---|
2026 | If OnSelectCell<>Nil Then OnSelectCell(Self,FSelectCol,NewValue);
|
---|
2027 | End
|
---|
2028 | Else FSelectRow:=NewValue;
|
---|
2029 | End;
|
---|
2030 | End;
|
---|
2031 |
|
---|
2032 | Procedure TGrid.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
|
---|
2033 | Var Visible:LongInt;
|
---|
2034 | Begin
|
---|
2035 | If ((FSelectCol>=0)And(FSelectRow>=0)) Then
|
---|
2036 | Begin
|
---|
2037 | Case KeyCode Of
|
---|
2038 | kbCLeft:If Col>FFixedCols Then Col:=Col-1;
|
---|
2039 | kbCRight:If Col<FColCount-1 Then Col:=Col+1;
|
---|
2040 | kbCUp:If Row>FFixedRows Then Row:=Row-1;
|
---|
2041 | kbCDown:If Row<FRowCount-1 Then Row:=Row+1;
|
---|
2042 | kbPageDown:
|
---|
2043 | Begin
|
---|
2044 | Visible:=VisibleRowCount;
|
---|
2045 | If FSelectRow+Visible<FRowCount-1 Then Row:=FSelectRow+Visible
|
---|
2046 | Else Row:=FRowCount-1;
|
---|
2047 | End;
|
---|
2048 | kbPageUp:
|
---|
2049 | Begin
|
---|
2050 | Visible:=VisibleRowCount;
|
---|
2051 | If FSelectRow-FFixedRows>Visible Then Row:=FSelectRow-Visible
|
---|
2052 | Else Row:=FFixedRows;
|
---|
2053 | End;
|
---|
2054 | Else Inherited ScanEvent(KeyCode,RepeatCount);
|
---|
2055 | End;
|
---|
2056 | End
|
---|
2057 | Else Inherited ScanEvent(KeyCode,RepeatCount);
|
---|
2058 | End;
|
---|
2059 |
|
---|
2060 | {
|
---|
2061 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
2062 | º º
|
---|
2063 | º Speed-Pascal/2 Version 2.0 º
|
---|
2064 | º º
|
---|
2065 | º Speed-Pascal Component Classes (SPCC) º
|
---|
2066 | º º
|
---|
2067 | º This section: TStringGrid Class Implementation º
|
---|
2068 | º º
|
---|
2069 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
2070 | º º
|
---|
2071 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
2072 | }
|
---|
2073 |
|
---|
2074 |
|
---|
2075 | Procedure TStringGrid.SetupCellDrawing(Col,Row:LongInt;AState:TGridDrawState;
|
---|
2076 | Var Alignment:TAlignment;Var Font:TFont);
|
---|
2077 | Begin
|
---|
2078 | Alignment:=taLeftJustify;
|
---|
2079 | Font:=Self.Font;
|
---|
2080 | End;
|
---|
2081 |
|
---|
2082 |
|
---|
2083 | Procedure TStringGrid.DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);
|
---|
2084 | Var
|
---|
2085 | X,Y:LongInt;
|
---|
2086 | S:String;
|
---|
2087 | OldClip:TRect;
|
---|
2088 | Exclude:TRect;
|
---|
2089 | CX,CY:LongInt;
|
---|
2090 | Alignment:TAlignment;
|
---|
2091 | TheFont,OldFont:TFont;
|
---|
2092 | Begin
|
---|
2093 | If ((FEdit<>Nil)And(FEdit.Control.Visible)) Then AState:=AState-[gdSelected,gdFocused];
|
---|
2094 | SetCellColors(Col,Row,AState);
|
---|
2095 | SetupCellDrawing(Col,Row,AState,Alignment,TheFont);
|
---|
2096 |
|
---|
2097 | If TheFont<>Canvas.Font Then
|
---|
2098 | Begin
|
---|
2099 | OldFont:=Canvas.Font;
|
---|
2100 | Canvas.Font:=TheFont;
|
---|
2101 | End
|
---|
2102 | Else OldFont:=Nil;
|
---|
2103 |
|
---|
2104 | S:=Cells[Col,Row];
|
---|
2105 | X:=rec.Left+2;
|
---|
2106 | Y:=rec.Top-2-Canvas.Font.Height;
|
---|
2107 |
|
---|
2108 | Canvas.GetTextExtent(S,CX,CY);
|
---|
2109 |
|
---|
2110 | Case Alignment Of
|
---|
2111 | taLeftJustify:;
|
---|
2112 | taRightJustify:If CX<(rec.Right-rec.Left)-2 Then X:=rec.Right-2-CX;
|
---|
2113 | taCenter:If CX<(rec.Right-rec.Left)-2 Then X:=(((rec.Right-rec.Left)-2)-CX) Div 2;
|
---|
2114 | End; {Case}
|
---|
2115 |
|
---|
2116 | Canvas.TextOut(X,Y,S);
|
---|
2117 | OldClip:=Canvas.ClipRect;
|
---|
2118 |
|
---|
2119 | Exclude.Left:=X;
|
---|
2120 | Exclude.Right:=X+CX;
|
---|
2121 | {$IFDEF OS2}
|
---|
2122 | dec(Exclude.Right);
|
---|
2123 | {$ENDIF}
|
---|
2124 | Exclude.Bottom:=Y;
|
---|
2125 | Exclude.Top:=Y+CY-1;
|
---|
2126 | Canvas.ClipRect:=rec;
|
---|
2127 | Canvas.ExcludeClipRect(Exclude);
|
---|
2128 | Inherited DrawCell(Col,Row,rec,AState);
|
---|
2129 | Canvas.ClipRect:=OldClip;
|
---|
2130 |
|
---|
2131 | If OldFont<>Nil Then Canvas.Font:=OldFont;
|
---|
2132 | End;
|
---|
2133 |
|
---|
2134 | {$HINTS OFF}
|
---|
2135 | Procedure TStringGrid.EvEntryKillFocus(Sender:TObject);
|
---|
2136 | Begin
|
---|
2137 | ClearFocus;
|
---|
2138 | End;
|
---|
2139 | {$HINTS ON}
|
---|
2140 |
|
---|
2141 |
|
---|
2142 | Function TStringGrid.SelectCell(Col,Row:LongInt):Boolean;
|
---|
2143 | Var rc:TRect;
|
---|
2144 | Ok:Boolean;
|
---|
2145 | Label L;
|
---|
2146 | Begin
|
---|
2147 | Result:=True;
|
---|
2148 | If ((FOptions*[goEditing]<>[])And(FOptions*[goAlwaysShowEditor]<>[])) Then
|
---|
2149 | Begin
|
---|
2150 | L:
|
---|
2151 | If ((FSelectCol>=0)And(FSelectRow>=0)And(FEdit<>Nil)And(FEdit.Control.Visible)And
|
---|
2152 | (FEdit.Text<>Cells[FSelectCol,FSelectRow])) Then
|
---|
2153 | Begin
|
---|
2154 | If ((FSelectCol=Col)And(FSelectRow=Row)) Then Exit;
|
---|
2155 |
|
---|
2156 | Try
|
---|
2157 | If OnSetEditText<>Nil Then OnSetEditText(Self,FSelectCol,FSelectRow,FEdit.Text);
|
---|
2158 | Cells[FSelectCol,FSelectRow]:=FEdit.Text;
|
---|
2159 | Except
|
---|
2160 | ON E:ESQLError Do ErrorBox(E.Message);
|
---|
2161 | Else Raise;
|
---|
2162 | End;
|
---|
2163 | End;
|
---|
2164 |
|
---|
2165 | If ((FSelectCol=Col)And(FSelectRow=Row)And
|
---|
2166 | (FEdit<>Nil)And(FEdit.Control.Visible)) Then Exit;
|
---|
2167 |
|
---|
2168 | If FOptions*[goAlwaysShowEditor]<>[] Then Inherited SelectCell(Col,Row);
|
---|
2169 |
|
---|
2170 | ShowEntry(Cells[FSelectCol,FSelectRow]);
|
---|
2171 |
|
---|
2172 | If FOptions*[goAlwaysShowEditor]=[] Then
|
---|
2173 | Begin
|
---|
2174 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
2175 | InvalidateRect(rc);
|
---|
2176 | Update;
|
---|
2177 | End;
|
---|
2178 | End
|
---|
2179 | Else
|
---|
2180 | Begin
|
---|
2181 | If ((FSelectCol=Col)And(FSelectRow=Row)And(FOptions*[goEditing]<>[])) Then
|
---|
2182 | Begin
|
---|
2183 | Ok:=True;
|
---|
2184 | If OnCanEdit<>Nil Then OnCanEdit(Self,Col,Row,Ok);
|
---|
2185 | If Ok Then Goto L;
|
---|
2186 | End;
|
---|
2187 |
|
---|
2188 | If ((Col<>FSelectCol)Or(Row<>FSelectRow)) Then
|
---|
2189 | If ((FSelectCol>=0)And(FSelectRow>=0)) Then
|
---|
2190 | Begin
|
---|
2191 | HideEditorIntern;
|
---|
2192 | End;
|
---|
2193 | Inherited SelectCell(Col,Row);
|
---|
2194 | End;
|
---|
2195 | End;
|
---|
2196 |
|
---|
2197 | Procedure TStringGrid.SetCell(Col,Row:LongInt;Const NewContent:String);
|
---|
2198 | Var Rows:TList;
|
---|
2199 | ps:PString;
|
---|
2200 | T:LongInt;
|
---|
2201 | NewValue:String;
|
---|
2202 | Begin
|
---|
2203 | If ((Row<0)Or(Row>FRowCount-1)Or(Col<0)Or(Col>FColCount-1)) Then Exit;
|
---|
2204 |
|
---|
2205 | {entry exists}
|
---|
2206 | If FColumns=Nil Then FColumns.Create;
|
---|
2207 | For T:=0 To Col-FColumns.Count Do //Append Columns
|
---|
2208 | Begin
|
---|
2209 | Rows.Create;
|
---|
2210 | FColumns.Add(Rows);
|
---|
2211 | End;
|
---|
2212 |
|
---|
2213 | Rows:=FColumns.Items[Col];
|
---|
2214 | If Rows=Nil Then
|
---|
2215 | Begin
|
---|
2216 | Rows.Create;
|
---|
2217 | FColumns.Items[Col]:=Rows;
|
---|
2218 | End;
|
---|
2219 |
|
---|
2220 | For T:=0 To Row-Rows.Count Do Rows.Add(Nil); //Append Rows ??
|
---|
2221 |
|
---|
2222 | NewValue:=NewContent;
|
---|
2223 | If OnSetCell<>Nil Then OnSetCell(Self,Col,Row,NewValue);
|
---|
2224 |
|
---|
2225 | ps:=Rows.Items[Row];
|
---|
2226 | If ps<>Nil Then FreeMem(ps,Length(ps^)+1);
|
---|
2227 |
|
---|
2228 | If NewValue='' Then ps:=Nil
|
---|
2229 | Else
|
---|
2230 | Begin
|
---|
2231 | GetMem(ps,Length(NewValue)+1);
|
---|
2232 | ps^:=NewValue;
|
---|
2233 | End;
|
---|
2234 | Rows.Items[Row]:=ps;
|
---|
2235 | End;
|
---|
2236 |
|
---|
2237 | Function TStringGrid.GetCell(Col,Row:LongInt):String;
|
---|
2238 | Var Rows:TList;
|
---|
2239 | ps:PString;
|
---|
2240 | Begin
|
---|
2241 | Result:='';
|
---|
2242 | If ((Row<0)Or(Row>FRowCount-1)Or(Col<0)Or(Col>FColCount-1)) Then Exit;
|
---|
2243 |
|
---|
2244 | {entry exists}
|
---|
2245 | If FColumns<>Nil Then
|
---|
2246 | If Col<=FColumns.Count-1 Then //Not Assigned
|
---|
2247 | Begin
|
---|
2248 | Rows:=FColumns.Items[Col];
|
---|
2249 | If Rows<>Nil Then
|
---|
2250 | Begin
|
---|
2251 | If Row<=Rows.Count-1 Then //Not Assigned
|
---|
2252 | Begin
|
---|
2253 | ps:=Rows.Items[Row];
|
---|
2254 | If ps=Nil Then Result:=''
|
---|
2255 | Else Result:=ps^;
|
---|
2256 | End;
|
---|
2257 | End;
|
---|
2258 | End;
|
---|
2259 | If OnGetCell<>Nil Then OnGetCell(Self,Col,Row,Result);
|
---|
2260 | End;
|
---|
2261 |
|
---|
2262 | Procedure TStringGrid.SetupComponent;
|
---|
2263 | Begin
|
---|
2264 | Inherited SetupComponent;
|
---|
2265 |
|
---|
2266 | Name:='StringGrid';
|
---|
2267 | End;
|
---|
2268 |
|
---|
2269 | Destructor TStringGrid.Destroy;
|
---|
2270 | Var T,t1:LongInt;
|
---|
2271 | Rows:TList;
|
---|
2272 | ps:PString;
|
---|
2273 | Begin
|
---|
2274 | //Destroy Columns/Rows that had been Assigned
|
---|
2275 | If FEdit<>Nil Then FEdit.Destroy;
|
---|
2276 | FEdit := Nil;
|
---|
2277 | If FColumns<>Nil Then
|
---|
2278 | Begin
|
---|
2279 | For T:=0 To FColumns.Count-1 Do
|
---|
2280 | Begin
|
---|
2281 | Rows:=FColumns.Items[T];
|
---|
2282 | If Rows<>Nil Then
|
---|
2283 | Begin
|
---|
2284 | For t1:=0 To Rows.Count-1 Do
|
---|
2285 | Begin
|
---|
2286 | ps:=Rows.Items[t1];
|
---|
2287 | If ps<>Nil Then FreeMem(ps,Length(ps^)+1);
|
---|
2288 | End;
|
---|
2289 | Rows.Destroy;
|
---|
2290 | End;
|
---|
2291 | End;
|
---|
2292 | FColumns.Destroy;
|
---|
2293 | FColumns := Nil;
|
---|
2294 | End;
|
---|
2295 |
|
---|
2296 | Inherited Destroy;
|
---|
2297 | End;
|
---|
2298 |
|
---|
2299 | Procedure TStringGrid.ClearFocus;
|
---|
2300 | Var rc:TRect;
|
---|
2301 | S:String;
|
---|
2302 | Begin
|
---|
2303 | If ((FSelectCol>=0)And(FSelectRow>=0)And(FEdit<>Nil)And(FEdit.Control.Visible)) Then
|
---|
2304 | Begin
|
---|
2305 | Try
|
---|
2306 | If FEdit.Text<>Cells[FSelectCol,FSelectRow] Then
|
---|
2307 | Begin
|
---|
2308 | If OnSetEditText<>Nil Then OnSetEditText(Self,FSelectCol,FSelectRow,FEdit.Text);
|
---|
2309 | Cells[FSelectCol,FSelectRow]:=FEdit.Text;
|
---|
2310 | End;
|
---|
2311 | Except
|
---|
2312 | ON E:ESQLError Do
|
---|
2313 | Begin
|
---|
2314 | s:=Cells[FSelectCol,FSelectRow];
|
---|
2315 | If OnGetEditText<>Nil Then OnGetEditText(Self,FSelectCol,FSelectRow,s);
|
---|
2316 | FEdit.Text:=s;
|
---|
2317 | ErrorBox(E.Message);
|
---|
2318 | End;
|
---|
2319 | Else Raise;
|
---|
2320 | End;
|
---|
2321 |
|
---|
2322 | FEdit.Hide;
|
---|
2323 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
2324 | InvalidateRect(rc);
|
---|
2325 | Update;
|
---|
2326 | End;
|
---|
2327 |
|
---|
2328 | Inherited ClearFocus;
|
---|
2329 | End;
|
---|
2330 |
|
---|
2331 | Procedure TStringGrid.ShowEntry(S:String);
|
---|
2332 | Var rc:TRect;
|
---|
2333 | W,H:LongInt;
|
---|
2334 | back,Fore:TColor;
|
---|
2335 | Control:TControl;
|
---|
2336 | FEditClass:TInplaceEditClass;
|
---|
2337 | EditMask:String;
|
---|
2338 | Begin
|
---|
2339 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
2340 | Inc(rc.Left);
|
---|
2341 | Dec(rc.Top,3);
|
---|
2342 | Dec(rc.Right);
|
---|
2343 | Inc(rc.Bottom,2);
|
---|
2344 |
|
---|
2345 | FEditClass:=ShowEditor(FSelectCol,FSelectRow);
|
---|
2346 | If FEditClass=Nil Then FEditClass:=TDefaultEdit;
|
---|
2347 |
|
---|
2348 | If ((FEdit<>Nil)And(FEditClass<>FEdit.ClassType)) Then
|
---|
2349 | Begin
|
---|
2350 | Focus; //FEdit darf beim Destroy nicht den Fokus haben
|
---|
2351 | FEdit.Hide;
|
---|
2352 | FEdit.Destroy;
|
---|
2353 | FEdit:=Nil;
|
---|
2354 | End;
|
---|
2355 |
|
---|
2356 | If FEdit=Nil Then FEdit:=FEditClass.Create(Self,FSelectCol,FSelectRow)
|
---|
2357 | Else
|
---|
2358 | Begin
|
---|
2359 | FEdit.Hide;
|
---|
2360 | FEdit.FCol:=FSelectCol;
|
---|
2361 | FEdit.FRow:=FSelectRow;
|
---|
2362 | Focus;
|
---|
2363 | FEdit.SetupEdit(Self);
|
---|
2364 | End;
|
---|
2365 |
|
---|
2366 | Control:=FEdit.Control;
|
---|
2367 | Include(Control.ComponentState, csDetail);
|
---|
2368 | FEdit.Hide;
|
---|
2369 | FEdit.Control.Parent:=Self;
|
---|
2370 | FEdit.Control.OnExit:=EvEntryKillFocus;
|
---|
2371 |
|
---|
2372 | FEdit.Control.Font:=Font;
|
---|
2373 | W:=(rc.Right-rc.Left);
|
---|
2374 | H:=Canvas.Font.Height;
|
---|
2375 | If rc.Left+W>=Width Then W:=(Width-rc.Left)-1;
|
---|
2376 | If ((FVertScrollBar<>Nil)And(FVertScrollBar.Visible)) Then
|
---|
2377 | If rc.Left+W>=FVertScrollBar.Left Then W:=FVertScrollBar.Left-rc.Left;
|
---|
2378 | If rc.Top-H<=0 Then H:=rc.Top-1;
|
---|
2379 | FEdit.SetWindowPos(rc.Left,rc.Top-H,W,H);
|
---|
2380 | If OnGetEditText<>Nil Then OnGetEditText(Self,FSelectCol,FSelectRow,S);
|
---|
2381 | FEdit.Text:=S;
|
---|
2382 | SetupCellColors(FSelectCol,FSelectRow,[],back,Fore);
|
---|
2383 | FEdit.Control.Color:=Back;
|
---|
2384 | FEdit.Control.PenColor:=Fore;
|
---|
2385 | FEdit.Control.Focus;
|
---|
2386 | FEdit.Show;
|
---|
2387 | End;
|
---|
2388 |
|
---|
2389 | Function TStringGrid.ShowEditor(Col,Row:LongInt):TInplaceEditClass;
|
---|
2390 | Begin
|
---|
2391 | If @FOnShowEditor<>Nil Then
|
---|
2392 | Result:=FOnShowEditor(Self,FSelectCol,FSelectRow)
|
---|
2393 | Else
|
---|
2394 | Result:=TDefaultEdit;
|
---|
2395 | End;
|
---|
2396 |
|
---|
2397 | Procedure TStringGrid.ShowEditorIntern;
|
---|
2398 | Var rc:TRect;
|
---|
2399 | Begin
|
---|
2400 | If ((FSelectCol<0)Or(FSelectRow<0)Or(((FEdit<>Nil)And(FEdit.Control.Visible)))) Then Exit;
|
---|
2401 |
|
---|
2402 | ShowEntry(Cells[FSelectCol,FSelectRow]);
|
---|
2403 |
|
---|
2404 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
2405 | InvalidateRect(rc);
|
---|
2406 | Update;
|
---|
2407 | End;
|
---|
2408 |
|
---|
2409 |
|
---|
2410 | Procedure TStringGrid.HideEditorIntern;
|
---|
2411 | Var rc:TRect;
|
---|
2412 | SelCol,SelRow:LongInt;
|
---|
2413 | Error:Boolean;
|
---|
2414 | ErrorText:String;
|
---|
2415 | Begin
|
---|
2416 | If ((FSelectCol>=0)And(FSelectRow>=0)And(FEdit<>Nil)And(FEdit.Control.Visible)) Then
|
---|
2417 | Begin
|
---|
2418 | Try
|
---|
2419 | If FEdit.Text<>Cells[FSelectCol,FSelectRow] Then
|
---|
2420 | Begin
|
---|
2421 | If OnSetEditText<>Nil Then OnSetEditText(Self,FSelectCol,FSelectRow,FEdit.Text);
|
---|
2422 | Cells[FSelectCol,FSelectRow]:=FEdit.Text;
|
---|
2423 | End;
|
---|
2424 | Error:=False;
|
---|
2425 | Except
|
---|
2426 | ON E:ESQLError Do
|
---|
2427 | Begin
|
---|
2428 | ErrorText:=Cells[FSelectCol,FSelectRow];
|
---|
2429 | If OnGetEditText<>Nil Then OnGetEditText(Self,FSelectCol,FSelectRow,ErrorText);
|
---|
2430 | FEdit.Text:=ErrorText;
|
---|
2431 | ErrorText:=E.Message;
|
---|
2432 | Error:=True;
|
---|
2433 | End;
|
---|
2434 | Else Raise;
|
---|
2435 | End;
|
---|
2436 |
|
---|
2437 | SelCol := FSelectCol;
|
---|
2438 | SelRow := FSelectRow;
|
---|
2439 | Focus; //FEdit darf beim Destroy nicht den Fokus haben
|
---|
2440 | FEdit.Hide;
|
---|
2441 | FEdit.Destroy;
|
---|
2442 | FEdit:=Nil;
|
---|
2443 | TGrid.SelectCell(SelCol,SelRow); //Selection erneuern
|
---|
2444 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
2445 | CaptureFocus;
|
---|
2446 | InvalidateRect(rc);
|
---|
2447 | Update;
|
---|
2448 | If Error Then ErrorBox(ErrorText);
|
---|
2449 | End
|
---|
2450 | Else If FEdit<>Nil Then FEdit.Hide;
|
---|
2451 | End;
|
---|
2452 |
|
---|
2453 | Procedure TStringGrid.CharEvent(Var key:Char;RepeatCount:Byte);
|
---|
2454 | Var rc:TRect;
|
---|
2455 | S:String;
|
---|
2456 | Ok:Boolean;
|
---|
2457 | Begin
|
---|
2458 | If ((FOptions*[goEditing]<>[])And(FSelectCol>=0)And(FSelectRow>=0)) Then
|
---|
2459 | Begin
|
---|
2460 | Ok:=True;
|
---|
2461 | If OnCanEdit<>Nil Then OnCanEdit(Self,Col,Row,Ok);
|
---|
2462 | If Ok Then
|
---|
2463 | Begin
|
---|
2464 | S:=key;
|
---|
2465 | ShowEntry(S);
|
---|
2466 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
2467 | InvalidateRect(rc);
|
---|
2468 | Update;
|
---|
2469 | exit;
|
---|
2470 | End;
|
---|
2471 | End;
|
---|
2472 |
|
---|
2473 | Inherited CharEvent(key,RepeatCount);
|
---|
2474 | End;
|
---|
2475 |
|
---|
2476 | Procedure TStringGrid.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
|
---|
2477 | Var
|
---|
2478 | Ok:Boolean;
|
---|
2479 | Begin
|
---|
2480 | If ((FSelectCol>=0)And(FSelectRow>=0)And(FOptions*[goEditing]<>[])) Then
|
---|
2481 | Begin
|
---|
2482 | Case KeyCode Of
|
---|
2483 | {$IFDEF OS2}
|
---|
2484 | kbCR,kbEnter:
|
---|
2485 | {$ENDIF}
|
---|
2486 | {$IFDEF Win95}
|
---|
2487 | kbCR:
|
---|
2488 | {$ENDIF}
|
---|
2489 | Begin
|
---|
2490 | If ((FEdit<>Nil)And(FEdit.Control.Visible)) Then HideEditorIntern
|
---|
2491 | Else
|
---|
2492 | Begin
|
---|
2493 | Ok:=True;
|
---|
2494 | If OnCanEdit<>Nil Then OnCanEdit(Self,Col,Row,Ok);
|
---|
2495 | If Ok Then ShowEditorIntern;
|
---|
2496 | End;
|
---|
2497 | KeyCode := kbNull;
|
---|
2498 | End;
|
---|
2499 | Else Inherited ScanEvent(KeyCode,RepeatCount);
|
---|
2500 | End;
|
---|
2501 | End
|
---|
2502 | Else Inherited ScanEvent(KeyCode,RepeatCount);
|
---|
2503 | End;
|
---|
2504 |
|
---|
2505 |
|
---|
2506 | Procedure TStringGrid.Resize;
|
---|
2507 | Var rc:TRect;
|
---|
2508 | W,H:LongInt;
|
---|
2509 | Begin
|
---|
2510 | Inherited Resize;
|
---|
2511 | If ((FSelectCol>=0)And(FSelectRow>=0)And(FOptions*[goEditing]<>[])And(FEdit<>Nil)And(FEdit.Control.Visible)) Then
|
---|
2512 | Begin
|
---|
2513 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
2514 | Inc(rc.Left);
|
---|
2515 | Dec(rc.Top,3);
|
---|
2516 | Dec(rc.Right);
|
---|
2517 | Inc(rc.Bottom,2);
|
---|
2518 | W:=(rc.Right-rc.Left)-2;
|
---|
2519 | H:=Canvas.Font.Height;
|
---|
2520 | If rc.Left+W>=Width Then W:=(Width-rc.Left)-1;
|
---|
2521 | If ((FVertScrollBar<>Nil)And(FVertScrollBar.Visible)) Then
|
---|
2522 | If rc.Left+W>=FVertScrollBar.Left Then W:=FVertScrollBar.Left-rc.Left;
|
---|
2523 | If rc.Top-H<=0 Then H:=rc.Top-1;
|
---|
2524 | FEdit.SetWindowPos(rc.Left,rc.Top-H,W,H);
|
---|
2525 | End;
|
---|
2526 | End;
|
---|
2527 |
|
---|
2528 | Procedure TStringGrid.SetEditorMode(NewValue:Boolean);
|
---|
2529 | Begin
|
---|
2530 | If NewValue Then ShowEditorIntern
|
---|
2531 | Else HideEditorIntern;
|
---|
2532 | End;
|
---|
2533 |
|
---|
2534 | {
|
---|
2535 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
2536 | º º
|
---|
2537 | º Speed-Pascal/2 Version 2.0 º
|
---|
2538 | º º
|
---|
2539 | º Speed-Pascal Component Classes (SPCC) º
|
---|
2540 | º º
|
---|
2541 | º This section: TDrawGrid Class Implementation º
|
---|
2542 | º º
|
---|
2543 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
2544 | º º
|
---|
2545 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
2546 | }
|
---|
2547 |
|
---|
2548 |
|
---|
2549 | Procedure TDrawGrid.SetupComponent;
|
---|
2550 | Begin
|
---|
2551 | Inherited SetupComponent;
|
---|
2552 |
|
---|
2553 | Name:='DrawGrid';
|
---|
2554 | FDefaultDrawing:=True;
|
---|
2555 | End;
|
---|
2556 |
|
---|
2557 | Procedure TDrawGrid.MouseToCell(X,Y:LongInt;Var ACol,ARow:LongInt);
|
---|
2558 | Begin
|
---|
2559 | GetSizeItem(Point(X,Y),ACol,ARow);
|
---|
2560 | End;
|
---|
2561 |
|
---|
2562 | Procedure TDrawGrid.SetDefaultDrawing(NewValue:Boolean);
|
---|
2563 | Begin
|
---|
2564 | FDefaultDrawing:=NewValue;
|
---|
2565 | Refresh;
|
---|
2566 | End;
|
---|
2567 |
|
---|
2568 | Procedure TDrawGrid.DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);
|
---|
2569 | Begin
|
---|
2570 | If ((DefaultDrawing)Or(Designed)) Then Inherited DrawCell(Col,Row,rec,AState);
|
---|
2571 | If FOnDrawCell<>Nil Then FOnDrawCell(Self,Col,Row,rec,AState);
|
---|
2572 | End;
|
---|
2573 |
|
---|
2574 | Procedure TDrawGrid.SetEditorMode(NewValue:Boolean);
|
---|
2575 | Begin
|
---|
2576 | If NewValue Then ShowEditor
|
---|
2577 | Else HideEditor;
|
---|
2578 | End;
|
---|
2579 |
|
---|
2580 | Procedure TDrawGrid.ShowEditor;
|
---|
2581 | Begin
|
---|
2582 | If ((FSelectCol>=0)And(FSelectRow>=0)And(FOptions*[goEditing]<>[])) Then
|
---|
2583 | Begin
|
---|
2584 | FEditorMode:=True;
|
---|
2585 | OpenEditor(FSelectCol,FSelectRow);
|
---|
2586 | End;
|
---|
2587 | End;
|
---|
2588 |
|
---|
2589 | Procedure TDrawGrid.HideEditor;
|
---|
2590 | Begin
|
---|
2591 | If Not FEditorMode Then Exit;
|
---|
2592 | FEditorMode:=False;
|
---|
2593 | CloseEditor;
|
---|
2594 | End;
|
---|
2595 |
|
---|
2596 | Procedure TDrawGrid.OpenEditor(Col,Row:LongInt);
|
---|
2597 | Begin
|
---|
2598 | If FOnOpenEditor<>Nil Then FOnOpenEditor(Self,Col,Row);
|
---|
2599 | End;
|
---|
2600 |
|
---|
2601 | Procedure TDrawGrid.CloseEditor;
|
---|
2602 | Begin
|
---|
2603 | If FOnCloseEditor<>Nil Then FOnCloseEditor(Self);
|
---|
2604 | End;
|
---|
2605 |
|
---|
2606 | Procedure TDrawGrid.SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);
|
---|
2607 | Begin
|
---|
2608 | Inherited SetupCellColors(Col,Row,AState,background,ForeGround);
|
---|
2609 | End;
|
---|
2610 |
|
---|
2611 | Function TDrawGrid.SelectCell(Col,Row:LongInt):Boolean;
|
---|
2612 | Var rc:TRect;
|
---|
2613 | Label L;
|
---|
2614 | Begin
|
---|
2615 | Result:=True;
|
---|
2616 | If ((FOptions*[goEditing]<>[])And(FOptions*[goAlwaysShowEditor]<>[])) Then
|
---|
2617 | Begin
|
---|
2618 | L:
|
---|
2619 | If ((FSelectCol>=0)And(FSelectRow>=0)And(FEditorMode=True)) Then
|
---|
2620 | Begin
|
---|
2621 | If ((FSelectCol=Col)And(FSelectRow=Row)) Then Exit;
|
---|
2622 | HideEditor;
|
---|
2623 | End;
|
---|
2624 |
|
---|
2625 | If FOptions*[goAlwaysShowEditor]<>[] Then Inherited SelectCell(Col,Row);
|
---|
2626 |
|
---|
2627 | ShowEditor;
|
---|
2628 |
|
---|
2629 | If FOptions*[goAlwaysShowEditor]=[] Then
|
---|
2630 | Begin
|
---|
2631 | rc:=GridRects[FSelectCol,FSelectRow];
|
---|
2632 | InvalidateRect(rc);
|
---|
2633 | Update;
|
---|
2634 | End;
|
---|
2635 | End
|
---|
2636 | Else
|
---|
2637 | Begin
|
---|
2638 | If ((FSelectCol=Col)And(FSelectRow=Row)And(FOptions*[goEditing]<>[])) Then Goto L;
|
---|
2639 | Inherited SelectCell(Col,Row);
|
---|
2640 | End;
|
---|
2641 | End;
|
---|
2642 |
|
---|
2643 | Begin
|
---|
2644 | End.
|
---|
2645 |
|
---|
2646 |
|
---|