ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/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
Original Path: ibx/trunk/design/IBDBReg.pas
File size: 34685 byte(s)
Log Message:
Borland IBX Open Source Release

File Contents

# User Rev Content
1 tony 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.