frxsdaccomponents.pas

ODAC+SDAC源代码

{******************************************}
{                                          }
{             FastReport v3.0              }
{         SDAC enduser components          }
{                                          }
// Created by: CoreLab
// E-mail: [e-mail]
{                                          }
{******************************************}

unit frxSDACComponents;

interface

{$I frx.inc}

uses
  Windows, Classes, frxClass, frxCustomDB, DB, MSAccess, OLEDBAccess, OLEDBC, SdacVcl
{$IFDEF Delphi6}
, Variants
{$ENDIF};


type
  TSDACTable = class(TMSTable)
  protected
    procedure InitFieldDefs; override;
  end;

  TSDACQuery = class(TMSQuery)
  protected
    procedure InitFieldDefs; override;
  end;

  TfrxSDACComponents = class(TfrxDBComponents)
  private
    FDefaultDatabase: TMSConnection;
    FOldComponents: TfrxSDACComponents;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetDescription: String; override;
  published
    property DefaultDatabase: TMSConnection read FDefaultDatabase write FDefaultDatabase;
  end;

  TfrxSDACDatabase = class(TfrxDialogComponent)
  private 
    FConnection: TMSConnection;

    function GetLoginPrompt: Boolean;
    procedure SetLoginPrompt(Value: Boolean);
    function GetDatabaseName: string;
    procedure SetDatabaseName(Value: string);
    function GetAuthentication: TMSAuthentication;
    procedure SetAuthentication(Value: TMSAuthentication);
    function GetUsername: string;
    procedure SetUsername(const Value: string);
    function GetPassword: string;
    procedure SetPassword(const Value: string);
    function GetServer: string;
    procedure SetServer(const Value: string);
    function GetConnected: Boolean;
    procedure SetConnected(Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function GetDescription: String; override;
    property Connection: TMSConnection read FConnection;
  published
    property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt default True;
    property DatabaseName: string read GetDatabaseName write SetDatabaseName;
    property Authentication: TMSAuthentication read GetAuthentication write SetAuthentication;
    property Username: string read GetUsername write SetUsername;
    property Password: string read GetPassword write SetPassword;
    property Server: string read GetServer write SetServer;
    property Connected: Boolean read GetConnected write SetConnected default False;
  end;

  TfrxSDACTable = class(TfrxCustomDataset)
  private
    FConnection: TfrxSDACDatabase;
    FTable: TSDACTable;
    procedure SetIndexFieldNames(const Value: string);
    function GetIndexFieldNames: string;
    function GetTableName: String;
    procedure SetTableName(const Value: String);
    procedure SetDatabase(const Value: TfrxSDACDatabase);

    function GetOrderFields: string;
    procedure SetOrderFields(Value: string);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetMaster(const Value: TDataSource); override;
    procedure SetMasterFields(const Value: String); override;
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
    property Table: TSDACTable read FTable;
  published
    property Database: TfrxSDACDatabase read FConnection write SetDatabase;
    property IndexFieldNames: String read GetIndexFieldNames write SetIndexFieldNames;
    property MasterFields;
    property TableName: String read GetTableName write SetTableName;

    property OrderFields: string read GetOrderFields write SetOrderFields;
  end;

  TfrxSDACQuery = class(TfrxCustomQuery)
  private
    FConnection: TfrxSDACDatabase;
    FQuery: TSDACQuery;
    procedure SetDatabase(const Value: TfrxSDACDatabase);
    procedure SetIndexFieldNames(const Value: string);
    function GetIndexFieldNames: string;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetMaster(const Value: TDataSource); override;
    procedure SetMasterFields(const Value: String); override;
    procedure SetSQL(Value: TStrings); override;
    function GetSQL: TStrings; override;
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
    procedure UpdateParams; override;
    property Query: TSDACQuery read FQuery;
  published
    property Database: TfrxSDACDatabase read FConnection write SetDatabase;
    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
    property MasterFields;
  end;

var
  SDACComponents: TfrxSDACComponents;


implementation

{$R *.res}

uses 
  Graphics, frxSDACRTTI, 
{$IFNDEF NO_EDITORS}
  frxSDACEditor, 
{$ENDIF}
  frxDsgnIntf, frxRes;

procedure GetMasterDetailNames(const Value: String; var MasterNames: string; var DetailNames: string);
var
  List: TStringList;
  i: integer;
begin
  List := TStringList.Create;
  try
    List.Delimiter := ';';
    List.DelimitedText := Value;
    MasterNames := '';
    DetailNames := '';
    for i := 0 to List.Count - 1 do begin
      if MasterNames <> '' then
        MasterNames := MasterNames + ';';
      if DetailNames <> '' then
        DetailNames := DetailNames + ';';
      MasterNames := MasterNames + List.Values[List.Names[i]];
      DetailNames := DetailNames + List.Names[i];
    end;
  finally
    List.Free;
  end;
end;

{ TSDACTable }

procedure TSDACTable.InitFieldDefs;
begin
  if TableName <> '' then
    inherited;
end;

{ TSDACQuery }

procedure TSDACQuery.InitFieldDefs;
begin
  if SQL.Text <> '' then
    inherited;
end;

{ TfrxSDACComponents }

constructor TfrxSDACComponents.Create(AOwner: TComponent);
begin
  inherited;
  FOldComponents := SDACComponents;
  SDACComponents := Self;
end;

destructor TfrxSDACComponents.Destroy;
begin
  if SDACComponents = Self then
    SDACComponents := FOldComponents;
  inherited;
end;

function TfrxSDACComponents.GetDescription: String;
begin
  Result := 'SDAC';
end;


{ TfrxSDACDatabase }

constructor TfrxSDACDatabase.Create(AOwner: TComponent);
begin
  inherited;
  FConnection := TMSConnection.Create(nil);
  Component := FConnection;
  FImageIndex := 37;
end;

destructor TfrxSDACDatabase.Destroy;
begin
  inherited;
end;

class function TfrxSDACDatabase.GetDescription: String;
begin
  Result := 'SDAC Database';
end;

function TfrxSDACDatabase.GetConnected: Boolean;
begin
  Result := FConnection.Connected;
end;

function TfrxSDACDatabase.GetUsername: string;
begin
  Result := FConnection.Username;
end;

function TfrxSDACDatabase.GetPassword: string;
begin
  Result := FConnection.Password;
end;

function TfrxSDACDatabase.GetServer: string;
begin
  Result := FConnection.Server;
end;

function TfrxSDACDatabase.GetLoginPrompt: Boolean;
begin
  Result := FConnection.LoginPrompt;
end;

procedure TfrxSDACDatabase.SetConnected(Value: Boolean);
begin
  FConnection.Connected := Value;
end;

procedure TfrxSDACDatabase.SetUsername(const Value: String);
begin
  FConnection.Username := Value;
end;

procedure TfrxSDACDatabase.SetPassword(const Value: String);
begin
  FConnection.Password := Value;
end;

procedure TfrxSDACDatabase.SetServer(const Value: String);
begin
  FConnection.Server := Value;
end;

procedure TfrxSDACDatabase.SetLoginPrompt(Value: Boolean);
begin
  FConnection.LoginPrompt := Value;
end;

function TfrxSDACDatabase.GetDatabaseName: string;
begin
  Result := FConnection.Database;
end;

procedure TfrxSDACDatabase.SetDatabaseName(Value: string);
begin
  FConnection.Database := Value;
end;

function TfrxSDACDatabase.GetAuthentication: TMSAuthentication;
begin
  Result := FConnection.Authentication;
end;

procedure TfrxSDACDatabase.SetAuthentication(Value: TMSAuthentication);
begin
  FConnection.Authentication := Value;
end;

{ TfrxSDACTable }

constructor TfrxSDACTable.Create(AOwner: TComponent);
begin
  FTable := TSDACTable.Create(nil);
  DataSet := FTable;
  SetDatabase(nil);
  inherited;
  FImageIndex := 38;
end;

class function TfrxSDACTable.GetDescription: String;
begin
  Result := 'SDAC Table';
end;

procedure TfrxSDACTable.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FConnection) then
    SetDatabase(nil);
