ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/design/IBDBReg.pas
Revision: 39
Committed: Tue May 17 08:14:52 2016 UTC (7 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 32140 byte(s)
Log Message:
Committing updates for Release R1-4-1

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