ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBDBReg.pas
Revision: 107
Committed: Thu Jan 18 14:37:40 2018 UTC (6 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 35267 byte(s)
Log Message:
Fixes merged

File Contents

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