end;

procedure TfrxSDACTable.SetDatabase(const Value: TfrxSDACDatabase);
begin
  FConnection := Value;
  if Value <> nil then
    FTable.Connection := Value.Connection
  else if SDACComponents <> nil then
    FTable.Connection := SDACComponents.DefaultDatabase
  else
    FTable.Connection := nil;
end;

function TfrxSDACTable.GetIndexFieldNames: string;
begin
  Result := FTable.IndexFieldNames;
end;

function TfrxSDACTable.GetTableName: String;
begin
  Result := FTable.TableName;
end;

procedure TfrxSDACTable.SetIndexFieldNames(const Value: String);
begin
  FTable.IndexFieldNames := Value;
end;

procedure TfrxSDACTable.SetTableName(const Value: String);
begin
  FTable.TableName := Value;
end;

procedure TfrxSDACTable.SetMaster(const Value: TDataSource);
begin
  FTable.MasterSource := Value;
end;

procedure TfrxSDACTable.SetMasterFields(const Value: String);
var
  MasterNames: string;
  DetailNames: string;
begin
  GetMasterDetailNames(MasterFields, MasterNames, DetailNames);
  FTable.MasterFields := MasterNames;
  FTable.DetailFields := DetailNames;
end;

function TfrxSDACTable.GetOrderFields: string;
begin
  Result := FTable.OrderFields; 
