www.pudn.com > Fr3ReportDLL.rar > frxADOComponents.pas

 
{******************************************} 
{                                          } 
{             FastReport v3.0              } 
{         ADO enduser components           } 
{                                          } 
{         Copyright (c) 1998-2004          } 
{         by Alexander Tzyganenko,         } 
{            Fast Reports Inc.             } 
{                                          } 
{******************************************} 
 
unit frxADOComponents; 
 
interface 
 
{$I frx.inc} 
 
uses 
  Windows, Classes, SysUtils, frxClass, frxCustomDB, DB, ADODB, ADOInt 
{$IFDEF Delphi6} 
, Variants 
{$ENDIF}; 
 
 
type 
  TfrxADOComponents = class(TfrxDBComponents) 
  private 
    FDefaultDatabase: TADOConnection; 
    FOldComponents: TfrxADOComponents; 
  public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
    function GetDescription: String; override; 
  published 
    property DefaultDatabase: TADOConnection read FDefaultDatabase write FDefaultDatabase; 
  end; 
 
  TfrxADODatabase = class(TfrxDialogComponent) 
  private 
    FDatabase: TADOConnection; 
    procedure SetConnected(Value: Boolean); 
    procedure SetDatabaseName(const Value: String); 
    procedure SetLoginPrompt(Value: Boolean); 
    function GetConnected: Boolean; 
    function GetDatabaseName: String; 
    function GetLoginPrompt: Boolean; 
  public 
    constructor Create(AOwner: TComponent); override; 
    class function GetDescription: String; override; 
    property Database: TADOConnection read FDatabase; 
  published 
    property DatabaseName: String read GetDatabaseName write SetDatabaseName; 
    property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt default True; 
    property Connected: Boolean read GetConnected write SetConnected default False; 
  end; 
 
  TfrxADOTable = class(TfrxCustomDataset) 
  private 
    FDatabase: TfrxADODatabase; 
    FTable: TADOTable; 
    procedure SetDatabase(Value: TfrxADODatabase); 
    procedure SetIndexName(const Value: String); 
    procedure SetTableName(const Value: String); 
    function GetIndexName: String; 
    function GetTableName: 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; 
    procedure BeforeStartReport; override; 
    property Table: TADOTable read FTable; 
  published 
    property Database: TfrxADODatabase read FDatabase write SetDatabase; 
    property IndexName: String read GetIndexName write SetIndexName; 
    property MasterFields; 
    property TableName: String read GetTableName write SetTableName; 
  end; 
 
  TfrxADOQuery = class(TfrxCustomQuery) 
  private 
    FDatabase: TfrxADODatabase; 
    FQuery: TADOQuery; 
    procedure SetDatabase(Value: TfrxADODatabase); 
  protected 
    procedure Notification(AComponent: TComponent; Operation: TOperation); override; 
    procedure OnChangeSQL(Sender: TObject); override; 
    procedure SetMaster(const Value: TDataSource); override; 
    procedure SetSQL(Value: TStrings); override; 
    function GetSQL: TStrings; override; 
  public 
    constructor Create(AOwner: TComponent); override; 
    class function GetDescription: String; override; 
    procedure BeforeStartReport; override; 
    procedure UpdateParams; override; 
    property Query: TADOQuery read FQuery; 
  published 
    property Database: TfrxADODatabase read FDatabase write SetDatabase; 
  end; 
 
 
procedure frxParamsToTParameters(Query: TfrxCustomQuery; Params: TParameters); 
 
var 
  ADOComponents: TfrxADOComponents; 
 
   
implementation 
 
uses 
  frxADORTTI, 
{$IFNDEF NO_EDITORS} 
  frxADOEditor, 
{$ENDIF} 
  frxDsgnIntf, frxRes; 
 
 
{ frxParamsToTParameters } 
 
procedure frxParamsToTParameters(Query: TfrxCustomQuery; Params: TParameters); 
var 
  i: Integer; 
  Item: TfrxParamItem; 
begin 
  for i := 0 to Params.Count - 1 do 
    if Query.Params.IndexOf(Params[i].Name) <> -1 then 
    begin 
      Item := Query.Params[Query.Params.IndexOf(Params[i].Name)]; 
      Params[i].DataType := Item.DataType; 
      Params[i].Attributes := [paNullable]; 
      if Trim(Item.Expression) <> '' then 
        if not (Query.IsLoading or Query.IsDesigning) then 
        begin 
          Query.Report.CurObject := Query.Name; 
          Item.Value := Query.Report.Calc(Item.Expression); 
        end; 
      Params[i].Value := Item.Value; 
    end; 
end; 
 
 
{ TfrxDBComponents } 
 
constructor TfrxADOComponents.Create(AOwner: TComponent); 
begin 
  inherited; 
  FOldComponents := ADOComponents; 
  ADOComponents := Self; 
end; 
 
destructor TfrxADOComponents.Destroy; 
begin 
  if ADOComponents = Self then 
    ADOComponents := FOldComponents; 
  inherited; 
end; 
 
function TfrxADOComponents.GetDescription: String; 
begin 
  Result := 'ADO'; 
end; 
 
 
{ TfrxADODatabase } 
 
constructor TfrxADODatabase.Create(AOwner: TComponent); 
begin 
  inherited; 
  FDatabase := TADOConnection.Create(nil); 
  Component := FDatabase; 
  FImageIndex := 37; 
