⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frxxxxcomponents.pas

📁 控件下载 控件下载 控件下载 控件下载 控件下载
💻 PAS
字号:

{******************************************}
{                                          }
{             FastReport v3.0              }
{         XXX enduser components           }
{                                          }

// Copyright
{                                          }
{******************************************}

unit frxXXXComponents;

interface

{$I frx.inc}

uses
  Windows, Classes, frxClass, frxCustomDB, DB, UXXX
{$IFDEF Delphi6}
, Variants
{$ENDIF};


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

  TfrxXXXDatabase = class(TfrxDialogComponent)
  private
    FDatabase: TXXXDatabase;
    procedure SetConnected(Value: Boolean);
    procedure SetDatabaseName(const Value: String);
    procedure SetLoginPrompt(Value: Boolean);
    procedure SetParams(Value: TStrings);
    function GetConnected: Boolean;
    function GetDatabaseName: String;
    function GetLoginPrompt: Boolean;
    function GetParams: TStrings;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function GetDescription: String; override;
    property Database: TXXXDatabase read FDatabase;
  published
    property DatabaseName: String read GetDatabaseName write SetDatabaseName;
    property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt default True;
    property Params: TStrings read GetParams write SetParams;
    property Connected: Boolean read GetConnected write SetConnected default False;
  end;

  TfrxXXXTable = class(TfrxCustomDataset)
  private
    FDatabase: TfrxXXXDatabase;
    FTable: TXXXTable;
    procedure SetIndexName(const Value: String);
    function GetIndexName: String;
    function GetTableName: String;
    procedure SetTableName(const Value: String);
    procedure SetDatabase(const Value: TfrxXXXDatabase);
  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: TXXXTable read FTable;
  published
    property Database: TfrxXXXDatabase read FDatabase write SetDatabase;
    property IndexName: String read GetIndexName write SetIndexName;
    property MasterFields;
    property TableName: String read GetTableName write SetTableName;
  end;

  TfrxXXXQuery = class(TfrxCustomQuery)
  private
    FDatabase: TfrxXXXDatabase;
    FQuery: TXXXQuery;
    procedure SetDatabase(const Value: TfrxXXXDatabase);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); 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: TXXXQuery read FQuery;
  published
    property Database: TfrxXXXDatabase read FDatabase write SetDatabase;
  end;

var
  XXXComponents: TfrxXXXComponents;


implementation

{$R *.res}

uses 
  frxXXXRTTI, 
{$IFNDEF NO_EDITORS}
  frxXXXEditor, 
{$ENDIF}
  frxDsgnIntf, frxRes;


{ TfrxXXXComponents }

constructor TfrxXXXComponents.Create(AOwner: TComponent);
begin
  inherited;
  FOldComponents := XXXComponents;
  XXXComponents := Self;
end;

destructor TfrxXXXComponents.Destroy;
begin
  if XXXComponents = Self then
    XXXComponents := FOldComponents;
  inherited;
end;

function TfrxXXXComponents.GetDescription: String;
begin
  Result := 'XXX';
end;


{ TfrxXXXDatabase }

constructor TfrxXXXDatabase.Create(AOwner: TComponent);
begin
  inherited;
  FDatabase := TXXXDatabase.Create(nil);
  Component := FDatabase;
  FImageIndex := 37;
end;

destructor TfrxXXXDatabase.Destroy;
begin
  inherited;
end;

class function TfrxXXXDatabase.GetDescription: String;
begin
  Result := 'XXX Database';
end;

function TfrxXXXDatabase.GetConnected: Boolean;
begin
  Result := FDatabase.Connected;
end;

function TfrxXXXDatabase.GetDatabaseName: String;
begin
  Result := FDatabase.DatabaseName;
end;

function TfrxXXXDatabase.GetLoginPrompt: Boolean;
begin
  Result := FDatabase.LoginPrompt;
end;

function TfrxXXXDatabase.GetParams: TStrings;
begin
  Result := FDatabase.Params;
end;

procedure TfrxXXXDatabase.SetConnected(Value: Boolean);
begin
  FDatabase.Connected := Value;
end;

procedure TfrxXXXDatabase.SetDatabaseName(const Value: String);
begin
  FDatabase.DatabaseName := Value;
end;

procedure TfrxXXXDatabase.SetLoginPrompt(Value: Boolean);
begin
  FDatabase.LoginPrompt := Value;
end;

procedure TfrxXXXDatabase.SetParams(Value: TStrings);
begin
  FDatabase.Params := Value;
end;


{ TfrxXXXTable }

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

class function TfrxXXXTable.GetDescription: String;
begin
  Result := 'XXX Table';
end;

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

procedure TfrxXXXTable.SetDatabase(const Value: TfrxXXXDatabase);
begin
  FDatabase := Value;
  if Value <> nil then
    FTable.Database := Value.Database
  else if XXXComponents <> nil then
    FTable.Database := XXXComponents.DefaultDatabase
  else
    FTable.Database := nil;
end;

function TfrxXXXTable.GetIndexName: String;
begin
  Result := FTable.IndexName;
end;

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

procedure TfrxXXXTable.SetIndexName(const Value: String);
begin
  FTable.IndexName := Value;
end;

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

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

procedure TfrxXXXTable.SetMasterFields(const Value: String);
begin
  FTable.MasterFields := Value;
end;

procedure TfrxXXXTable.BeforeStartReport;
begin
  SetDatabase(FDatabase);
end;


{ TfrxXXXQuery }

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

class function TfrxXXXQuery.GetDescription: String;
begin
  Result := 'XXX Query';
end;

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

procedure TfrxXXXQuery.SetDatabase(const Value: TfrxXXXDatabase);
begin
  FDatabase := Value;
  if Value <> nil then
    FQuery.Database := Value.Database
  else if XXXComponents <> nil then
    FQuery.Database := XXXComponents.DefaultDatabase
  else
    FQuery.Database := nil;
end;

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

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

procedure TfrxXXXQuery.SetMaster(const Value: TDataSource);
begin
  FQuery.DataSource := Value;
end;

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

procedure TfrxXXXQuery.BeforeStartReport;
begin
  SetDatabase(FDatabase);
end;



var
  CatBmp: TBitmap;

initialization
  CatBmp := TBitmap.Create;
  CatBmp.LoadFromResourceName(hInstance, 'frxXXX');
  frxObjects.RegisterCategory('XXX', CatBmp, 'XXX Components');
  frxObjects.RegisterObject1(TfrxXXXDataBase, nil, '', 'XXX', 0, 37);
  frxObjects.RegisterObject1(TfrxXXXTable, nil, '', 'XXX', 0, 38);
  frxObjects.RegisterObject1(TfrxXXXQuery, nil, '', 'XXX', 0, 39);

finalization
  CatBmp.Free;
  frxObjects.UnRegister(TfrxXXXDataBase);
  frxObjects.UnRegister(TfrxXXXTable);
  frxObjects.UnRegister(TfrxXXXQuery);


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -