ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBDBReg.pas
Revision: 33
Committed: Sat Jul 18 12:30:52 2015 UTC (9 years, 4 months ago) by tony
Content type: text/x-pascal
File size: 32006 byte(s)
Log Message:
Committing updates for Release R1-3-1

File Contents

# User Rev Content
1 tony 33 {************************************************************************}
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.