ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/design/IBDBReg.pas
Revision: 31
Committed: Tue Jul 14 15:31:25 2015 UTC (8 years, 8 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/design/IBDBReg.pas
File size: 33148 byte(s)
Log Message:
Committing updates for Release R1-3-0

File Contents

# Content
1 {************************************************************************}
2 { }
3 { Borland Delphi Visual Component Library }
4 { InterBase Express core components }
5 { }
6 { Copyright (c) 1998-2000 Inprise Corporation }
7 { }
8 { InterBase Express is based in part on the product }
9 { Free IB Components, written by Gregory H. Deatz for }
10 { Hoagland, Longo, Moran, Dunst & Doukas Company. }
11 { Free IB Components is used under license. }
12 { }
13 { The contents of this file are subject to the InterBase }
14 { Public License Version 1.0 (the "License"); you may not }
15 { use this file except in compliance with the License. You }
16 { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17 { Software distributed under the License is distributed on }
18 { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19 { express or implied. See the License for the specific language }
20 { governing rights and limitations under the License. }
21 { The Original Code was created by InterBase Software Corporation }
22 { and its successors. }
23 { Portions created by Inprise Corporation are Copyright (C) Inprise }
24 { Corporation. All Rights Reserved. }
25 { Contributor(s): Jeff Overcash }
26 { }
27 { IBX For Lazarus (Firebird Express) }
28 { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 { Portions created by MWA Software are copyright McCallum Whyman }
30 { Associates Ltd 2011 }
31 {************************************************************************}
32
33 unit IBDBReg;
34
35 {$MODE Delphi}
36
37 (*
38 * Compiler defines
39 *)
40 {$A+} (* Aligned records: On *)
41 {$B-} (* Short circuit boolean expressions: Off *)
42 {$G+} (* Imported data: On *)
43 {$H+} (* Huge Strings: On *)
44 {$J-} (* Modification of Typed Constants: Off *)
45 {$M+} (* Generate run-time type information: On *)
46 {$O+} (* Optimization: On *)
47 {$Q-} (* Overflow checks: Off *)
48 {$R-} (* Range checks: Off *)
49 {$T+} (* Typed address: On *)
50 {$U+} (* Pentim-safe FDIVs: On *)
51 {$W-} (* Always generate stack frames: Off *)
52 {$X+} (* Extended syntax: On *)
53 {$Z1} (* Minimum Enumeration Size: 1 Byte *)
54
55 interface
56
57 uses SysUtils, Classes, Graphics, Dialogs, Controls, Forms, TypInfo,
58 DB, IBTable, IBDatabase, IBEventsEditor, LazarusPackageIntf,
59 IBUpdateSQL, IBXConst, ComponentEditors, PropEdits, DBPropEdits, FieldsEditor,
60 dbFieldLinkPropEditor, dbFieldListPropEditor, IBDialogs;
61
62 type
63
64 { TIBFileNameProperty
65 Property editor the DataBase Name property. Brings up the Open dialog }
66
67 TIBFileNameProperty = class(TStringProperty)
68 public
69 procedure Edit; override;
70 function GetAttributes: TPropertyAttributes; override;
71 end;
72
73 { TIBNameProperty
74 }
75 TIBNameProperty = class(TStringProperty)
76 public
77 function GetAttributes: TPropertyAttributes; override;
78 end;
79
80 { TIBStoredProcNameProperty
81 Editor for the TIBStoredProc.StoredProcName property. Displays a drop-down list of all
82 the StoredProcedures in the Database.}
83 TIBStoredProcNameProperty = class(TIBNameProperty)
84 public
85 procedure GetValues(Proc: TGetStrProc); override;
86 end;
87
88 { TIBTableNameProperty
89 Editor for the TIBTable.TableName property. Displays a drop-down list of all
90 the Tables in the Database.}
91 TIBTableNameProperty = class(TIBNameProperty)
92 public
93 procedure GetValues(Proc: TGetStrProc); override;
94 end;
95
96 { TDBStringProperty }
97
98 TDBStringProperty = class(TStringProperty)
99 private
100 function ConnecttoDB: boolean;
101 public
102 function GetAttributes: TPropertyAttributes; override;
103 procedure GetValueList(List: TStrings); virtual;
104 procedure GetValues(Proc: TGetStrProc); override;
105 procedure Edit; override;
106 end;
107
108 { TIBIndexFieldNamesProperty }
109
110 TIBIndexFieldNamesProperty = class(TDBStringProperty)
111 public
112 procedure GetValueList(List: TStrings); override;
113 end;
114
115 TIBIndexNameProperty = class(TDBStringProperty)
116 public
117 procedure GetValueList(List: TStrings); override;
118 end;
119
120 { TIBDatabaseEditor }
121
122 TIBDatabaseEditor = class(TComponentEditor)
123 procedure ExecuteVerb(Index: Integer); override;
124 function GetVerb(Index: Integer): string; override;
125 function GetVerbCount: Integer; override;
126 end;
127
128 { TIBTransactionEditor }
129
130 TIBTransactionEditor = class(TComponentEditor)
131 public
132 procedure ExecuteVerb(Index: Integer); override;
133 function GetVerb(Index: Integer): string; override;
134 function GetVerbCount: Integer; override;
135 end;
136
137 { TIBQueryEditor }
138
139 TIBQueryEditor = class(TFieldsComponentEditor)
140 public
141 procedure ExecuteVerb(Index: Integer); override;
142 function GetVerb(Index: Integer): string; override;
143 function GetVerbCount: Integer; override;
144 end;
145
146 { TIBStoredProcEditor }
147
148 TIBStoredProcEditor = class(TFieldsComponentEditor)
149 public
150 procedure ExecuteVerb(Index: Integer); override;
151 function GetVerb(Index: Integer): string; override;
152 function GetVerbCount: Integer; override;
153 end;
154
155 { TIBDataSetEditor }
156
157 TIBDataSetEditor = class(TFieldsComponentEditor)
158 public
159 procedure ExecuteVerb(Index: Integer); override;
160 function GetVerb(Index: Integer): string; override;
161 function GetVerbCount: Integer; override;
162 end;
163
164 { TIBUpdateSQLEditor }
165
166 TIBUpdateSQLEditor = class(TComponentEditor)
167 public
168 procedure ExecuteVerb(Index: Integer); override;
169 function GetVerb(Index: Integer): string; override;
170 function GetVerbCount: Integer; override;
171 end;
172
173 { TIBSQLEditor }
174
175 TIBSQLEditor = class(TComponentEditor)
176 public
177 procedure ExecuteVerb(Index: Integer); override;
178 function GetVerb(Index: Integer): string; override;
179 function GetVerbCount: Integer; override;
180 end;
181
182 { TIBServiceEditor}
183
184 TIBServiceEditor = class(TComponentEditor)
185 public
186 procedure ExecuteVerb(Index: Integer); override;
187 function GetVerb(Index: Integer): string; override;
188 function GetVerbCount: Integer; override;
189 end;
190
191 TIBStoredProcParamsProperty = class(TCollectionPropertyEditor)
192 public
193 procedure Edit; override;
194 end;
195
196 { TIBTableFieldLinkProperty }
197
198 TIBTableFieldLinkProperty = class(TFieldLinkProperty)
199 private
200 FTable: TIBTable;
201 protected
202 function GetIndexDefs: TIndexDefs; override;
203 function GetIndexFieldNames: string; override;
204 function GetMasterFields: string; override;
205 procedure SetIndexFieldNames(const Value: string); override;
206 procedure SetMasterFields(const Value: string); override;
207 public
208 procedure Edit; override;
209 end;
210
211 { TSQLPropertyEditor }
212
213 TSQLPropertyEditor = class(TStringsPropertyEditor)
214 public
215 function GetAttributes: TPropertyAttributes; override;
216 end;
217
218 { TIBQuerySQLProperty }
219
220 TIBQuerySQLProperty = class(TSQLPropertyEditor)
221 public
222 procedure Edit; override;
223 end;
224
225 {TIBSQLSQLPropertyEditor }
226
227 TIBSQLSQLPropertyEditor = class(TSQLPropertyEditor)
228 public
229 procedure Edit; override;
230 end;
231
232 { TIBDatasetSQLProperty }
233
234 TIBDatasetSQLProperty = class(TSQLPropertyEditor)
235 public
236 procedure Edit; override;
237 end;
238
239 { TIBSQLProperty }
240
241 TIBSQLProperty = class(TSQLPropertyEditor)
242 public
243 procedure Edit; override;
244 end;
245
246 { TUpdateSQLPropertyEditor }
247
248 TUpdateSQLPropertyEditor = class(TSQLPropertyEditor)
249 protected
250 FIBUpdateSQL: TIBUpdateSQL;
251 FDatabase: TIBDatabase;
252 function GetObjects: boolean;
253 end;
254
255 { TIBUpdateSQLProperty }
256
257 TIBUpdateSQLProperty = class(TSQLPropertyEditor)
258 public
259 procedure Edit; override;
260 end;
261
262 { TIBRefreshSQLProperty }
263
264 TIBRefreshSQLProperty = class(TSQLPropertyEditor)
265 public
266 procedure Edit; override;
267 end;
268
269 { TIBInsertSQLProperty }
270
271 TIBInsertSQLProperty = class(TSQLPropertyEditor)
272 public
273 procedure Edit; override;
274 end;
275
276 { TIBDeleteSQLProperty }
277
278 TIBDeleteSQLProperty = class(TSQLPropertyEditor)
279 public
280 procedure Edit; override;
281 end;
282
283 { TIBUpdateSQLUpdateProperty }
284
285 TIBUpdateSQLUpdateProperty = class(TUpdateSQLPropertyEditor)
286 public
287 procedure Edit; override;
288 end;
289
290 { TIBUpdateSQLRefreshSQLProperty }
291
292 TIBUpdateSQLRefreshSQLProperty = class(TUpdateSQLPropertyEditor)
293 public
294 procedure Edit; override;
295 end;
296
297 { TIBUpdateSQLInsertSQLProperty }
298
299 TIBUpdateSQLInsertSQLProperty = class(TUpdateSQLPropertyEditor)
300 public
301 procedure Edit; override;
302 end;
303
304 { TIBUpdateSQLDeleteProperty }
305
306 TIBUpdateSQLDeleteProperty = class(TUpdateSQLPropertyEditor)
307 public
308 function GetAttributes: TPropertyAttributes; override;
309 procedure Edit; override;
310 end;
311
312 { TIBEventListProperty }
313
314 TIBEventListProperty = class(TClassProperty)
315 public
316 function GetAttributes: TPropertyAttributes; override;
317 procedure Edit; override;
318 end;
319
320 {TIBGeneratorProperty}
321
322 TIBGeneratorProperty = class(TPersistentPropertyEditor)
323 public
324 function GetAttributes: TPropertyAttributes; override;
325 procedure Edit; override;
326 end;
327
328 { TDBDynamicGridFieldProperty }
329
330 TDBDynamicGridFieldProperty = class(TFieldProperty)
331 public
332 procedure FillValues(const Values: TStringList); override;
333 end;
334
335 { TDBLookupPropertiesGridFieldProperty }
336
337 TDBLookupPropertiesGridFieldProperty = class(TFieldProperty)
338 public
339 procedure FillValues(const Values: TStringList); override;
340 end;
341
342 { TIBTreeViewFieldProperty }
343
344 TIBTreeViewFieldProperty = class(TFieldProperty)
345 public
346 procedure FillValues(const Values: TStringList); override;
347 end;
348
349 { TIBDynamicGridIndexNamesProperty }
350
351 TIBDynamicGridIndexNamesProperty = class(TIndexFieldNamesProperty)
352 protected
353 function GetFieldDefs: TFieldDefs; override;
354 function GetIndexFieldNames: string; override;
355 procedure SetIndexFieldNames(const Value: string); override;
356 end;
357
358
359
360 procedure Register;
361
362 implementation
363
364 uses IB, IBQuery, IBStoredProc, IBCustomDataSet,
365 IBIntf, IBSQL, IBSQLMonitor, IBDatabaseInfo, IBEvents,
366 IBServices, IBDatabaseEdit, IBTransactionEdit,
367 IBBatchMove, IBExtract,LResources, IBSelectSQLEditor,
368 IBModifySQLEditor,IBDeleteSQLEditor,IBRefreshSQLEditor,
369 IBInsertSQLEditor, IBGeneratorEditor, IBUpdateSQLEditor, IBDataSetEditor,
370 IBSQLEditor, ibserviceeditor, LCLVersion, IBDynamicGrid, IBLookupComboEditBox,
371 IBTreeView, DBControlGrid;
372
373
374
375 procedure Register;
376 begin
377 if not TryIBLoad then
378 begin
379 MessageDlg('IBX is unable to locate the Firebird Library - have you remembered to install it?',mtError,[mbOK],0);
380 Exit;
381 end;
382
383 RegisterNoIcon([TIBStringField, TIBBCDField]);
384 {$if lcl_fullversion < 01010000}
385 {see http://bugs.freepascal.org/view.php?id=19035 }
386 RegisterNoIcon([TIntegerField]);
387 {$endif}
388 RegisterComponents(IBPalette1, [ TIBQuery, TIBDataSet,
389 TIBDatabase, TIBTransaction, TIBUpdateSQL, TIBEvents,
390 TIBSQL, TIBDatabaseInfo, TIBSQLMonitor,
391 TIBStoredProc,TIBBatchMove, TIBTable,TIBExtract]);
392 if IBServiceAPIPresent then
393 RegisterComponents(IBPalette2, [TIBConfigService, TIBBackupService,
394 TIBRestoreService, TIBValidationService, TIBStatisticalService,
395 TIBLogService, TIBSecurityService, TIBServerProperties]);
396
397
398 RegisterComponents(IBPalette3,[TIBLookupComboEditBox,TIBDynamicGrid,TIBTreeView,TDBControlGrid]);
399 RegisterPropertyEditor(TypeInfo(TIBFileName), TIBDatabase, 'DatabaseName', TIBFileNameProperty); {do not localize}
400 RegisterPropertyEditor(TypeInfo(string), TIBStoredProc, 'StoredProcName', TIBStoredProcNameProperty); {do not localize}
401 RegisterPropertyEditor(TypeInfo(TParams), TIBStoredProc, 'Params', TIBStoredProcParamsProperty);
402 RegisterPropertyEditor(TypeInfo(string), TIBTable, 'TableName', TIBTableNameProperty); {do not localize}
403 RegisterPropertyEditor(TypeInfo(string), TIBTable, 'IndexName', TIBIndexNameProperty); {do not localize}
404 RegisterPropertyEditor(TypeInfo(string), TIBTable, 'IndexFieldNames', TIBIndexFieldNamesProperty); {do not localize}
405 RegisterPropertyEditor(TypeInfo(string), TIBTable, 'MasterFields', TIBTableFieldLinkProperty); {do not localize}
406 RegisterPropertyEditor(TypeInfo(TStrings), TIBQuery, 'SQL', TIBQuerySQLProperty); {do not localize}
407 RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'SelectSQL', TIBDatasetSQLProperty); {do not localize}
408 RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'ModifySQL', TIBUpdateSQLProperty); {do not localize}
409 RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'InsertSQL', TIBInsertSQLProperty); {do not localize}
410 RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'RefreshSQL', TIBRefreshSQLProperty); {do not localize}
411 RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'DeleteSQL', TIBDeleteSQLProperty); {do not localize}
412 RegisterPropertyEditor(TypeInfo(TStrings), TIBSQL, 'SQL', TIBSQLSQLPropertyEditor); {do not localize}
413 RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdateSQL, 'RefreshSQL', TIBUpdateSQLRefreshSQLProperty); {do not localize}
414 RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdateSQL, 'ModifySQL', TIBUpdateSQLUpdateProperty); {do not localize}
415 RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdateSQL, 'InsertSQL', TIBUpdateSQLInsertSQLProperty); {do not localize}
416 RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdateSQL, 'DeleteSQL', TIBUpdateSQLDeleteProperty); {do not localize}
417 RegisterPropertyEditor(TypeInfo(TStrings), TIBEvents, 'Events', TIBEventListProperty); {do not localize}
418 RegisterPropertyEditor(TypeInfo(TPersistent), TIBDataSet, 'GeneratorField', TIBGeneratorProperty); {do not localize}
419 RegisterPropertyEditor(TypeInfo(TPersistent), TIBQuery, 'GeneratorField', TIBGeneratorProperty); {do not localize}
420
421 RegisterComponentEditor(TIBDatabase, TIBDatabaseEditor);
422 RegisterComponentEditor(TIBTransaction, TIBTransactionEditor);
423 RegisterComponentEditor(TIBUpdateSQL, TIBUpdateSQLEditor);
424 RegisterComponentEditor(TIBDataSet, TIBDataSetEditor);
425 RegisterComponentEditor(TIBQuery, TIBQueryEditor);
426 RegisterComponentEditor(TIBStoredProc, TIBStoredProcEditor);
427 RegisterComponentEditor(TIBSQL, TIBSQLEditor);
428 RegisterComponentEditor(TIBCustomService, TIBServiceEditor);
429
430
431 {Firebird Data Access Controls}
432 RegisterPropertyEditor(TypeInfo(string), TDBLookupProperties, 'KeyField', TDBDynamicGridFieldProperty);
433 RegisterPropertyEditor(TypeInfo(string), TDBLookupProperties, 'ListField', TDBDynamicGridFieldProperty);
434 RegisterPropertyEditor(TypeInfo(string), TIBDynamicGrid, 'IndexFieldNames', TIBDynamicGridIndexNamesProperty);
435 RegisterPropertyEditor(TypeInfo(string), TDBLookupProperties, 'DataFieldName', TDBLookupPropertiesGridFieldProperty);
436 RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'KeyField', TIBTreeViewFieldProperty);
437 RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'TextField', TIBTreeViewFieldProperty);
438 RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'ParentField', TIBTreeViewFieldProperty);
439 RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'HasChildField', TIBTreeViewFieldProperty);
440
441 end;
442
443 procedure LoadDataSourceFields(DataSource: TDataSource; List: TStrings);
444 var
445 DataSet: TDataSet;
446 i: Integer;
447 begin
448 if Assigned(DataSource) then
449 begin
450 DataSet := DataSource.DataSet;
451 if Assigned(DataSet) then
452 begin
453 if DataSet.Fields.Count > 0 then
454 DataSet.GetFieldNames(List)
455 else
456 begin
457 DataSet.FieldDefs.Update;
458 for i := 0 to DataSet.FieldDefs.Count - 1 do
459 List.Add(DataSet.FieldDefs[i].Name);
460 end;
461 end;
462 end;
463 end;
464
465 { TDBLookupPropertiesGridFieldProperty }
466
467 procedure TDBLookupPropertiesGridFieldProperty.FillValues(
468 const Values: TStringList);
469 var
470 P: TDBLookupProperties;
471 begin
472 P :=TDBLookupProperties(GetComponent(0));
473 if not (P is TDBLookupProperties) then exit;
474 LoadDataSourceFields(TIBDynamicGrid(P.Owner.Grid).DataSource, Values);
475 end;
476
477 { TIBTreeViewFieldProperty }
478
479 procedure TIBTreeViewFieldProperty.FillValues(const Values: TStringList);
480 var ListSource: TDataSource;
481 begin
482 ListSource := TIBTreeView(GetComponent(0)).DataSource;
483 LoadDataSourceFields(ListSource, Values);
484 end;
485
486 { TIBDynamicGridIndexNamesProperty }
487
488 function TIBDynamicGridIndexNamesProperty.GetFieldDefs: TFieldDefs;
489 var Grid: TIBDynamicGrid;
490 begin
491 Result := nil;
492 Grid := TIBDynamicGrid(GetComponent(0));
493 if assigned(Grid.DataSource) and assigned(Grid.DataSource.DataSet) then
494 Result := Grid.DataSource.DataSet.FieldDefs
495 end;
496
497 function TIBDynamicGridIndexNamesProperty.GetIndexFieldNames: string;
498 var Grid: TIBDynamicGrid;
499 begin
500 Grid := TIBDynamicGrid(GetComponent(0));
501 Result := Grid.IndexFieldNames
502 end;
503
504 procedure TIBDynamicGridIndexNamesProperty.SetIndexFieldNames(
505 const Value: string);
506 var Grid: TIBDynamicGrid;
507 begin
508 Grid := TIBDynamicGrid(GetComponent(0));
509 Grid.IndexFieldNames := Value
510 end;
511
512 { TDBDynamicGridFieldProperty }
513
514 procedure TDBDynamicGridFieldProperty.FillValues(const Values: TStringList);
515 var
516 P: TDBLookupProperties;
517 begin
518 P :=TDBLookupProperties(GetComponent(0));
519 if not (P is TDBLookupProperties) then exit;
520 LoadDataSourceFields(P.ListSource, Values);
521 end;
522
523 { TIBServiceEditor }
524
525 procedure TIBServiceEditor.ExecuteVerb(Index: Integer);
526 begin
527 if Index < inherited GetVerbCount then
528 inherited ExecuteVerb(Index) else
529 begin
530 Dec(Index, inherited GetVerbCount);
531 case Index of
532 0 : if ibserviceeditor.EditIBService(TIBCustomService(Component)) then Designer.Modified;
533 end;
534 end;
535 end;
536
537 function TIBServiceEditor.GetVerb(Index: Integer): string;
538 begin
539 if Index < inherited GetVerbCount then
540 Result := inherited GetVerb(Index) else
541 begin
542 Dec(Index, inherited GetVerbCount);
543 case Index of
544 0: Result := SIBServiceEditor;
545 1 : Result := SInterbaseExpressVersion;
546 end;
547 end;
548 end;
549
550 function TIBServiceEditor.GetVerbCount: Integer;
551 begin
552 Result := inherited GetVerbCount + 2;
553 end;
554
555 { TIBFileNameProperty }
556 procedure TIBFileNameProperty.Edit;
557 begin
558 with TOpenDialog.Create(Application) do
559 try
560 InitialDir := ExtractFilePath(GetStrValue);
561 Filter := SDatabaseFilter; {do not localize}
562 if Execute then
563 SetStrValue(FileName);
564 finally
565 Free
566 end;
567 end;
568
569 function TIBFileNameProperty.GetAttributes: TPropertyAttributes;
570 begin
571 Result := [paDialog];
572 end;
573
574 { TIBNameProperty }
575
576 function TIBNameProperty.GetAttributes: TPropertyAttributes;
577 begin
578 Result := [paValueList, paSortList];
579 end;
580
581 { TIBStoredProcNameProperty }
582
583 procedure TIBStoredProcNameProperty.GetValues(Proc: TGetStrProc);
584 var
585 StoredProc : TIBStoredProc;
586 i : integer;
587 begin
588 StoredProc := GetComponent(0) as TIBStoredProc;
589 if StoredProc.Database = nil then
590 Exit;
591
592 with StoredProc do
593 try
594 for I := 0 to StoredProcedureNames.Count - 1 do
595 Proc (StoredProcedureNames[i]);
596 except on E: Exception do
597 MessageDlg(E.Message,mtError,[mbOK],0)
598 end;
599 end;
600
601 { TIBTableNameProperty }
602
603 procedure TIBTableNameProperty.GetValues(Proc: TGetStrProc);
604 var
605 Table : TIBTable;
606 i : integer;
607 begin
608 Table := GetComponent(0) as TIBTable;
609 if Table.Database = nil then
610 Exit;
611 with Table do
612 for I := 0 to TableNames.Count - 1 do
613 Proc (TableNames[i]);
614 end;
615
616 { TDBStringProperty }
617
618 function TDBStringProperty.ConnecttoDB: boolean;
619 var DataSet: TIBCustomDataSet;
620 begin
621 Result := false;
622 DataSet := (GetComponent(0) as TIBCustomDataSet);
623 if assigned(Dataset.Database) then
624 begin
625 try
626 DataSet.Database.Connected := true;
627 except on E: Exception do
628 ShowMessage(E.Message)
629 end;
630 Result := DataSet.Database.Connected
631 end;
632 end;
633
634 function TDBStringProperty.GetAttributes: TPropertyAttributes;
635 begin
636 Result := [paValueList, paSortList, paMultiSelect];
637 end;
638
639 procedure TDBStringProperty.GetValueList(List: TStrings);
640 begin
641 end;
642
643 procedure TDBStringProperty.GetValues(Proc: TGetStrProc);
644 var
645 I: Integer;
646 Values: TStringList;
647 begin
648 if not ConnecttoDB then Exit;
649 Values := TStringList.Create;
650 try
651 GetValueList(Values);
652 for I := 0 to Values.Count - 1 do Proc(Values[I]);
653 finally
654 Values.Free;
655 end;
656 end;
657
658 procedure TDBStringProperty.Edit;
659 begin
660 if ConnecttoDB then
661 inherited Edit;
662 end;
663
664 { Utility Functions }
665
666 function GetPropertyValue(Instance: TPersistent; const PropName: string): TPersistent;
667 var
668 PropInfo: PPropInfo;
669 begin
670 Result := nil;
671 PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, PropName);
672 if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
673 Result := TObject(GetOrdProp(Instance, PropInfo)) as TPersistent;
674 end;
675
676 function GetIndexDefs(Component: TPersistent): TIndexDefs;
677 var
678 DataSet: TDataSet;
679 begin
680 DataSet := Component as TDataSet;
681 Result := GetPropertyValue(DataSet, 'IndexDefs') as TIndexDefs; {do not localize}
682 if Assigned(Result) then
683 begin
684 Result.Updated := False;
685 Result.Update;
686 end;
687 end;
688
689 { TIBIndexFieldNamesProperty }
690
691 procedure TIBIndexFieldNamesProperty.GetValueList(List: TStrings);
692 var
693 I: Integer;
694 IndexDefs: TIndexDefs;
695 begin
696 IndexDefs := GetIndexDefs(GetComponent(0));
697 for I := 0 to IndexDefs.Count - 1 do
698 with IndexDefs[I] do
699 if (Options * [ixExpression, ixDescending] = []) and (Fields <> '') then
700 List.Add(Fields);
701 end;
702
703
704 { TIBIndexNameProperty }
705
706 procedure TIBIndexNameProperty.GetValueList(List: TStrings);
707 begin
708 GetIndexDefs(GetComponent(0)).GetItemNames(List);
709 end;
710
711 { TSQLPropertyEditor }
712
713 function TSQLPropertyEditor.GetAttributes: TPropertyAttributes;
714 begin
715 Result := inherited GetAttributes + [paDialog] - [paMultiSelect,paSubProperties];
716 end;
717
718 { TIBQuerySQLProperty }
719
720 procedure TIBQuerySQLProperty.Edit;
721 var
722 Query: TIBQuery;
723 begin
724 Query := GetComponent(0) as TIBQuery;
725 if IBSelectSQLEditor.EditSQL(Query,Query.SQL) then Modified;
726 end;
727
728 { TIBDatasetSQLProperty }
729
730 procedure TIBDatasetSQLProperty.Edit;
731 var
732 IBDataset: TIBDataset;
733 begin
734 IBDataset := GetComponent(0) as TIBDataset;
735 if IBSelectSQLEditor.EditSQL(IBDataSet,IBDataSet.SelectSQL) then Modified;
736 end;
737
738 { TIBSQLProperty }
739
740 procedure TIBSQLProperty.Edit;
741 var
742 IBSQL: TIBSQL;
743 begin
744 IBSQL := GetComponent(0) as TIBSQL;
745 if IBSQLEditor.EditIBSQL(IBSQL) then Modified;
746 end;
747
748 { TIBUpdateSQLEditor }
749
750 procedure TIBUpdateSQLEditor.ExecuteVerb(Index: Integer);
751 begin
752 if IBUpdateSQLEditor.EditIBUpdateSQL(TIBUpdateSQL(Component)) then Modified;
753 end;
754
755 function TIBUpdateSQLEditor.GetVerb(Index: Integer): string;
756 begin
757 case Index of
758 0 : Result := SIBUpdateSQLEditor;
759 1: Result := SInterbaseExpressVersion;
760 end;
761 end;
762
763 function TIBUpdateSQLEditor.GetVerbCount: Integer;
764 begin
765 Result := 2;
766 end;
767
768 { TIBDataSetEditor }
769
770 procedure TIBDataSetEditor.ExecuteVerb(Index: Integer);
771 var
772 IBDataset: TIBDataset;
773 begin
774 if Index < inherited GetVerbCount then
775 inherited ExecuteVerb(Index) else
776 begin
777 Dec(Index, inherited GetVerbCount);
778 case Index of
779 0:
780 if IBDataSetEditor.EditIBDataSet(TIBDataSet(Component)) then
781 Designer.Modified;
782 1: (Component as TIBDataSet).ExecSQL;
783 end;
784 end;
785 end;
786
787 function TIBDataSetEditor.GetVerb(Index: Integer): string;
788 begin
789 if Index < inherited GetVerbCount then
790 Result := inherited GetVerb(Index) else
791 begin
792 Dec(Index, inherited GetVerbCount);
793 case Index of
794 0: Result := SIBDataSetEditor;
795 1: Result := SExecute;
796 2: Result := SInterbaseExpressVersion;
797 end;
798 end;
799 end;
800
801 function TIBDataSetEditor.GetVerbCount: Integer;
802 begin
803 Result := inherited GetVerbCount + 3;
804 end;
805
806 { TIBEventListProperty }
807
808 function TIBEventListProperty.GetAttributes: TPropertyAttributes;
809 begin
810 Result := inherited GetAttributes + [paDialog] - [paMultiSelect,paSubProperties];
811 end;
812
813 procedure TIBEventListProperty.Edit;
814 var
815 Events: TStrings;
816 IBEvents: TIBEvents;
817 begin
818 IBEvents := GetComponent(0) as TIBEvents;
819 Events := TStringList.Create;
820 try
821 Events.Assign( IBEvents.Events);
822 if EditAlerterEvents( Events) then
823 begin
824 IBEvents.Events.Assign(Events);
825 Modified
826 end;
827 finally
828 Events.Free;
829 end;
830 end;
831
832 { TIBDatabaseEditor }
833 procedure TIBDatabaseEditor.ExecuteVerb(Index: Integer);
834 begin
835 if Index < inherited GetVerbCount then
836 inherited ExecuteVerb(Index) else
837 begin
838 Dec(Index, inherited GetVerbCount);
839 case Index of
840 0 : if EditIBDatabase(TIBDatabase(Component)) then Designer.Modified;
841 end;
842 end;
843 end;
844
845 function TIBDatabaseEditor.GetVerb(Index: Integer): string;
846 begin
847 if Index < inherited GetVerbCount then
848 Result := inherited GetVerb(Index) else
849 begin
850 Dec(Index, inherited GetVerbCount);
851 case Index of
852 0: Result := SIBDatabaseEditor;
853 1 : Result := SInterbaseExpressVersion;
854 end;
855 end;
856 end;
857
858 function TIBDatabaseEditor.GetVerbCount: Integer;
859 begin
860 Result := inherited GetVerbCount + 2;
861 end;
862
863 { TIBTransactionEditor }
864
865 procedure TIBTransactionEditor.ExecuteVerb(Index: Integer);
866 begin
867 case Index of
868 0: if EditIBTransaction(TIBTransaction(Component)) then Designer.Modified;
869 end;
870 end;
871
872 function TIBTransactionEditor.GetVerb(Index: Integer): string;
873 begin
874 case Index of
875 0: Result := SIBTransactionEditor;
876 1: Result := SInterbaseExpressVersion;
877 end;
878 end;
879
880 function TIBTransactionEditor.GetVerbCount: Integer;
881 begin
882 Result := 2;
883 end;
884
885 { TIBQueryEditor }
886
887 procedure TIBQueryEditor.ExecuteVerb(Index: Integer);
888 var
889 Query: TIBQuery;
890 begin
891 if Index < inherited GetVerbCount then
892 inherited ExecuteVerb(Index) else
893 begin
894 Query := Component as TIBQuery;
895 Dec(Index, inherited GetVerbCount);
896 case Index of
897 0: Query.ExecSQL;
898 1: if ibselectsqleditor.EditSQL(Query,Query.SQL) then Designer.Modified;
899 end;
900 end;
901 end;
902
903 function TIBQueryEditor.GetVerb(Index: Integer): string;
904 begin
905 if Index < inherited GetVerbCount then
906 Result := inherited GetVerb(Index) else
907 begin
908 Dec(Index, inherited GetVerbCount);
909 case Index of
910 0: Result := SExecute;
911 1: Result := SEditSQL;
912 2: Result := SInterbaseExpressVersion;
913 end;
914 end;
915 end;
916
917 function TIBQueryEditor.GetVerbCount: Integer;
918 begin
919 Result := inherited GetVerbCount + 3;
920 end;
921
922 { TIBStoredProcEditor }
923
924 procedure TIBStoredProcEditor.ExecuteVerb(Index: Integer);
925 begin
926 if Index < inherited GetVerbCount then
927 inherited ExecuteVerb(Index) else
928 begin
929 Dec(Index, inherited GetVerbCount);
930 if Index = 0 then (Component as TIBStoredProc).ExecProc;
931 end;
932 end;
933
934 function TIBStoredProcEditor.GetVerb(Index: Integer): string;
935 begin
936 if Index < inherited GetVerbCount then
937 Result := inherited GetVerb(Index) else
938 begin
939 Dec(Index, inherited GetVerbCount);
940 case Index of
941 0: Result := SExecute;
942 1: Result := SInterbaseExpressVersion;
943 end;
944 end;
945 end;
946
947 function TIBStoredProcEditor.GetVerbCount: Integer;
948 begin
949 Result := inherited GetVerbCount + 2;
950 end;
951
952 { TIBStoredProcParamsProperty }
953
954 procedure TIBStoredProcParamsProperty.Edit;
955 var
956 StoredProc: TIBStoredProc;
957 Params: TParams;
958 begin
959 StoredProc := (GetComponent(0) as TIBStoredProc);
960 Params := TParams.Create(nil);
961 try
962 StoredProc.CopyParams(Params);
963 finally
964 Params.Free;
965 end;
966 inherited Edit;
967 end;
968
969 { TIBTableFieldLinkProperty }
970
971 procedure TIBTableFieldLinkProperty.Edit;
972 begin
973 FTable := DataSet as TIBTable;
974 if assigned(FTable.Database) then
975 FTable.Database.Connected := true;
976 inherited Edit;
977 end;
978
979 function TIBTableFieldLinkProperty.GetIndexDefs: TIndexDefs;
980 begin
981 Result := FTable.IndexDefs
982 end;
983
984 function TIBTableFieldLinkProperty.GetIndexFieldNames: string;
985 begin
986 Result := FTable.IndexFieldNames;
987 end;
988
989 function TIBTableFieldLinkProperty.GetMasterFields: string;
990 begin
991 Result := FTable.MasterFields;
992 end;
993
994 procedure TIBTableFieldLinkProperty.SetIndexFieldNames(const Value: string);
995 begin
996 FTable.IndexFieldNames := Value;
997 end;
998
999 procedure TIBTableFieldLinkProperty.SetMasterFields(const Value: string);
1000 begin
1001 FTable.MasterFields := Value;
1002 end;
1003
1004 { TIBUpdateSQLProperty }
1005
1006 procedure TIBUpdateSQLProperty.Edit;
1007 var
1008 IBDataset: TIBDataset;
1009 begin
1010 IBDataset := GetComponent(0) as TIBDataset;
1011 if IBModifySQLEditor.EditSQL(IBDataSet,IBDataSet.ModifySQL) then Modified;
1012 end;
1013
1014 { TIBUpdateSQLUpdateProperty }
1015
1016 procedure TIBUpdateSQLUpdateProperty.Edit;
1017 begin
1018 GetObjects;
1019 if IBModifySQLEditor.EditSQL(FIBUpdateSQL.DataSet,FIBUpdateSQL.ModifySQL) then Modified;
1020 end;
1021
1022 { TIBRefreshSQLProperty }
1023
1024 procedure TIBRefreshSQLProperty.Edit;
1025 var
1026 IBDataset: TIBDataset;
1027 aDatabase: TIBDatabase;
1028 begin
1029 IBDataset := GetComponent(0) as TIBDataset;
1030 if IBRefreshSQLEditor.EditSQL(IBDataSet,IBDataSet.RefreshSQL) then Modified;
1031 end;
1032
1033 { TIBUpdateSQLRefreshSQLProperty }
1034
1035 procedure TIBUpdateSQLRefreshSQLProperty.Edit;
1036 begin
1037 GetObjects;
1038 if IBRefreshSQLEditor.EditSQL(FIBUpdateSQL.DataSet,FIBUpdateSQL.RefreshSQL) then Modified;
1039 end;
1040
1041 { TIBDeleteSQLProperty }
1042
1043 procedure TIBDeleteSQLProperty.Edit;
1044 var
1045 IBDataset: TIBDataSet;
1046 begin
1047 IBDataset := GetComponent(0) as TIBDataSet;
1048 if IBDeleteSQLEditor.EditSQL(IBDataSet,IBDataSet.DeleteSQL) then Modified;
1049 end;
1050
1051 { TIBUpdateSQLDeleteProperty }
1052
1053 function TIBUpdateSQLDeleteProperty.GetAttributes: TPropertyAttributes;
1054 begin
1055 Result:=inherited GetAttributes;
1056 end;
1057
1058 procedure TIBUpdateSQLDeleteProperty.Edit;
1059 begin
1060 GetObjects;
1061 if IBDeleteSQLEditor.EditSQL(FIBUpdateSQL.DataSet,FIBUpdateSQL.DeleteSQL) then Modified;
1062 end;
1063
1064 { TUpdateSQLPropertyEditor }
1065
1066 function TUpdateSQLPropertyEditor.GetObjects: boolean;
1067 begin
1068 Result := false;
1069 FIBUpdateSQL := GetComponent(0) as TIBUpdateSQL;
1070 if not assigned(FIBUpdateSQL) or not assigned(FIBUpdateSQL.DataSet) then
1071 Exit;
1072 FDatabase := nil;
1073 if FIBUpdateSQL.DataSet is TIBQuery then
1074 begin
1075 FDatabase := (FIBUpdateSQL.DataSet as TIBQuery).Database;
1076 Result := true
1077 end;
1078 end;
1079
1080 { TIBInsertSQLProperty }
1081
1082 procedure TIBInsertSQLProperty.Edit;
1083 var
1084 IBDataset: TIBDataSet;
1085 begin
1086 IBDataset := GetComponent(0) as TIBDataSet;
1087 if IBInsertSQLEditor.EditSQL(IBDataSet,IBDataSet.InsertSQL) then Modified;
1088 end;
1089
1090 { TIBUpdateSQLInsertSQLProperty }
1091
1092 procedure TIBUpdateSQLInsertSQLProperty.Edit;
1093 begin
1094 GetObjects;
1095 if IBInsertSQLEditor.EditSQL(FIBUpdateSQL.Dataset,FIBUpdateSQL.InsertSQL) then Modified;
1096 end;
1097
1098 { TIBGeneratorProperty }
1099
1100 function TIBGeneratorProperty.GetAttributes: TPropertyAttributes;
1101 begin
1102 Result:= inherited GetAttributes + [paDialog] - [paMultiSelect,paValueList];
1103 end;
1104
1105 procedure TIBGeneratorProperty.Edit;
1106 begin
1107 if IBGeneratorEditor.EditGenerator(GetPersistentReference as TIBGenerator) then Modified;
1108 end;
1109
1110 { TIBSQLEditor }
1111
1112 procedure TIBSQLEditor.ExecuteVerb(Index: Integer);
1113 begin
1114 if IBSQLEditor.EditIBSQL(TIBSQL(Component)) then Modified;
1115 end;
1116
1117 function TIBSQLEditor.GetVerb(Index: Integer): string;
1118 begin
1119 case Index of
1120 0 : Result := SIBSQLEditor;
1121 1: Result := SInterbaseExpressVersion;
1122 end;
1123 end;
1124
1125 function TIBSQLEditor.GetVerbCount: Integer;
1126 begin
1127 Result:= 2
1128 end;
1129
1130 { TIBSQLSQLPropertyEditor }
1131
1132 procedure TIBSQLSQLPropertyEditor.Edit;
1133 var
1134 IBSQL: TIBSQL;
1135 begin
1136 IBSQL := GetComponent(0) as TIBSQL;
1137 if IBSQLEditor.EditIBSQL(IBSQL) then Modified;
1138 end;
1139
1140 initialization
1141 {$I IBDBReg.lrs}
1142 end.