end;

procedure TfrxSDACTable.SetOrderFields(Value: string);
begin
  FTable.OrderFields := Value;
end;

{ TfrxSDACQuery }

constructor TfrxSDACQuery.Create(AOwner: TComponent);
begin
  FQuery := TSDACQuery.Create(nil);
  Dataset := FQuery;
  SetDatabase(nil);
  inherited;
  FImageIndex := 39;
end;

class function TfrxSDACQuery.GetDescription: String;
begin
  Result := 'SDAC Query';
end;

procedure TfrxSDACQuery.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FConnection) then
    SetDatabase(nil);
end;

procedure TfrxSDACQuery.SetDatabase(const Value: TfrxSDACDatabase);
begin
  FConnection := Value;
  if Value <> nil then
    FQuery.Connection := Value.Connection
  else if SDACComponents <> nil then
    FQuery.Connection := SDACComponents.DefaultDatabase
  else
    FQuery.Connection := nil;
end;

procedure TfrxSDACQuery.SetIndexFieldNames(const Value: String);
begin
  FQuery.IndexFieldNames := Value;
end;

function TfrxSDACQuery.GetIndexFieldNames: string;
begin
  Result := FQuery.IndexFieldNames;
end;

function TfrxSDACQuery.GetSQL: TStrings;
begin
  Result := FQuery.SQL;
end;

procedure TfrxSDACQuery.SetSQL(Value: TStrings);
begin
  FQuery.SQL := Value;
end;

procedure TfrxSDACQuery.SetMaster(const Value: TDataSource);
begin
  FQuery.MasterSource := Value;
end;

procedure TfrxSDACQuery.SetMasterFields(const Value: String);
var
  MasterNames: string;
  DetailNames: string;
begin
  GetMasterDetailNames(MasterFields, MasterNames, DetailNames);
  FQuery.MasterFields := MasterNames;
  FQuery.DetailFields := DetailNames;
end;

procedure TfrxSDACQuery.UpdateParams;
begin
  frxParamsToTParams(Self, FQuery.Params);
end;


var
  CatBmp: TBitmap;

initialization
  CatBmp :=TBitmap.Create;
  CatBmp.LoadFromResourceName(HInstance, 'FRXSDACOBJECTS');

  frxObjects.RegisterCategory('SDAC', CatBmp, 'SDAC Components');
  frxObjects.RegisterObject1(TfrxSDACDataBase, nil, '', 'SDAC', 0, 37);
  frxObjects.RegisterObject1(TfrxSDACTable, nil, '', 'SDAC', 0, 38);
  frxObjects.RegisterObject1(TfrxSDACQuery, nil, '', 'SDAC', 0, 39);

finalization
  CatBmp.Free;
  frxObjects.UnRegister(TfrxSDACDataBase);
  frxObjects.UnRegister(TfrxSDACTable);
  frxObjects.UnRegister(TfrxSDACQuery);
end.