ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/design/IBDBReg.pas
(Generate patch)

Comparing ibx/trunk/design/IBDBReg.pas (file contents):
Revision 35 by tony, Tue Jan 26 14:38:47 2016 UTC vs.
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC

# Line 27 | Line 27
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                                                 }
30 > {    Associates Ltd 2011 - 2018                                               }
31   {************************************************************************}
32  
33   unit IBDBReg;
# Line 39 | Line 39 | unit IBDBReg;
39   *)
40   {$A+}                           (* Aligned records: On *)
41   {$B-}                           (* Short circuit boolean expressions: Off *)
42 – {$G+}                           (* Imported data: On *)
42   {$H+}                           (* Huge Strings: On *)
43   {$J-}                           (* Modification of Typed Constants: Off *)
44   {$M+}                           (* Generate run-time type information: On *)
# Line 47 | Line 46 | unit IBDBReg;
46   {$Q-}                           (* Overflow checks: Off *)
47   {$R-}                           (* Range checks: Off *)
48   {$T+}                           (* Typed address: On *)
50 – {$U+}                           (* Pentim-safe FDIVs: On *)
49   {$W-}                           (* Always generate stack frames: Off *)
50   {$X+}                           (* Extended syntax: On *)
51   {$Z1}                           (* Minimum Enumeration Size: 1 Byte *)
# Line 56 | Line 54 | interface
54  
55   uses SysUtils, Classes, Graphics, Dialogs, Controls, Forms, TypInfo,
56       DB, IBTable, IBDatabase,  IBEventsEditor,  LazarusPackageIntf,
57 <      IBUpdateSQL, IBXConst, ComponentEditors, PropEdits, DBPropEdits, FieldsEditor,
57 >      IBUpdateSQL, IBUpdate, ComponentEditors, PropEdits, DBPropEdits, FieldsEditor,
58       dbFieldLinkPropEditor, dbFieldListPropEditor, IBDialogs;
59  
60   type
# Line 85 | Line 83 | type
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.}
# Line 134 | Line 140 | type
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)
# Line 188 | Line 203 | type
203     function GetVerbCount: Integer; override;
204    end;
205  
206 <  TIBStoredProcParamsProperty = class(TCollectionPropertyEditor)
206 >  { TIBXServiceEditor }
207 >
208 >  TIBXServiceEditor = class(TComponentEditor)
209    public
210 <    procedure Edit; override;
210 >    procedure ExecuteVerb(Index: Integer); override;
211 >    function GetVerb(Index: Integer): string; override;
212 >    function GetVerbCount: Integer; override;
213 >  end;
214 >
215 >  TIBStoredProcParamsProperty = class(TCollectionPropertyEditor)
216    end;
217  
218    { TIBTableFieldLinkProperty }
# Line 309 | Line 331 | type
331      procedure Edit; override;
332    end;
333  
334 +  { TIBUpdateRefreshSQLProperty }
335 +
336 +  TIBUpdateRefreshSQLProperty = class(TSQLPropertyEditor)
337 +  protected
338 +    FIBUpdate: TIBUpdate;
339 +    FDatabase: TIBDatabase;
340 +    function GetObjects: boolean;
341 +  public
342 +    procedure Edit; override;
343 +  end;
344 +
345 +
346   { TIBEventListProperty }
347  
348    TIBEventListProperty = class(TClassProperty)
# Line 355 | Line 389 | type
389      procedure SetIndexFieldNames(const Value: string); override;
390    end;
391  
392 +  { TIBFieldDefsProperty }
393 +
394 +  TIBFieldDefsProperty = class(TCollectionPropertyEditor)
395 +  public
396 +    procedure Edit; override;
397 +  end;
398 +
399 +  { TIBIndexDefsProperty }
400 +
401 +  TIBIndexDefsProperty = class(TCollectionPropertyEditor)
402 +  public
403 +    procedure Edit; override;
404 +  end;
405  
406  
407   procedure Register;
408  
409   implementation
410  
411 < uses IB, IBQuery, IBStoredProc, IBCustomDataSet,
412 <     IBIntf, IBSQL, IBSQLMonitor, IBDatabaseInfo, IBEvents,
413 <     IBServices, IBDatabaseEdit, IBTransactionEdit,
411 > uses IB, IBQuery, IBStoredProc, IBCustomDataSet, FBMessages,
412 >     IBSQL, IBSQLMonitor, IBDatabaseInfo, IBEvents, IBTypes,
413 >     IBServices, IBXServices, IBDatabaseEdit, IBTransactionEdit,
414       IBBatchMove, IBExtract,LResources, IBSelectSQLEditor,
415       IBModifySQLEditor,IBDeleteSQLEditor,IBRefreshSQLEditor,
416       IBInsertSQLEditor, IBGeneratorEditor, IBUpdateSQLEditor, IBDataSetEditor,
417       IBSQLEditor, ibserviceeditor, LCLVersion, IBDynamicGrid, IBLookupComboEditBox,
418 <     IBTreeView, DBControlGrid;
419 <
418 >     IBTreeView, DBControlGrid, ibxscript, IBLocalDBSupport, IBDSDialogs,
419 >     IBArrayGrid, IBVersion, IBDataOutput, IBXServiceEditor;
420  
421 + const
422 +  IBPalette1 = 'Firebird'; {do not localize}
423 +  IBPalette2 = 'Firebird Legacy Admin'; {do not localize}
424 +  IBPalette3 = 'Firebird Data Controls';   {do not localize}
425 +  IBPalette4 = 'Firebird Admin'; {do not localize}
426 +
427 + resourcestring
428 +   SInterbaseExpressVersion = 'Firebird Express for Lazarus ' + IBX_VERSION;
429 +   SEditSQL = 'Edit SQL';
430 +   SIBSQLEditor = 'IBSQL Editor';
431 +   SIBServiceEditor = 'Edit IB Service';
432 +   SIBUpdateSQLEditor = '&UpdateSQL Editor...';
433 +   SIBDataSetEditor = '&Dataset Editor...';
434 +   SExecute = 'E&xecute';
435 +   SIBDatabaseEditor = 'Da&tabase Editor...';
436 +   SIBTransactionEditor = '&Transaction Editor...';
437 +   SIBUpdateLayout = 'Update Layout';
438  
439   procedure Register;
440   begin
# Line 380 | Line 444 | begin
444      Exit;
445    end;
446  
447 <  RegisterNoIcon([TIBStringField, TIBBCDField, TIBMemoField]);
447 >  RegisterNoIcon([TIBStringField, TIBBCDField, TIBMemoField, TIBArrayField,
448 >    TIBSmallintField, TIBIntegerField, TIBLargeIntField]);
449    {$if lcl_fullversion < 01010000}
450    {see http://bugs.freepascal.org/view.php?id=19035 }
451    RegisterNoIcon([TIntegerField]);
452    {$endif}
453    RegisterComponents(IBPalette1, [ TIBQuery, TIBDataSet,
454 <   TIBDatabase, TIBTransaction, TIBUpdateSQL, TIBEvents,
454 >   TIBDatabase, TIBTransaction, TIBUpdateSQL, TIBUpdate, TIBEvents,
455       TIBSQL, TIBDatabaseInfo, TIBSQLMonitor,
456 <       TIBStoredProc,TIBBatchMove,  TIBTable,TIBExtract]);
457 <  if IBServiceAPIPresent  then
456 >       TIBStoredProc,TIBBatchMove,  TIBTable,TIBExtract, TIBXScript, TIBLocalDBSupport,
457 >       TIBBlockFormatOut,TIBCSVDataOut,TIBInsertStmtsOut]);
458 >  if FirebirdAPI.HasServiceAPI  then
459 >  begin
460 >    RegisterComponents(IBPalette4, [TIBXServicesConnection, TIBXConfigService,
461 >      TIBXClientSideBackupService, TIBXServerSideBackupService,
462 >      TIBXClientSideRestoreService, TIBXServerSideRestoreService,
463 >      TIBXValidationService, TIBXOnlineValidationService, TIBXStatisticalService,
464 >      TIBXLogService, TIBXSecurityService, TIBXServerProperties,
465 >      TIBXLimboTransactionResolutionService,TIBXServicesUserList, TIBXServicesLimboTransactionsList]);
466      RegisterComponents(IBPalette2, [TIBConfigService, TIBBackupService,
467 <      TIBRestoreService, TIBValidationService, TIBStatisticalService,
467 >      TIBRestoreService, TIBValidationService,
468 >      TIBOnlineValidationService, TIBStatisticalService,
469        TIBLogService, TIBSecurityService, TIBServerProperties]);
470 +  end;
471  
472 +  RegisterComponents(IBPalette3,[TIBLookupComboEditBox,TIBDynamicGrid,TIBTreeView,TDBControlGrid, TIBArrayGrid]);
473  
398 –  RegisterComponents(IBPalette3,[TIBLookupComboEditBox,TIBDynamicGrid,TIBTreeView,TDBControlGrid]);
474    RegisterPropertyEditor(TypeInfo(TIBFileName), TIBDatabase, 'DatabaseName', TIBFileNameProperty); {do not localize}
475    RegisterPropertyEditor(TypeInfo(string), TIBStoredProc, 'StoredProcName', TIBStoredProcNameProperty); {do not localize}
476 +  RegisterPropertyEditor(TypeInfo(string), TIBStoredProc, 'PackageName', TIBPackageNameProperty); {do not localize}
477    RegisterPropertyEditor(TypeInfo(TParams), TIBStoredProc, 'Params', TIBStoredProcParamsProperty);
478    RegisterPropertyEditor(TypeInfo(string), TIBTable, 'TableName', TIBTableNameProperty); {do not localize}
479    RegisterPropertyEditor(TypeInfo(string), TIBTable, 'IndexName', TIBIndexNameProperty); {do not localize}
480    RegisterPropertyEditor(TypeInfo(string), TIBTable, 'IndexFieldNames', TIBIndexFieldNamesProperty); {do not localize}
481    RegisterPropertyEditor(TypeInfo(string), TIBTable, 'MasterFields', TIBTableFieldLinkProperty); {do not localize}
482 +  RegisterPropertyEditor(TypeInfo(TFieldDefs), TIBTable, 'FieldDefs', TIBFieldDefsProperty); {do not localize}
483 +  RegisterPropertyEditor(TypeInfo(TIndexDefs), TIBTable, 'IndexDefs', TIBIndexDefsProperty); {do not localize}
484    RegisterPropertyEditor(TypeInfo(TStrings), TIBQuery, 'SQL', TIBQuerySQLProperty); {do not localize}
485    RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'SelectSQL', TIBDatasetSQLProperty); {do not localize}
486    RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'ModifySQL', TIBUpdateSQLProperty); {do not localize}
# Line 414 | Line 492 | begin
492    RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdateSQL, 'ModifySQL', TIBUpdateSQLUpdateProperty); {do not localize}
493    RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdateSQL, 'InsertSQL', TIBUpdateSQLInsertSQLProperty); {do not localize}
494    RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdateSQL, 'DeleteSQL', TIBUpdateSQLDeleteProperty); {do not localize}
495 +  RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdate, 'RefreshSQL', TIBUpdateRefreshSQLProperty); {do not localize}
496    RegisterPropertyEditor(TypeInfo(TStrings), TIBEvents, 'Events', TIBEventListProperty); {do not localize}
497    RegisterPropertyEditor(TypeInfo(TPersistent), TIBDataSet, 'GeneratorField', TIBGeneratorProperty);  {do not localize}
498    RegisterPropertyEditor(TypeInfo(TPersistent), TIBQuery, 'GeneratorField', TIBGeneratorProperty);  {do not localize}
499 +  RegisterPropertyEditor(TypeInfo(TPersistent), TIBTable, 'GeneratorField', TIBGeneratorProperty);  {do not localize}
500  
501    RegisterComponentEditor(TIBDatabase, TIBDatabaseEditor);
502    RegisterComponentEditor(TIBTransaction, TIBTransactionEditor);
# Line 426 | Line 506 | begin
506    RegisterComponentEditor(TIBStoredProc, TIBStoredProcEditor);
507    RegisterComponentEditor(TIBSQL, TIBSQLEditor);
508    RegisterComponentEditor(TIBCustomService, TIBServiceEditor);
509 +  RegisterComponentEditor(TIBArrayGrid, TIBArrayGridEditor);
510 +  RegisterComponentEditor(TIBXServicesConnection, TIBXServiceEditor);
511  
512  
513    {Firebird Data Access Controls}
# Line 437 | Line 519 | begin
519    RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'TextField', TIBTreeViewFieldProperty);
520    RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'ParentField', TIBTreeViewFieldProperty);
521    RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'HasChildField', TIBTreeViewFieldProperty);
522 +  RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'ImageIndexField', TIBTreeViewFieldProperty);
523 +  RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'SelectedIndexField', TIBTreeViewFieldProperty);
524  
525 +  IBGUIInterface :=  TIBDSLCLInterface.Create;
526   end;
527  
528   procedure LoadDataSourceFields(DataSource: TDataSource; List: TStrings);
# Line 462 | Line 547 | begin
547    end;
548   end;
549  
550 + { TIBXServiceEditor }
551 +
552 + procedure TIBXServiceEditor.ExecuteVerb(Index: Integer);
553 + begin
554 +  if Index < inherited GetVerbCount then
555 +    inherited ExecuteVerb(Index) else
556 +  begin
557 +    Dec(Index, inherited GetVerbCount);
558 +    case Index of
559 +      0 : if IBXServiceEditor.EditIBXService(TIBXServicesConnection(Component)) then Designer.Modified;
560 +    end;
561 +  end;
562 + end;
563 +
564 + function TIBXServiceEditor.GetVerb(Index: Integer): string;
565 + begin
566 +  if Index < inherited GetVerbCount then
567 +    Result := inherited GetVerb(Index) else
568 +  begin
569 +    Dec(Index, inherited GetVerbCount);
570 +    case Index of
571 +      0: Result := SIBServiceEditor;
572 +      1 : Result := SInterbaseExpressVersion;
573 +    end;
574 +  end;
575 + end;
576 +
577 + function TIBXServiceEditor.GetVerbCount: Integer;
578 + begin
579 +  Result := inherited GetVerbCount + 2;
580 + end;
581 +
582 + { TIBUpdateRefreshSQLProperty }
583 +
584 + function TIBUpdateRefreshSQLProperty.GetObjects: boolean;
585 + begin
586 +  Result := false;
587 +  FIBUpdate := GetComponent(0) as TIBUpdate;
588 +  if not assigned(FIBUpdate) or not assigned(FIBUpdate.DataSet) then
589 +    Exit;
590 +  FDatabase := nil;
591 +  if FIBUpdate.DataSet is TIBQuery then
592 +  begin
593 +    FDatabase := (FIBUpdate.DataSet as TIBQuery).Database;
594 +    Result := true
595 +  end;
596 + end;
597 +
598 + procedure TIBUpdateRefreshSQLProperty.Edit;
599 + begin
600 +  GetObjects;
601 +  if IBRefreshSQLEditor.EditSQL(FIBUpdate.DataSet,FIBUpdate.RefreshSQL) then Modified;
602 + end;
603 +
604 + { TIBPackageNameProperty }
605 +
606 + procedure TIBPackageNameProperty.GetValues(Proc: TGetStrProc);
607 + var
608 +   StoredProc : TIBStoredProc;
609 +   i : integer;
610 + begin
611 +    StoredProc := GetComponent(0) as TIBStoredProc;
612 +    if StoredProc.Database = nil then
613 +      Exit;
614 +
615 +    with StoredProc do
616 +    try
617 +      for I := 0 to PackageNames.Count - 1 do
618 +        Proc (PackageNames[i]);
619 +    except on E: Exception do
620 +      MessageDlg(E.Message,mtError,[mbOK],0)
621 +    end;
622 + end;
623 +
624 + { TIBIndexDefsProperty }
625 +
626 + procedure TIBIndexDefsProperty.Edit;
627 + var IndexDefs: TIndexDefs;
628 + begin
629 +  IndexDefs := TIndexDefs(GetObjectValue);
630 +  if IndexDefs <> nil then
631 +    IndexDefs.Update;
632 +  inherited Edit;
633 + end;
634 +
635 + { TIBFieldDefsProperty }
636 +
637 + procedure TIBFieldDefsProperty.Edit;
638 + var FieldDefs: TFieldDefs;
639 + begin
640 +  FieldDefs := TFieldDefs(GetObjectValue);
641 +  if FieldDefs <> nil then
642 +    FieldDefs.Update;
643 +  inherited Edit;
644 + end;
645 +
646 + { TIBArrayGridEditor }
647 +
648 + procedure TIBArrayGridEditor.ExecuteVerb(Index: Integer);
649 + begin
650 +  if Index < inherited GetVerbCount then
651 +    inherited ExecuteVerb(Index)
652 +  else
653 +  case Index of
654 +    0: TIBArrayGrid(Component).UpdateLayout;
655 +  end;
656 + end;
657 +
658 + function TIBArrayGridEditor.GetVerb(Index: Integer): string;
659 + begin
660 +  if Index < inherited GetVerbCount then
661 +    Result := inherited GetVerb(Index) else
662 +  begin
663 +    Dec(Index, inherited GetVerbCount);
664 +    case Index of
665 +      0: Result := SIBUpdateLayout;
666 +      1 : Result := SInterbaseExpressVersion ;
667 +    end;
668 +  end;
669 + end;
670 +
671 + function TIBArrayGridEditor.GetVerbCount: Integer;
672 + begin
673 +  Result := 2;
674 + end;
675 +
676   { TDBLookupPropertiesGridFieldProperty }
677  
678   procedure TDBLookupPropertiesGridFieldProperty.FillValues(
# Line 742 | Line 953 | var
953    IBSQL: TIBSQL;
954   begin
955    IBSQL := GetComponent(0) as TIBSQL;
956 <  if IBSQLEditor.EditIBSQL(IBSQL) then Modified;
956 >  if IBSQLEditor.EditSQL(IBSQL) then Modified;
957   end;
958  
959   { TIBUpdateSQLEditor }
# Line 756 | Line 967 | function TIBUpdateSQLEditor.GetVerb(Inde
967   begin
968    case Index of
969      0 : Result := SIBUpdateSQLEditor;
970 <    1: Result := SInterbaseExpressVersion;
970 >    1: Result := SInterbaseExpressVersion ;
971    end;
972   end;
973  
# Line 768 | Line 979 | end;
979   { TIBDataSetEditor }
980  
981   procedure TIBDataSetEditor.ExecuteVerb(Index: Integer);
771 – var
772 –  IBDataset: TIBDataset;
982   begin
983    if Index < inherited GetVerbCount then
984      inherited ExecuteVerb(Index) else
# Line 793 | Line 1002 | begin
1002      case Index of
1003        0: Result := SIBDataSetEditor;
1004        1: Result := SExecute;
1005 <      2: Result := SInterbaseExpressVersion;
1005 >      2: Result := SInterbaseExpressVersion ;
1006      end;
1007    end;
1008   end;
# Line 850 | Line 1059 | begin
1059      Dec(Index, inherited GetVerbCount);
1060      case Index of
1061        0: Result := SIBDatabaseEditor;
1062 <      1 : Result := SInterbaseExpressVersion;
1062 >      1 : Result := SInterbaseExpressVersion ;
1063      end;
1064    end;
1065   end;
# Line 873 | Line 1082 | function TIBTransactionEditor.GetVerb(In
1082   begin
1083    case Index of
1084      0: Result := SIBTransactionEditor;
1085 <    1: Result := SInterbaseExpressVersion;
1085 >    1: Result := SInterbaseExpressVersion ;
1086    end;
1087   end;
1088  
# Line 909 | Line 1118 | begin
1118      case Index of
1119        0: Result := SExecute;
1120        1: Result := SEditSQL;
1121 <      2: Result := SInterbaseExpressVersion;
1121 >      2: Result := SInterbaseExpressVersion ;
1122      end;
1123    end;
1124   end;
# Line 939 | Line 1148 | begin
1148      Dec(Index, inherited GetVerbCount);
1149      case Index of
1150        0: Result := SExecute;
1151 <      1: Result := SInterbaseExpressVersion;
1151 >      1: Result := SInterbaseExpressVersion ;
1152      end;
1153    end;
1154   end;
# Line 949 | Line 1158 | begin
1158    Result := inherited GetVerbCount + 2;
1159   end;
1160  
952 – { TIBStoredProcParamsProperty }
953 –
954 – procedure TIBStoredProcParamsProperty.Edit;
955 – var
956 –  StoredProc: TIBStoredProc;
957 –  Params: TParams;
958 – begin
959 –  StoredProc := (GetComponent(0) as TIBStoredProc);
960 –  Params := TParams.Create(nil);
961 –  try
962 –    StoredProc.CopyParams(Params);
963 –  finally
964 –    Params.Free;
965 –  end;
966 –  inherited Edit;
967 – end;
968 –
1161   { TIBTableFieldLinkProperty }
1162  
1163   procedure TIBTableFieldLinkProperty.Edit;
# Line 1024 | Line 1216 | end;
1216   procedure TIBRefreshSQLProperty.Edit;
1217   var
1218    IBDataset: TIBDataset;
1027 –  aDatabase: TIBDatabase;
1219   begin
1220    IBDataset := GetComponent(0) as TIBDataset;
1221    if IBRefreshSQLEditor.EditSQL(IBDataSet,IBDataSet.RefreshSQL) then Modified;
# Line 1111 | Line 1302 | end;
1302  
1303   procedure TIBSQLEditor.ExecuteVerb(Index: Integer);
1304   begin
1305 <  if IBSQLEditor.EditIBSQL(TIBSQL(Component)) then Modified;
1305 >  if IBSQLEditor.EditSQL(TIBSQL(Component)) then Modified;
1306   end;
1307  
1308   function TIBSQLEditor.GetVerb(Index: Integer): string;
1309   begin
1310    case Index of
1311      0 : Result := SIBSQLEditor;
1312 <    1: Result := SInterbaseExpressVersion;
1312 >    1: Result := SInterbaseExpressVersion ;
1313    end;
1314   end;
1315  
# Line 1134 | Line 1325 | var
1325    IBSQL: TIBSQL;
1326   begin
1327    IBSQL := GetComponent(0) as TIBSQL;
1328 <  if IBSQLEditor.EditIBSQL(IBSQL) then Modified;
1328 >  if IBSQLEditor.EditSQL(IBSQL) then Modified;
1329   end;
1330  
1331   initialization

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines