ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBDBReg.pas
Revision: 1
Committed: Mon Jul 31 16:43:00 2000 UTC (23 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 34685 byte(s)
Log Message:
Borland IBX Open Source Release

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 {************************************************************************}
28
29 unit IBDBReg;
30
31 (*
32 * Compiler defines
33 *)
34 {$A+} (* Aligned records: On *)
35 {$B-} (* Short circuit boolean expressions: Off *)
36 {$G+} (* Imported data: On *)
37 {$H+} (* Huge Strings: On *)
38 {$J-} (* Modification of Typed Constants: Off *)
39 {$M+} (* Generate run-time type information: On *)
40 {$O+} (* Optimization: On *)
41 {$Q-} (* Overflow checks: Off *)
42 {$R-} (* Range checks: Off *)
43 {$T+} (* Typed address: On *)
44 {$U+} (* Pentim-safe FDIVs: On *)
45 {$W-} (* Always generate stack frames: Off *)
46 {$X+} (* Extended syntax: On *)
47 {$Z1} (* Minimum Enumeration Size: 1 Byte *)
48
49 interface
50
51 uses Windows, SysUtils, Classes, Graphics, Dialogs, Controls, Forms, TypInfo,
52 DsgnIntf, DB, ParentageSupport, dsndb, DBReg, ColnEdit, FldLinks, SQLEdit,
53 DataModelSupport, IBTable, IBDatabase, IBUpdateSQLEditor, IBEventsEditor,
54 IBXConst;
55
56 type
57
58 { TIBFileNameProperty
59 Property editor the DataBase Name property. Brings up the Open dialog }
60
61 TIBFileNameProperty = class(TStringProperty)
62 public
63 procedure Edit; override;
64 function GetAttributes: TPropertyAttributes; override;
65 end;
66
67 { TIBNameProperty
68 }
69 TIBNameProperty = class(TStringProperty)
70 public
71 function GetAttributes: TPropertyAttributes; override;
72 end;
73
74 { TIBStoredProcNameProperty
75 Editor for the TIBStoredProc.StoredProcName property. Displays a drop-down list of all
76 the StoredProcedures in the Database.}
77 TIBStoredProcNameProperty = class(TIBNameProperty)
78 public
79 procedure GetValues(Proc: TGetStrProc); override;
80 end;
81
82 { TIBTableNameProperty
83 Editor for the TIBTable.TableName property. Displays a drop-down list of all
84 the Tables in the Database.}
85 TIBTableNameProperty = class(TIBNameProperty)
86 public
87 procedure GetValues(Proc: TGetStrProc); override;
88 end;
89
90 TDBStringProperty = class(TStringProperty)
91 public
92 function GetAttributes: TPropertyAttributes; override;
93 procedure GetValueList(List: TStrings); virtual;
94 procedure GetValues(Proc: TGetStrProc); override;
95 end;
96
97 TIBIndexFieldNamesProperty = class(TDBStringProperty)
98 public
99 procedure GetValueList(List: TStrings); override;
100 end;
101
102 TIBIndexNameProperty = class(TDBStringProperty)
103 public
104 procedure GetValueList(List: TStrings); override;
105 end;
106
107 { TIBDatabaseEditor }
108
109 TIBDatabaseEditor = class(TComponentEditor)
110 procedure ExecuteVerb(Index: Integer); override;
111 function GetVerb(Index: Integer): string; override;
112 function GetVerbCount: Integer; override;
113 end;
114
115 { TIBTransactionEditor }
116
117 TIBTransactionEditor = class(TComponentEditor)
118 public
119 procedure ExecuteVerb(Index: Integer); override;
120 function GetVerb(Index: Integer): string; override;
121 function GetVerbCount: Integer; override;
122 end;
123
124 { TIBQueryEditor }
125
126 TIBQueryEditor = class(TDataSetEditor)
127 protected
128 FGetTableNamesProc: TGetTableNamesProc;
129 FGetFieldnamesProc: TGetFieldNamesProc;
130 public
131 procedure EditSQL;
132 procedure ExecuteVerb(Index: Integer); override;
133 function GetVerb(Index: Integer): string; override;
134 function GetVerbCount: Integer; override;
135 end;
136
137 { TIBStoredProcEditor }
138
139 TIBStoredProcEditor = class(TDataSetEditor)
140 public
141 procedure ExecuteVerb(Index: Integer); override;
142 function GetVerb(Index: Integer): string; override;
143 function GetVerbCount: Integer; override;
144 end;
145
146 { TIBDataSetEditor }
147
148 TIBDataSetEditor = class(TDataSetEditor)
149 protected
150 FGetTableNamesProc: TGetTableNamesProc;
151 FGetFieldnamesProc: TGetFieldNamesProc;
152 public
153 procedure EditSQL;
154 procedure ExecuteVerb(Index: Integer); override;
155 function GetVerb(Index: Integer): string; override;
156 function GetVerbCount: Integer; override;
157 end;
158
159 { TIBUpdateSQLEditor }
160
161 TIBUpdateSQLEditor = class(TComponentEditor)
162 public
163 procedure ExecuteVerb(Index: Integer); override;
164 function GetVerb(Index: Integer): string; override;
165 function GetVerbCount: Integer; override;
166 end;
167
168 TIBStoredProcParamsProperty = class(TCollectionProperty)
169 public
170 procedure Edit; override;
171 end;
172
173 TIBTableFieldLinkProperty = class(TFieldLinkProperty)
174 private
175 FTable: TIBTable;
176 protected
177 function GetIndexFieldNames: string; override;
178 function GetMasterFields: string; override;
179 procedure SetIndexFieldNames(const Value: string); override;
180 procedure SetMasterFields(const Value: string); override;
181 public
182 procedure Edit; override;
183 end;
184
185 { TSQLPropertyEditor }
186
187 TSQLPropertyEditor = class(TClassProperty)
188 protected
189 FGetTableNamesProc: TGetTableNamesProc;
190 FGetFieldnamesProc: TGetFieldNamesProc;
191 public
192 procedure EditSQL;
193 function GetAttributes: TPropertyAttributes; override;
194 end;
195
196 { TIBQuerySQLProperty }
197
198 TIBQuerySQLProperty = class(TSQLPropertyEditor)
199 public
200 procedure Edit; override;
201 end;
202
203 { TIBDatasetSQLProperty }
204
205 TIBDatasetSQLProperty = class(TSQLPropertyEditor)
206 public
207 procedure Edit; override;
208 end;
209
210 { TIBSQLProperty }
211
212 TIBSQLProperty = class(TSQLPropertyEditor)
213 public
214 procedure Edit; override;
215 end;
216
217 TIBEventListProperty = class(TClassProperty)
218 public
219 function GetAttributes: TPropertyAttributes; override;
220 procedure Edit; override;
221 end;
222
223 { DataModel Designer stuff }
224
225 TIBSQLSprig = class(TSprig)
226 public
227 procedure FigureParent; override;
228 function AnyProblems: Boolean; override;
229 function DragDropTo(AItem: TSprig): Boolean; override;
230 function DragOverTo(AItem: TSprig): Boolean; override;
231 class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;
232 end;
233
234 TIBCustomDataSetSprig = class(TDataSetSprig)
235 public
236 procedure FigureParent; override;
237 function AnyProblems: Boolean; override;
238 function DragDropTo(AItem: TSprig): Boolean; override;
239 function DragOverTo(AItem: TSprig): Boolean; override;
240 class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;
241 end;
242
243 TIBQuerySprig = class(TIBCustomDataSetSprig)
244 public
245 function AnyProblems: Boolean; override;
246 end;
247
248 TIBTableSprig = class(TIBCustomDataSetSprig)
249 public
250 function AnyProblems: Boolean; override;
251 function Caption: string; override;
252 end;
253
254 TIBStoredProcSprig = class(TIBCustomDataSetSprig)
255 public
256 function AnyProblems: Boolean; override;
257 function Caption: string; override;
258 end;
259
260 TIBUpdateSQLSprig = class(TSprigAtRoot)
261 public
262 function AnyProblems: Boolean; override;
263 end;
264
265 TIBDatabaseSprig = class(TSprigAtRoot)
266 public
267 function AnyProblems: Boolean; override;
268 function Caption: string; override;
269 end;
270
271 TIBTransactionSprig = class(TSprig)
272 public
273 function Caption: string; override;
274 procedure FigureParent; override;
275 function AnyProblems: Boolean; override;
276 function DragDropTo(AItem: TSprig): Boolean; override;
277 function DragOverTo(AItem: TSprig): Boolean; override;
278 class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;
279 end;
280
281 TIBDatabaseInfoSprig = class(TSprig)
282 public
283 class function ParentProperty: string; override;
284 end;
285
286 TIBEventsSprig = class(TSprig)
287 public
288 class function ParentProperty: string; override;
289 function AnyProblems: Boolean; override;
290 end;
291
292 TIBTransactionIsland = class(TIsland)
293 public
294 function VisibleTreeParent: Boolean; override;
295 end;
296
297 TIBSQLIsland = class(TIsland)
298 public
299 function VisibleTreeParent: Boolean; override;
300 end;
301
302 TIBCustomDataSetIsland = class(TDataSetIsland)
303 public
304 function VisibleTreeParent: Boolean; override;
305 end;
306
307 TIBTableIsland = class(TIBCustomDataSetIsland)
308 end;
309
310 TIBTableMasterDetailBridge = class(TMasterDetailBridge)
311 public
312 function CanEdit: Boolean; override;
313 class function OmegaIslandClass: TIslandClass; override;
314 class function GetOmegaSource(AItem: TPersistent): TDataSource; override;
315 class procedure SetOmegaSource(AItem: TPersistent; ADataSource: TDataSource); override;
316 function Caption: string; override;
317 function Edit: Boolean; override;
318 end;
319
320 TIBQueryIsland = class(TIBCustomDataSetIsland)
321 end;
322
323 TIBQueryMasterDetailBridge = class(TMasterDetailBridge)
324 public
325 class function RemoveMasterFieldsAsWell: Boolean; override;
326 class function OmegaIslandClass: TIslandClass; override;
327 class function GetOmegaSource(AItem: TPersistent): TDataSource; override;
328 class procedure SetOmegaSource(AItem: TPersistent; ADataSource: TDataSource); override;
329 function Caption: string; override;
330 end;
331
332 procedure Register;
333
334 implementation
335
336 uses IB, IBQuery, IBStoredProc, IBUpdateSQL, IBCustomDataSet,
337 IBIntf, IBSQL, IBSQLMonitor, IBDatabaseInfo, IBEvents,
338 IBServices, IBInstall, IBDatabaseEdit, IBTransactionEdit,
339 IBBatchMove, DBLogDlg;
340
341 procedure Register;
342 begin
343 RegisterComponents(IBPalette1, [TIBTable, TIBQuery,
344 TIBStoredProc, TIBDatabase, TIBTransaction, TIBUpdateSQL,
345 TIBDataSet, TIBSQL, TIBDatabaseInfo, TIBSQLMonitor, TIBEvents]);
346 {$IFDEF IB6_ONLY}
347 if (TryIBLoad) and (GetIBClientVersion >= 6) then
348 RegisterComponents(IBPalette2, [TIBConfigService, TIBBackupService,
349 TIBRestoreService, TIBValidationService, TIBStatisticalService,
350 TIBLogService, TIBSecurityService, TIBServerProperties,
351 TIBInstall, TIBUninstall]);
352 {$ENDIF}
353 RegisterClasses([TIBStringField, TIBBCDField]);
354 RegisterFields([TIBStringField, TIBBCDField]);
355 RegisterPropertyEditor(TypeInfo(TIBFileName), TIBDatabase, 'DatabaseName', TIBFileNameProperty); {do not localize}
356 RegisterPropertyEditor(TypeInfo(string), TIBStoredProc, 'StoredProcName', TIBStoredProcNameProperty); {do not localize}
357 RegisterPropertyEditor(TypeInfo(TParams), TIBStoredProc, 'Params', TIBStoredProcParamsProperty);
358 RegisterPropertyEditor(TypeInfo(string), TIBTable, 'TableName', TIBTableNameProperty); {do not localize}
359 RegisterPropertyEditor(TypeInfo(string), TIBTable, 'IndexName', TIBIndexNameProperty); {do not localize}
360 RegisterPropertyEditor(TypeInfo(string), TIBTable, 'IndexFieldNames', TIBIndexFieldNamesProperty); {do not localize}
361 RegisterPropertyEditor(TypeInfo(string), TIBTable, 'MasterFields', TIBTableFieldLinkProperty); {do not localize}
362 RegisterPropertyEditor(TypeInfo(TStrings), TIBQuery, 'SQL', TIBQuerySQLProperty); {do not localize}
363 RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'SelectSQL', TIBDatasetSQLProperty); {do not localize}
364 RegisterPropertyEditor(TypeInfo(TStrings), TIBSQL, 'SQL', TIBSQLProperty); {do not localize}
365 RegisterPropertyEditor(TypeInfo(TStrings), TIBEvents, 'Events', TIBEventListProperty); {do not localize}
366
367 RegisterComponentEditor(TIBDatabase, TIBDatabaseEditor);
368 RegisterComponentEditor(TIBTransaction, TIBTransactionEditor);
369 RegisterComponentEditor(TIBUpdateSQL, TIBUpdateSQLEditor);
370 RegisterComponentEditor(TIBDataSet, TIBDataSetEditor);
371 RegisterComponentEditor(TIBQuery, TIBQueryEditor);
372 RegisterComponentEditor(TIBStoredProc, TIBStoredProcEditor);
373
374 RegisterSprigType(TIBDatabase, TIBDatabaseSprig);
375 RegisterSprigType(TIBTransaction, TIBTransactionSprig);
376
377 RegisterSprigType(TIBDatabaseInfo, TIBDatabaseInfoSprig);
378 RegisterSprigType(TIBEvents, TIBEventsSprig);
379 RegisterSprigType(TIBSQL, TIBSQLSprig);
380
381 RegisterSprigType(TIBUpdateSQL, TIBUpdateSQLSprig);
382
383 RegisterSprigType(TIBCustomDataSet, TIBCustomDataSetSprig);
384 RegisterSprigType(TIBQuery, TIBQuerySprig);
385 RegisterSprigType(TIBTable, TIBTableSprig);
386 RegisterSprigType(TIBStoredProc, TIBStoredProcSprig);
387
388 RegisterIslandType(TIBTransactionSprig, TIBTransactionIsland);
389 RegisterIslandType(TIBSQLSprig, TIBSQLIsland);
390 RegisterIslandType(TIBCustomDataSetSprig, TIBCustomDataSetIsland);
391 RegisterIslandType(TIBTableSprig, TIBTableIsland);
392 RegisterIslandType(TIBQuerySprig, TIBQueryIsland);
393
394 RegisterBridgeType(TDataSetIsland, TIBTableIsland, TIBTableMasterDetailBridge);
395 RegisterBridgeType(TDataSetIsland, TIBQueryIsland, TIBQueryMasterDetailBridge);
396 end;
397
398 { TIBFileNameProperty }
399 procedure TIBFileNameProperty.Edit;
400 begin
401 with TOpenDialog.Create(Application) do
402 try
403 InitialDir := ExtractFilePath(GetStrValue);
404 Filter := 'Database Files|*.gdb'; {do not localize}
405 if Execute then
406 SetStrValue(FileName);
407 finally
408 Free
409 end;
410 end;
411
412 function TIBFileNameProperty.GetAttributes: TPropertyAttributes;
413 begin
414 Result := [paDialog];
415 end;
416
417 { TIBNameProperty }
418
419 function TIBNameProperty.GetAttributes: TPropertyAttributes;
420 begin
421 Result := [paValueList, paSortList];
422 end;
423
424 { TIBStoredProcNameProperty }
425
426 procedure TIBStoredProcNameProperty.GetValues(Proc: TGetStrProc);
427 var
428 StoredProc : TIBStoredProc;
429 i : integer;
430 begin
431 StoredProc := GetComponent(0) as TIBStoredProc;
432 with StoredProc do
433 for I := 0 to StoredProcedureNames.Count - 1 do
434 Proc (StoredProcedureNames[i]);
435 end;
436
437 { TIBTableNameProperty }
438
439 procedure TIBTableNameProperty.GetValues(Proc: TGetStrProc);
440 var
441 TableName : TIBTable;
442 i : integer;
443 begin
444 TableName := GetComponent(0) as TIBTable;
445 with TableName do
446 for I := 0 to TableNames.Count - 1 do
447 Proc (TableNames[i]);
448 end;
449
450 { TDBStringProperty }
451
452 function TDBStringProperty.GetAttributes: TPropertyAttributes;
453 begin
454 Result := [paValueList, paSortList, paMultiSelect];
455 end;
456
457 procedure TDBStringProperty.GetValueList(List: TStrings);
458 begin
459 end;
460
461 procedure TDBStringProperty.GetValues(Proc: TGetStrProc);
462 var
463 I: Integer;
464 Values: TStringList;
465 begin
466 Values := TStringList.Create;
467 try
468 GetValueList(Values);
469 for I := 0 to Values.Count - 1 do Proc(Values[I]);
470 finally
471 Values.Free;
472 end;
473 end;
474
475 { Utility Functions }
476
477 function GetPropertyValue(Instance: TPersistent; const PropName: string): TPersistent;
478 var
479 PropInfo: PPropInfo;
480 begin
481 Result := nil;
482 PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, PropName);
483 if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
484 Result := TObject(GetOrdProp(Instance, PropInfo)) as TPersistent;
485 end;
486
487 function GetIndexDefs(Component: TPersistent): TIndexDefs;
488 var
489 DataSet: TDataSet;
490 begin
491 DataSet := Component as TDataSet;
492 Result := GetPropertyValue(DataSet, 'IndexDefs') as TIndexDefs; {do not localize}
493 if Assigned(Result) then
494 begin
495 Result.Updated := False;
496 Result.Update;
497 end;
498 end;
499
500 { TIBIndexFieldNamesProperty }
501
502 procedure TIBIndexFieldNamesProperty.GetValueList(List: TStrings);
503 var
504 I: Integer;
505 IndexDefs: TIndexDefs;
506 begin
507 IndexDefs := GetIndexDefs(GetComponent(0));
508 for I := 0 to IndexDefs.Count - 1 do
509 with IndexDefs[I] do
510 if (Options * [ixExpression, ixDescending] = []) and (Fields <> '') then
511 List.Add(Fields);
512 end;
513
514
515 { TIBIndexNameProperty }
516
517 procedure TIBIndexNameProperty.GetValueList(List: TStrings);
518 begin
519 GetIndexDefs(GetComponent(0)).GetItemNames(List);
520 end;
521
522 { TSQLPropertyEditor }
523
524 procedure TSQLPropertyEditor.EditSQL;
525 var
526 SQLText: string;
527 SQL: TStrings;
528 begin
529 SQL := TStringList.Create;
530 try
531 SQL.Assign(TStrings(GetOrdValue));
532 SQLText := SQL.Text;
533 if (SQLEdit.EditSQL(SQLText, FGetTableNamesProc, FGetFieldNamesProc)) and
534 (SQL.Text <> SQLText) then
535 begin
536 SQL.Text := SQLText;
537 SetOrdValue(LongInt(SQL));
538 end;
539 finally
540 SQL.free;
541 end;
542 end;
543
544 function TSQLPropertyEditor.GetAttributes: TPropertyAttributes;
545 begin
546 Result := inherited GetAttributes + [paDialog] - [paSubProperties];
547 end;
548
549 { TIBQuerySQLProperty }
550
551 procedure TIBQuerySQLProperty.Edit;
552 var
553 Query: TIBQuery;
554 begin
555 Query := TIBQuery(GetComponent(0));
556 if Assigned(Query.Database) then
557 begin
558 FGetTableNamesProc := Query.Database.GetTableNames;
559 FGetFieldNamesProc := Query.Database.GetFieldNames;
560 end
561 else
562 begin
563 FGetTableNamesProc := nil;
564 FGetFieldNamesProc := nil;
565 end;
566 EditSQL;
567 end;
568
569 { TIBDatasetSQLProperty }
570
571 procedure TIBDatasetSQLProperty.Edit;
572 var
573 IBDataset: TIBDataset;
574 begin
575 IBDataset := TIBDataset(GetComponent(0));
576 if Assigned(IBDataSet.Database) then
577 begin
578 FGetTableNamesProc := IBDataset.Database.GetTableNames;
579 FGetFieldNamesProc := IBDataset.Database.GetFieldNames;
580 end
581 else
582 begin
583 FGetTableNamesProc := nil;
584 FGetFieldNamesProc := nil;
585 end;
586 EditSQL;
587 end;
588
589 { TIBSQLProperty }
590
591 procedure TIBSQLProperty.Edit;
592 var
593 IBSQL: TIBSQL;
594 begin
595 IBSQL := TIBSQL(GetComponent(0));
596 if Assigned(IBSQL.Database) then
597 begin
598 FGetTableNamesProc := IBSQL.Database.GetTableNames;
599 FGetFieldNamesProc := IBSQL.Database.GetFieldNames;
600 end
601 else
602 begin
603 FGetTableNamesProc := nil;
604 FGetFieldNamesProc := nil;
605 end;
606 EditSQL;
607 end;
608
609 { TIBUpdateSQLEditor }
610
611 procedure TIBUpdateSQLEditor.ExecuteVerb(Index: Integer);
612 begin
613 if EditIBUpdateSQL(TIBUpdateSQL(Component)) then Designer.Modified;
614 end;
615
616 function TIBUpdateSQLEditor.GetVerb(Index: Integer): string;
617 begin
618 case Index of
619 0 : Result := SIBUpdateSQLEditor;
620 2: Result := SInterbaseExpressVersion;
621 end;
622 end;
623
624 function TIBUpdateSQLEditor.GetVerbCount: Integer;
625 begin
626 Result := 2;
627 end;
628
629 { TIBDataSetEditor }
630
631 procedure TIBDataSetEditor.EditSQL;
632 var
633 SQLText: string;
634 SQL: TStrings;
635 begin
636 SQL := TStringList.Create;
637 try
638 SQL.Assign(TIBDataset(Component).SelectSQL);
639 SQLText := SQL.Text;
640 if (SQLEdit.EditSQL(SQLText, FGetTableNamesProc, FGetFieldNamesProc)) and
641 (SQL.Text <> SQLText) then
642 begin
643 SQL.Text := SQLText;
644 TIBDataset(Component).SelectSQL.Assign(SQL);
645 end;
646 finally
647 SQL.free;
648 end;
649 end;
650
651 procedure TIBDataSetEditor.ExecuteVerb(Index: Integer);
652 var
653 IBDataset: TIBDataset;
654 begin
655 if Index < inherited GetVerbCount then
656 inherited ExecuteVerb(Index) else
657 begin
658 Dec(Index, inherited GetVerbCount);
659 case Index of
660 0:
661 if EditIBDataSet(TIBDataSet(Component)) then
662 Designer.Modified;
663 1: (Component as TIBDataSet).ExecSQL;
664 2:
665 begin
666 IBDataset := TIBDataset(Component);
667 if Assigned(IBDataSet.Database) then
668 begin
669 FGetTableNamesProc := IBDataset.Database.GetTableNames;
670 FGetFieldNamesProc := IBDataset.Database.GetFieldNames;
671 end
672 else
673 begin
674 FGetTableNamesProc := nil;
675 FGetFieldNamesProc := nil;
676 end;
677 EditSQL;
678 end;
679 end;
680 end;
681 end;
682
683 function TIBDataSetEditor.GetVerb(Index: Integer): string;
684 begin
685 if Index < inherited GetVerbCount then
686 Result := inherited GetVerb(Index) else
687 begin
688 Dec(Index, inherited GetVerbCount);
689 case Index of
690 0: Result := SIBDataSetEditor;
691 1: Result := SExecute;
692 2: Result := SEditSQL;
693 3: Result := SInterbaseExpressVersion;
694 end;
695 end;
696 end;
697
698 function TIBDataSetEditor.GetVerbCount: Integer;
699 begin
700 Result := inherited GetVerbCount + 4;
701 end;
702
703 { TIBEventListProperty }
704
705 function TIBEventListProperty.GetAttributes: TPropertyAttributes;
706 begin
707 Result := inherited GetAttributes + [paDialog] - [paSubProperties];
708 end;
709
710 procedure TIBEventListProperty.Edit;
711 var
712 Events: TStrings;
713 begin
714 Events := TStringList.Create;
715 try
716 Events.Assign( TStrings(GetOrdValue));
717 if EditAlerterEvents( Events) then SetOrdValue( longint(Events));
718 finally
719 Events.Free;
720 end;
721 end;
722
723 { TIBDatabaseEditor }
724 procedure TIBDatabaseEditor.ExecuteVerb(Index: Integer);
725 begin
726 if Index < inherited GetVerbCount then
727 inherited ExecuteVerb(Index) else
728 begin
729 Dec(Index, inherited GetVerbCount);
730 case Index of
731 0 : if EditIBDatabase(TIBDatabase(Component)) then Designer.Modified;
732 end;
733 end;
734 end;
735
736 function TIBDatabaseEditor.GetVerb(Index: Integer): string;
737 begin
738 if Index < inherited GetVerbCount then
739 Result := inherited GetVerb(Index) else
740 begin
741 Dec(Index, inherited GetVerbCount);
742 case Index of
743 0: Result := SIBDatabaseEditor;
744 1 : Result := SInterbaseExpressVersion;
745 end;
746 end;
747 end;
748
749 function TIBDatabaseEditor.GetVerbCount: Integer;
750 begin
751 Result := inherited GetVerbCount + 2;
752 end;
753
754 { TIBTransactionEditor }
755
756 procedure TIBTransactionEditor.ExecuteVerb(Index: Integer);
757 begin
758 case Index of
759 0: if EditIBTransaction(TIBTransaction(Component)) then Designer.Modified;
760 end;
761 end;
762
763 function TIBTransactionEditor.GetVerb(Index: Integer): string;
764 begin
765 case Index of
766 0: Result := SIBTransactionEditor;
767 1: Result := SInterbaseExpressVersion;
768 end;
769 end;
770
771 function TIBTransactionEditor.GetVerbCount: Integer;
772 begin
773 Result := 2;
774 end;
775
776 { TIBQueryEditor }
777
778 procedure TIBQueryEditor.EditSQL;
779 var
780 SQLText: string;
781 SQL: TStrings;
782 begin
783 SQL := TStringList.Create;
784 try
785 SQL.Assign(TIBQuery(Component).SQL);
786 SQLText := SQL.Text;
787 if (SQLEdit.EditSQL(SQLText, FGetTableNamesProc, FGetFieldNamesProc)) and
788 (SQL.Text <> SQLText) then
789 begin
790 SQL.Text := SQLText;
791 TIBQuery(Component).SQL.Assign(SQL);
792 end;
793 finally
794 SQL.free;
795 end;
796 end;
797
798 procedure TIBQueryEditor.ExecuteVerb(Index: Integer);
799 var
800 Query: TIBQuery;
801 begin
802 if Index < inherited GetVerbCount then
803 inherited ExecuteVerb(Index) else
804 begin
805 Query := Component as TIBQuery;
806 Dec(Index, inherited GetVerbCount);
807 case Index of
808 0: Query.ExecSQL;
809 1:
810 begin
811 if Assigned(Query.Database) then
812 begin
813 FGetTableNamesProc := Query.Database.GetTableNames;
814 FGetFieldNamesProc := Query.Database.GetFieldNames;
815 end
816 else
817 begin
818 FGetTableNamesProc := nil;
819 FGetFieldNamesProc := nil;
820 end;
821 EditSQL;
822 end;
823 end;
824 end;
825 end;
826
827 function TIBQueryEditor.GetVerb(Index: Integer): string;
828 begin
829 if Index < inherited GetVerbCount then
830 Result := inherited GetVerb(Index) else
831 begin
832 Dec(Index, inherited GetVerbCount);
833 case Index of
834 0: Result := SExecute;
835 1: Result := SEditSQL;
836 2: Result := SInterbaseExpressVersion;
837 end;
838 end;
839 end;
840
841 function TIBQueryEditor.GetVerbCount: Integer;
842 begin
843 Result := inherited GetVerbCount + 3;
844 end;
845
846 { TIBStoredProcEditor }
847
848 procedure TIBStoredProcEditor.ExecuteVerb(Index: Integer);
849 begin
850 if Index < inherited GetVerbCount then
851 inherited ExecuteVerb(Index) else
852 begin
853 Dec(Index, inherited GetVerbCount);
854 if Index = 0 then (Component as TIBStoredProc).ExecProc;
855 end;
856 end;
857
858 function TIBStoredProcEditor.GetVerb(Index: Integer): string;
859 begin
860 if Index < inherited GetVerbCount then
861 Result := inherited GetVerb(Index) else
862 begin
863 Dec(Index, inherited GetVerbCount);
864 case Index of
865 0: Result := SExecute;
866 1: Result := SInterbaseExpressVersion;
867 end;
868 end;
869 end;
870
871 function TIBStoredProcEditor.GetVerbCount: Integer;
872 begin
873 Result := inherited GetVerbCount + 2;
874 end;
875
876 { TIBStoredProcParamsProperty }
877
878 procedure TIBStoredProcParamsProperty.Edit;
879 var
880 StoredProc: TIBStoredProc;
881 Params: TParams;
882 begin
883 StoredProc := (GetComponent(0) as TIBStoredProc);
884 Params := TParams.Create(nil);
885 try
886 StoredProc.CopyParams(Params);
887 finally
888 Params.Free;
889 end;
890 inherited Edit;
891 end;
892
893 { TIBTableFieldLinkProperty }
894
895 procedure TIBTableFieldLinkProperty.Edit;
896 begin
897 FTable := DataSet as TIBTable;
898 inherited Edit;
899 end;
900
901 function TIBTableFieldLinkProperty.GetIndexFieldNames: string;
902 begin
903 Result := FTable.IndexFieldNames;
904 end;
905
906 function TIBTableFieldLinkProperty.GetMasterFields: string;
907 begin
908 Result := FTable.MasterFields;
909 end;
910
911 procedure TIBTableFieldLinkProperty.SetIndexFieldNames(const Value: string);
912 begin
913 FTable.IndexFieldNames := Value;
914 end;
915
916 procedure TIBTableFieldLinkProperty.SetMasterFields(const Value: string);
917 begin
918 FTable.MasterFields := Value;
919 end;
920
921 { TIBDatabaseSprig }
922
923 function TIBDatabaseSprig.AnyProblems: Boolean;
924 begin
925 Result := (TIBDatabase(Item).DatabaseName = '') or
926 (TIBDatabase(Item).DefaultTransaction = nil);
927 end;
928
929 function TIBDatabaseSprig.Caption: string;
930 begin
931 Result := CaptionFor(TIBDatabase(Item).DatabaseName, UniqueName);
932 end;
933
934 { TIBTransactionSprig }
935
936 function TIBTransactionSprig.AnyProblems: Boolean;
937 begin
938 Result := TIBTransaction(Item).DefaultDatabase = nil;
939 end;
940
941 function TIBTransactionSprig.Caption: string;
942 begin
943 if (TIBTransaction(Item).DefaultDatabase <> nil) and
944 (TIBTransaction(Item).DefaultDatabase.DefaultTransaction = Item) then
945 Result := CaptionFor(Format(SDefaultTransaction, [UniqueName]))
946 else
947 Result := inherited Caption;
948 end;
949
950 procedure TIBTransactionSprig.FigureParent;
951 begin
952 SeekParent(TIBTransaction(Item).DefaultDatabase).Add(Self);
953 end;
954
955 function TIBTransactionSprig.DragDropTo(AItem: TSprig): Boolean;
956 begin
957 Result := False;
958 if AItem is TIBDatabaseSprig then
959 begin
960 Result := TIBDatabase(AItem.Item) <> TIBTransaction(Item).DefaultDatabase;
961 if Result then
962 begin
963 TIBTransaction(Item).DefaultDatabase := TIBDatabase(AItem.Item);
964 TIBDatabase(AItem.Item).DefaultTransaction := TIBTransaction(Item);
965 end;
966 end
967 end;
968
969 function TIBTransactionSprig.DragOverTo(AItem: TSprig): Boolean;
970 begin
971 Result := (AItem is TIBDatabaseSprig);
972 end;
973
974 class function TIBTransactionSprig.PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean;
975 begin
976 Result := (AParent is TIBDatabaseSprig);
977 end;
978
979 { support stuff for sprigs }
980
981 function IBAnyProblems(ATransaction: TIBTransaction; ADatabase: TIBDatabase): Boolean;
982 begin
983 Result := (ATransaction = nil) or
984 (ADatabase = nil) or
985 (ATransaction.DefaultDatabase <> ADatabase);
986 end;
987
988 procedure IBFigureParent(ASprig: TSprig; ATransaction: TIBTransaction; ADatabase: TIBDatabase);
989 begin
990 if ATransaction <> nil then
991 ASprig.SeekParent(ATransaction).Add(ASprig)
992 else if ADatabase <> nil then
993 ASprig.SeekParent(ADatabase).Add(ASprig)
994 else
995 ASprig.Root.Add(ASprig);
996 end;
997
998 function IBDragOver(ASprig: TSprig): Boolean;
999 begin
1000 Result := (ASprig is TIBTransactionSprig) or
1001 (ASprig is TIBDatabaseSprig);
1002 end;
1003
1004 function IBDropOver(AParent: TSprig; var ATransaction: TIBTransaction; var ADatabase: TIBDatabase): Boolean;
1005 var
1006 vParentTransaction: TIBTransaction;
1007 vParentDatabase: TIBDatabase;
1008 begin
1009 Result := False;
1010 if AParent is TIBTransactionSprig then
1011 begin
1012 vParentTransaction := TIBTransaction(AParent.Item);
1013 Result := vParentTransaction <> ATransaction;
1014 if Result then
1015 ATransaction := vParentTransaction;
1016 if (vParentTransaction.DefaultDatabase = nil) or
1017 (ADatabase <> vParentTransaction.DefaultDatabase) then
1018 begin
1019 Result := True;
1020 ADatabase := vParentTransaction.DefaultDatabase;
1021 end;
1022 end else if AParent is TIBDatabaseSprig then
1023 begin
1024 vParentDatabase := TIBDatabase(AParent.Item);
1025 Result := vParentDatabase <> ADatabase;
1026 if Result then
1027 ADatabase := vParentDatabase;
1028 if (vParentDatabase.DefaultTransaction = nil) or
1029 (ATransaction <> vParentDatabase.DefaultTransaction) then
1030 begin
1031 Result := True;
1032 ATransaction := vParentDatabase.DefaultTransaction;
1033 end;
1034 end;
1035 end;
1036
1037 { TIBSQLSprig }
1038
1039 function TIBSQLSprig.AnyProblems: Boolean;
1040 begin
1041 Result := IBAnyProblems(TIBSQL(Item).Transaction,
1042 TIBSQL(Item).Database) or
1043 (TIBSQL(Item).SQL.Count = 0);
1044 end;
1045
1046 function TIBSQLSprig.DragDropTo(AItem: TSprig): Boolean;
1047 var
1048 vTransaction: TIBTransaction;
1049 vDatabase: TIBDatabase;
1050 begin
1051 with TIBSQL(Item) do
1052 begin
1053 vTransaction := Transaction;
1054 vDatabase := Database;
1055 Result := IBDropOver(AItem, vTransaction, vDatabase);
1056 if Result then
1057 begin
1058 Transaction := vTransaction;
1059 Database := vDatabase;
1060 end;
1061 end;
1062 end;
1063
1064 function TIBSQLSprig.DragOverTo(AItem: TSprig): Boolean;
1065 begin
1066 Result := IBDragOver(AItem);
1067 end;
1068
1069 procedure TIBSQLSprig.FigureParent;
1070 begin
1071 IBFigureParent(Self, TIBSQL(Item).Transaction,
1072 TIBSQL(Item).Database);
1073 end;
1074
1075 class function TIBSQLSprig.PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean;
1076 begin
1077 Result := IBDragOver(AParent);
1078 end;
1079
1080 { TIBCustomDataSetSprig }
1081
1082 function TIBCustomDataSetSprig.AnyProblems: Boolean;
1083 begin
1084 Result := IBAnyProblems(TIBCustomDataSet(Item).Transaction,
1085 TIBCustomDataSet(Item).Database);
1086 end;
1087
1088 procedure TIBCustomDataSetSprig.FigureParent;
1089 begin
1090 IBFigureParent(Self, TIBCustomDataSet(Item).Transaction,
1091 TIBCustomDataSet(Item).Database);
1092 end;
1093
1094 function TIBCustomDataSetSprig.DragDropTo(AItem: TSprig): Boolean;
1095 var
1096 vTransaction: TIBTransaction;
1097 vDatabase: TIBDatabase;
1098 begin
1099 with TIBCustomDataSet(Item) do
1100 begin
1101 vTransaction := Transaction;
1102 vDatabase := Database;
1103 Result := IBDropOver(AItem, vTransaction, vDatabase);
1104 if Result then
1105 begin
1106 Transaction := vTransaction;
1107 Database := vDatabase;
1108 end;
1109 end;
1110 end;
1111
1112 function TIBCustomDataSetSprig.DragOverTo(AItem: TSprig): Boolean;
1113 begin
1114 Result := IBDragOver(AItem);
1115 end;
1116
1117 class function TIBCustomDataSetSprig.PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean;
1118 begin
1119 Result := IBDragOver(AParent);
1120 end;
1121
1122 { TIBStoredProcSprig }
1123
1124 function TIBStoredProcSprig.AnyProblems: Boolean;
1125 begin
1126 Result := inherited AnyProblems or
1127 (TIBStoredProc(Item).StoredProcName = '');
1128 end;
1129
1130 function TIBStoredProcSprig.Caption: string;
1131 begin
1132 Result := CaptionFor(TIBStoredProc(Item).StoredProcName, UniqueName);
1133 end;
1134
1135 { TIBTableSprig }
1136
1137 function TIBTableSprig.AnyProblems: Boolean;
1138 begin
1139 Result := inherited AnyProblems or
1140 (TIBTable(Item).TableName = '');
1141 end;
1142
1143 function TIBTableSprig.Caption: string;
1144 begin
1145 Result := CaptionFor(TIBTable(Item).TableName, UniqueName);
1146 end;
1147
1148 { TIBQuerySprig }
1149
1150 function TIBQuerySprig.AnyProblems: Boolean;
1151 begin
1152 Result := inherited AnyProblems or
1153 (TIBQuery(Item).SQL.Count = 0);
1154 end;
1155
1156 { TIBDatabaseInfoSprig }
1157
1158 class function TIBDatabaseInfoSprig.ParentProperty: string;
1159 begin
1160 Result := 'Database'; { do not localize }
1161 end;
1162
1163 { TIBUpdateSQLSprig }
1164
1165 function TIBUpdateSQLSprig.AnyProblems: Boolean;
1166 begin
1167 with TIBUpdateSQL(Item) do
1168 Result := (ModifySQL.Count = 0) and
1169 (InsertSQL.Count = 0) and
1170 (DeleteSQL.Count = 0) and
1171 (RefreshSQL.Count = 0);
1172 end;
1173
1174 { TIBEventsSprig }
1175
1176 function TIBEventsSprig.AnyProblems: Boolean;
1177 begin
1178 Result := inherited AnyProblems or
1179 (TIBEvents(Item).Events.Count = 0);
1180 end;
1181
1182 class function TIBEventsSprig.ParentProperty: string;
1183 begin
1184 Result := 'Database'; { do not localize }
1185 end;
1186
1187 { TIBTableMasterDetailBridge }
1188
1189 function TIBTableMasterDetailBridge.CanEdit: Boolean;
1190 begin
1191 Result := True;
1192 end;
1193
1194 function TIBTableMasterDetailBridge.Caption: string;
1195 begin
1196 if TIBTable(Omega.Item).MasterFields = '' then
1197 Result := SNoMasterFields
1198 else
1199 Result := TIBTable(Omega.Item).MasterFields;
1200 end;
1201
1202 function TIBTableMasterDetailBridge.Edit: Boolean;
1203 var
1204 vPropEd: TIBTableFieldLinkProperty;
1205 begin
1206 vPropEd := TIBTableFieldLinkProperty.CreateWith(TDataSet(Omega.Item));
1207 try
1208 vPropEd.Edit;
1209 Result := vPropEd.Changed;
1210 finally
1211 vPropEd.Free;
1212 end;
1213 end;
1214
1215 class function TIBTableMasterDetailBridge.GetOmegaSource(
1216 AItem: TPersistent): TDataSource;
1217 begin
1218 Result := TIBTable(AItem).MasterSource;
1219 end;
1220
1221 class function TIBTableMasterDetailBridge.OmegaIslandClass: TIslandClass;
1222 begin
1223 Result := TIBTableIsland;
1224 end;
1225
1226 class procedure TIBTableMasterDetailBridge.SetOmegaSource(
1227 AItem: TPersistent; ADataSource: TDataSource);
1228 begin
1229 TIBTable(AItem).MasterSource := ADataSource;
1230 end;
1231
1232 { TIBQueryMasterDetailBridge }
1233
1234 function TIBQueryMasterDetailBridge.Caption: string;
1235 begin
1236 Result := SParamsFields;
1237 end;
1238
1239 class function TIBQueryMasterDetailBridge.GetOmegaSource(
1240 AItem: TPersistent): TDataSource;
1241 begin
1242 Result := TIBQuery(AItem).DataSource;
1243 end;
1244
1245 class function TIBQueryMasterDetailBridge.OmegaIslandClass: TIslandClass;
1246 begin
1247 Result := TIBQueryIsland;
1248 end;
1249
1250 class function TIBQueryMasterDetailBridge.RemoveMasterFieldsAsWell: Boolean;
1251 begin
1252 Result := False;
1253 end;
1254
1255 class procedure TIBQueryMasterDetailBridge.SetOmegaSource(
1256 AItem: TPersistent; ADataSource: TDataSource);
1257 begin
1258 TIBQuery(AItem).DataSource := ADataSource;
1259 end;
1260
1261 { TIBCustomDataSetIsland }
1262
1263 function TIBCustomDataSetIsland.VisibleTreeParent: Boolean;
1264 begin
1265 Result := False;
1266 end;
1267
1268 { TIBSQLIsland }
1269
1270 function TIBSQLIsland.VisibleTreeParent: Boolean;
1271 begin
1272 Result := False;
1273 end;
1274
1275 { TIBTransactionIsland }
1276
1277 function TIBTransactionIsland.VisibleTreeParent: Boolean;
1278 begin
1279 Result := TIBTransaction(Sprig.Item).DefaultDatabase = nil;
1280 end;
1281
1282 end.