PC Format Collection 48/SENT14D.ISO/tech/delphi/disk12/lib.pak/DBREG.PAS

Pascal/Delphi Source File | 1995-08-24 | 15.3 KB | 585 lines

unit DBReg;

interface

uses Classes, DsgnIntf;

procedure Register;

implementation

uses DB, DBTables, DBCtrls, DBGrids, Report, Controls, MaskProp, MaskText,
  Mask, DBConsts, SysUtils, DBLookup, DSDesign, DBEdit, FldLinks, TypInfo,
  LibConst, QBE, QBindDlg, ProcDlg;

{ TDataSetEditor }

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

procedure TDataSetEditor.ExecuteVerb(Index: Integer);
begin
  ShowDatasetDesigner(Designer, TTable(Component));
end;

function TDataSetEditor.GetVerb(Index: Integer): string;
begin
  Result := LoadStr(SDatasetDesigner);
end;

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

{ TDatabaseEditor }

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

procedure TDatabaseEditor.ExecuteVerb(Index: Integer);
begin
  if EditDatabase(TDatabase(Component)) then Designer.Modified;
end;

function TDatabaseEditor.GetVerb(Index: Integer): string;
begin
  Result := LoadStr(SDatabaseEditor);
end;

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

{ TBatchMoveEditor }

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

procedure TBatchMoveEditor.ExecuteVerb(Index: Integer);
begin
  TBatchMove(Component).Execute;
end;

function TBatchMoveEditor.GetVerb(Index: Integer): string;
begin
  Result := LoadStr(SBatchExecute);
end;

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

{ TDataSetProperty }

type
  TDataSetProperty = class(TComponentProperty)
  public
    procedure GetValues(Proc: TGetStrProc); override;
  end;

procedure TDataSetProperty.GetValues(Proc: TGetStrProc);
var
  Linked: Boolean;
  I, J: Integer;
  Component: TComponent;
begin
  for I := 0 to Designer.Form.ComponentCount - 1 do
  begin
    Component := Designer.Form.Components[I];
    if (Component is TDataSet) and (Component.Name <> '') then
    begin
      Linked := False;
      for J := 0 to PropCount - 1 do
        Linked := Linked or
          TDataSource(GetComponent(J)).IsLinkedTo(TDataSet(Component));
      if not Linked then Proc(Component.Name);
    end;
  end;
end;

{ TDataSourceProperty }

type
  TDataSourceProperty = class(TComponentProperty)
  public
    procedure GetValues(Proc: TGetStrProc); override;
  end;

procedure TDataSourceProperty.GetValues(Proc: TGetStrProc);
var
  Linked: Boolean;
  I, J: Integer;
  Component: TComponent;
begin
  for I := 0 to Designer.Form.ComponentCount - 1 do
  begin
    Component := Designer.Form.Components[I];
    if (Component is TDataSource) and (Component.Name <> '') then
    begin
      Linked := False;
      for J := 0 to PropCount - 1 do
        Linked := Linked or
          TDataSet(GetComponent(J)).IsLinkedTo(TDataSource(Component));
      if not Linked then Proc(Component.Name);
    end;
  end;
end;

{ TDBStringProperty }

type
  TDBStringProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValueList(List: TStrings); virtual; abstract;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

function TDBStringProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList, paMultiSelect];
end;

procedure TDBStringProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Values: TStringList;
begin
  Values := TStringList.Create;
  try
    GetValueList(Values);
    for I := 0 to Values.Count - 1 do Proc(Values[I]);
  finally
    Values.Free;
  end;
end;

{ TDatabaseNameProperty }

type
  TDatabaseNameProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

procedure TDatabaseNameProperty.GetValueList(List: TStrings);
begin
  Session.GetDatabaseNames(List);
end;

{ TAliasNameProperty }

type
  TAliasNameProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

procedure TAliasNameProperty.GetValueList(List: TStrings);
begin
  Session.GetAliasNames(List);
end;

{ TDriverNameProperty }

type
  TDriverNameProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

procedure TDriverNameProperty.GetValueList(List: TStrings);
begin
  Session.GetDriverNames(List);
end;

{ TTableNameProperty }

type
  TTableNameProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

procedure TTableNameProperty.GetValueList(List: TStrings);
const
  Masks: array[TTableType] of string[5] = ('', '*.DB', '*.DBF', '*.TXT');
var
  Table: TTable;
begin
  Table := GetComponent(0) as TTable;
  Session.GetTableNames(Table.DatabaseName, Masks[Table.TableType],
    Table.TableType = ttDefault, False, List);
end;

{ TIndexNameProperty }

type
  TIndexNameProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

procedure TIndexNameProperty.GetValueList(List: TStrings);
begin
  (GetComponent(0) as TTable).GetIndexNames(List);
end;

{ TProcedureNameProperty }

type
  TProcedureNameProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

procedure TProcedureNameProperty.GetValueList(List: TStrings);
begin
  Session.GetStoredProcNames((GetComponent(0) as TDBDataSet).DatabaseName, List);
end;

{ TIndexFieldNamesProperty }

type
  TIndexFieldNamesProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

procedure TIndexFieldNamesProperty.GetValueList(List: TStrings);
var
  I: Integer;
begin
  with GetComponent(0) as TTable do
  begin
    IndexDefs.Update;
    for I := 0 to IndexDefs.Count - 1 do
      with IndexDefs[I] do
        if not (ixExpression in Options) then List.Add(Fields);
  end;
end;

{ TDataFieldProperty }

type
  TDataFieldProperty = class(TDBStringProperty)
  public
    function GetDataSourcePropName: string; virtual;
    procedure GetValueList(List: TStrings); override;
  end;

function TDataFieldProperty.GetDataSourcePropName: string;
begin
  Result := 'DataSource';
end;

procedure TDataFieldProperty.GetValueList(List: TStrings);
var
  Instance: TComponent;
  PropInfo: PPropInfo;
  DataSource: TDataSource;
begin
  Instance := GetComponent(0);
  PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, GetDataSourcePropName);
  if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
  begin
    DataSource := TObject(GetOrdProp(Instance, PropInfo)) as TDataSource;
    if (DataSource <> nil) and (DataSource.DataSet <> nil) then
      DataSource.DataSet.GetFieldNames(List);
  end;
end;

{ TLookupFieldProperty }

type
  TLookupFieldProperty = class(TDataFieldProperty)
  public
    function GetDataSourcePropName: string; override;
  end;

function TLookupFieldProperty.GetDataSourcePropName: string;
begin
  Result := 'LookupSource';
end;

{ TLookupIndexProperty }

type
  TLookupIndexProperty = class(TLookupFieldProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

procedure TLookupIndexProperty.GetValueList(List: TStrings);
var
  Instance: TComponent;
  PropInfo: PPropInfo;
  DataSource: TDataSource;
begin
  Instance := GetComponent(0);
  PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, GetDataSourcePropName);
  if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
  begin
    DataSource := TObject(GetOrdProp(Instance, PropInfo)) as TDataSource;
    if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    begin
      if (DataSource.DataSet is TTable) and
          (TTable(DataSource.DataSet).IndexFieldCount > 0) then
        List.Add(TTable(DataSource.DataSet).IndexFields[0].FieldName)
      else
        DataSource.DataSet.GetFieldNames(List);
    end;
  end;
end;

{ TDBImageEditor }

type
  TDBImageEditor = class(TDefaultEditor)
  public
    procedure Copy; override;
  end;

procedure TDBImageEditor.Copy;
begin
  TDBImage(Component).CopyToClipboard;
end;

{ TQueryEditor }

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

procedure TQueryEditor.ExecuteVerb(Index: Integer);
var
  Query: TQuery;
  List: TParams;
begin
  Query := Component as TQuery;
  case Index of
    0: ShowDatasetDesigner(Designer, TTable(Component));
    1:
      begin
        List := TParams.Create;
        try
          List.Assign(Query.Params);
          if EditQueryParams(Query, List) then
          begin
            Query.Params := List;
            if Designer <> nil then Designer.Modified;
          end;
        finally
          List.Free;
        end;
     end;
    2: ExecBuilder(Query);
  end;
end;

function TQueryEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := LoadStr(SDatasetDesigner);
    1: Result := LoadStr(SBindVerb);
    2: Result := LoadStr(SQBEVerb);
  end;
end;

function TQueryEditor.GetVerbCount: Integer;
begin
  if not VQBLoadAttempted then InitVQB;
  if VQBLoaded then Result := 3
  else Result := 2;
end;

{ TStoredProcEditor }

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

procedure TStoredProcEditor.Edit;
begin
  ShowDatasetDesigner(Designer, TTable(Component));
end;

procedure TStoredProcEditor.ExecuteVerb(Index: Integer);
var
  StoredProc: TStoredProc;
  List: TParams;
begin
  StoredProc := Component as TStoredProc;
  case Index of
    0: Edit;
    1:
      begin
        List := TParams.Create;
        try
          StoredProc.CopyParams(List);
          if EditProcParams(StoredProc, List) then
          begin
            StoredProc.UnPrepare;
            StoredProc.Params := List;
            if Designer <> nil then Designer.Modified;
          end;
        finally
          List.Free;
        end;
      end;
  end;
end;

function TStoredProcEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := LoadStr(SDatasetDesigner);
    1: Result := LoadStr(SBindVerb);
  end;
end;

function TStoredProcEditor.GetVerbCount: Integer;
begin
  Result := 2;
end;

{ TParamsProperty }

type
  TParamsProperty = class(TPropertyEditor)
  public
    function GetValue: string; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

function TParamsProperty.GetValue: string;
begin
  Result := Format('(%s)', [TParams.ClassName]);
