source: trunk/Sibyl/SPCC/GRIDS.PAS@ 105

Last change on this file since 105 was 7, checked in by RBRi, 19 years ago

+ sibyl staff
  • Property svn:eol-style set to native
File size: 80.6 KB
Line 
1
2{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3 º º
4 º Sibyl Portable Component Classes º
5 º º
6 º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
7 º º
8 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
9
10Unit Grids;
11
12
13Interface
14
15{$IFDEF OS2}
16Uses Os2Def,BseDos,PmWin,PmGpi,PmDev,PmStdDlg;
17{$ENDIF}
18
19{$IFDEF Win95}
20Uses WinDef,WinBase,WinNt,WinUser,WinGDI,CommCtrl;
21{$ENDIF}
22
23Uses Dos,Classes,Forms,Graphics,Buttons,StdCtrls,DBBase,Dialogs,Mask;
24
25
26Type
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
366Implementation
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
382Constructor TInplaceEdit.Create(Grid:TGrid;Col,Row:LongInt);
383Begin
384 Inherited Create;
385 FGrid:=Grid;
386 FCol:=Col;
387 FRow:=Row;
388 SetupEdit(Grid);
389End;
390
391Destructor TInplaceEdit.Destroy;
392Begin
393 FGrid:=Nil;
394 Inherited Destroy;
395End;
396
397Procedure TInplaceEdit.SetInternalText(Const NewValue:String);
398Begin
399 SetText(NewValue);
400End;
401
402Function TInplaceEdit.GetInternalControl:TControl;
403Begin
404 Result:=GetControl;
405End;
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
422Type
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
438Function TDefaultEdit.GetText:String;
439Begin
440 Result:=FEdit.Text;
441End;
442
443Function TDefaultEdit.GetControl:TControl;
444Begin
445 Result:=FEdit;
446End;
447
448Procedure TDefaultEdit.SetText(Const NewValue:String);
449Begin
450 FEdit.Text:=NewValue;
451End;
452
453Procedure TDefaultEdit.SetWindowPos(X,Y,W,H:LongInt);
454Begin
455 FEdit.SetWindowPos(X,Y,W,H);
456End;
457
458Procedure TDefaultEdit.SetupEdit(Grid:TGrid);
459Var EditMask:String;
460Begin
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;
485End;
486
487Destructor TDefaultEdit.Destroy;
488Begin
489 FEdit.Destroy;
490 Inherited Destroy;
491End;
492
493Procedure TDefaultEdit.Show;
494Begin
495 FEdit.SelLength := 0; // clear selection
496 FEdit.SelStart:=0;
497 FEdit.Show;
498End;
499
500Procedure TDefaultEdit.Hide;
501Begin
502 FEdit.Hide;
503End;
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
519Procedure TGrid.BeginUpdate;
520Begin
521 FUpdateLocked:=True;
522End;
523
524Procedure TGrid.EndUpdate;
525Begin
526 FUpdateLocked:=False;
527 Invalidate;
528End;
529
530Procedure TGrid.ClearFocus;
531Var rc:TRect;
532Begin
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;
541End;
542
543Procedure TGrid.KillFocus;
544Var rc:TRect;
545Begin
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;
553End;
554
555Procedure TGrid.SetFocus;
556Var rc:TRect;
557Begin
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;
565End;
566
567
568Procedure TGrid.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
569Type PGridSizes=^TGridSizes;
570 TGridSizes=Record
571 EntryType:Byte;
572 Index:LongInt;
573 Value:LongInt;
574 End;
575Var sizes:PGridSizes;
576 T:LongInt;
577Begin
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);
592End;
593
594
595Function TGrid.WriteSCUResource(Stream:TResourceStream):Boolean;
596Const
597 ColEntry:Byte=1;
598 RowEntry:Byte=0;
599Var MemStream:TMemoryStream;
600 T,t1:LongInt;
601 Col:LongInt;
602 Row:LongInt;
603Begin
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;
632End;
633
634Procedure TGrid.SetColWidth(Col:LongInt;NewWidth:LongInt);
635Begin
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;
642End;
643
644Function TGrid.GetColWidth(Col:LongInt):LongInt;
645Begin
646 Result:=0;
647 If ((Col<0)Or(Col>=FColCount)) Then Exit;
648 Result:=FColWidths^[Col];
649End;
650
651Procedure TGrid.SetRowHeight(Row:LongInt;NewHeight:LongInt);
652Begin
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;
659End;
660
661Function TGrid.GetRowHeight(Row:LongInt):LongInt;
662Begin
663 Result:=0;
664 If ((Row<0)Or(Row>=FRowCount)) Then Exit;
665 Result:=FRowHeights^[Row];
666End;
667
668Procedure TGrid.SetEntryColor(NewColor:TColor);
669Begin
670 FEntryColor:=NewColor;
671 //ClearFocus;
672 If Not FUpdateLocked Then Invalidate;
673End;
674
675Procedure TGrid.SetFixedColor(NewColor:TColor);
676Begin
677 FFixedColor:=NewColor;
678 If Not FUpdateLocked Then Invalidate;
679End;
680
681Procedure TGrid.SetFixedRows(NewRows:LongInt);
682Begin
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;
689End;
690
691Procedure TGrid.SetFixedCols(NewCols:LongInt);
692Begin
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;
699End;
700
701Procedure TGrid.SetDefaultColWidth(NewWidth:LongInt);
702Var T:LongInt;
703 P:Pointer;
704Begin
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;
717End;
718
719Procedure TGrid.SetOptions(NewOptions:TGridOptions);
720Begin
721 FOptions:=NewOptions;
722 If Not FUpdateLocked Then Invalidate;
723End;
724
725Procedure TGrid.SetDefaultRowHeight(NewHeight:LongInt);
726Var T:LongInt;
727 P:Pointer;
728Begin
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;
742End;
743
744Procedure TGrid.SetColCount(NewCount:LongInt);
745Begin
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);
753End;
754
755Procedure TGrid.SetRowCount(NewCount:LongInt);
756Begin
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);
764End;
765
766Procedure TGrid.UpdateScrollBars;
767Var MaxWidth,MaxHeight:LongInt;
768 viewarea:LongInt;
769Begin
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;
826End;
827
828
829
830Procedure TGrid.Show;
831Begin
832 Inherited Show;
833
834 UpdateScrollBars;
835End;
836
837Procedure TGrid.Resize;
838Begin
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;
861End;
862
863
864Procedure TGrid.CreateHScrollBar;
865Begin
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); {!}
878End;
879
880
881Procedure TGrid.CreateVScrollBar;
882Begin
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); {!}
896End;
897
898
899Procedure TGrid.SetScrollBars(NewValue:TScrollStyle);
900Begin
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;
951End;
952
953{$HINTS OFF}
954Procedure TGrid.SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);
955Begin
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;
986End;
987{$HINTS ON}
988
989Procedure TGrid.SetCellColors(Col,Row:LongInt;AState:TGridDrawState);
990Var back,Fore:TColor;
991Begin
992 SetupCellColors(Col,Row,AState,back,Fore);
993 Canvas.Brush.color:=back;
994 Canvas.Pen.color:=Fore;
995End;
996
997{$HINTS OFF}
998Procedure TGrid.DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);
999Var rc:TRect;
1000Begin
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;
1040End;
1041{$HINTS ON}
1042
1043Procedure TGrid.Redraw(Const rec:TRect);
1044Var 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;
1053Label Ende;
1054Begin
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
1145Ende:
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;
1258End;
1259
1260Procedure TGrid.UpdateGridContents(NewCols,NewRows:LongInt);
1261Var T:LongInt;
1262 P:Pointer;
1263 Def:LongInt;
1264Begin
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;
1356End;
1357
1358Destructor TGrid.Destroy;
1359Begin
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;
1368End;
1369
1370Procedure TGrid.SetupComponent;
1371Begin
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);
1396End;
1397
1398Procedure TGrid.SetScrollBar(ScrollBar:TScrollBar;NewValue:LongInt);
1399Begin
1400 ScrollBar.Position:=NewValue;
1401 //ClearFocus;
1402 If Not FUpdateLocked Then Invalidate;
1403End;
1404
1405Procedure TGrid.SetTopRow(NewValue:LongInt);
1406Begin
1407 FVertScrollBar.Position:=NewValue;
1408End;
1409
1410Procedure TGrid.SetLeftCol(NewValue:LongInt);
1411Begin
1412 FHorzScrollBar.Position:=NewValue;
1413End;
1414
1415Procedure TGrid.Scroll(ScrollBar:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);
1416Begin
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;
1433End;
1434
1435Procedure TGrid.GetGridExtent(Var CX,CY:LongInt);
1436Var T:LongInt;
1437Begin
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]);
1442End;
1443
1444Function TGrid.GetVisibleRowCount:LongInt;
1445Var T,H,MinHeight:LongInt;
1446Begin
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;
1467End;
1468
1469Function TGrid.GetVisibleColCount:LongInt;
1470Var T,W,MaxWidth:LongInt;
1471Begin
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;
1492End;
1493
1494Function TGrid.GetGridWidth:LongInt;
1495Var T:LongInt;
1496Begin
1497 Result:=0;
1498 For T:=0 To FColCount-1 Do Inc(Result,FColWidths^[T]);
1499End;
1500
1501Function TGrid.GetGridHeight:LongInt;
1502Var T:LongInt;
1503Begin
1504 Result:=0;
1505 For T:=0 To FRowCount-1 Do Inc(Result,FRowHeights^[T]);
1506End;
1507
1508{$HINTS OFF}
1509Function TGrid.ScrollHorzTrack(ScrollBar:TScrollBar;NewPosition:LongInt):LongInt;
1510Var MaxWidth,MaxHeight,Value:LongInt;
1511 T:LongInt;
1512Begin
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;
1530End;
1531
1532Function TGrid.ScrollVertTrack(ScrollBar:TScrollBar;NewPosition:LongInt):LongInt;
1533Var MaxWidth,MaxHeight,Value:LongInt;
1534 T:LongInt;
1535Begin
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;
1553End;
1554{$HINTS ON}
1555
1556Function TGrid.CellRect(Col,Row:LongInt):TRect;
1557Var X,Y:LongInt;
1558 LeftCount,UpCount:LongInt;
1559 T,t1:LongInt;
1560 TheRowHeight:LongInt;
1561 TheColWidth:LongInt;
1562 DrawIt:Boolean;
1563Begin
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;
1608End;
1609
1610
1611Function TGrid.GetSizeItem(Const pt:TPoint;Var Col,Row:LongInt):TCursor;
1612Var T,t1:LongInt;
1613 LeftCount,UpCount:LongInt;
1614 DrawIt:Boolean;
1615 ColWidth,RowHeight:LongInt;
1616 X,Y:LongInt;
1617Begin
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;
1688End;
1689
1690
1691{$HINTS OFF}
1692Procedure TGrid.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
1693Var
1694 Row:LongInt;
1695 Col:LongInt;
1696 Shape:TCursor;
1697 X1,y1:LongInt;
1698Begin
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}
1731End;
1732
1733Procedure TGrid.RowHeightChanged(Row:LongInt);
1734Begin
1735End;
1736
1737Procedure TGrid.ColWidthChanged(Col:LongInt);
1738Begin
1739End;
1740
1741Procedure TGrid.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1742Var Row:LongInt;
1743 Col:LongInt;
1744 Shape:TCursor;
1745Begin
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;
1790End;
1791
1792Procedure TGrid.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1793Var T:LongInt;
1794 Col:LongInt;
1795 Row:LongInt;
1796 DNS:TDesignerNotifyStruct;
1797Begin
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;
1841End;
1842
1843Function TGrid.GetSelection:TGridRect;
1844Begin
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;
1851End;
1852
1853Procedure TGrid.SetSelection(NewValue:TGridRect);
1854Begin
1855 //we only Do support Single Selection For now...
1856 SelectCell(NewValue.Left,NewValue.Top);
1857End;
1858
1859Function TGrid.SelectCell(Col,Row:LongInt):Boolean;
1860Var 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
1904Begin
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;
1997End;
1998
1999Procedure TGrid.SetUpdateLocked(NewValue:Boolean);
2000Begin
2001 If NewValue=FGridUpdateLocked Then Exit;
2002 FGridUpdateLocked:=NewValue;
2003 If Not FGridUpdateLocked Then If Handle<>0 Then Invalidate;
2004End;
2005
2006Procedure TGrid.SetCol(NewValue:LongInt);
2007Begin
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;
2017End;
2018
2019Procedure TGrid.SetRow(NewValue:LongInt);
2020Begin
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;
2030End;
2031
2032Procedure TGrid.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
2033Var Visible:LongInt;
2034Begin
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);
2058End;
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
2075Procedure TStringGrid.SetupCellDrawing(Col,Row:LongInt;AState:TGridDrawState;
2076 Var Alignment:TAlignment;Var Font:TFont);
2077Begin
2078 Alignment:=taLeftJustify;
2079 Font:=Self.Font;
2080End;
2081
2082
2083Procedure TStringGrid.DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);
2084Var
2085 X,Y:LongInt;
2086 S:String;
2087 OldClip:TRect;
2088 Exclude:TRect;
2089 CX,CY:LongInt;
2090 Alignment:TAlignment;
2091 TheFont,OldFont:TFont;
2092Begin
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;
2132End;
2133
2134{$HINTS OFF}
2135Procedure TStringGrid.EvEntryKillFocus(Sender:TObject);
2136Begin
2137 ClearFocus;
2138End;
2139{$HINTS ON}
2140
2141
2142Function TStringGrid.SelectCell(Col,Row:LongInt):Boolean;
2143Var rc:TRect;
2144 Ok:Boolean;
2145Label L;
2146Begin
2147 Result:=True;
2148 If ((FOptions*[goEditing]<>[])And(FOptions*[goAlwaysShowEditor]<>[])) Then
2149 Begin
2150L:
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;
2195End;
2196
2197Procedure TStringGrid.SetCell(Col,Row:LongInt;Const NewContent:String);
2198Var Rows:TList;
2199 ps:PString;
2200 T:LongInt;
2201 NewValue:String;
2202Begin
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;
2235End;
2236
2237Function TStringGrid.GetCell(Col,Row:LongInt):String;
2238Var Rows:TList;
2239 ps:PString;
2240Begin
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);
2260End;
2261
2262Procedure TStringGrid.SetupComponent;
2263Begin
2264 Inherited SetupComponent;
2265
2266 Name:='StringGrid';
2267End;
2268
2269Destructor TStringGrid.Destroy;
2270Var T,t1:LongInt;
2271 Rows:TList;
2272 ps:PString;
2273Begin
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;
2297End;
2298
2299Procedure TStringGrid.ClearFocus;
2300Var rc:TRect;
2301 S:String;
2302Begin
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;
2329End;
2330
2331Procedure TStringGrid.ShowEntry(S:String);
2332Var rc:TRect;
2333 W,H:LongInt;
2334 back,Fore:TColor;
2335 Control:TControl;
2336 FEditClass:TInplaceEditClass;
2337 EditMask:String;
2338Begin
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;
2387End;
2388
2389Function TStringGrid.ShowEditor(Col,Row:LongInt):TInplaceEditClass;
2390Begin
2391 If @FOnShowEditor<>Nil Then
2392 Result:=FOnShowEditor(Self,FSelectCol,FSelectRow)
2393 Else
2394 Result:=TDefaultEdit;
2395End;
2396
2397Procedure TStringGrid.ShowEditorIntern;
2398Var rc:TRect;
2399Begin
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;
2407End;
2408
2409
2410Procedure TStringGrid.HideEditorIntern;
2411Var rc:TRect;
2412 SelCol,SelRow:LongInt;
2413 Error:Boolean;
2414 ErrorText:String;
2415Begin
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;
2451End;
2452
2453Procedure TStringGrid.CharEvent(Var key:Char;RepeatCount:Byte);
2454Var rc:TRect;
2455 S:String;
2456 Ok:Boolean;
2457Begin
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);
2474End;
2475
2476Procedure TStringGrid.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
2477Var
2478 Ok:Boolean;
2479Begin
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);
2503End;
2504
2505
2506Procedure TStringGrid.Resize;
2507Var rc:TRect;
2508 W,H:LongInt;
2509Begin
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;
2526End;
2527
2528Procedure TStringGrid.SetEditorMode(NewValue:Boolean);
2529Begin
2530 If NewValue Then ShowEditorIntern
2531 Else HideEditorIntern;
2532End;
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
2549Procedure TDrawGrid.SetupComponent;
2550Begin
2551 Inherited SetupComponent;
2552
2553 Name:='DrawGrid';
2554 FDefaultDrawing:=True;
2555End;
2556
2557Procedure TDrawGrid.MouseToCell(X,Y:LongInt;Var ACol,ARow:LongInt);
2558Begin
2559 GetSizeItem(Point(X,Y),ACol,ARow);
2560End;
2561
2562Procedure TDrawGrid.SetDefaultDrawing(NewValue:Boolean);
2563Begin
2564 FDefaultDrawing:=NewValue;
2565 Refresh;
2566End;
2567
2568Procedure TDrawGrid.DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);
2569Begin
2570 If ((DefaultDrawing)Or(Designed)) Then Inherited DrawCell(Col,Row,rec,AState);
2571 If FOnDrawCell<>Nil Then FOnDrawCell(Self,Col,Row,rec,AState);
2572End;
2573
2574Procedure TDrawGrid.SetEditorMode(NewValue:Boolean);
2575Begin
2576 If NewValue Then ShowEditor
2577 Else HideEditor;
2578End;
2579
2580Procedure TDrawGrid.ShowEditor;
2581Begin
2582 If ((FSelectCol>=0)And(FSelectRow>=0)And(FOptions*[goEditing]<>[])) Then
2583 Begin
2584 FEditorMode:=True;
2585 OpenEditor(FSelectCol,FSelectRow);
2586 End;
2587End;
2588
2589Procedure TDrawGrid.HideEditor;
2590Begin
2591 If Not FEditorMode Then Exit;
2592 FEditorMode:=False;
2593 CloseEditor;
2594End;
2595
2596Procedure TDrawGrid.OpenEditor(Col,Row:LongInt);
2597Begin
2598 If FOnOpenEditor<>Nil Then FOnOpenEditor(Self,Col,Row);
2599End;
2600
2601Procedure TDrawGrid.CloseEditor;
2602Begin
2603 If FOnCloseEditor<>Nil Then FOnCloseEditor(Self);
2604End;
2605
2606Procedure TDrawGrid.SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);
2607Begin
2608 Inherited SetupCellColors(Col,Row,AState,background,ForeGround);
2609End;
2610
2611Function TDrawGrid.SelectCell(Col,Row:LongInt):Boolean;
2612Var rc:TRect;
2613Label L;
2614Begin
2615 Result:=True;
2616 If ((FOptions*[goEditing]<>[])And(FOptions*[goAlwaysShowEditor]<>[])) Then
2617 Begin
2618L:
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;
2641End;
2642
2643Begin
2644End.
2645
2646
Note: See TracBrowser for help on using the repository browser.