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 143 by tony, Fri Feb 23 12:11:21 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 189 | Line 204 | type
204    end;
205  
206    TIBStoredProcParamsProperty = class(TCollectionPropertyEditor)
192 –  public
193 –    procedure Edit; override;
207    end;
208  
209    { TIBTableFieldLinkProperty }
# Line 309 | Line 322 | type
322      procedure Edit; override;
323    end;
324  
325 +  { TIBUpdateRefreshSQLProperty }
326 +
327 +  TIBUpdateRefreshSQLProperty = class(TSQLPropertyEditor)
328 +  protected
329 +    FIBUpdate: TIBUpdate;
330 +    FDatabase: TIBDatabase;
331 +    function GetObjects: boolean;
332 +  public
333 +    procedure Edit; override;
334 +  end;
335 +
336 +
337   { TIBEventListProperty }
338  
339    TIBEventListProperty = class(TClassProperty)
# Line 355 | Line 380 | type
380      procedure SetIndexFieldNames(const Value: string); override;
381    end;
382  
383 +  { TIBFieldDefsProperty }
384 +
385 +  TIBFieldDefsProperty = class(TCollectionPropertyEditor)
386 +  public
387 +    procedure Edit; override;
388 +  end;
389 +
390 +  { TIBIndexDefsProperty }
391 +
392 +  TIBIndexDefsProperty = class(TCollectionPropertyEditor)
393 +  public
394 +    procedure Edit; override;
395 +  end;
396  
397  
398   procedure Register;
399  
400   implementation
401  
402 < uses IB, IBQuery, IBStoredProc, IBCustomDataSet,
403 <     IBIntf, IBSQL, IBSQLMonitor, IBDatabaseInfo, IBEvents,
402 > uses IB, IBQuery, IBStoredProc, IBCustomDataSet, FBMessages,
403 >     IBSQL, IBSQLMonitor, IBDatabaseInfo, IBEvents, IBTypes,
404       IBServices, IBDatabaseEdit, IBTransactionEdit,
405       IBBatchMove, IBExtract,LResources, IBSelectSQLEditor,
406       IBModifySQLEditor,IBDeleteSQLEditor,IBRefreshSQLEditor,
407       IBInsertSQLEditor, IBGeneratorEditor, IBUpdateSQLEditor, IBDataSetEditor,
408       IBSQLEditor, ibserviceeditor, LCLVersion, IBDynamicGrid, IBLookupComboEditBox,
409 <     IBTreeView, DBControlGrid;
410 <
409 >     IBTreeView, DBControlGrid, ibxscript, IBLocalDBSupport, IBDSDialogs,
410 >     IBArrayGrid, IBVersion, IBDataOutput;
411  
412 + const
413 +  IBPalette1 = 'Firebird'; {do not localize}
414 +  IBPalette2 = 'Firebird Admin'; {do not localize}
415 +  IBPalette3 = 'Firebird Data Controls';   {do not localize}
416 +  
417 + resourcestring
418 +   SInterbaseExpressVersion = 'Firebird Express for Lazarus ' + IBX_VERSION;
419 +   SEditSQL = 'Edit SQL';
420 +   SIBSQLEditor = 'IBSQL Editor';
421 +   SIBServiceEditor = 'Edit IB Service';
422 +   SIBUpdateSQLEditor = '&UpdateSQL Editor...';
423 +   SIBDataSetEditor = '&Dataset Editor...';
424 +   SExecute = 'E&xecute';
425 +   SIBDatabaseEditor = 'Da&tabase Editor...';
426 +   SIBTransactionEditor = '&Transaction Editor...';
427 +   SIBUpdateLayout = 'Update Layout';
428  
429   procedure Register;
430   begin
# Line 380 | Line 434 | begin
434      Exit;
435    end;
436  
437 <  RegisterNoIcon([TIBStringField, TIBBCDField, TIBMemoField]);
437 >  RegisterNoIcon([TIBStringField, TIBBCDField, TIBMemoField, TIBArrayField,
438 >    TIBSmallintField, TIBIntegerField, TIBLargeIntField]);
439    {$if lcl_fullversion < 01010000}
440    {see http://bugs.freepascal.org/view.php?id=19035 }
441    RegisterNoIcon([TIntegerField]);
442    {$endif}
443    RegisterComponents(IBPalette1, [ TIBQuery, TIBDataSet,
444 <   TIBDatabase, TIBTransaction, TIBUpdateSQL, TIBEvents,
444 >   TIBDatabase, TIBTransaction, TIBUpdateSQL, TIBUpdate, TIBEvents,
445       TIBSQL, TIBDatabaseInfo, TIBSQLMonitor,
446 <       TIBStoredProc,TIBBatchMove,  TIBTable,TIBExtract]);
447 <  if IBServiceAPIPresent  then
446 >       TIBStoredProc,TIBBatchMove,  TIBTable,TIBExtract, TIBXScript, TIBLocalDBSupport,
447 >       TIBBlockFormatOut,TIBCSVDataOut,TIBInsertStmtsOut]);
448 >  if FirebirdAPI.HasServiceAPI  then
449      RegisterComponents(IBPalette2, [TIBConfigService, TIBBackupService,
450 <      TIBRestoreService, TIBValidationService, TIBStatisticalService,
450 >      TIBRestoreService, TIBValidationService, TIBOnlineValidationService, TIBStatisticalService,
451        TIBLogService, TIBSecurityService, TIBServerProperties]);
452  
453  
454 <  RegisterComponents(IBPalette3,[TIBLookupComboEditBox,TIBDynamicGrid,TIBTreeView,TDBControlGrid]);
454 >  RegisterComponents(IBPalette3,[TIBLookupComboEditBox,TIBDynamicGrid,TIBTreeView,TDBControlGrid, TIBArrayGrid]);
455    RegisterPropertyEditor(TypeInfo(TIBFileName), TIBDatabase, 'DatabaseName', TIBFileNameProperty); {do not localize}
456    RegisterPropertyEditor(TypeInfo(string), TIBStoredProc, 'StoredProcName', TIBStoredProcNameProperty); {do not localize}
457 +  RegisterPropertyEditor(TypeInfo(string), TIBStoredProc, 'PackageName', TIBPackageNameProperty); {do not localize}
458    RegisterPropertyEditor(TypeInfo(TParams), TIBStoredProc, 'Params', TIBStoredProcParamsProperty);
459    RegisterPropertyEditor(TypeInfo(string), TIBTable, 'TableName', TIBTableNameProperty); {do not localize}
460    RegisterPropertyEditor(TypeInfo(string), TIBTable, 'IndexName', TIBIndexNameProperty); {do not localize}
461    RegisterPropertyEditor(TypeInfo(string), TIBTable, 'IndexFieldNames', TIBIndexFieldNamesProperty); {do not localize}
462    RegisterPropertyEditor(TypeInfo(string), TIBTable, 'MasterFields', TIBTableFieldLinkProperty); {do not localize}
463 +  RegisterPropertyEditor(TypeInfo(TFieldDefs), TIBTable, 'FieldDefs', TIBFieldDefsProperty); {do not localize}
464 +  RegisterPropertyEditor(TypeInfo(TIndexDefs), TIBTable, 'IndexDefs', TIBIndexDefsProperty); {do not localize}
465    RegisterPropertyEditor(TypeInfo(TStrings), TIBQuery, 'SQL', TIBQuerySQLProperty); {do not localize}
466    RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'SelectSQL', TIBDatasetSQLProperty); {do not localize}
467    RegisterPropertyEditor(TypeInfo(TStrings), TIBDataSet, 'ModifySQL', TIBUpdateSQLProperty); {do not localize}
# Line 414 | Line 473 | begin
473    RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdateSQL, 'ModifySQL', TIBUpdateSQLUpdateProperty); {do not localize}
474    RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdateSQL, 'InsertSQL', TIBUpdateSQLInsertSQLProperty); {do not localize}
475    RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdateSQL, 'DeleteSQL', TIBUpdateSQLDeleteProperty); {do not localize}
476 +  RegisterPropertyEditor(TypeInfo(TStrings), TIBUpdate, 'RefreshSQL', TIBUpdateRefreshSQLProperty); {do not localize}
477    RegisterPropertyEditor(TypeInfo(TStrings), TIBEvents, 'Events', TIBEventListProperty); {do not localize}
478    RegisterPropertyEditor(TypeInfo(TPersistent), TIBDataSet, 'GeneratorField', TIBGeneratorProperty);  {do not localize}
479    RegisterPropertyEditor(TypeInfo(TPersistent), TIBQuery, 'GeneratorField', TIBGeneratorProperty);  {do not localize}
480 +  RegisterPropertyEditor(TypeInfo(TPersistent), TIBTable, 'GeneratorField', TIBGeneratorProperty);  {do not localize}
481  
482    RegisterComponentEditor(TIBDatabase, TIBDatabaseEditor);
483    RegisterComponentEditor(TIBTransaction, TIBTransactionEditor);
# Line 426 | Line 487 | begin
487    RegisterComponentEditor(TIBStoredProc, TIBStoredProcEditor);
488    RegisterComponentEditor(TIBSQL, TIBSQLEditor);
489    RegisterComponentEditor(TIBCustomService, TIBServiceEditor);
490 +  RegisterComponentEditor(TIBArrayGrid, TIBArrayGridEditor);
491  
492  
493    {Firebird Data Access Controls}
# Line 437 | Line 499 | begin
499    RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'TextField', TIBTreeViewFieldProperty);
500    RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'ParentField', TIBTreeViewFieldProperty);
501    RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'HasChildField', TIBTreeViewFieldProperty);
502 +  RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'ImageIndexField', TIBTreeViewFieldProperty);
503 +  RegisterPropertyEditor(TypeInfo(string), TIBTreeView, 'SelectedIndexField', TIBTreeViewFieldProperty);
504  
505 +  IBGUIInterface :=  TIBDSLCLInterface.Create;
506   end;
507  
508   procedure LoadDataSourceFields(DataSource: TDataSource; List: TStrings);
# Line 462 | Line 527 | begin
527    end;
528   end;
529  
530 + { TIBUpdateRefreshSQLProperty }
531 +
532 + function TIBUpdateRefreshSQLProperty.GetObjects: boolean;
533 + begin
534 +  Result := false;
535 +  FIBUpdate := GetComponent(0) as TIBUpdate;
536 +  if not assigned(FIBUpdate) or not assigned(FIBUpdate.DataSet) then
537 +    Exit;
538 +  FDatabase := nil;
539 +  if FIBUpdate.DataSet is TIBQuery then
540 +  begin
541 +    FDatabase := (FIBUpdate.DataSet as TIBQuery).Database;
542 +    Result := true
543 +  end;
544 + end;
545 +
546 + procedure TIBUpdateRefreshSQLProperty.Edit;
547 + begin
548 +  GetObjects;
549 +  if IBRefreshSQLEditor.EditSQL(FIBUpdate.DataSet,FIBUpdate.RefreshSQL) then Modified;
550 + end;
551 +
552 + { TIBPackageNameProperty }
553 +
554 + procedure TIBPackageNameProperty.GetValues(Proc: TGetStrProc);
555 + var
556 +   StoredProc : TIBStoredProc;
557 +   i : integer;
558 + begin
559 +    StoredProc := GetComponent(0) as TIBStoredProc;
560 +    if StoredProc.Database = nil then
561 +      Exit;
562 +
563 +    with StoredProc do
564 +    try
565 +      for I := 0 to PackageNames.Count - 1 do
566 +        Proc (PackageNames[i]);
567 +    except on E: Exception do
568 +      MessageDlg(E.Message,mtError,[mbOK],0)
569 +    end;
570 + end;
571 +
572 + { TIBIndexDefsProperty }
573 +
574 + procedure TIBIndexDefsProperty.Edit;
575 + var IndexDefs: TIndexDefs;
576 + begin
577 +  IndexDefs := TIndexDefs(GetObjectValue);
578 +  if IndexDefs <> nil then
579 +    IndexDefs.Update;
580 +  inherited Edit;
581 + end;
582 +
583 + { TIBFieldDefsProperty }
584 +
585 + procedure TIBFieldDefsProperty.Edit;
586 + var FieldDefs: TFieldDefs;
587 + begin
588 +  FieldDefs := TFieldDefs(GetObjectValue);
589 +  if FieldDefs <> nil then
590 +    FieldDefs.Update;
591 +  inherited Edit;
592 + end;
593 +
594 + { TIBArrayGridEditor }
595 +
596 + procedure TIBArrayGridEditor.ExecuteVerb(Index: Integer);
597 + begin
598 +  if Index < inherited GetVerbCount then
599 +    inherited ExecuteVerb(Index)
600 +  else
601 +  case Index of
602 +    0: TIBArrayGrid(Component).UpdateLayout;
603 +  end;
604 + end;
605 +
606 + function TIBArrayGridEditor.GetVerb(Index: Integer): string;
607 + begin
608 +  if Index < inherited GetVerbCount then
609 +    Result := inherited GetVerb(Index) else
610 +  begin
611 +    Dec(Index, inherited GetVerbCount);
612 +    case Index of
613 +      0: Result := SIBUpdateLayout;
614 +      1 : Result := SInterbaseExpressVersion ;
615 +    end;
616 +  end;
617 + end;
618 +
619 + function TIBArrayGridEditor.GetVerbCount: Integer;
620 + begin
621 +  Result := 2;
622 + end;
623 +
624   { TDBLookupPropertiesGridFieldProperty }
625  
626   procedure TDBLookupPropertiesGridFieldProperty.FillValues(
# Line 742 | Line 901 | var
901    IBSQL: TIBSQL;
902   begin
903    IBSQL := GetComponent(0) as TIBSQL;
904 <  if IBSQLEditor.EditIBSQL(IBSQL) then Modified;
904 >  if IBSQLEditor.EditSQL(IBSQL) then Modified;
905   end;
906  
907   { TIBUpdateSQLEditor }
# Line 756 | Line 915 | function TIBUpdateSQLEditor.GetVerb(Inde
915   begin
916    case Index of
917      0 : Result := SIBUpdateSQLEditor;
918 <    1: Result := SInterbaseExpressVersion;
918 >    1: Result := SInterbaseExpressVersion ;
919    end;
920   end;
921  
# Line 768 | Line 927 | end;
927   { TIBDataSetEditor }
928  
929   procedure TIBDataSetEditor.ExecuteVerb(Index: Integer);
771 – var
772 –  IBDataset: TIBDataset;
930   begin
931    if Index < inherited GetVerbCount then
932      inherited ExecuteVerb(Index) else
# Line 793 | Line 950 | begin
950      case Index of
951        0: Result := SIBDataSetEditor;
952        1: Result := SExecute;
953 <      2: Result := SInterbaseExpressVersion;
953 >      2: Result := SInterbaseExpressVersion ;
954      end;
955    end;
956   end;
# Line 850 | Line 1007 | begin
1007      Dec(Index, inherited GetVerbCount);
1008      case Index of
1009        0: Result := SIBDatabaseEditor;
1010 <      1 : Result := SInterbaseExpressVersion;
1010 >      1 : Result := SInterbaseExpressVersion ;
1011      end;
1012    end;
1013   end;
# Line 873 | Line 1030 | function TIBTransactionEditor.GetVerb(In
1030   begin
1031    case Index of
1032      0: Result := SIBTransactionEditor;
1033 <    1: Result := SInterbaseExpressVersion;
1033 >    1: Result := SInterbaseExpressVersion ;
1034    end;
1035   end;
1036  
# Line 909 | Line 1066 | begin
1066      case Index of
1067        0: Result := SExecute;
1068        1: Result := SEditSQL;
1069 <      2: Result := SInterbaseExpressVersion;
1069 >      2: Result := SInterbaseExpressVersion ;
1070      end;
1071    end;
1072   end;
# Line 939 | Line 1096 | begin
1096      Dec(Index, inherited GetVerbCount);
1097      case Index of
1098        0: Result := SExecute;
1099 <      1: Result := SInterbaseExpressVersion;
1099 >      1: Result := SInterbaseExpressVersion ;
1100      end;
1101    end;
1102   end;
# Line 949 | Line 1106 | begin
1106    Result := inherited GetVerbCount + 2;
1107   end;
1108  
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 –
1109   { TIBTableFieldLinkProperty }
1110  
1111   procedure TIBTableFieldLinkProperty.Edit;
# Line 1024 | Line 1164 | end;
1164   procedure TIBRefreshSQLProperty.Edit;
1165   var
1166    IBDataset: TIBDataset;
1027 –  aDatabase: TIBDatabase;
1167   begin
1168    IBDataset := GetComponent(0) as TIBDataset;
1169    if IBRefreshSQLEditor.EditSQL(IBDataSet,IBDataSet.RefreshSQL) then Modified;
# Line 1111 | Line 1250 | end;
1250  
1251   procedure TIBSQLEditor.ExecuteVerb(Index: Integer);
1252   begin
1253 <  if IBSQLEditor.EditIBSQL(TIBSQL(Component)) then Modified;
1253 >  if IBSQLEditor.EditSQL(TIBSQL(Component)) then Modified;
1254   end;
1255  
1256   function TIBSQLEditor.GetVerb(Index: Integer): string;
1257   begin
1258    case Index of
1259      0 : Result := SIBSQLEditor;
1260 <    1: Result := SInterbaseExpressVersion;
1260 >    1: Result := SInterbaseExpressVersion ;
1261    end;
1262   end;
1263  
# Line 1134 | Line 1273 | var
1273    IBSQL: TIBSQL;
1274   begin
1275    IBSQL := GetComponent(0) as TIBSQL;
1276 <  if IBSQLEditor.EditIBSQL(IBSQL) then Modified;
1276 >  if IBSQLEditor.EditSQL(IBSQL) then Modified;
1277   end;
1278  
1279   initialization

Diff Legend

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