end;

function TParamsProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paDialog];
end;

{ TStoredParamsProperty }
type
  TStoredParamsProperty = class(TParamsProperty)
    procedure Edit; override;
  end;

procedure TStoredParamsProperty.Edit;
var
  List: TParams;
  StoredProc: TStoredProc;
begin
  StoredProc := GetComponent(0) as TStoredProc;
  List := TParams.Create;
  try
    StoredProc.CopyParams(List);
    if EditProcParams(StoredProc, List) then
    begin
      StoredProc.UnPrepare;
      StoredProc.Params := List;
      if Designer <> nil then Designer.Modified;
    end;
  finally
    List.Free;
  end;
end;

{ TQueryParamsProperty }
type
  TQueryParamsProperty = class(TParamsProperty)
    procedure Edit; override;
  end;

procedure TQueryParamsProperty.Edit;
var
  List: TParams;
  Query: TQuery;
begin
  Query := GetComponent(0) as TQuery;
  List := TParams.Create;
  try
    List.Assign(Query.Params);
    if EditQueryParams(Query, List) then
    begin
      Query.Params := List;
      if Designer <> nil then Designer.Modified;
    end;
  finally
    List.Free;
  end;
end;

{ Registration }

procedure Register;
begin
  RegisterComponents(LoadStr(srDAccess), [TDataSource, TTable, TQuery,
    TStoredProc, TDatabase, TBatchMove, TReport]);
  RegisterComponents(LoadStr(srDControls), [TDBGrid, TDBNavigator, TDBText,
    TDBEdit, TDBMemo, TDBImage, TDBListBox, TDBComboBox,
    TDBCheckBox, TDBRadioGroup, TDBLookupList, TDBLookupCombo]);
  RegisterNoIcon([TField]);
  RegisterFields([TStringField, TIntegerField, TSmallintField, TWordField,
    TFloatField, TCurrencyField, TBCDField, TBooleanField, TDateField,
    TVarBytesField, TBytesField, TTimeField, TDateTimeField,
    TBlobField, TMemoField, TGraphicField]);
  RegisterPropertyEditor(TypeInfo(TDataSet), TDataSource, 'DataSet', TDataSetProperty);
  RegisterPropertyEditor(TypeInfo(TDataSource), TTable, 'MasterSource', TDataSourceProperty);
  RegisterPropertyEditor(TypeInfo(TDataSource), TQuery, 'DataSource', TDataSourceProperty);
  RegisterPropertyEditor(TypeInfo(TSymbolStr), TDatabase, 'AliasName', TAliasNameProperty);
  RegisterPropertyEditor(TypeInfo(TSymbolStr), TDatabase, 'DriverName', TDriverNameProperty);
  RegisterPropertyEditor(TypeInfo(TFileName), TDBDataSet, 'DatabaseName', TDatabaseNameProperty);
  RegisterPropertyEditor(TypeInfo(TFileName), TTable, 'TableName', TTableNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TTable, 'IndexName', TIndexNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TTable, 'IndexFieldNames', TIndexFieldNamesProperty);
  RegisterPropertyEditor(TypeInfo(string), TComponent, 'DataField', TDataFieldProperty);
  RegisterPropertyEditor(TypeInfo(string), TWinControl, 'LookupField', TLookupIndexProperty);
  RegisterPropertyEditor(TypeInfo(string), TWinControl, 'LookupDisplay', TLookupFieldProperty);
  RegisterPropertyEditor(TypeInfo(string), TDBEdit, 'EditMask', TMaskProperty);
  RegisterPropertyEditor(TypeInfo(string), TField, 'EditMask', TMaskProperty);
  RegisterPropertyEditor(TypeInfo(string), TReport, 'ReportDir', TReportDirProperty);
  RegisterPropertyEditor(TypeInfo(string), TReport, 'ReportName', TReportNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TTable, 'MasterFields', TFieldLinkProperty);
  RegisterPropertyEditor(TypeInfo(string), TQuery, 'StoredProcName', TProcedureNameProperty);
  RegisterPropertyEditor(TypeInfo(TParams), TQuery, 'Params', TQueryParamsProperty);
  RegisterPropertyEditor(TypeInfo(string), TStoredProc, 'StoredProcName', TProcedureNameProperty);
  RegisterPropertyEditor(TypeInfo(TParams), TStoredProc, 'Params', TStoredParamsProperty);
  RegisterComponentEditor(TDataset, TDataSetEditor);
  RegisterComponentEditor(TDatabase, TDatabaseEditor);
  RegisterComponentEditor(TBatchMove, TBatchMoveEditor);
  RegisterComponentEditor(TReport, TReportEditor);
  RegisterComponentEditor(TDBImage, TDBImageEditor);
  RegisterComponentEditor(TQuery, TQueryEditor);
  RegisterComponentEditor(TStoredProc, TStoredProcEditor);
end;

end.