ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/design/IBDBReg.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/design/IBDBReg.pas
File size: 34497 byte(s)
Log Message:
Committing updates for Release R2-0-0

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