end; 
 
class function TfrxADODatabase.GetDescription: String; 
begin 
  Result := frxResources.Get('obADODB'); 
end; 
 
function TfrxADODatabase.GetConnected: Boolean; 
begin 
  Result := FDatabase.Connected; 
end; 
 
function TfrxADODatabase.GetDatabaseName: String; 
begin 
  Result := FDatabase.ConnectionString; 
end; 
 
function TfrxADODatabase.GetLoginPrompt: Boolean; 
begin 
  Result := FDatabase.LoginPrompt; 
end; 
 
procedure TfrxADODatabase.SetConnected(Value: Boolean); 
begin 
  FDatabase.Connected := Value; 
end; 
 
procedure TfrxADODatabase.SetDatabaseName(const Value: String); 
begin 
  FDatabase.ConnectionString := Value; 
end; 
 
procedure TfrxADODatabase.SetLoginPrompt(Value: Boolean); 
begin 
  FDatabase.LoginPrompt := Value; 
end; 
 
 
{ TfrxADOTable } 
 
constructor TfrxADOTable.Create(AOwner: TComponent); 
begin 
  FTable := TADOTable.Create(nil); 
  DataSet := FTable; 
  SetDatabase(nil); 
  inherited; 
  FImageIndex := 38; 
end; 
 
class function TfrxADOTable.GetDescription: String; 
begin 
  Result := frxResources.Get('obADOTb'); 
end; 
 
procedure TfrxADOTable.Notification(AComponent: TComponent; Operation: TOperation); 
begin 
  inherited; 
  if (Operation = opRemove) and (AComponent = FDatabase) then 
    SetDatabase(nil); 
end; 
 
procedure TfrxADOTable.SetDatabase(Value: TfrxADODatabase); 
begin 
  FDatabase := Value; 
  if Value <> nil then 
    FTable.Connection := Value.Database 
  else if ADOComponents <> nil then 
    FTable.Connection := ADOComponents.DefaultDatabase 
  else 
    FTable.Connection := nil; 
end; 
 
function TfrxADOTable.GetIndexName: String; 
begin 
  Result := FTable.IndexName; 
end; 
 
function TfrxADOTable.GetTableName: String; 
begin 
  Result := FTable.TableName; 
end; 
 
procedure TfrxADOTable.SetIndexName(const Value: String); 
begin 
  FTable.IndexName := Value; 
end; 
 
procedure TfrxADOTable.SetTableName(const Value: String); 
begin 
  FTable.TableName := Value; 
end; 
 
procedure TfrxADOTable.SetMaster(const Value: TDataSource); 
begin 
  FTable.MasterSource := Value; 
end; 
 
procedure TfrxADOTable.SetMasterFields(const Value: String); 
begin 
  FTable.MasterFields := Value; 
end; 
 
procedure TfrxADOTable.BeforeStartReport; 
begin 
  SetDatabase(FDatabase); 
end; 
 
 
{ TfrxADOQuery } 
 
constructor TfrxADOQuery.Create(AOwner: TComponent); 
begin 
  FQuery := TADOQuery.Create(nil); 
  Dataset := FQuery; 
  SetDatabase(nil); 
  inherited; 
  FImageIndex := 39; 
end; 
 
class function TfrxADOQuery.GetDescription: String; 
begin 
  Result := frxResources.Get('obADOQ'); 
end; 
 
procedure TfrxADOQuery.Notification(AComponent: TComponent; Operation: TOperation); 
begin 
  inherited; 
  if (Operation = opRemove) and (AComponent = FDatabase) then 
    SetDatabase(nil); 
end; 
 
function TfrxADOQuery.GetSQL: TStrings; 
begin 
  Result := FQuery.SQL; 
end; 
 
procedure TfrxADOQuery.SetSQL(Value: TStrings); 
begin 
  FQuery.SQL := Value; 
end; 
 
procedure TfrxADOQuery.SetDatabase(Value: TfrxADODatabase); 
begin 
  FDatabase := Value; 
  if Value <> nil then 
    FQuery.Connection := Value.Database 
  else if ADOComponents <> nil then 
    FQuery.Connection := ADOComponents.DefaultDatabase 
  else 
    FQuery.Connection := nil; 
end; 
 
procedure TfrxADOQuery.SetMaster(const Value: TDataSource); 
begin 
  FQuery.DataSource := Value; 
end; 
 
procedure TfrxADOQuery.UpdateParams; 
begin 
  frxParamsToTParameters(Self, FQuery.Parameters); 
end; 
 
procedure TfrxADOQuery.OnChangeSQL(Sender: TObject); 
begin 
  FQuery.Parameters.ParseSQL(FQuery.SQL.Text, True); 
  inherited; 
end; 
 
procedure TfrxADOQuery.BeforeStartReport; 
begin 
  SetDatabase(FDatabase); 
end; 
 
 
initialization 
  frxObjects.RegisterCategory('ADO', nil, 'obADOComps', 35); 
  frxObjects.RegisterObject1(TfrxADODataBase, nil, '', 'ADO', 0, 37); 
  frxObjects.RegisterObject1(TfrxADOTable, nil, '', 'ADO', 0, 38); 
  frxObjects.RegisterObject1(TfrxADOQuery, nil, '', 'ADO', 0, 39); 
 
 
 
end.