source: trunk/Sibyl/SPCC/DBCTRLS.PAS@ 9

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

+ sibyl staff
  • Property svn:eol-style set to native
File size: 95.4 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 DBCtrls;
11
12
13Interface
14
15{$R DBCtrls}
16
17Uses SysUtils,Classes,Forms,Grids,DBBase,Buttons,StdCtrls,Dialogs,ExtCtrls,Mask;
18
19Type
20 {$M+}
21 TDBGridOptions = Set Of
22 (dgBorder,dgRowResize,dgColumnResize,dgEditing,dgAlwaysShowEditor,
23 dgShowSelection,dgAlwaysShowSelection,dgConfirmDelete,
24 dgCancelOnExit,dgIndicator,dgTitles,dgMouseSelect,dgLineNumbers,
25 dgEnableMaskEdit);
26 {$M-}
27
28 TDBGrid=Class;
29 TDBGridColumn=Class;
30 TDBGridColumns=Class;
31
32 TDBColumnTitle=Class
33 Private
34 FCaption:^String;
35 FAlignment:TAlignment;
36 FFont:TFont;
37 FColor:TColor;
38 FGrid:TDBGrid;
39 FColumn:TDBGridColumn;
40 FPenColor:TColor;
41 Private
42 Function GetFont:TFont;
43 Procedure SetFont(NewFont:TFont);
44 Procedure SetColor(NewColor:TColor);
45 Procedure SetPenColor(NewColor:TColor);
46 Procedure SetAlignment(NewValue:TAlignment);
47 Function GetCaption:String;
48 Procedure SetCaption(Const NewValue:String);
49 Public
50 Constructor Create(DBGrid:TDBGrid;Column:TDBGridColumn);
51 Destructor Destroy;Override;
52 Public
53 Property Font:TFont Read GetFont Write SetFont;
54 Property Color:TColor Read FColor Write SetColor;
55 Property PenColor:TColor Read FPenColor Write SetPenColor;
56 Property Alignment:TAlignment Read FAlignment Write SetAlignment;
57 Property Caption:String Read GetCaption Write SetCaption;
58 End;
59
60 TDBGridColumn=Class
61 Private
62 FFieldName:^String;
63 FTitle:TDBColumnTitle;
64 FColor:TColor;
65 FGrid:TDBGrid;
66 FColumns:TDBGridColumns;
67 FWidth:LongInt;
68 FAlignment:TAlignment;
69 FReadOnly:Boolean;
70 FFont:TFont;
71 FPenColor:TColor;
72 Private
73 Function GetFieldName:String;
74 Procedure SetFieldName(Const NewValue:String);
75 Procedure SetTitle(NewTitle:TDBColumnTitle);
76 Procedure SetColor(NewColor:TColor);
77 Procedure SetPenColor(NewColor:TColor);
78 Function GetWidth:LongInt;
79 Procedure SetWidth(NewWidth:LongInt);
80 Procedure SetAlignment(NewValue:TAlignment);
81 Function GetFont:TFont;
82 Procedure SetFont(NewFont:TFont);
83 Public
84 Constructor Create(DBGrid:TDBGrid;Columns:TDBGridColumns);
85 Destructor Destroy;Override;
86 Public
87 Property FieldName:String Read GetFieldName Write SetFieldName;
88 Property Title:TDBColumnTitle Read FTitle Write SetTitle;
89 Property Color:TColor Read FColor Write SetColor;
90 Property PenColor:TColor Read FPenColor Write SetPenColor;
91 Property Width:LongInt Read GetWidth Write SetWidth;
92 Property Alignment:TAlignment Read FAlignment Write SetAlignment;
93 Property ReadOnly:Boolean Read FReadOnly Write FReadOnly;
94 Property Font:TFont Read GetFont Write SetFont;
95 End;
96
97 {$HINTS OFF}
98 TDBGridColumns=Class(TList)
99 Private
100 FAutoCreated:Boolean;
101 FGrid:TDBGrid;
102 FUpdateLocked:Boolean;
103 Private
104 Function GetColumn(Index:LongInt):TDBGridColumn;
105 Procedure SetColumn(Index:LongInt;Column:TDBGridColumn);
106 Protected
107 Procedure FreeItem(Item:Pointer);Override;
108 Public
109 Constructor Create(DBGrid:TDBGrid);
110 Destructor Destroy;Override;
111 Function Add:TDBGridColumn;
112 Procedure Delete(Index:LongInt);
113 Procedure BeginUpdate;
114 Procedure EndUpdate;
115 Public
116 Property AutoCreated:Boolean Read FAutoCreated;
117 Property Items[Index:LongInt]:TDBGridColumn Read GetColumn Write SetColumn;Default;
118 Property Grid:TDBGrid Read FGrid;
119 End;
120 {$HINTS ON}
121
122 TDBGrid=Class(TStringGrid)
123 Private
124 FDataLink:TTableDataLink;
125 FGridOptions:TDBGridOptions;
126 FColumns:TDBGridColumns;
127 Procedure SetDataSource(NewValue:TDataSource);
128 Function GetDataSource:TDataSource;
129 Procedure SetGridOptions(NewValue:TDBGridOptions);
130 Procedure SetColumns(NewColumns:TDBGridColumns);
131 Protected
132 Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
133 Procedure SetFont(NewFont:TFont);Override;
134 Procedure Scroll(ScrollBar:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);Override;
135 Procedure SetupComponent;Override;
136 Function GetCell(Col,Row:LongInt):String;Override;
137 Procedure SetCell(Col,Row:LongInt;Const NewContent:String);Override;
138 Function SelectCell(Col,Row:LongInt):Boolean;Override;
139 Procedure SetupCellDrawing(Col,Row:LongInt;AState:TGridDrawState;
140 Var Alignment:TAlignment;Var DrawFont:TFont);Override;
141 Procedure SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);Override;
142 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
143 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
144 Procedure RowHeightChanged(Row:LongInt);Override;
145 Procedure ColWidthChanged(Col:LongInt);Override;
146 Function ShowEditor(Col,Row:LongInt):TInplaceEditClass;Override;
147 Protected
148 Property FixedCols;
149 Property FixedRows;
150 Property ColCount;
151 Property RowCount;
152 Property Options;
153 Public
154 Destructor Destroy;Override;
155 Procedure DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);Override;
156 Published
157 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
158 Property GridOptions:TDBGridOptions Read FGridOptions Write SetGridOptions;
159 Property Columns:TDBGridColumns Read FColumns Write SetColumns;
160 End;
161
162 TDBEdit=Class(TEdit)
163 Private
164 FDataLink:TFieldDataLink;
165 Procedure SetDataSource(NewValue:TDataSource);
166 Function GetDataSource:TDataSource;
167 Procedure SetDataField(NewValue:String);
168 Function GetDataField:String;
169 Procedure WriteBack;
170 Protected
171 Procedure SetupComponent;Override;
172 Procedure SetupShow;Override;
173 Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
174 Procedure KillFocus;Override;
175 Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
176 Public
177 Destructor Destroy;Override;
178 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
179 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
180 Published
181 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
182 Property DataField:String Read GetDataField Write SetDataField;
183 End;
184
185 TDBText=Class(TLabel)
186 Private
187 FDataLink:TFieldDataLink;
188 Procedure SetDataSource(NewValue:TDataSource);
189 Function GetDataSource:TDataSource;
190 Procedure SetDataField(NewValue:String);
191 Function GetDataField:String;
192 Protected
193 Procedure SetupComponent;Override;
194 Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
195 Procedure SetupShow;Override;
196 Public
197 Destructor Destroy;Override;
198 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
199 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
200 Published
201 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
202 Property DataField:String Read GetDataField Write SetDataField;
203 End;
204
205 TDBCheckBox=Class(TCheckBox)
206 Private
207 FDataLink:TFieldDataLink;
208 FValueChecked:PString;
209 FValueUnchecked:PString;
210 Procedure SetDataSource(NewValue:TDataSource);
211 Function GetDataSource:TDataSource;
212 Procedure SetDataField(NewValue:String);
213 Function GetDataField:String;
214 Procedure SetValueChecked(NewValue:String);
215 Function GetValueChecked:String;
216 Procedure SetValueUnchecked(NewValue:String);
217 Function GetValueUnchecked:String;
218 Procedure WriteBack;
219 Protected
220 Procedure SetupComponent;Override;
221 Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
222 Procedure SetupShow;Override;
223 Procedure Click;Override;
224 Public
225 Destructor Destroy;Override;
226 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
227 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
228 Published
229 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
230 Property ValueChecked:String Read GetValueChecked Write SetValueChecked;
231 Property ValueUnchecked:String Read GetValueUnchecked Write SetValueUnchecked;
232 Property DataField:String Read GetDataField Write SetDataField;
233 End;
234
235
236 TDBImage=Class(TImage)
237 Private
238 FDataLink:TFieldDataLink;
239 FChangeLock:Boolean;
240 Procedure SetDataSource(NewValue:TDataSource);
241 Function GetDataSource:TDataSource;
242 Procedure SetDataField(NewValue:String);
243 Function GetDataField:String;
244 Procedure WriteBack;
245 Protected
246 Procedure SetupComponent;Override;
247 Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
248 Procedure SetupShow;Override;
249 Procedure Change;Override;
250 Public
251 Destructor Destroy;Override;
252 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
253 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
254 Property Bitmap;
255 Published
256 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
257 Property DataField:String Read GetDataField Write SetDataField;
258 End;
259
260
261 TDBMemo=Class(TMemo)
262 Private
263 FDataLink:TFieldDataLink;
264 Procedure SetDataSource(NewValue:TDataSource);
265 Function GetDataSource:TDataSource;
266 Procedure SetDataField(NewValue:String);
267 Function GetDataField:String;
268 Procedure WriteBack;
269 Protected
270 Procedure SetupComponent;Override;
271 Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
272 Procedure SetupShow;Override;
273 Procedure KillFocus;Override;
274 Public
275 Destructor Destroy;Override;
276 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
277 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
278 Published
279 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
280 Property DataField:String Read GetDataField Write SetDataField;
281 End;
282
283 {$HINTS OFF}
284 TDBListBox=Class(TListBox)
285 Private
286 FDataLink:TFieldDataLink;
287 FDBStrings:TStrings;
288 Private
289 Procedure SetDataSource(NewValue:TDataSource);
290 Function GetDataSource:TDataSource;
291 Procedure SetDataField(NewValue:String);
292 Function GetDataField:String;
293 Procedure SetItems(NewValue:TStrings);
294 Protected
295 Procedure SetupComponent;Override;
296 Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
297 Procedure SetupShow;Override;
298 Procedure ItemFocus(Index:LongInt);Override;
299 Public
300 Destructor Destroy;Override;
301 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
302 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
303 Public
304 Property Items:TStrings Read FDBStrings Write SetItems;
305 Published
306 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
307 Property DataField:String Read GetDataField Write SetDataField;
308 End;
309 {$HINTS ON}
310
311 TDBComboBox=Class(TComboBox)
312 Private
313 FDataLink:TFieldDataLink;
314 FLock:Boolean;
315 Private
316 Procedure SetDataSource(NewValue:TDataSource);
317 Function GetDataSource:TDataSource;
318 Procedure SetDataField(NewValue:String);
319 Function GetDataField:String;
320 Procedure WriteBack;
321 Protected
322 Procedure EditChange;Override;
323 Procedure SetupShow;Override;
324 Procedure SetupComponent;Override;
325 Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
326 Public
327 Destructor Destroy;Override;
328 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
329 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
330 Published
331 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
332 Property DataField:String Read GetDataField Write SetDataField;
333 End;
334
335 TDBRadioGroup=Class(TRadioGroup)
336 Private
337 FDataLink:TFieldDataLink;
338 FValues:TStrings;
339 FLock:Boolean;
340 Private
341 Procedure SetDataSource(NewValue:TDataSource);
342 Function GetDataSource:TDataSource;
343 Procedure SetDataField(NewValue:String);
344 Function GetDataField:String;
345 Function GetValue:String;
346 Procedure SetValue(Const NewValue:String);
347 Procedure SetValues(NewValue:TStrings);
348 Procedure WriteBack;
349 Protected
350 Procedure SetupShow;Override;
351 Procedure SetupComponent;Override;
352 Procedure DataChange(Sender:TObject;event:TDataChange);Virtual;
353 Procedure ItemIndexChange;Override;
354 Public
355 Destructor Destroy;Override;
356 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
357 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
358 Public
359 Property Value:String Read GetValue Write SetValue;
360 Property Values:TStrings Read FValues Write SetValues;
361 Published
362 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
363 Property DataField:String Read GetDataField Write SetDataField;
364 End;
365
366 {$M+}
367 TNavigateBtn=(dbFirst, dbPrior, dbNext, dbLast, dbInsert,
368 dbDelete, dbEdit, dbPost, dbCancel, dbRefresh);
369 TNavigateBtnSet=Set Of TNavigateBtn;
370
371 TNavClick=Procedure(Sender:TObject;Button:TNavigateBtn) Of Object;
372 {$M-}
373
374 TDBNavigator=Class(TControl)
375 Private
376 FButtons:Array[TNavigateBtn] Of TBitBtn;
377 FVisibleButtons:TNavigateBtnSet;
378 FEnabledButtons:TNavigateBtnSet;
379 FDataLink:TTableDataLink;
380 FOnNavClick:TNavClick;
381 Procedure SetVisibleButtons(NewState:TNavigateBtnSet);
382 Procedure SetEnabledButtons(NewState:TNavigateBtnSet);
383 Function GetButton(Index:TNavigateBtn):TBitBtn;
384 Function GetDataSource:TDataSource;
385 Procedure SetDataSource(NewValue:TDataSource);
386 Procedure EvButtonClick(Sender:TObject);
387 Protected
388 Procedure CommandEvent(Var Command:TCommand);Override;
389 Procedure SetupComponent;Override;
390 Procedure CreateWnd;Override;
391 Procedure RealignControls;Override;
392 Property Buttons[Index:TNavigateBtn]:TBitBtn Read GetButton;
393 Property Hint;
394 Property Cursor;
395 Public
396 Destructor Destroy;Override;
397 Property XAlign;
398 Property XStretch;
399 Property YAlign;
400 Property YStretch;
401 Published
402 Property Align;
403 Property DataSource:TDataSource Read GetDataSource Write SetDataSource;
404 Property DragCursor;
405 Property DragMode;
406 Property Enabled;
407 Property EnabledButtons:TNavigateBtnSet Read FEnabledButtons Write SetEnabledButtons;
408 Property ParentShowHint;
409 Property ShowHint;
410 Property TabOrder;
411 Property TabStop;
412 Property Visible;
413 Property VisibleButtons:TNavigateBtnSet Read FVisibleButtons Write SetVisibleButtons;
414 Property ZOrder;
415
416 Property OnCanDrag;
417 Property OnClick:TNavClick Read FOnNavClick Write FOnNavClick;
418 Property OnDragDrop;
419 Property OnDragOver;
420 Property OnEndDrag;
421 Property OnEnter;
422 Property OnExit;
423 Property OnMouseMove;
424 Property OnResize;
425 Property OnSetupShow;
426 Property OnStartDrag;
427 End;
428
429
430Implementation
431
432{
433ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
434º º
435º Speed-Pascal/2 Version 2.0 º
436º º
437º Speed-Pascal Component Classes (SPCC) º
438º º
439º This section: TDBGridColumns Class Implementation º
440º º
441º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
442º º
443ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
444}
445
446
447Procedure TDBGridColumns.BeginUpdate;
448Begin
449 FUpdateLocked:=True;
450End;
451
452Procedure TDBGridColumns.EndUpdate;
453Begin
454 FUpdateLocked:=False;
455 If FGrid<>Nil Then
456 If FGrid.FColumns=Self Then FGrid.Invalidate;
457End;
458
459Function TDBGridColumns.GetColumn(Index:LongInt):TDBGridColumn;
460Begin
461 Result:=TDBGridColumn(Inherited Items[Index]);
462End;
463
464Procedure TDBGridColumns.SetColumn(Index:LongInt;Column:TDBGridColumn);
465Var OldColumn:TDBGridColumn;
466Begin
467 OldColumn:=Items[Index];
468 If OldColumn<>Column Then OldColumn.Destroy;
469
470 Inherited Items[Index]:=Column;
471End;
472
473Procedure TDBGridColumns.FreeItem(Item:Pointer);
474Var Column:TDBGridColumn;
475Begin
476 Inherited FreeItem(Item);
477 Column:=Item;
478 If Column<>Nil Then Column.Destroy;
479End;
480
481Function TDBGridColumns.Add:TDBGridColumn;
482Begin
483 Result.Create(FGrid,Self);
484 Inherited Add(Result);
485End;
486
487Procedure TDBGridColumns.Delete(Index:LongInt);
488Begin
489 Inherited Delete(Index);
490 If FGrid<>Nil Then If Not FUpdateLocked Then
491 If FGrid.FColumns=Self Then FGrid.Invalidate;
492End;
493
494Constructor TDBGridColumns.Create(DBGrid:TDBGrid);
495Begin
496 Inherited Create;
497 FGrid:=DBGrid;
498End;
499
500Destructor TDBGridColumns.Destroy;
501Begin
502 If FGrid<>Nil Then
503 If FGrid.FColumns=Self Then FGrid.FColumns:=Nil;
504 Inherited Destroy;
505End;
506
507{
508ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
509º º
510º Speed-Pascal/2 Version 2.0 º
511º º
512º Speed-Pascal Component Classes (SPCC) º
513º º
514º This section: TDBGridColumn Class Implementation º
515º º
516º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
517º º
518ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
519}
520
521Function TDBGridColumn.GetFieldName:String;
522Begin
523 If FFieldName<>Nil Then Result:=FFieldName^
524 Else Result:='';
525End;
526
527Procedure TDBGridColumn.SetFieldName(Const NewValue:String);
528Begin
529 If FFieldName<>Nil Then FreeMem(FFieldName,Length(FFieldName^)+1);
530 GetMem(FFieldName,Length(NewValue)+1);
531 FFieldName^:=NewValue;
532 If FColumns<>Nil Then
533 If Not FColumns.FUpdateLocked Then
534 If FGrid.FColumns=FColumns Then FGrid.Invalidate;
535End;
536
537Procedure TDBGridColumn.SetTitle(NewTitle:TDBColumnTitle);
538Begin
539 If NewTitle<>FTitle Then FTitle.Destroy;
540 FTitle:=NewTitle;
541 If FTitle=Nil Then FTitle.Create(FGrid,Self);
542 FTitle.FGrid:=FGrid;
543 If FColumns<>Nil Then
544 If Not FColumns.FUpdateLocked Then
545 If FGrid.FColumns=FColumns Then FGrid.Invalidate;
546End;
547
548Procedure TDBGridColumn.SetColor(NewColor:TColor);
549Begin
550 FColor:=NewColor;
551 If FColumns<>Nil Then
552 If Not FColumns.FUpdateLocked Then
553 If FGrid.FColumns=FColumns Then FGrid.Invalidate;
554End;
555
556Procedure TDBGridColumn.SetPenColor(NewColor:TColor);
557Begin
558 FPenColor:=NewColor;
559 If FColumns<>Nil Then
560 If Not FColumns.FUpdateLocked Then
561 If FGrid.FColumns=FColumns Then FGrid.Invalidate;
562End;
563
564Function TDBGridColumn.GetWidth:LongInt;
565Begin
566 If FGrid.Columns<>Nil Then
567 If FGrid.Columns.IndexOf(Self)>=0 Then
568 Result:=FGrid.ColWidths[FGrid.FColumns.IndexOf(Self)+FGrid.FixedCols];
569End;
570
571Procedure TDBGridColumn.SetWidth(NewWidth:LongInt);
572Begin
573 If FGrid.Columns<>Nil Then
574 If FGrid.Columns.IndexOf(Self)>=0 Then
575 FGrid.ColWidths[FGrid.FColumns.IndexOf(Self)+FGrid.FixedCols]:=NewWidth;
576End;
577
578Procedure TDBGridColumn.SetAlignment(NewValue:TAlignment);
579Begin
580 FAlignment:=NewValue;
581 If FColumns<>Nil Then
582 If Not FColumns.FUpdateLocked Then
583 If FGrid.FColumns=FColumns Then FGrid.Invalidate;
584End;
585
586Function TDBGridColumn.GetFont:TFont;
587Begin
588 If FFont<>Nil Then Result:=FFont
589 Else Result:=FGrid.Font;
590End;
591
592Procedure TDBGridColumn.SetFont(NewFont:TFont);
593Begin
594 If NewFont=FFont Then Exit;
595 FFont:=NewFont;
596 If FColumns<>Nil Then
597 If Not FColumns.FUpdateLocked Then
598 If FGrid.FColumns=FColumns Then FGrid.Invalidate;
599End;
600
601{$HINTS OFF}
602Constructor TDBGridColumn.Create(DBGrid:TDBGrid;Columns:TDBGridColumn);
603Begin
604 Inherited Create;
605 FGrid:=DBGrid;
606 FTitle.Create(FGrid,Self);
607 FColor:=FGrid.EntryColor;
608 FPenColor:=FGrid.PenColor;
609 FWidth:=40;
610 FAlignment:=taLeftJustify;
611End;
612{$HINTS ON}
613
614Destructor TDBGridColumn.Destroy;
615Begin
616 If FFieldName<>Nil Then FreeMem(FFieldName,Length(FFieldName^)+1);
617 If FTitle<>Nil Then FTitle.Destroy;
618End;
619
620{
621ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
622º º
623º Speed-Pascal/2 Version 2.0 º
624º º
625º Speed-Pascal Component Classes (SPCC) º
626º º
627º This section: TDBColumnTitle Class Implementation º
628º º
629º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
630º º
631ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
632}
633
634Function TDBColumnTitle.GetFont:TFont;
635Begin
636 If FFont<>Nil Then Result:=FFont
637 Else Result:=FGrid.Font;
638End;
639
640Procedure TDBColumnTitle.SetFont(NewFont:TFont);
641Begin
642 If NewFont=FFont Then Exit;
643 FFont:=NewFont;
644 If FColumn.FColumns<>Nil Then
645 If Not FColumn.FColumns.FUpdateLocked Then
646 If FGrid.FColumns=FColumn.FColumns Then FGrid.Invalidate;
647End;
648
649Procedure TDBColumnTitle.SetColor(NewColor:TColor);
650Begin
651 FColor:=NewColor;
652 If FColumn.FColumns<>Nil Then
653 If Not FColumn.FColumns.FUpdateLocked Then
654 If FGrid.FColumns=FColumn.FColumns Then FGrid.Invalidate;
655End;
656
657Procedure TDBColumnTitle.SetPenColor(NewColor:TColor);
658Begin
659 FPenColor:=NewColor;
660 If FColumn.FColumns<>Nil Then
661 If Not FColumn.FColumns.FUpdateLocked Then
662 If FGrid.FColumns=FColumn.FColumns Then FGrid.Invalidate;
663End;
664
665Procedure TDBColumnTitle.SetAlignment(NewValue:TAlignment);
666Begin
667 FAlignment:=NewValue;
668 If FColumn.FColumns<>Nil Then
669 If Not FColumn.FColumns.FUpdateLocked Then
670 If FGrid.FColumns=FColumn.FColumns Then FGrid.Invalidate;
671End;
672
673Constructor TDBColumnTitle.Create(DBGrid:TDBGrid;Column:TDBGridColumn);
674Begin
675 Inherited Create;
676
677 FGrid:=DBGrid;
678 FColumn:=Column;
679 FColor:=FGrid.FixedColor;
680 FPenColor:=FGrid.PenColor;
681 FAlignment:=taLeftJustify;
682End;
683
684Destructor TDBColumnTitle.Destroy;
685Begin
686 If FCaption<>Nil Then FreeMem(FCaption,Length(FCaption^)+1);
687 Inherited Destroy;
688End;
689
690Function TDBColumnTitle.GetCaption:String;
691Begin
692 If FCaption<>Nil Then Result:=FCaption^
693 Else Result:=FColumn.FieldName;
694End;
695
696Procedure TDBColumnTitle.SetCaption(Const NewValue:String);
697Begin
698 If FCaption<>Nil Then FreeMem(FCaption,Length(FCaption^)+1);
699 GetMem(FCaption,Length(NewValue)+1);
700 FCaption^:=NewValue;
701 If FColumn.FColumns<>Nil Then
702 If Not FColumn.FColumns.FUpdateLocked Then
703 If FGrid.FColumns=FColumn.FColumns Then FGrid.Invalidate;
704End;
705
706{
707ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
708º º
709º Speed-Pascal/2 Version 2.0 º
710º º
711º Speed-Pascal Component Classes (SPCC) º
712º º
713º This section: TDBGrid Class Implementation º
714º º
715º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
716º º
717ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
718}
719
720Type TInplaceDBEdit=Class(TInplaceEdit)
721 Protected
722 FControl:TControl;
723 FFieldType:TFieldType;
724 Protected
725 Function GetText:String;Override;
726 Function GetControl:TComponent;Override;
727 Procedure SetText(Const NewValue:String);Override;
728 Procedure SetWindowPos(X,Y,W,H:LongInt);Override;
729 Procedure SetupEdit(Grid:TGrid);Override;
730 Destructor Destroy;Override;
731 Procedure Show;Override;
732 Procedure Hide;Override;
733 End;
734
735Function TInplaceDBEdit.GetText:String;
736Begin
737 Case FFieldType Of
738 ftSmallInt,ftInteger,ftWord,ftFloat,ftCurrency:Result:=TEdit(FControl).Text;
739 ftBoolean:Result:=TComboBox(FControl).Text;
740 ftDate,ftTime,ftDateTime:Result:=TMaskEdit(FControl).Text;
741 End; //case
742End;
743
744Function TInplaceDBEdit.GetControl:TComponent;
745Begin
746 Result:=FControl;
747End;
748
749Procedure TInplaceDBEdit.SetText(Const NewValue:String);
750Begin
751 Case FFieldType Of
752 ftSmallInt,ftInteger,ftWord,ftFloat,ftCurrency:TEdit(FControl).Text:=NewValue;
753 ftBoolean:TComboBox(FControl).Text:=NewValue;
754 ftDate,ftTime,ftDateTime:TMaskEdit(FControl).Text:=NewValue;
755 End; //case
756End;
757
758Procedure TInplaceDBEdit.SetWindowPos(X,Y,W,H:LongInt);
759Begin
760 Case FFieldType Of
761 ftSmallInt,ftInteger,ftWord,ftFloat,ftCurrency,
762 ftDate,ftTime,ftDateTime:FControl.SetWindowPos(X,Y,W,H);
763 ftBoolean:FControl.SetWindowPos(X-1,Y+2,W+2,H);
764 End; //case
765End;
766
767Procedure TInplaceDBEdit.SetupEdit(Grid:TGrid);
768Var Edit:TEdit;
769 ComboBox:TComboBox;
770 FieldType:TFieldType;
771 MaskEdit:TMaskEdit;
772 Index:Longint;
773
774 Function BuildMask(Value:String):String;
775 Var t:LongInt;
776 Begin
777 If pos(' ampm',Value)<>0 Then Value[0]:=chr(Pos(' ampm',Value)-1);
778 If ((pos('h:',Value)=1)Or(pos(' h:',Value)<>0)) Then
779 Insert('h',Value,pos('h:',Value));
780 For t:=1 To Length(Value) Do
781 If Value[t] In ['y','d','m','h','s'] Then Value[t]:='9';
782 Result:=Value+';1;0';
783 End;
784Begin
785 Index:=Col-Grid.FixedCols;
786 FieldType:=TDBGrid(Grid).FDataLink.DataSource.DataSet.FieldTypes[Index];
787 If FControl<>Nil Then If FieldType<>FFieldType Then
788 Begin
789 FControl.Destroy;
790 FControl:=Nil;
791 End;
792 FFieldType:=FieldType;
793
794 If FControl=Nil Then
795 Begin
796 Case FFieldType Of
797 ftSmallInt,ftInteger,ftWord,ftFloat,ftCurrency:
798 Begin
799 Edit.Create(Grid);
800 Edit.NumbersOnly:=True;
801 Edit.BorderStyle:=bsNone;
802 FControl:=Edit;
803 End;
804 ftBoolean:
805 Begin
806 ComboBox.Create(Grid);
807 ComboBox.Style:=csDropDownList;
808 ComboBox.Items.Add('True');
809 ComboBox.Items.Add('False');
810 ComboBox.BorderStyle:=bsNone;
811 FControl:=ComboBox;
812 End;
813 ftDate:
814 Begin
815 MaskEdit.Create(Grid);
816 MaskEdit.BorderStyle:=bsNone;
817 MaskEdit.EditMask:=BuildMask(ShortDateFormat);
818 FControl:=MaskEdit;
819 End;
820 ftTime:
821 Begin
822 MaskEdit.Create(Grid);
823 MaskEdit.BorderStyle:=bsNone;
824 MaskEdit.EditMask:=BuildMask(LongTimeFormat);
825 FControl:=MaskEdit;
826 End;
827 ftDateTime:
828 Begin
829 MaskEdit.Create(Grid);
830 MaskEdit.BorderStyle:=bsNone;
831 MaskEdit.EditMask:=BuildMask(ShortDateFormat+' '+LongTimeFormat);
832 FControl:=MaskEdit;
833 End;
834 End; //case
835 End;
836End;
837
838Destructor TInplaceDBEdit.Destroy;
839Begin
840 FControl.Destroy;
841 Inherited Destroy;
842End;
843
844Procedure TInplaceDBEdit.Show;
845Begin
846 If FFieldType=ftBoolean Then TComboBox(FControl).OnExit:=Nil; //!!
847 FControl.Show;
848End;
849
850Procedure TInplaceDBEdit.Hide;
851Begin
852 FControl.Hide;
853End;
854
855Type
856 TColumnsRec=Record
857 ColAlignment:TAlignment;
858 ColColor:TColor;
859 ColPenColor:TColor;
860 ColWidth:LongInt;
861 ColReadOnly:Boolean;
862 TitleAlignment:TAlignment;
863 TitleColor:TColor;
864 TitlePenColor:TColor;
865 End;
866
867Function TDBGrid.ShowEditor(Col,Row:LongInt):TInplaceEditClass;
868Var FieldType:TFieldType;
869Begin
870 Col:=Col-FixedCols;
871 Result:=Nil; //default editor
872 If FGridOptions*[dgEnableMaskEdit]<>[] Then
873 If FDataLink.DataSource<>Nil Then
874 If FDataLink.DataSource.DataSet<>Nil Then
875 If FDataLink.DataSource.DataSet.Active Then
876 If Col>=0 Then
877 If Col<=FDataLink.DataSource.DataSet.FieldCount Then
878 Begin
879 FieldType:=FDataLink.DataSource.DataSet.FieldTypes[Col];
880 Case FieldType Of
881 ftSmallInt,ftInteger,ftWord,ftBoolean,
882 ftFloat,ftCurrency:Result:=TInplaceDBEdit;
883 ftDate,ftTime,ftDateTime:Result:=TInplaceDBEdit;
884 End; //case
885 End;
886End;
887
888Procedure TDBGrid.SetFont(NewFont:TFont);
889Var Column:TDBGridColumn;
890 OldFont:TFont;
891 T:LongInt;
892Begin
893 OldFont:=Font;
894 Inherited SetFont(NewFont);
895
896 If ((NewFont<>OldFont)And(FColumns<>Nil)) Then For T:=0 To FColumns.Count-1 Do
897 Begin
898 Column:=FColumns[T];
899 If Column.Font=OldFont Then Column.Font:=NewFont;
900 If Column.Title.Font=OldFont Then Column.Title.Font:=NewFont;
901 End;
902End;
903
904{$HINTS OFF}
905Procedure TDBGrid.RowHeightChanged(Row:LongInt);
906Begin
907End;
908{$HINTS ON}
909
910Procedure TDBGrid.ColWidthChanged(Col:LongInt);
911Var Column:TDBGridColumn;
912Begin
913 If FColumns<>Nil Then
914 Begin
915 If Col-FixedCols>=0 Then
916 If Col-FixedCols<=FColumns.Count-1 Then
917 Begin
918 Column:=FColumns.Items[Col-FixedCols];
919 If Column<>Nil Then Column.Width:=ColWidths[Col];
920 End;
921 FColumns.FAutoCreated := False;
922 End;
923End;
924
925Function TDBGrid.WriteSCUResource(Stream:TResourceStream):Boolean;
926Var MemStream:TMemoryStream;
927 T:LongInt;
928 Column:TDBGridColumn;
929 rec:TColumnsRec;
930 S,s1:String;
931 Attrs:TFontAttributes;
932Begin
933 Result:=Inherited WriteSCUResource(Stream);
934 If Not Result Then Exit;
935
936 If FColumns<>Nil Then
937 If Not FColumns.AutoCreated Then
938 If FColumns.Count>0 Then
939 Begin
940 MemStream.Create;
941
942 T:=FColumns.Count-1;
943 MemStream.WriteBuffer(T,4); //Array elements
944 For T:=0 To FColumns.Count-1 Do
945 Begin
946 Column:=FColumns.Items[T];
947
948 rec.ColAlignment:=Column.Alignment;
949 rec.ColColor:=Column.color;
950 rec.ColPenColor:=Column.PenColor;
951 rec.ColWidth:=Column.Width;
952 rec.ColReadOnly:=Column.ReadOnly;
953 rec.TitleAlignment:=Column.Title.Alignment;
954 rec.TitlePenColor:=Column.Title.PenColor;
955 rec.TitleColor:=Column.Title.color;
956
957 MemStream.WriteBuffer(rec,SizeOf(TColumnsRec));
958
959 S:=Column.FieldName;
960 MemStream.WriteBuffer(S,Length(S)+1);
961 S:=Column.Title.Caption;
962 MemStream.WriteBuffer(S,Length(S)+1);
963
964 If Column.Font=Font Then S:=''
965 Else
966 Begin
967 S:=Column.Font.FaceName;
968 If Column.Font.IsDefault Then S:='System Default Font';
969 S:=tostr(Column.Font.PointSize)+'.'+S;
970
971 s1:=S;
972 UpcaseStr(s1);
973 Attrs:=Column.Font.Attributes;
974 If Attrs*[faBold]<>[] Then If Pos(' BOLD',s1)=0 Then S:=S+'!BOLD!';
975 If Attrs*[faItalic]<>[] Then If Pos(' ITALIC',s1)=0 Then S:=S+'!ITALIC!';
976 If Attrs*[faOutline]<>[] Then S:=S+'!OUTLINE!';
977 If Attrs*[faStrikeOut]<>[] Then S:=S+'!STRIKEOUT!';
978 If Attrs*[faUnderScore]<>[] Then S:=S+'!UNDERSCORE!';
979 End;
980 MemStream.WriteBuffer(S,Length(S)+1);
981
982 If Column.Title.Font=Font Then S:=''
983 Else
984 Begin
985 S:=Column.Title.Font.FaceName;
986 If Column.Title.Font.IsDefault Then S:='System Default Font';
987 S:=tostr(Column.Title.Font.PointSize)+'.'+S;
988
989 s1:=S;
990 UpcaseStr(s1);
991 Attrs:=Column.Title.Font.Attributes;
992 If Attrs*[faBold]<>[] Then If Pos(' BOLD',s1)=0 Then S:=S+'!BOLD!';
993 If Attrs*[faItalic]<>[] Then If Pos(' ITALIC',s1)=0 Then S:=S+'!ITALIC!';
994 If Attrs*[faOutline]<>[] Then S:=S+'!OUTLINE!';
995 If Attrs*[faStrikeOut]<>[] Then S:=S+'!STRIKEOUT!';
996 If Attrs*[faUnderScore]<>[] Then S:=S+'!UNDERSCORE!';
997 End;
998 MemStream.WriteBuffer(S,Length(S)+1);
999 End;
1000
1001 If MemStream.Size>0 Then Result:=Stream.NewResourceEntry(rnDBGridCols,
1002 MemStream.Memory^,MemStream.Size);
1003 MemStream.Destroy;
1004 End;
1005End;
1006
1007Function ModifyFontName(FontName:String;Const Attrs:TFontAttributes):String;
1008Begin
1009 Result:=FontName;
1010 UpcaseStr(FontName);
1011 If Attrs*[faItalic]<>[] Then If Pos(' ITALIC',FontName)=0 Then Result:=Result+'.Italic';
1012 If Attrs*[faBold]<>[] Then If Pos(' BOLD',FontName)=0 Then Result:=Result+'.Bold';
1013 If Attrs*[faOutline]<>[] Then Result:=Result+'.Outline';
1014 If Attrs*[faStrikeOut]<>[] Then Result:=Result+'.Strikeout';
1015 If Attrs*[faUnderScore]<>[] Then Result:=Result+'.Underscore';
1016End;
1017
1018Procedure TDBGrid.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
1019Var Count:^LongInt;
1020 T,t1:LongInt;
1021 Temp:^Byte;
1022 Column:TDBGridColumn;
1023 rec:TColumnsRec;
1024 S,s1:String;
1025 PointSize:LongInt;
1026 C:Integer;
1027 Attrs:TFontAttributes;
1028Begin
1029 If ResName=rnDBGridCols Then
1030 Begin
1031 Count:=@Data;
1032 Temp:=@Data;
1033 Inc(Temp,4);
1034 If Count^>=0 Then //FColumns.Count-1 was written to SCU
1035 Begin
1036 FColumns.Create(Self);
1037 FColumns.BeginUpdate;
1038 End;
1039 For T:=0 To Count^ Do
1040 Begin
1041 Column:=FColumns.Add;
1042 System.Move(Temp^,rec,SizeOf(TColumnsRec));
1043 Inc(Temp,SizeOf(TColumnsRec));
1044 Column.Alignment:=rec.ColAlignment;
1045 Column.color:=rec.ColColor;
1046 Column.PenColor:=rec.ColPenColor;
1047 Column.Width:=rec.ColWidth;
1048 Column.ReadOnly:=rec.ColReadOnly;
1049 Column.Title.Alignment:=rec.TitleAlignment;
1050 Column.Title.PenColor:=rec.TitlePenColor;
1051 Column.Title.color:=rec.TitleColor;
1052
1053 System.Move(Temp^,S,Temp^+1);
1054 Inc(Temp,Temp^+1);
1055 Column.FieldName:=S;
1056 System.Move(Temp^,S,Temp^+1);
1057 Inc(Temp,Temp^+1);
1058 Column.Title.Caption:=S;
1059
1060 System.Move(Temp^,S,Temp^+1);
1061 Inc(Temp,Temp^+1);
1062 If S<>'' Then
1063 Begin
1064 Attrs:=[];
1065 t1:=Pos('!',S);
1066 If t1<>0 Then
1067 Begin
1068 If Pos('!BOLD!',S)<>0 Then Attrs:=Attrs+[faBold];
1069 If Pos('!ITALIC!',S)<>0 Then Attrs:=Attrs+[faItalic];
1070 If Pos('!OUTLINE!',S)<>0 Then Attrs:=Attrs+[faOutline];
1071 If Pos('!STRIKEOUT!',S)<>0 Then Attrs:=Attrs+[faStrikeOut];
1072 If Pos('!UNDERSCORE!',S)<>0 Then Attrs:=Attrs+[faUnderScore];
1073 If Attrs<>[] Then S[0]:=Chr(t1-1);
1074 End;
1075
1076 PointSize:=0;
1077 If Pos('.',S)<>0 Then
1078 Begin
1079 s1:=Copy(S,1,Pos('.',S)-1);
1080 Delete(S,1,Pos('.',S));
1081 Val(s1,PointSize,C);
1082 End;
1083 S:=ModifyFontName(S,Attrs);
1084 Column.Font:=Screen.GetFontFromPointSize(S,PointSize);
1085 End;
1086
1087 System.Move(Temp^,S,Temp^+1);
1088 Inc(Temp,Temp^+1);
1089 If S<>'' Then
1090 Begin
1091 Attrs:=[];
1092 t1:=Pos('!',S);
1093 If t1<>0 Then
1094 Begin
1095 If Pos('!BOLD!',S)<>0 Then Attrs:=Attrs+[faBold];
1096 If Pos('!ITALIC!',S)<>0 Then Attrs:=Attrs+[faItalic];
1097 If Pos('!OUTLINE!',S)<>0 Then Attrs:=Attrs+[faOutline];
1098 If Pos('!STRIKEOUT!',S)<>0 Then Attrs:=Attrs+[faStrikeOut];
1099 If Pos('!UNDERSCORE!',S)<>0 Then Attrs:=Attrs+[faUnderScore];
1100 If Attrs<>[] Then S[0]:=Chr(t1-1);
1101 End;
1102
1103 PointSize:=0;
1104 If Pos('.',S)<>0 Then
1105 Begin
1106 s1:=Copy(S,1,Pos('.',S)-1);
1107 Delete(S,1,Pos('.',S));
1108 Val(s1,PointSize,C);
1109 End;
1110 S:=ModifyFontName(S,Attrs);
1111 Column.Title.Font:=Screen.GetFontFromPointSize(S,PointSize);
1112 End;
1113 End;
1114 If FColumns<>Nil Then FColumns.EndUpdate;
1115 End
1116 Else Inherited ReadSCUResource(ResName,Data,DataLen);
1117End;
1118
1119Procedure TDBGrid.SetColumns(NewColumns:TDBGridColumns);
1120Var T:LongInt;
1121 Column:TDBGridColumn;
1122Begin
1123 If NewColumns<>FColumns Then If FColumns<>Nil Then FColumns.Destroy;
1124 FColumns:=NewColumns;
1125
1126 If FColumns<>Nil Then FColumns.FGrid:=Self;
1127
1128 If FColumns<>Nil Then If FColumns.Count=0 Then
1129 Begin
1130 FColumns.Destroy;
1131 FColumns:=Nil;
1132 End;
1133
1134 If FColumns<>Nil Then
1135 Begin
1136 ColCount:=FColumns.Count+FixedCols;
1137 For T:=0 To FColumns.Count-1 Do
1138 Begin
1139 Column:=FColumns.Items[T];
1140 ColWidths[T+FixedCols]:=Column.Width;
1141 End;
1142 End
1143 Else
1144 Begin
1145 If FDataLink.DataSource<>Nil Then ColCount:=FDataLink.FieldCount+FixedCols;
1146 End;
1147
1148 Invalidate;
1149End;
1150
1151Procedure TDBGrid.SetGridOptions(NewValue:TDBGridOptions);
1152Var IOptions:TGridOptions;
1153Begin
1154 IOptions:=[];
1155 FGridOptions:=NewValue;
1156 If FGridOptions*[dgBorder]<>[] Then Include(IOptions,goBorder);
1157 If FGridOptions*[dgRowResize]<>[] Then Include(IOptions,goRowSizing);
1158 If FGridOptions*[dgColumnResize]<>[] Then Include(IOptions,goColSizing);
1159 If FGridOptions*[dgEditing]<>[] Then Include(IOptions,goEditing);
1160 If FGridOptions*[dgAlwaysShowEditor]<>[] Then Include(IOptions,goAlwaysShowEditor);
1161 If FGridOptions*[dgShowSelection]<>[] Then Include(IOptions,goShowSelection);
1162 If FGridOptions*[dgAlwaysShowSelection]<>[] Then Include(IOptions,goAlwaysShowSelection);
1163 If FGridOptions*[dgMouseSelect]<>[] Then Include(IOptions,goMouseSelect);
1164 Inherited Options:=IOptions;
1165
1166 If FGridOptions*[dgIndicator]=[] Then FixedCols:=0
1167 Else FixedCols:=1;
1168 If FGridOptions*[dgTitles]=[] Then FixedRows:=0
1169 Else FixedRows:=1;
1170End;
1171
1172Function TDBGrid.SelectCell(Col,Row:LongInt):Boolean;
1173Begin
1174 Result:=Inherited SelectCell(Col,Row);
1175 If FDataLink.DataSource<>Nil Then
1176 If FDataLink.DataSource.DataSet<>Nil Then
1177 If FDataLink.DataSource.DataSet.Active Then
1178 Begin
1179 Try
1180 FDataLink.DataSource.DataSet.CurrentRow:=Row-1;
1181 Except
1182 ON E:ESQLError Do ErrorBox(E.Message);
1183 Else Raise;
1184 End;
1185 End;
1186End;
1187
1188Procedure TDBGrid.Scroll(ScrollBar:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);
1189Begin
1190 If ScrollCode In [scVertTrack,scHorzTrack] Then Exit;
1191 Inherited Scroll(ScrollBar,ScrollCode,ScrollPos);
1192End;
1193
1194Procedure TDBGrid.SetupCellColors(Col,Row:LongInt;AState:TGridDrawState;Var background,ForeGround:TColor);
1195Var Col1:LongInt;
1196 Column:TDBGridColumn;
1197Begin
1198 Col1:=Col-FixedCols;
1199 If ((FColumns<>Nil)And(Col1>=0)And(Col1<FColumns.Count)) Then
1200 Begin
1201 Column:=FColumns.Items[Col1];
1202 If Row<FixedRows Then
1203 Begin
1204 background:=Column.Title.color;
1205 ForeGround:=Column.Title.PenColor;
1206 End
1207 Else
1208 Begin
1209 background:=Column.color;
1210 ForeGround:=Column.PenColor;
1211 End;
1212 End
1213 Else Inherited SetupCellColors(Col,Row,AState,background,ForeGround);
1214
1215 If AState*[gdFixed]=[] Then
1216 Begin
1217 If AState*[gdSelected]<>[] Then If Options*[goShowSelection,goEditing]<>[] Then
1218 Begin
1219 If AState*[gdFocused]=[] Then
1220 Begin
1221 If Options*[goAlwaysShowSelection]<>[] Then
1222 Begin
1223 background:=clHighlight;
1224 ForeGround:=clHighlightText;
1225 End;
1226 End
1227 Else
1228 Begin
1229 background:=clHighlight;
1230 ForeGround:=clHighlightText;
1231 End;
1232 End;
1233 End;
1234End;
1235
1236Procedure TDBGrid.SetupCellDrawing(Col,Row:LongInt;AState:TGridDrawState;
1237 Var Alignment:TAlignment;Var DrawFont:TFont);
1238Var Col1:LongInt;
1239 Column:TDBGridColumn;
1240Begin
1241 Col1:=Col-FixedCols;
1242 If ((FColumns<>Nil)And(Col1>=0)And(Col1<FColumns.Count)) Then
1243 Begin
1244 Column:=FColumns.Items[Col1];
1245 If Row<FixedRows Then
1246 Begin
1247 Alignment:=Column.Title.Alignment;
1248 DrawFont:=Column.Title.Font;
1249 End
1250 Else
1251 Begin
1252 Alignment:=Column.Alignment;
1253 DrawFont:=Column.Font;
1254 End;
1255 End
1256 Else Inherited SetupCellDrawing(Col,Row,AState,Alignment,DrawFont);
1257End;
1258
1259Procedure TDBGrid.DrawCell(Col,Row:LongInt;rec:TRect;AState:TGridDrawState);
1260Var rc:TRect;
1261 X,Y,CX,CY:LongInt;
1262 s:String;
1263Begin
1264 If Canvas=Nil Then Exit;
1265
1266 Inherited DrawCell(Col,Row,rec,AState);
1267
1268 If ((AState*[gdFixed]<>[])And(Col=0)And(Col<FixedCols)And(Row-FixedRows>=0)And
1269 (FDataLink.DataSource<>Nil)And(FDataLink.DataSource.DataSet<>Nil)) Then
1270 Begin
1271 If Row-FixedRows=FDataLink.DataSource.DataSet.CurrentRow Then
1272 Begin
1273 {Draw Polygon To Mark Current Row In DataSet}
1274 rc:=GridRects[Col,Row];
1275 Canvas.ClipRect := rc;
1276 X:=rc.Left+((((rc.Right-rc.Left)-10) Div 2));
1277 Y:=rc.Bottom+(((rc.Top-rc.Bottom)-10) Div 2);
1278 Canvas.Pen.Color:=PenColor;
1279 If FDataLink.DataSource.DataSet.RowInserted
1280 Then Canvas.PolyLine([Point(X,Y),Point(X,Y+10),Point(X+10,Y+5),Point(X,Y)])
1281 Else Canvas.Polygon([Point(X,Y),Point(X,Y+10),Point(X+10,Y+5),Point(X,Y)]);
1282 End
1283 Else
1284 Begin
1285 If dgLineNumbers In FGridOptions Then
1286 Begin
1287 rc:=GridRects[Col,Row];
1288 Canvas.ClipRect:=rc;
1289 s:=tostr(Row-FixedRows+1);
1290 Canvas.GetTextExtent(s,CX,CY);
1291 X:=rc.Right-3-CX;
1292 Y:=rc.Top-2-Canvas.Font.Height;
1293 Canvas.Pen.Color:=PenColor;
1294 Canvas.TextOut(X,Y,s);
1295 End;
1296 End;
1297 End;
1298End;
1299
1300Function TDBGrid.GetCell(Col,Row:LongInt):String;
1301Var
1302 Field:TField;
1303 Column:TDBGridColumn;
1304 Col1:LongInt;
1305Begin
1306 Result:='';
1307
1308 If Row<=FixedRows-1 Then
1309 Begin
1310 If Row=0 Then If Col>=FixedCols-1 Then
1311 Begin
1312 If FColumns<>Nil Then
1313 Begin
1314 Col1:=Col-FixedCols;
1315 If ((Col1>=0)And(Col1<FColumns.Count)) Then
1316 Begin
1317 Column:=FColumns.Items[Col1];
1318 Result:=Column.Title.Caption;
1319 If Result='' Then Result:=Column.FieldName;
1320 End
1321 Else Result:=Inherited GetCell(Col,Row);
1322 End
1323 Else
1324 Begin
1325 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
1326 Result:=FDataLink.DataSource.DataSet.FieldNames[Col-FixedCols];
1327 End;
1328 End;
1329 End
1330 Else If Col<=FixedCols-1 Then Exit
1331 Else
1332 Begin
1333 Try
1334 Field:=Nil;
1335 If FColumns<>Nil Then
1336 Begin
1337 Col1:=Col-FixedCols;
1338 If ((Col1>=0)And(Col1<FColumns.Count)) Then
1339 Begin
1340 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then
1341 Begin
1342 Result:=Inherited GetCell(Col,Row);
1343 Exit;
1344 End;
1345
1346 Column:=FColumns.Items[Col1];
1347 Field:=FDataLink.FieldsFromColumnName[Column.FieldName,Row-FixedRows];
1348 If Field=Nil Then //ColumnName does Not exist
1349 Begin
1350 Result:=Inherited GetCell(Col,Row);
1351 Exit;
1352 End;
1353 End
1354 Else
1355 Begin
1356 Result:=Inherited GetCell(Col,Row);
1357 Exit;
1358 End;
1359 End
1360 Else
1361 Begin
1362 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
1363 Field:=FDataLink.Fields[Col-FixedCols,Row-FixedRows];
1364 If Field=Nil Then RowCount:=Row; {no more Rows}
1365 End;
1366 Except
1367 ON E:ESQLError Do
1368 Begin
1369 ErrorBox(E.Message);
1370 Field:=Nil;
1371 End;
1372 Else Raise;
1373 End;
1374 If Field<>Nil Then Result:=Field.AsString;
1375 End;
1376End;
1377
1378{$HINTS OFF}
1379Procedure TDBGrid.SetCell(Col,Row:LongInt;Const NewContent:String);
1380Var Field:TField;
1381 Column:TDBGridColumn;
1382 Col1:LongInt;
1383Begin
1384 If FDataLink.DataSource=Nil Then Exit;
1385 If FDataLink.DataSource.DataSet=Nil Then Exit;
1386
1387 If ((Col<FixedCols)Or(Row<FixedRows)) Then Exit;
1388
1389 Try
1390 Field:=Nil;
1391 If FColumns<>Nil Then
1392 Begin
1393 Col1:=Col-FixedCols;
1394 If ((Col1>=0)And(Col1<FColumns.Count)) Then
1395 Begin
1396 Column:=FColumns.Items[Col1];
1397 If Not Column.ReadOnly Then
1398 Begin
1399 Field:=FDataLink.FieldsFromColumnName[Column.FieldName,Row-FixedRows];
1400 If Field=Nil Then //ColumnName does Not exist
1401 Begin
1402 Inherited SetCell(Col,Row,NewContent);
1403 Exit;
1404 End;
1405 End;
1406 End
1407 Else
1408 Begin
1409 Inherited SetCell(Col,Row,NewContent);
1410 Exit;
1411 End;
1412 End
1413 Else Field:=FDataLink.Fields[Col-FixedCols,Row-FixedRows];
1414 Except
1415 ON E:ESQLError Do
1416 Begin
1417 ErrorBox(E.Message);
1418 Field:=Nil;
1419 End;
1420 Else Raise;
1421 End;
1422
1423 If Field=Nil Then Exit;
1424
1425 If Field.AsString=NewContent Then Exit;
1426 Field.AsString:=NewContent;
1427 If Not FDataLink.DataSource.DataSet.RowInserted
1428 Then FDataLink.DataSource.DataSet.Post
1429 Else FDataLink.DataSource.DataSet.Refresh;
1430End;
1431
1432Procedure TDBGrid.DataChange(Sender:TObject;event:TDataChange);
1433Var Col,Row:LongInt;
1434 I:LongInt;
1435 FieldClass:TFieldClass;
1436 LastRow:LongInt;
1437 T,t1:LongInt;
1438 X,Y:LongInt;
1439 su:Boolean;
1440 Max:LongInt;
1441 dummy:TDBGridColumn;
1442Begin
1443 If Event=deTableNameChanged Then
1444 Begin
1445 Columns:=Nil;
1446 exit;
1447 End;
1448
1449 GridUpdateLocked:=True;
1450 If FDataLink.DataSource<>Nil Then
1451 Begin
1452 If (FColumns=Nil) And (FDataLink.FieldCount>0) Then
1453 Begin
1454 //add default columns
1455 ColCount:=FDataLink.FieldCount+FixedCols; {!!}
1456
1457 FColumns.Create(Self);
1458 FColumns.FAutoCreated := True;
1459
1460 For t:=0 To FDataLink.FieldCount-1 Do
1461 Begin
1462 dummy:=FColumns.Add;
1463 dummy.Alignment:=taLeftJustify;
1464 dummy.Color:=clEntryField;
1465 dummy.PenColor:=clBlack;
1466 dummy.Width:=DefaultColWidth;
1467 dummy.Font:=Font;
1468 dummy.FieldName:=FDataLink.FieldNames[t];
1469 dummy.Title.Alignment:=taLeftJustify;
1470 dummy.Title.Color:=clLtGray;
1471 dummy.Title.PenColor:=clBlack;
1472 dummy.Title.Font:=Font;
1473 If FDataLink.DataSource.DataSet<>Nil Then
1474 Begin
1475 FieldClass:=FDataLink.DataSource.DataSet.FieldDefs[t].FieldClass;
1476 If (FieldClass Is TMemoField) Or
1477 (FieldClass Is TBlobField)
1478 Then dummy.ReadOnly:=True;
1479
1480 If (FieldClass Is TSmallintField) Or
1481 (FieldClass Is TIntegerField) Or
1482 (FieldClass Is TFloatField)
1483 Then dummy.Alignment:=taRightJustify;
1484
1485 If (FieldClass Is TStringField)
1486 Then dummy.Width:=Font.Width*FDataLink.DataSource.DataSet.FieldDefs[t].Size Div 2;
1487 End;
1488 End;
1489 End;
1490
1491 If (FDataLink.FieldCount = 0) Then
1492 If FColumns <> Nil Then
1493 If FColumns.FAutoCreated Then
1494 Begin
1495 //remove default columns
1496 SetColumns(Nil);
1497 End;
1498
1499 If FColumns<>Nil Then ColCount:=FColumns.Count+FixedCols
1500 Else ColCount:=FDataLink.FieldCount+FixedCols;
1501
1502 If FDataLink.DataSource.DataSet<>Nil Then
1503 Begin
1504 If RowCount<>FDataLink.DataSource.DataSet.MaxRows+FixedRows Then
1505 RowCount:=FDataLink.DataSource.DataSet.MaxRows+FixedRows;
1506
1507 //check If CurrentRow fits In Window
1508 Max:=FDataLink.DataSource.DataSet.CurrentRow;
1509 If Max<>-1 Then
1510 Begin
1511 If Max<TopRow Then
1512 Begin
1513 {Scroll up}
1514 FUpScrolled:=0;
1515 FUpExtent:=0;
1516 su:=True;
1517 End
1518 Else su:=False;
1519
1520 //check If marker would fit In Window
1521 If GridOptions*[dgBorder]<>[] Then Y:=Height-1
1522 Else Y:=Height;
1523 If HorzScrollBar<>Nil Then
1524 If HorzScrollBar.Visible Then Dec(Y,HorzScrollBar.Height);
1525 For T:=0 To FixedRows-1 Do Dec(Y,RowHeights[T]);
1526 For T:=FixedRows+TopRow To FixedRows+Max Do Dec(Y,RowHeights[T]);
1527 If Y<0 Then //Scroll
1528 Begin
1529 T:=TopRow;
1530 For t1:=FixedRows+TopRow To FixedRows+Max Do
1531 Begin
1532 Inc(FUpExtent,RowHeights[t1]);
1533 Inc(T);
1534 Inc(Y,RowHeights[t1]);
1535 If Y>0 Then break;
1536 End;
1537 FUpScrolled:=T;
1538 End;
1539 VertScrollBar.Position:=FUpExtent;
1540 Invalidate;
1541 End;
1542 End;
1543 End;
1544 GridUpdateLocked:=False; //Redraw whole Grid
1545End;
1546{$HINTS ON}
1547
1548Procedure TDBGrid.SetDataSource(NewValue:TDataSource);
1549Begin
1550 FDataLink.DataSource:=NewValue;
1551End;
1552
1553Function TDBGrid.GetDataSource:TDataSource;
1554Begin
1555 Result:=FDataLink.DataSource;
1556End;
1557
1558Procedure TDBGrid.SetupComponent;
1559Begin
1560 Inherited SetupComponent;
1561
1562 FGridOptions:=[dgBorder,dgShowSelection,dgTitles,dgIndicator,dgMouseSelect,dgEnableMaskEdit];
1563 FDataLink.Create(Self);
1564 FDataLink.OnDataChange:=DataChange;
1565 Include(FDataLink.ComponentState, csDetail);
1566 Name:='DBGrid';
1567 ColWidths[0]:=20;
1568End;
1569
1570Destructor TDBGrid.Destroy;
1571Begin
1572 If FColumns<>Nil Then FColumns.Destroy;
1573 FDataLink.OnDataChange:=Nil;
1574 FDataLink.Destroy;
1575 FDataLink:=Nil;
1576
1577 Inherited Destroy;
1578End;
1579
1580{
1581ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1582º º
1583º Speed-Pascal/2 Version 2.0 º
1584º º
1585º Speed-Pascal Component Classes (SPCC) º
1586º º
1587º This section: TDBEdit Class Implementation º
1588º º
1589º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1590º º
1591ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1592}
1593
1594Function TDBEdit.WriteSCUResource(Stream:TResourceStream):Boolean;
1595Var S:String;
1596Begin
1597 Result:=Inherited WriteSCUResource(Stream);
1598 If Result=False Then Exit;
1599
1600 S:=FDataLink.FieldName;
1601 Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
1602End;
1603
1604Procedure TDBEdit.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
1605Var S:String;
1606Begin
1607 If ResName = rnDBDataField Then
1608 Begin
1609 System.Move(Data,S,DataLen);
1610 FDataLink.FieldName:=S;
1611 End
1612 Else Inherited ReadSCUResource(ResName,Data,DataLen);
1613End;
1614
1615Procedure TDBEdit.SetDataSource(NewValue:TDataSource);
1616Begin
1617 FDataLink.DataSource:=NewValue;
1618End;
1619
1620Function TDBEdit.GetDataSource:TDataSource;
1621Begin
1622 Result:=FDataLink.DataSource;
1623End;
1624
1625Procedure TDBEdit.SetDataField(NewValue:String);
1626Begin
1627 FDataLink.FieldName:=NewValue;
1628End;
1629
1630Function TDBEdit.GetDataField:String;
1631Begin
1632 Result:=FDataLink.FieldName;
1633End;
1634
1635Procedure TDBEdit.SetupComponent;
1636Begin
1637 Inherited SetupComponent;
1638
1639 FDataLink.Create(Self);
1640 FDataLink.OnDataChange:=DataChange;
1641 Include(FDataLink.ComponentState, csDetail);
1642 Name:='DBEdit';
1643End;
1644
1645Destructor TDBEdit.Destroy;
1646Begin
1647 FDataLink.OnDataChange:=Nil;
1648 FDataLink.Destroy;
1649 FDataLink:=Nil;
1650
1651 Inherited Destroy;
1652End;
1653
1654{$HINTS OFF}
1655Procedure TDBEdit.DataChange(Sender:TObject;event:TDataChange);
1656Var Field:TField;
1657Begin
1658 Try
1659 Field:=FDataLink.Field;
1660 Except
1661 ON E:ESQLError Do
1662 Begin
1663 ErrorBox(E.Message);
1664 Field:=Nil;
1665 End;
1666 Else Raise;
1667 End;
1668 If Field<>Nil Then Caption:=Field.AsString
1669 Else Caption:='';
1670End;
1671{$HINTS ON}
1672
1673Procedure TDBEdit.SetupShow;
1674Begin
1675 Inherited SetupShow;
1676 DataChange(FDataLink,deDataBaseChanged);
1677End;
1678
1679
1680Procedure TDBEdit.WriteBack;
1681Var S:String;
1682 Field:TField;
1683Begin
1684 If FDataLink = Nil Then exit;
1685 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
1686 S:=Text;
1687
1688 Try
1689 Field:=FDataLink.Field;
1690 If Field<>Nil Then
1691 If Field.AsString<>S Then
1692 Begin
1693 Field.AsString:=S;
1694 If Not FDataLink.DataSource.DataSet.RowInserted
1695 Then FDataLink.DataSource.DataSet.Post
1696 Else FDataLink.DataSource.DataSet.Refresh;
1697 End;
1698 Except
1699 ON E:ESQLError Do
1700 Begin
1701 ErrorBox(E.Message);
1702 Field:=Nil;
1703 End;
1704 Else Raise;
1705 End;
1706End;
1707
1708Procedure TDBEdit.KillFocus;
1709Begin
1710 WriteBack;
1711
1712 Inherited KillFocus;
1713End;
1714
1715Procedure TDBEdit.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
1716Begin
1717 If KeyCode=kbCR Then WriteBack;
1718
1719 Inherited ScanEvent(KeyCode,RepeatCount);
1720End;
1721
1722{
1723ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1724º º
1725º Speed-Pascal/2 Version 2.0 º
1726º º
1727º Speed-Pascal Component Classes (SPCC) º
1728º º
1729º This section: TDBText Class Implementation º
1730º º
1731º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1732º º
1733ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1734}
1735
1736Function TDBText.WriteSCUResource(Stream:TResourceStream):Boolean;
1737Var S:String;
1738Begin
1739 Result:=Inherited WriteSCUResource(Stream);
1740 If Result=False Then Exit;
1741 S:=FDataLink.FieldName;
1742 Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
1743End;
1744
1745Procedure TDBText.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
1746Var S:String;
1747Begin
1748 If ResName = rnDBDataField Then
1749 Begin
1750 System.Move(Data,S,DataLen);
1751 FDataLink.FieldName:=S;
1752 End
1753 Else Inherited ReadSCUResource(ResName,Data,DataLen);
1754End;
1755
1756
1757Procedure TDBText.SetDataSource(NewValue:TDataSource);
1758Begin
1759 FDataLink.DataSource:=NewValue;
1760End;
1761
1762Function TDBText.GetDataSource:TDataSource;
1763Begin
1764 Result:=FDataLink.DataSource;
1765End;
1766
1767Procedure TDBText.SetDataField(NewValue:String);
1768Begin
1769 FDataLink.FieldName:=NewValue;
1770End;
1771
1772Function TDBText.GetDataField:String;
1773Begin
1774 Result:=FDataLink.FieldName;
1775End;
1776
1777Procedure TDBText.SetupComponent;
1778Begin
1779 Inherited SetupComponent;
1780
1781 FDataLink.Create(Self);
1782 FDataLink.OnDataChange:=DataChange;
1783 Include(FDataLink.ComponentState, csDetail);
1784
1785 Name:='DBText';
1786 Caption:=Name;
1787 AutoSize:=False;
1788End;
1789
1790Destructor TDBText.Destroy;
1791Begin
1792 FDataLink.OnDataChange:=Nil;
1793 FDataLink.Destroy;
1794 FDataLink:=Nil;
1795
1796 Inherited Destroy;
1797End;
1798
1799{$HINTS OFF}
1800Procedure TDBText.DataChange(Sender:TObject;event:TDataChange);
1801Var Field:TField;
1802Begin
1803 Try
1804 Field:=FDataLink.Field;
1805 Except
1806 ON E:ESQLError Do
1807 Begin
1808 ErrorBox(E.Message);
1809 Field:=Nil;
1810 End;
1811 Else Raise;
1812 End;
1813 If Field<>Nil Then Caption:=Field.AsString
1814 Else Caption:='';
1815End;
1816{$HINTS ON}
1817
1818Procedure TDBText.SetupShow;
1819Begin
1820 Inherited SetupShow;
1821 DataChange(FDataLink,deDataBaseChanged);
1822End;
1823
1824{
1825ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1826º º
1827º Speed-Pascal/2 Version 2.0 º
1828º º
1829º Speed-Pascal Component Classes (SPCC) º
1830º º
1831º This section: TDBCheckBox Class Implementation º
1832º º
1833º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1834º º
1835ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1836}
1837
1838Function TDBCheckBox.WriteSCUResource(Stream:TResourceStream):Boolean;
1839Var S:String;
1840Begin
1841 Result:=Inherited WriteSCUResource(Stream);
1842 If Result=False Then Exit;
1843 S:=FDataLink.FieldName;
1844 Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
1845End;
1846
1847Procedure TDBCheckBox.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
1848Var S:String;
1849Begin
1850 If ResName = rnDBDataField Then
1851 Begin
1852 System.Move(Data,S,DataLen);
1853 FDataLink.FieldName:=S;
1854 End
1855 Else Inherited ReadSCUResource(ResName,Data,DataLen);
1856End;
1857
1858
1859Procedure TDBCheckBox.SetDataSource(NewValue:TDataSource);
1860Begin
1861 FDataLink.DataSource:=NewValue;
1862End;
1863
1864Function TDBCheckBox.GetDataSource:TDataSource;
1865Begin
1866 Result:=FDataLink.DataSource;
1867End;
1868
1869Procedure TDBCheckBox.SetDataField(NewValue:String);
1870Begin
1871 FDataLink.FieldName:=NewValue;
1872End;
1873
1874Function TDBCheckBox.GetDataField:String;
1875Begin
1876 Result:=FDataLink.FieldName;
1877End;
1878
1879Procedure TDBCheckBox.SetupComponent;
1880Begin
1881 Inherited SetupComponent;
1882
1883 FDataLink.Create(Self);
1884 FDataLink.OnDataChange:=DataChange;
1885 Include(FDataLink.ComponentState, csDetail);
1886
1887 Name:='DBCheckBox';
1888 Caption:=Name;
1889
1890 ValueChecked := 'True';
1891 ValueUnchecked := 'False';
1892End;
1893
1894Destructor TDBCheckBox.Destroy;
1895Begin
1896 FDataLink.OnDataChange:=Nil;
1897 FDataLink.Destroy;
1898 FDataLink:=Nil;
1899 If FValueChecked<>Nil Then FreeMem(FValueChecked,Length(FValueChecked^)+1);
1900 FValueChecked:=Nil;
1901 If FValueUnchecked<>Nil Then FreeMem(FValueUnchecked,Length(FValueUnchecked^)+1);
1902 FValueUnchecked:=Nil;
1903
1904 Inherited Destroy;
1905End;
1906
1907
1908Procedure TDBCheckBox.WriteBack;
1909Var S:String;
1910 Field:TField;
1911Begin
1912 If FDataLink = Nil Then exit;
1913 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
1914 If Checked Then S:=ValueChecked
1915 Else S:=ValueUnchecked;
1916
1917 Try
1918 Field:=FDataLink.Field;
1919 If Field<>Nil Then
1920 If Field.AsString<>S Then
1921 Begin
1922 Field.AsString:=S;
1923 If Not FDataLink.DataSource.DataSet.RowInserted
1924 Then FDataLink.DataSource.DataSet.Post
1925 Else FDataLink.DataSource.DataSet.Refresh;
1926 End;
1927 Except
1928 ON E:ESQLError Do
1929 Begin
1930 ErrorBox(E.Message);
1931 Field:=Nil;
1932 End;
1933 Else Raise;
1934 End;
1935End;
1936
1937Procedure TDBCheckBox.Click;
1938Begin
1939 Inherited Click;
1940
1941 WriteBack;
1942End;
1943
1944{$HINTS OFF}
1945Procedure TDBCheckBox.DataChange(Sender:TObject;event:TDataChange);
1946Var Field:TField;
1947 S,s1:String;
1948 Value:String;
1949 B:Byte;
1950Begin
1951 Try
1952 Field:=FDataLink.Field;
1953 Except
1954 ON E:ESQLError Do
1955 Begin
1956 ErrorBox(E.Message);
1957 Field:=Nil;
1958 End;
1959 Else Raise;
1960 End;
1961 If Field<>Nil Then
1962 Begin
1963 Value:=Field.AsString;
1964 If Value <> '' Then
1965 Begin
1966 S:=ValueChecked;
1967 UpcaseStr(S);
1968 UpcaseStr(Value);
1969 B:=Pos(';',S);
1970 While B<>0 Do
1971 Begin
1972 s1:=Copy(S,1,B-1);
1973 Delete(S,1,B);
1974 If s1=Value Then
1975 Begin
1976 Checked:=True;
1977 Exit;
1978 End;
1979 B:=Pos(';',S);
1980 End;
1981 Checked:=S=Value;
1982 End
1983 Else State:=cbGrayed;
1984 End
1985 //Else Checked:=False;
1986 Else State:=cbGrayed;
1987End;
1988{$HINTS ON}
1989
1990Procedure TDBCheckBox.SetupShow;
1991Begin
1992 Inherited SetupShow;
1993 DataChange(FDataLink,deDataBaseChanged);
1994End;
1995
1996Procedure TDBCheckBox.SetValueChecked(NewValue:String);
1997Begin
1998 If FValueChecked<>Nil Then FreeMem(FValueChecked,Length(FValueChecked^)+1);
1999 If NewValue<>'' Then
2000 Begin
2001 GetMem(FValueChecked,Length(NewValue)+1);
2002 FValueChecked^:=NewValue;
2003 End
2004 Else FValueChecked:=Nil;
2005End;
2006
2007Function TDBCheckBox.GetValueChecked:String;
2008Begin
2009 If FValueChecked=Nil Then Result:=''
2010 Else Result:=FValueChecked^;
2011End;
2012
2013Procedure TDBCheckBox.SetValueUnchecked(NewValue:String);
2014Begin
2015 If FValueUnchecked<>Nil Then FreeMem(FValueUnchecked,Length(FValueUnchecked^)+1);
2016 If NewValue<>'' Then
2017 Begin
2018 GetMem(FValueUnchecked,Length(NewValue)+1);
2019 FValueUnchecked^:=NewValue;
2020 End
2021 Else FValueUnchecked:=Nil;
2022End;
2023
2024Function TDBCheckBox.GetValueUnchecked:String;
2025Begin
2026 If FValueUnchecked=Nil Then Result:=''
2027 Else Result:=FValueUnchecked^;
2028End;
2029
2030
2031{
2032ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2033º º
2034º Speed-Pascal/2 Version 2.0 º
2035º º
2036º Speed-Pascal Component Classes (SPCC) º
2037º º
2038º This section: TDBImage Class Implementation º
2039º º
2040º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2041º º
2042ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2043}
2044
2045Function TDBImage.WriteSCUResource(Stream:TResourceStream):Boolean;
2046Var S:String;
2047Begin
2048 Result:=Inherited WriteSCUResource(Stream);
2049 If Result=False Then Exit;
2050 S:=FDataLink.FieldName;
2051 Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
2052End;
2053
2054Procedure TDBImage.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
2055Var S:String;
2056Begin
2057 If ResName = rnDBDataField Then
2058 Begin
2059 System.Move(Data,S,DataLen);
2060 FDataLink.FieldName:=S;
2061 End
2062 Else Inherited ReadSCUResource(ResName,Data,DataLen);
2063End;
2064
2065
2066Procedure TDBImage.SetDataSource(NewValue:TDataSource);
2067Begin
2068 FDataLink.DataSource:=NewValue;
2069End;
2070
2071Function TDBImage.GetDataSource:TDataSource;
2072Begin
2073 Result:=FDataLink.DataSource;
2074End;
2075
2076Procedure TDBImage.SetDataField(NewValue:String);
2077Begin
2078 FDataLink.FieldName:=NewValue;
2079End;
2080
2081Function TDBImage.GetDataField:String;
2082Begin
2083 Result:=FDataLink.FieldName;
2084End;
2085
2086Procedure TDBImage.SetupComponent;
2087Begin
2088 Inherited SetupComponent;
2089
2090 FDataLink.Create(Self);
2091 FDataLink.OnDataChange:=DataChange;
2092 Include(FDataLink.ComponentState, csDetail);
2093
2094 Name:='DBImage';
2095End;
2096
2097Destructor TDBImage.Destroy;
2098Begin
2099(* destroyed In Inherited
2100 If FBitmap<>Nil Then
2101 Begin
2102 FBitmap.Destroy;
2103 FBitmap:=Nil;
2104 End;
2105*)
2106 FDataLink.OnDataChange:=Nil;
2107 FDataLink.Destroy;
2108 FDataLink:=Nil;
2109
2110 Inherited Destroy;
2111End;
2112
2113Procedure TDBImage.SetupShow;
2114Begin
2115 NeedBitmap := False;
2116 Inherited SetupShow;
2117 DataChange(FDataLink,deDataBaseChanged);
2118End;
2119
2120//Inhalt der Grafik hat sich ge„ndert - in DB zurckschreiben
2121Procedure TDBImage.Change;
2122Begin
2123 If FChangeLock Then exit;
2124
2125 Inherited Change;
2126
2127 FChangeLock:=True;
2128 WriteBack;
2129
2130 FChangeLock:=False;
2131End;
2132
2133{$HINTS OFF}
2134Procedure TDBImage.DataChange(Sender:TObject;event:TDataChange);
2135Var Field:TField;
2136Begin
2137 If FChangeLock Then exit;
2138 FChangeLock:=True;
2139 Try
2140 Field := FDataLink.Field;
2141 Except
2142 ON E:ESQLError Do
2143 Begin
2144 ErrorBox(E.Message);
2145 Field:=Nil;
2146 End;
2147 Else
2148 Begin
2149 FChangeLock:=False;
2150 Raise;
2151 End;
2152 End;
2153 If Field Is TBlobField Then
2154 Begin
2155 Try
2156 {creates A New Bitmap In GetBitmap If FBitmap = Nil}
2157 Bitmap.LoadFromMem(TBlobField(Field).Value^,Field.ValueLen);
2158 Except
2159 Bitmap := Nil;
2160 End;
2161 End
2162 Else Bitmap := Nil;
2163
2164 Invalidate;
2165 FChangeLock:=False;
2166End;
2167{$HINTS ON}
2168
2169Procedure TDBImage.WriteBack;
2170Var Field:TBlobField;
2171 Stream:TMemoryStream;
2172Begin
2173 If FDataLink = Nil Then exit;
2174 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
2175
2176 Try
2177 Field:=TBlobField(FDataLink.Field);
2178 If Field<>Nil Then
2179 Begin
2180 If Field Is TBlobField Then
2181 Begin
2182 Stream.Create;
2183 Bitmap.SaveToStream(Stream);
2184 Field.LoadFromStream(Stream);
2185 Stream.Destroy;
2186
2187 If Not FDataLink.DataSource.DataSet.RowInserted
2188 Then FDataLink.DataSource.DataSet.Post
2189 Else FDataLink.DataSource.DataSet.Refresh;
2190 End;
2191 End;
2192 Except
2193 On E:ESQLError Do
2194 Begin
2195 ErrorBox(E.Message);
2196 Field:=Nil;
2197 End;
2198 Else Raise;
2199 End;
2200End;
2201
2202
2203{
2204ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2205º º
2206º Speed-Pascal/2 Version 2.0 º
2207º º
2208º Speed-Pascal Component Classes (SPCC) º
2209º º
2210º This section: TDBMemo Class Implementation º
2211º º
2212º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2213º º
2214ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2215}
2216
2217Function TDBMemo.WriteSCUResource(Stream:TResourceStream):Boolean;
2218Var S:String;
2219Begin
2220 Result:=Inherited WriteSCUResource(Stream);
2221 If Result=False Then Exit;
2222 S:=FDataLink.FieldName;
2223 Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
2224End;
2225
2226Procedure TDBMemo.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
2227Var S:String;
2228Begin
2229 If ResName = rnDBDataField Then
2230 Begin
2231 System.Move(Data,S,DataLen);
2232 FDataLink.FieldName:=S;
2233 End
2234 Else Inherited ReadSCUResource(ResName,Data,DataLen);
2235End;
2236
2237
2238Procedure TDBMemo.SetDataSource(NewValue:TDataSource);
2239Begin
2240 FDataLink.DataSource:=NewValue;
2241End;
2242
2243Function TDBMemo.GetDataSource:TDataSource;
2244Begin
2245 Result:=FDataLink.DataSource;
2246End;
2247
2248Procedure TDBMemo.SetDataField(NewValue:String);
2249Begin
2250 FDataLink.FieldName:=NewValue;
2251End;
2252
2253Function TDBMemo.GetDataField:String;
2254Begin
2255 Result:=FDataLink.FieldName;
2256End;
2257
2258Procedure TDBMemo.SetupComponent;
2259Begin
2260 Inherited SetupComponent;
2261
2262 FDataLink.Create(Self);
2263 FDataLink.OnDataChange:=DataChange;
2264 Include(FDataLink.ComponentState, csDetail);
2265
2266 Name:='DBMemo';
2267End;
2268
2269Destructor TDBMemo.Destroy;
2270Begin
2271 FDataLink.OnDataChange:=Nil;
2272 FDataLink.Destroy;
2273 FDataLink:=Nil;
2274
2275 Inherited Destroy;
2276End;
2277
2278{$HINTS OFF}
2279Procedure TDBMemo.DataChange(Sender:TObject;event:TDataChange);
2280Var Field:TField;
2281Begin
2282 Try
2283 Field:=FDataLink.Field;
2284 Except
2285 ON E:ESQLError Do
2286 Begin
2287 ErrorBox(E.Message);
2288 Field:=Nil;
2289 End;
2290 Else Raise;
2291 End;
2292 If Field<>Nil Then
2293 Begin
2294 If Field Is TBlobField Then
2295 Lines.SetText(PChar(TBlobField(Field).Value))
2296 Else If Field Is TMemoField Then
2297 Lines.SetText(PChar(TMemoField(Field).Value))
2298 Else
2299 Lines.SetText(Nil);
2300 End
2301 Else
2302 Begin
2303 Lines.SetText(Nil);
2304 End;
2305End;
2306{$HINTS ON}
2307
2308Procedure TDBMemo.SetupShow;
2309Begin
2310 Inherited SetupShow;
2311 DataChange(FDataLink,deDataBaseChanged);
2312End;
2313
2314
2315Procedure TDBMemo.WriteBack;
2316Var Ansi:AnsiString;
2317 pc:PChar;
2318 Field:TField;
2319Begin
2320 If FDataLink = Nil Then exit;
2321 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
2322
2323 Try
2324 Field:=FDataLink.Field;
2325 If Field<>Nil Then
2326 Begin
2327 pc:=Lines.GetText;
2328 If pc <> Nil Then
2329 Begin
2330 Ansi:=pc^;
2331 StrDispose(pc);
2332 End
2333 Else Ansi := '';
2334
2335 If Field.AsAnsiString<>Ansi Then
2336 Begin
2337 Field.AsAnsiString:=Ansi;
2338 If Not FDataLink.DataSource.DataSet.RowInserted
2339 Then FDataLink.DataSource.DataSet.Post
2340 Else FDataLink.DataSource.DataSet.Refresh;
2341 End;
2342 End;
2343 Except
2344 On E:ESQLError Do
2345 Begin
2346 ErrorBox(E.Message);
2347 Field:=Nil;
2348 End;
2349 Else Raise;
2350 End;
2351End;
2352
2353Procedure TDBMemo.KillFocus;
2354Begin
2355 WriteBack;
2356
2357 Inherited KillFocus;
2358End;
2359
2360
2361{
2362ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2363º º
2364º Speed-Pascal/2 Version 2.0 º
2365º º
2366º Speed-Pascal Component Classes (SPCC) º
2367º º
2368º This section: TDBListBox Class Implementation º
2369º º
2370º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2371º º
2372ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2373}
2374
2375Function TDBListBox.WriteSCUResource(Stream:TResourceStream):Boolean;
2376Var S:String;
2377Begin
2378 Result:=Inherited WriteSCUResource(Stream);
2379 If Result=False Then Exit;
2380 S:=FDataLink.FieldName;
2381 Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
2382End;
2383
2384Procedure TDBListBox.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
2385Var S:String;
2386Begin
2387 If ResName = rnDBDataField Then
2388 Begin
2389 System.Move(Data,S,DataLen);
2390 FDataLink.FieldName:=S;
2391 End
2392 Else Inherited ReadSCUResource(ResName,Data,DataLen);
2393End;
2394
2395
2396Procedure TDBListBox.SetDataSource(NewValue:TDataSource);
2397Begin
2398 FDataLink.DataSource:=NewValue;
2399End;
2400
2401Function TDBListBox.GetDataSource:TDataSource;
2402Begin
2403 Result:=FDataLink.DataSource;
2404End;
2405
2406Procedure TDBListBox.SetDataField(NewValue:String);
2407Begin
2408 FDataLink.FieldName:=NewValue;
2409End;
2410
2411Function TDBListBox.GetDataField:String;
2412Begin
2413 Result:=FDataLink.FieldName;
2414End;
2415
2416Type
2417 TDBListBoxStrings=Class(TStrings)
2418 Private
2419 Items:TStrings;
2420 DataLink:TFieldDataLink;
2421 Protected
2422 Function GetCount:LongInt; Override;
2423 Function Get(Index:LongInt):String; Override;
2424 Function GetObject(Index:LongInt):TObject; Override;
2425 Procedure Put(Index:LongInt;Const S:String); Override;
2426 Procedure PutObject(Index:LongInt;AObject:TObject); Override;
2427 Public
2428 Procedure Assign(AStrings:TStrings); Override;
2429 Function Add(Const S:String):LongInt; Override;
2430 Procedure Insert(Index:LongInt;Const S:String); Override;
2431 Procedure Delete(Index:LongInt); Override;
2432 Procedure Clear; Override;
2433 {$IFDEF OS2}
2434 Function IndexOf(Const S:String):LongInt; Override;
2435 {$ENDIF}
2436 End;
2437
2438Function TDBListBoxStrings.GetCount:LongInt;
2439Begin
2440 Result:=Items.Count;
2441End;
2442
2443Function TDBListBoxStrings.Get(Index:LongInt):String;
2444Begin
2445 Result:=Items.Strings[Index];
2446End;
2447
2448Function TDBListBoxStrings.GetObject(Index:LongInt):TObject;
2449Begin
2450 Result:=Items.Objects[Index];
2451End;
2452
2453Procedure TDBListBoxStrings.Put(Index:LongInt;Const S:String);
2454Var Field:TField;
2455Begin
2456 If ((DataLink.DataSource=Nil)Or(DataLink.DataSource.DataSet=Nil)) Then Exit;
2457
2458 //Change DataBase
2459 Try
2460 Field:=DataLink.Field;
2461 If Field<>Nil Then If Field.AsString<>S Then
2462 Begin
2463 Field.AsString:=S;
2464 If Not DataLink.DataSource.DataSet.RowInserted
2465 Then DataLink.DataSource.DataSet.Post
2466 Else DataLink.DataSource.DataSet.Refresh;
2467 End;
2468 Except
2469 ON E:ESQLError Do
2470 Begin
2471 ErrorBox(E.Message);
2472 Field:=Nil;
2473 End;
2474 Else Raise;
2475 End;
2476
2477 If Field<>Nil Then Items.Strings[Index]:=S;
2478End;
2479
2480Procedure TDBListBoxStrings.PutObject(Index:LongInt;AObject:TObject);
2481Begin
2482 Items.Objects[Index]:=AObject;
2483End;
2484
2485Procedure TDBListBoxStrings.Assign(AStrings:TStrings);
2486Var T:LongInt;
2487Begin
2488 If AStrings=Nil Then Exit;
2489 For T:=0 To Count-1 Do
2490 Begin
2491 If T>AStrings.Count-1 Then Exit;
2492 Strings[T]:=AStrings.Strings[T];
2493 End;
2494End;
2495
2496Function TDBListBoxStrings.Add(Const S:String):LongInt;
2497Begin
2498 Result := Items.Add(S);
2499 //Change DataBase
2500End;
2501
2502Procedure TDBListBoxStrings.Insert(Index:LongInt;Const S:String);
2503Begin
2504 Items.Insert(Index,S);
2505 //Change DataBase
2506End;
2507
2508Procedure TDBListBoxStrings.Delete(Index:LongInt);
2509Begin
2510 Items.Delete(Index);
2511 //Change DataBase
2512End;
2513
2514Procedure TDBListBoxStrings.Clear;
2515Begin
2516 Items.Clear;
2517 //Change DataBase
2518End;
2519
2520{$IFDEF OS2}
2521Function TDBListBoxStrings.IndexOf(Const S:String):LongInt;
2522Begin
2523 Result:=Items.IndexOf(S);
2524End;
2525{$ENDIF}
2526
2527Procedure TDBListBox.SetupComponent;
2528Begin
2529 Inherited SetupComponent;
2530
2531 FDBStrings:=TDBListBoxStrings.Create;
2532 TDBListBoxStrings(FDBStrings).Items:=Inherited Items;
2533 FDataLink.Create(Self);
2534 FDataLink.OnDataChange:=DataChange;
2535 Include(FDataLink.ComponentState, csDetail);
2536
2537 Name:='DBListBox';
2538End;
2539
2540Destructor TDBListBox.Destroy;
2541Begin
2542 FDataLink.OnDataChange:=Nil;
2543 FDataLink.Destroy;
2544 FDataLink:=Nil;
2545 FDBStrings.Destroy;
2546 FDBStrings:=Nil;
2547
2548 Inherited Destroy;
2549End;
2550
2551{$HINTS OFF}
2552Procedure TDBListBox.DataChange(Sender:TObject;event:TDataChange);
2553Var Field:TField;
2554 OldRow:LongInt;
2555 Eof:Boolean;
2556Begin
2557 If ((event=deDataBaseChanged)Or(Items.Count=0)) Then
2558 Begin
2559 BeginUpdate;
2560 Items.Clear;
2561 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)Or
2562 (Not FDataLink.DataSource.DataSet.Active)) Then
2563 Begin
2564 EndUpdate;
2565 Exit;
2566 End;
2567
2568 FDataLink.DataSource.DataSet.DataChangeLock:=True;
2569 OldRow:=FDataLink.DataSource.DataSet.CurrentRow;
2570
2571 Try
2572 FDataLink.DataSource.DataSet.First;
2573
2574 Repeat
2575 Try
2576 Field:=FDataLink.Field;
2577 Except
2578 ON E:ESQLError Do
2579 Begin
2580 ErrorBox(E.Message);
2581 Field:=Nil;
2582 End;
2583 Else Raise;
2584 End;
2585
2586 If Field<>Nil Then TDBListBoxStrings(FDBStrings).Items.Add(Field.AsString);
2587
2588 Eof:=FDataLink.DataSource.DataSet.Eof;
2589 FDataLink.DataSource.DataSet.Next;
2590 Until Eof;
2591 Except
2592 End;
2593
2594 FDataLink.DataSource.DataSet.CurrentRow:=OldRow;
2595 FDataLink.DataSource.DataSet.DataChangeLock:=False;
2596 EndUpdate;
2597 ItemIndex:=OldRow;
2598 End
2599 Else If event=dePositionChanged Then
2600 Begin
2601 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
2602 ItemIndex:=FDataLink.DataSource.DataSet.CurrentRow;
2603 End;
2604End;
2605{$HINTS ON}
2606
2607Procedure TDBListBox.SetupShow;
2608Begin
2609 Inherited SetupShow;
2610 TDBListBoxStrings(FDBStrings).Items:=Inherited Items;
2611 DataChange(FDataLink,deDataBaseChanged);
2612End;
2613
2614Procedure TDBListBox.SetItems(NewValue:TStrings);
2615Begin
2616 TDBListBoxStrings(FDBStrings).Assign(NewValue);
2617End;
2618
2619Procedure TDBListBox.ItemFocus(Index:LongInt);
2620Begin
2621 Inherited ItemFocus(Index);
2622 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
2623 FDataLink.DataSource.DataSet.CurrentRow:=ItemIndex;
2624End;
2625
2626{
2627ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2628º º
2629º Speed-Pascal/2 Version 2.0 º
2630º º
2631º Speed-Pascal Component Classes (SPCC) º
2632º º
2633º This section: TDBComboBox Class Implementation º
2634º º
2635º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2636º º
2637ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2638}
2639
2640Function TDBComboBox.WriteSCUResource(Stream:TResourceStream):Boolean;
2641Var S:String;
2642Begin
2643 Result:=Inherited WriteSCUResource(Stream);
2644 If Result=False Then Exit;
2645 S:=FDataLink.FieldName;
2646 Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
2647End;
2648
2649Procedure TDBComboBox.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
2650Var S:String;
2651Begin
2652 If ResName = rnDBDataField Then
2653 Begin
2654 System.Move(Data,S,DataLen);
2655 FDataLink.FieldName:=S;
2656 End
2657 Else Inherited ReadSCUResource(ResName,Data,DataLen);
2658End;
2659
2660Procedure TDBComboBox.SetDataSource(NewValue:TDataSource);
2661Begin
2662 FDataLink.DataSource:=NewValue;
2663End;
2664
2665Function TDBComboBox.GetDataSource:TDataSource;
2666Begin
2667 Result:=FDataLink.DataSource;
2668End;
2669
2670Procedure TDBComboBox.SetDataField(NewValue:String);
2671Begin
2672 FDataLink.FieldName:=NewValue;
2673End;
2674
2675Function TDBComboBox.GetDataField:String;
2676Begin
2677 Result:=FDataLink.FieldName;
2678End;
2679
2680Procedure TDBComboBox.SetupComponent;
2681Begin
2682 Inherited SetupComponent;
2683
2684 FDataLink.Create(Self);
2685 FDataLink.OnDataChange:=DataChange;
2686 Include(FDataLink.ComponentState, csDetail);
2687
2688 Name:='DBComboBox';
2689End;
2690
2691Destructor TDBComboBox.Destroy;
2692Begin
2693 FDataLink.OnDataChange:=Nil;
2694 FDataLink.Destroy;
2695 FDataLink:=Nil;
2696
2697 Inherited Destroy;
2698End;
2699
2700{$HINTS OFF}
2701Procedure TDBComboBox.DataChange(Sender:TObject;event:TDataChange);
2702Var Field:TField;
2703 S:String;
2704Begin
2705 Try
2706 Field:=FDataLink.Field;
2707 If Field<>Nil Then
2708 Begin
2709 S:=Field.AsString;
2710 If S<>Text Then Text:=S;
2711 End;
2712 Except
2713 ON E:ESQLError Do
2714 Begin
2715 ErrorBox(E.Message);
2716 Field:=Nil;
2717 End;
2718 Else Raise;
2719 End;
2720End;
2721{$HINTS ON}
2722
2723Procedure TDBComboBox.SetupShow;
2724Begin
2725 Inherited SetupShow;
2726 DataChange(FDataLink,deDataBaseChanged);
2727End;
2728
2729Procedure TDBComboBox.WriteBack;
2730Var Field:TField;
2731Begin
2732 If FDataLink = Nil Then exit;
2733 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
2734
2735 Try
2736 Field:=FDataLink.Field;
2737 If Field<>Nil Then
2738 If Field.AsString<>Text Then
2739 Begin
2740 Field.AsString:=Text;
2741 If Not FDataLink.DataSource.DataSet.RowInserted
2742 Then FDataLink.DataSource.DataSet.Post
2743 Else FDataLink.DataSource.DataSet.Refresh;
2744 End;
2745 Except
2746 FLock:=False;
2747 ON E:ESQLError Do
2748 Begin
2749 ErrorBox(E.Message);
2750 Field:=Nil;
2751 End;
2752 Else Raise;
2753 End;
2754End;
2755
2756
2757Procedure TDBComboBox.EditChange;
2758Begin
2759 If FLock Then Exit;
2760 FLock:=True;
2761 WriteBack;
2762 FLock:=False;
2763End;
2764
2765
2766{
2767ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2768º º
2769º Speed-Pascal/2 Version 2.0 º
2770º º
2771º Speed-Pascal Component Classes (SPCC) º
2772º º
2773º This section: TDBRadioGroup Class Implementation º
2774º º
2775º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2776º º
2777ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2778}
2779
2780Function TDBRadioGroup.WriteSCUResource(Stream:TResourceStream):Boolean;
2781Var S:String;
2782Begin
2783 Result:=Inherited WriteSCUResource(Stream);
2784 If Result=False Then Exit;
2785 S:=FDataLink.FieldName;
2786 Result:=Stream.NewResourceEntry(rnDBDataField,S,Length(S)+1);
2787End;
2788
2789Procedure TDBRadioGroup.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
2790Var S:String;
2791Begin
2792 If ResName = rnDBDataField Then
2793 Begin
2794 System.Move(Data,S,DataLen);
2795 FDataLink.FieldName:=S;
2796 End
2797 Else Inherited ReadSCUResource(ResName,Data,DataLen);
2798End;
2799
2800Procedure TDBRadioGroup.SetDataSource(NewValue:TDataSource);
2801Begin
2802 FDataLink.DataSource:=NewValue;
2803End;
2804
2805Function TDBRadioGroup.GetDataSource:TDataSource;
2806Begin
2807 Result:=FDataLink.DataSource;
2808End;
2809
2810Procedure TDBRadioGroup.SetDataField(NewValue:String);
2811Begin
2812 FDataLink.FieldName:=NewValue;
2813End;
2814
2815Function TDBRadioGroup.GetDataField:String;
2816Begin
2817 Result:=FDataLink.FieldName;
2818End;
2819
2820Procedure TDBRadioGroup.SetupComponent;
2821Begin
2822 Inherited SetupComponent;
2823
2824 FValues:=TStringList.Create;
2825 FDataLink.Create(Self);
2826 FDataLink.OnDataChange:=DataChange;
2827 Include(FDataLink.ComponentState, csDetail);
2828
2829 Name:='DBRadioGroup';
2830End;
2831
2832Destructor TDBRadioGroup.Destroy;
2833Begin
2834 FDataLink.OnDataChange:=Nil;
2835 FDataLink.Destroy;
2836 FDataLink:=Nil;
2837 FValues.Destroy;
2838 FValues:=Nil;
2839
2840 Inherited Destroy;
2841End;
2842
2843{$HINTS OFF}
2844Procedure TDBRadioGroup.DataChange(Sender:TObject;event:TDataChange);
2845Var Field:TField;
2846 S:String;
2847 T:LongInt;
2848Begin
2849 Try
2850 Field:=FDataLink.Field;
2851 If Field<>Nil Then
2852 If Value<>Field.AsString Then Value:=Field.AsString;
2853 Except
2854 ON E:ESQLError Do
2855 Begin
2856 ErrorBox(E.Message);
2857 Field:=Nil;
2858 End;
2859 Else Raise;
2860 End;
2861End;
2862{$HINTS ON}
2863
2864Procedure TDBRadioGroup.SetupShow;
2865Begin
2866 Inherited SetupShow;
2867 DataChange(FDataLink,deDataBaseChanged);
2868End;
2869
2870Procedure TDBRadioGroup.WriteBack;
2871Var S:String;
2872 Field:TField;
2873Begin
2874 If FDataLink = Nil Then exit;
2875 If ((FDataLink.DataSource=Nil)Or(FDataLink.DataSource.DataSet=Nil)) Then Exit;
2876 If ((FLock)Or(ItemIndex<0)) Then Exit;
2877
2878 FLock:=True;
2879 If ItemIndex<FValues.Count Then S:=FValues[ItemIndex]
2880 Else If ItemIndex<Items.Count Then S:=Items[ItemIndex]
2881 Else Exit;
2882
2883 Try
2884 Field:=FDataLink.Field;
2885 If Field<>Nil Then
2886 If Field.AsString<>S Then
2887 Begin
2888 Field.AsString:=S;
2889 If Not FDataLink.DataSource.DataSet.RowInserted
2890 Then FDataLink.DataSource.DataSet.Post
2891 Else FDataLink.DataSource.DataSet.Refresh;
2892 End;
2893 Except
2894 FLock:=False;
2895 ON E:ESQLError Do
2896 Begin
2897 ErrorBox(E.Message);
2898 Field:=Nil;
2899 End;
2900 Else Raise;
2901 End;
2902 FLock:=False;
2903End;
2904
2905
2906Procedure TDBRadioGroup.ItemIndexChange;
2907Begin
2908 WriteBack;
2909End;
2910
2911
2912Function TDBRadioGroup.GetValue:String;
2913Begin
2914 If ItemIndex<0 Then Result:=''
2915 Else
2916 Begin
2917 If ItemIndex<FValues.Count Then Result:=FValues[ItemIndex]
2918 Else If ItemIndex<Items.Count Then Result:=Items[ItemIndex]
2919 Else Result:='';
2920 End;
2921End;
2922
2923Procedure TDBRadioGroup.SetValue(Const NewValue:String);
2924Var T:LongInt;
2925Begin
2926 For T:=0 To FValues.Count-1 Do
2927 Begin
2928 If FValues[T]=NewValue Then
2929 Begin
2930 If ItemIndex<>T Then ItemIndex:=T;
2931 Exit;
2932 End;
2933 End;
2934
2935 For T:=0 To Items.Count-1 Do
2936 Begin
2937 If Items[T]=NewValue Then
2938 Begin
2939 If ItemIndex<>T Then ItemIndex:=T;
2940 Exit;
2941 End;
2942 End;
2943
2944 ItemIndex:=-1;
2945End;
2946
2947Procedure TDBRadioGroup.SetValues(NewValue:TStrings);
2948Begin
2949 FValues.Assign(NewValue);
2950End;
2951
2952{
2953ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2954º º
2955º Speed-Pascal/2 Version 2.0 º
2956º º
2957º Speed-Pascal Component Classes (SPCC) º
2958º º
2959º This section: TDBNavigator Class Implementation º
2960º º
2961º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2962º º
2963ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2964}
2965
2966Const
2967 cmDBFirst = TCommand(cmBase+70);
2968 cmDBPrior = TCommand(cmBase+71);
2969 cmDBNext = TCommand(cmBase+72);
2970 cmDBLast = TCommand(cmBase+73);
2971 cmDBInsert = TCommand(cmBase+74);
2972 cmDBDelete = TCommand(cmBase+75);
2973 cmDBEdit = TCommand(cmBase+76);
2974 cmDBPost = TCommand(cmBase+77);
2975 cmDBCancel = TCommand(cmBase+78);
2976 cmDBRefresh = TCommand(cmBase+79);
2977
2978
2979Procedure TDBNavigator.SetVisibleButtons(NewState:TNavigateBtnSet);
2980Var T:TNavigateBtn;
2981Begin
2982 FVisibleButtons:=NewState;
2983 For T:=dbFirst To dbRefresh Do FButtons[T].Visible:=NewState*[T]<>[];
2984 RealignControls;
2985End;
2986
2987Procedure TDBNavigator.SetEnabledButtons(NewState:TNavigateBtnSet);
2988Var T:TNavigateBtn;
2989Begin
2990 FEnabledButtons:=NewState;
2991 For T:=dbFirst To dbRefresh Do FButtons[T].Enabled:=NewState*[T]<>[];
2992 If Handle<>0 Then Invalidate;
2993End;
2994
2995Procedure TDBNavigator.RealignControls;
2996Var X:LongInt;
2997 Count,W:LongInt;
2998 T:TNavigateBtn;
2999Begin
3000 If Handle=0 Then Exit;
3001
3002 X:=0;
3003
3004 Count:=0;
3005 For T:=dbFirst To dbRefresh Do If FVisibleButtons*[T]<>[] Then Inc(Count);
3006
3007 W:=Width Div Count;
3008 For T:=dbFirst To dbRefresh Do
3009 Begin
3010 If FVisibleButtons*[T]<>[] Then
3011 Begin
3012 FButtons[T].SetWindowPos(X,0,W,Height);
3013 Inc(X,FButtons[T].Width);
3014 End
3015 Else
3016 If Designed Then FButtons[T].SetWindowPos(X,Height,W,Height);
3017 End;
3018End;
3019
3020
3021Function TDBNavigator.GetButton(Index:TNavigateBtn):TBitBtn;
3022Begin
3023 Result := FButtons[Index];
3024End;
3025
3026
3027Procedure TDBNavigator.SetupComponent;
3028Type
3029 TButDataRec=Record
3030 bmp:String[20];
3031 cmd:TCommand;
3032 Bubble:LongWord;
3033 End;
3034Const
3035 ButData:Array[TNavigateBtn] Of TButDataRec=
3036 ((bmp:'StdBmpDBFirst';cmd:cmDBFirst;Bubble:SFirstRecordHint),
3037 (bmp:'StdBmpDBPrior';cmd:cmDBPrior;Bubble:SPriorRecordHint),
3038 (bmp:'StdBmpDBNext';cmd:cmDBNext;Bubble:SNextRecordHint),
3039 (bmp:'StdBmpDBLast';cmd:cmDBLast;Bubble:SLastRecordHint),
3040 (bmp:'StdBmpDBInsert';cmd:cmDBInsert;Bubble:SInsertRecordHint),
3041 (bmp:'StdBmpDBDelete';cmd:cmDBDelete;Bubble:SDeleteRecordHint),
3042 (bmp:'StdBmpDBEdit';cmd:cmDBEdit;Bubble:SEditRecordHint),
3043 (bmp:'StdBmpDBPost';cmd:cmDBPost;Bubble:SPostRecordHint),
3044 (bmp:'StdBmpDBCancel';cmd:cmDBCancel;Bubble:SCancelRecordHint),
3045 (bmp:'StdBmpDBRefresh';cmd:cmDBRefresh;Bubble:SRefreshRecordHint));
3046Var T:TNavigateBtn;
3047Begin
3048 Inherited SetupComponent;
3049
3050 FDataLink.Create(Self);
3051 FDataLink.OnDataChange:=Nil{DataChange};
3052 Include(FDataLink.ComponentState, csDetail);
3053
3054 Name:='DBNavigator';
3055 FVisibleButtons:=[dbFirst..dbRefresh];
3056 FEnabledButtons:=[dbFirst..dbRefresh];
3057 Width:=240;
3058 Height:=25;
3059 ParentColor:=True;
3060
3061 For T:=dbFirst To dbRefresh Do
3062 Begin
3063 FButtons[T]:=InsertBitBtn(Self,32,0,32,32, bkCustom,'',
3064 LoadNLSStr(ButData[T].Bubble));
3065 FButtons[T].Command:=ButData[T].cmd;
3066 FButtons[T].Glyph.LoadFromResourceName(ButData[T].bmp);
3067 FButtons[T].YAlign:=yaBottom;
3068 FButtons[T].YStretch:=ysParent;
3069 Include(FButtons[T].ComponentState, csDetail);
3070 FButtons[T].SetDesigning(Designed);
3071
3072 If Not Designed Then
3073 Begin
3074 FButtons[T].Tag := LongInt(T);
3075 FButtons[T].OnClick := EvButtonClick;
3076 End;
3077 End;
3078
3079 VisibleButtons:=VisibleButtons-[dbEdit];
3080End;
3081
3082Destructor TDBNavigator.Destroy;
3083Begin
3084 FDataLink.OnDataChange:=Nil;
3085 FDataLink.Destroy;
3086 FDataLink:=Nil;
3087
3088 Inherited Destroy;
3089End;
3090
3091Procedure TDBNavigator.CreateWnd;
3092Begin
3093 Inherited CreateWnd;
3094
3095 RealignControls;
3096End;
3097
3098
3099Procedure TDBNavigator.SetDataSource(NewValue:TDataSource);
3100Begin
3101 FDataLink.DataSource:=NewValue;
3102End;
3103
3104Function TDBNavigator.GetDataSource:TDataSource;
3105Begin
3106 Result:=FDataLink.DataSource;
3107End;
3108
3109
3110Procedure TDBNavigator.CommandEvent(Var Command:TCommand);
3111Begin
3112 Inherited CommandEvent(Command);
3113
3114 If ((FDataLink<>Nil)And(FDataLink.DataSource<>Nil)And
3115 (FDataLink.DataSource.DataSet<>Nil)) Then
3116 Begin
3117 Try
3118 Case Command Of
3119 cmDBFirst:FDataLink.DataSource.DataSet.First;
3120 cmDBPrior:FDataLink.DataSource.DataSet.Prior;
3121 cmDBNext:FDataLink.DataSource.DataSet.Next;
3122 cmDBLast:FDataLink.DataSource.DataSet.Last;
3123 cmDBInsert:FDataLink.DataSource.DataSet.Insert;
3124 cmDBDelete:FDataLink.DataSource.DataSet.Delete;
3125 cmDBEdit: ;
3126 cmDBPost:FDataLink.DataSource.DataSet.Post;
3127 cmDBCancel:FDataLink.DataSource.DataSet.Cancel;
3128 cmDBRefresh:FDataLink.DataSource.DataSet.Refresh;
3129 End;
3130 Except
3131 ON E:ESQLError Do ErrorBox(E.Message);
3132 ON EDataBaseError Do
3133 Begin
3134 End;
3135 Else Raise;
3136 End;
3137 End;
3138End;
3139
3140
3141Procedure TDBNavigator.EvButtonClick(Sender:TObject);
3142Begin
3143 If FOnNavClick <> Nil
3144 Then FOnNavClick(Self,TNavigateBtn(TComponent(Sender).Tag));
3145End;
3146
3147
3148Begin
3149End.
3150
Note: See TracBrowser for help on using the repository browser.