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

File Contents

# User Rev Content
1 tony 17 {************************************************************************}
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 tony 19 uses SysUtils, Classes, Graphics, Dialogs, Controls, Forms, TypInfo,
58 tony 17 DB, IBTable, IBDatabase, IBEventsEditor, LazarusPackageIntf,
59 tony 19 IBUpdateSQL, IBXConst, ComponentEditors, PropEdits, DBPropEdits, FieldsEditor,
60 tony 31 dbFieldLinkPropEditor, dbFieldListPropEditor, IBDialogs;
61 tony 17
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 tony 19 { TDBStringProperty }
97    
98 tony 17 TDBStringProperty = class(TStringProperty)
99 tony 19 private
100     function ConnecttoDB: boolean;
101 tony 17 public
102     function GetAttributes: TPropertyAttributes; override;
103     procedure GetValueList(List: TStrings); virtual;
104     procedure GetValues(Proc: TGetStrProc); override;
105 tony 19 procedure Edit; override;
106 tony 17 end;
107    
108 tony 19 { TIBIndexFieldNamesProperty }
109    
110 tony 17 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 tony 19
196     { TIBTableFieldLinkProperty }
197    
198 tony 17 TIBTableFieldLinkProperty = class(TFieldLinkProperty)
199     private
200     FTable: TIBTable;
201     protected
202 tony 19 function GetIndexDefs: TIndexDefs; override;
203 tony 17 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 tony 19
211 tony 17 { 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 tony 21 { 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 tony 17 procedure Register;
361    
362     implementation
363    
364     uses IB, IBQuery, IBStoredProc, IBCustomDataSet,
365     IBIntf, IBSQL, IBSQLMonitor, IBDatabaseInfo, IBEvents,
366     IBServices, IBDatabaseEdit, IBTransactionEdit,
367 tony 21 IBBatchMove, IBExtract,LResources, IBSelectSQLEditor,
368 tony 17 IBModifySQLEditor,IBDeleteSQLEditor,IBRefreshSQLEditor,
369     IBInsertSQLEditor, IBGeneratorEditor, IBUpdateSQLEditor, IBDataSetEditor,
370 tony 21 IBSQLEditor, ibserviceeditor, LCLVersion, IBDynamicGrid, IBLookupComboEditBox,
371 tony 23 IBTreeView, DBControlGrid;
372 tony 17
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 tony 21
397    
398 tony 23 RegisterComponents(IBPalette3,[TIBLookupComboEditBox,TIBDynamicGrid,TIBTreeView,TDBControlGrid]);
399 tony 17 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 tony 19 RegisterPropertyEditor(TypeInfo(string), TIBTable, 'MasterFields', TIBTableFieldLinkProperty); {do not localize}
406 tony 17 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 tony 21
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 tony 17 end;
442    
443 tony 21 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 tony 17 { 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 tony 19 Table : TIBTable;
606 tony 17 i : integer;
607     begin
608 tony 19 Table := GetComponent(0) as TIBTable;
609     if Table.Database = nil then
610     Exit;
611     with Table do
612 tony 17 for I := 0 to TableNames.Count - 1 do
613     Proc (TableNames[i]);
614     end;
615    
616     { TDBStringProperty }
617    
618 tony 19 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 tony 17 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 tony 19 if not ConnecttoDB then Exit;
649 tony 17 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 tony 19 procedure TDBStringProperty.Edit;
659     begin
660     if ConnecttoDB then
661     inherited Edit;
662     end;
663    
664 tony 17 { 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 tony 19 if IBSelectSQLEditor.EditSQL(Query,Query.SQL) then Modified;
726 tony 17 end;
727    
728     { TIBDatasetSQLProperty }
729    
730     procedure TIBDatasetSQLProperty.Edit;
731     var
732     IBDataset: TIBDataset;
733     begin
734     IBDataset := GetComponent(0) as TIBDataset;
735 tony 19 if IBSelectSQLEditor.EditSQL(IBDataSet,IBDataSet.SelectSQL) then Modified;
736 tony 17 end;
737    
738     { TIBSQLProperty }
739    
740     procedure TIBSQLProperty.Edit;
741     var
742     IBSQL: TIBSQL;
743     begin
744     IBSQL := GetComponent(0) as TIBSQL;
745 tony 19 if IBSQLEditor.EditIBSQL(IBSQL) then Modified;
746 tony 17 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 tony 19 1: if ibselectsqleditor.EditSQL(Query,Query.SQL) then Designer.Modified;
899 tony 17 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 tony 19
969 tony 17 { TIBTableFieldLinkProperty }
970    
971     procedure TIBTableFieldLinkProperty.Edit;
972     begin
973     FTable := DataSet as TIBTable;
974 tony 19 if assigned(FTable.Database) then
975     FTable.Database.Connected := true;
976 tony 17 inherited Edit;
977     end;
978    
979 tony 19 function TIBTableFieldLinkProperty.GetIndexDefs: TIndexDefs;
980     begin
981     Result := FTable.IndexDefs
982     end;
983    
984 tony 17 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 tony 19 end;
1003 tony 17
1004     { TIBUpdateSQLProperty }
1005    
1006     procedure TIBUpdateSQLProperty.Edit;
1007     var
1008     IBDataset: TIBDataset;
1009     begin
1010     IBDataset := GetComponent(0) as TIBDataset;
1011 tony 19 if IBModifySQLEditor.EditSQL(IBDataSet,IBDataSet.ModifySQL) then Modified;
1012 tony 17 end;
1013    
1014     { TIBUpdateSQLUpdateProperty }
1015    
1016     procedure TIBUpdateSQLUpdateProperty.Edit;
1017     begin
1018     GetObjects;
1019 tony 19 if IBModifySQLEditor.EditSQL(FIBUpdateSQL.DataSet,FIBUpdateSQL.ModifySQL) then Modified;
1020 tony 17 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 tony 19 if IBRefreshSQLEditor.EditSQL(IBDataSet,IBDataSet.RefreshSQL) then Modified;
1031 tony 17 end;
1032    
1033     { TIBUpdateSQLRefreshSQLProperty }
1034    
1035     procedure TIBUpdateSQLRefreshSQLProperty.Edit;
1036     begin
1037     GetObjects;
1038 tony 19 if IBRefreshSQLEditor.EditSQL(FIBUpdateSQL.DataSet,FIBUpdateSQL.RefreshSQL) then Modified;
1039 tony 17 end;
1040    
1041     { TIBDeleteSQLProperty }
1042    
1043     procedure TIBDeleteSQLProperty.Edit;
1044     var
1045 tony 19 IBDataset: TIBDataSet;
1046 tony 17 begin
1047 tony 19 IBDataset := GetComponent(0) as TIBDataSet;
1048     if IBDeleteSQLEditor.EditSQL(IBDataSet,IBDataSet.DeleteSQL) then Modified;
1049 tony 17 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 tony 19 if IBDeleteSQLEditor.EditSQL(FIBUpdateSQL.DataSet,FIBUpdateSQL.DeleteSQL) then Modified;
1062 tony 17 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 tony 19 IBDataset: TIBDataSet;
1085 tony 17 begin
1086 tony 19 IBDataset := GetComponent(0) as TIBDataSet;
1087     if IBInsertSQLEditor.EditSQL(IBDataSet,IBDataSet.InsertSQL) then Modified;
1088 tony 17 end;
1089    
1090     { TIBUpdateSQLInsertSQLProperty }
1091    
1092     procedure TIBUpdateSQLInsertSQLProperty.Edit;
1093     begin
1094     GetObjects;
1095 tony 19 if IBInsertSQLEditor.EditSQL(FIBUpdateSQL.Dataset,FIBUpdateSQL.InsertSQL) then Modified;
1096 tony 17 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 tony 31 end.