📄 frxxxxcomponents.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 + -