regfibpluseditors.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

{***************************************************************}
{ FIBPlus - component library for direct access to Firebird and }
{ Interbase databases                                           }
{                                                               }
{    FIBPlus is based in part on the product                    }
{    Free IB Components, written by Gregory H. Deatz for        }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.            }
{    mailto:[e-mail]                                    }
{                                                               }
{    Copyright (c) 1998-2004 Serge Buzadzhy                     }
{    Contact: [e-mail]                                  }
{                                                               }
{ ------------------------------------------------------------- }
{    FIBPlus home page      : http://www.fibplus.net/           }
{    FIBPlus support e-mail : [e-mail]               }
{ ------------------------------------------------------------- }
{                                                               }
{  Please see the file License.txt for full license information }
{***************************************************************}



unit RegFIBPlusEditors;

interface
{$I FIBPlus.inc}
uses
 Classes, SysUtils, DB,
 {$IFDEF MSWINDOWS}
  Dialogs, Controls,Forms,
  pFIBDataSet, pFIBDatabase, pFIBStoredProc,EdErrorInfo, EdParamToFields,
  pFIBQuery, DSContainer,  pFIBErrorHandler, pFIBConditionsEdit,pFIBSQLLog,
 {$IFDEF  INC_SERVICE_SUPPORT}
     IB_Services, IB_Install,
 {$ENDIF}
 {$IFNDEF NO_MONITOR}
   FIBSQLMonitor,
 {$ENDIF}

  {$IFDEF D6+}
     DesignEditors,DesignIntf, Variants,
  {$else}
     DsgnIntf,
  {$endif}
  pFIBDBEdit,pFIBTrEdit,pFIBProps
;
 {$ENDIF}
 {$IFDEF LINUX}
  QDialogs, QControls,QForms,
  pFIBDataSet, pFIBDatabase, pFIBStoredProc,
  pFIBQuery, DSContainer,pFIBErrorHandler,
  pFIBConditionsEdit,EdErrorInfo,EdParamToFields,
  {$IFDEF D6+}

 DesignEditors,DesignIntf, Variants,
  {$else}
     DsgnIntf,
  {$endif}
  pFIBDBEdit,pFIBTrEdit,  pFIBProps
    {$IFDEF  INC_SERVICE_SUPPORT}
     , IB_Services
    {$ENDIF}

;
 {$ENDIF}


type
  TpFIBTransactionEditor = class(TComponentEditor)
    procedure ExecuteVerb(Index: Integer); override;
    function  GetVerb(Index: Integer): string; override;
    function  GetVerbCount: Integer; override;
  end;

  TpFIBQueryEditor = class(TComponentEditor)
    procedure ExecuteVerb(Index: Integer); override;
    function  GetVerb(Index: Integer): string; override;
    function  GetVerbCount: Integer; override;
  end;

  TpFIBSQLLoggerEditor = class(TComponentEditor)
    procedure ExecuteVerb(Index: Integer); override;
    function  GetVerb(Index: Integer): string; override;
    function  GetVerbCount: Integer; override;
  end;


  TpFIBDatabaseEditor = class(TComponentEditor)
    procedure ExecuteVerb(Index: Integer); override;
    function  GetVerb(Index: Integer): string; override;
    function  GetVerbCount: Integer; override;
  end;

  TFIBSQLsProperties = class(TClassProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure Edit; override;
  end;

  TFIBSQLsProperty = class(TClassProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure Edit; override;
  end;

  TpFIBSQLPropEdit =class(TClassProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

  TEdParamToFields     = class(TClassProperty)
  public
    function  GetAttributes: TPropertyAttributes; override;
    function  GetValue: string; override;
    procedure Edit; override;
  end;

  TFIBConditionsEditor = class(TClassProperty)
  public
    function  GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;


  TFIBGenSQlEd = class(TComponentEditor)
  {$IFDEF D6+}
    DefaultEditor: IComponentEditor;
  {$ELSE}
    DefaultEditor: TComponentEditor;
  {$ENDIF}
  public
{$IFDEF VER100}
    constructor Create(AComponent: TComponent; ADesigner: TFormDesigner); override;
{$ELSE}
  {$IFNDEF D6+}
    constructor Create(AComponent: TComponent; ADesigner: IFormDesigner); override;
  {$ELSE}
    constructor Create(AComponent: TComponent; ADesigner: IDesigner); override;
  {$ENDIF}
{$ENDIF}
    destructor Destroy; override;
    procedure ExecuteVerb(Index: Integer); override;
    function  GetVerb(Index: Integer): string; override;
    function  GetVerbCount: Integer; override;
    procedure SaveDataSetInfo;
  end;

  TpFIBAutoUpdateOptionsEditor = class(TClassProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

  TpFIBTRParamsEditor = class(TClassProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure Edit; override;
  end;

  TpFIBDataSetOptionsEditor = class(TSetProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

procedure Register;

implementation

uses
{$IFNDEF NO_REGISTRY} RegUtils, {$ENDIF}
     ToCodeEditor,FIBDataSet, FIBQuery, FIBDatabase, SqlTxtRtns, StrUtil,
     EdFieldInfo, pFIBDataInfo, EdDataSetInfo,FIBDBLoginDlg,FIBConsts,
     pFIBAutoUpdEditor, pFIBDataSetOptions,FIBSQLEditor, FIBDataSQLEditor;

const FIBPalette = 'FIBPlus';


type

  TFileNameProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function  GetAttributes: TPropertyAttributes; override;
  end;

 TFIBAliasEdit = class(TStringProperty)
    function  GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
 end;

function TFIBAliasEdit.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes;
  Result := Result + [paValueList]
end;

procedure TFIBAliasEdit.GetValues(Proc: TGetStrProc);
var i: integer;
  Keys: Variant;
begin
{$IFNDEF NO_REGISTRY}
  if PropCount > 1 then Exit;
  Keys := DefAllSubKey(['Software', RegFIBRoot, 'Aliases']);
  if VarType(Keys) = varBoolean then Exit;
  for i := VarArrayLowBound(Keys, 1) to VarArrayHighBound(Keys, 1) do Proc(Keys[i])
{$ENDIF}  
end;
//
type
 TFIBTrKindEdit = class(TStringProperty)
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
 end;

function TFIBTrKindEdit.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes;
  Result := Result + [paValueList]
end;

procedure TFIBTrKindEdit.GetValues(Proc: TGetStrProc);
var i: integer;
    Keys,v: Variant;
begin
{$IFNDEF NO_REGISTRY}
  if PropCount > 1 then Exit;
  Keys := DefAllSubKey(['Software', RegFIBRoot, RegFIBTrKinds]);
  Proc('NoUserKind');
  if VarType(Keys) = varBoolean then Exit;
  for i := VarArrayLowBound(Keys, 1) to VarArrayHighBound(Keys, 1) do
  begin
   v:=DefReadFromRegistry(['Software', RegFIBRoot, RegFIBTrKinds,
    Keys[i]
   ],['Name']);
   if VarType(v) <> varBoolean then
    Proc(v[0,0])
  end;
{$ENDIF}  
end;


type
  TDataSet_ID_Edit = class(TIntegerProperty)
  public
    function  GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

function TDataSet_ID_Edit.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes + [paDialog];
end;

procedure TDataSet_ID_Edit.Edit;
var
  OldID: integer;
begin
  OldID := TpFIBDataSet(GetComponent(0)).DataSet_ID;
  with TpFibDataSet(GetComponent(0)) do
  if Database=nil  then
   Exit
  else    
  if not ExistDRepositaryTable(DataBase) then
  begin
   if not (urDataSetInfo in DataBase.UseRepositories) then
     raise Exception.Create(SCompEditDataSetInfoForbid);
    if
      MessageDlg(SCompEditInfoTableNotExist, mtConfirmation, [mbOK, mbCancel], 0
      ) <> mrOk
    then
      Exit;
    CreateDRepositaryTable(TpFibDataSet(GetComponent(0)).DataBase);
  end;

  ChooseDSInfo(TpFIBDataSet(GetComponent(0)));
  if OldID <> TpFIBDataSet(GetComponent(0)).DataSet_ID then
    Modified
end;
//
type TTableNameEdit = class(TStringProperty)
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TTableNameEdit.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes;
  Result := Result + [paValueList]
end;

procedure TTableNameEdit.GetValues(Proc: TGetStrProc);
var i: integer;
  Tables: TStrings;
begin
  if PropCount > 1 then Exit;
  if not (TAutoUpdateOptions(GetComponent(0)).Owner is TpFIBDataSet) then Exit;
  Tables := TStringList.Create;
  with TpFIBDataSet(TAutoUpdateOptions(GetComponent(0)).Owner) do
  try
    AllTables(SelectSQL.Text, Tables);
    for i := 0 to Pred(Tables.Count) do Proc(ExtractWord(1, Tables[i], [' ']));
  finally
    Tables.Free
  end
end;
//

type
  TKeyFieldNameEdit = class(TStringProperty)
    function  GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TKeyFieldNameEdit.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes;
  Result := Result + [paValueList]
end;

procedure TKeyFieldNameEdit.GetValues(Proc: TGetStrProc);
var i: integer;
  Tables: TStrings;
begin
  if PropCount > 1 then
   Exit;
  if not (TAutoUpdateOptions(GetComponent(0)).Owner is TpFIBDataSet) then Exit;
  if not Assigned(TpFIBDataSet(TAutoUpdateOptions(GetComponent(0)).Owner).Database) then Exit;
  Tables := TStringList.Create;
  with TpFIBDataSet(TAutoUpdateOptions(GetComponent(0)).Owner),
       TAutoUpdateOptions(GetComponent(0))
  do
  try
   try
    if IsBlank(UpdateTableName) then
    begin
     ShowMessage('Error: UpdateTableName is empty');
     Exit;
    end;
    FieldDefs.Update;
    if FieldCount>0 then
      for i := 0 to Pred(FieldCount) do
      begin
        if (Fields[i] is TLargeIntField) or
(Fields[i] is TIntegerField) or ((Fields[i] is TBCDField)and (TBCDField(Fields[i]).Size=0))
        and
          EquelStrings(GetRelationTableName(Fields[i]),UpdateTableName,False)
        then
        begin
         Proc(Fields[i].FieldName);
        end;
      end
    else
    begin
      if not QSelect.Prepared then
       QSelect.Prepare;
      for i := 0 to Pred(FieldDefs.Count) do
      begin
        if (FieldDefs[i].DataType in [ftSmallint, ftInteger]) and
         EquelStrings(GetRelationTableName(FieldDefs[i]),UpdateTableName,False)
        then
        begin
         Proc(FieldDefs[i].Name);
        end
        else
        if ((FieldDefs[i].DataType =ftBCD) and (FieldDefs[i].Size=0)) and
         EquelStrings(GetRelationTableName(FieldDefs[i]),UpdateTableName,False)
        then
        begin
         Proc(FieldDefs[i].Name);
        end;
      end;
    end;
   except
   end; 
  finally
    Tables.Free
  end
end;


function TpFIBTransactionEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

function TpFIBTransactionEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := SCompEditEditTransaction;