unit amaFrxSQLiteComponents;
interface
{$I frx.inc}
uses Classes, SysUtils, frxClass,
DB, frxCustomDB, ASGSQLite3;
type
TfrxamaSQLiteComponents =
class(TfrxDBComponents)
private
FDefaultDatabase: TASQLite3DB;
FOldComponents: TfrxamaSQLiteComponents;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
function GetDescription:
String;
override;
published
property DefaultDatabase: TASQLite3DB
read FDefaultDatabase
write FDefaultDatabase;
end;
TfrxamaSQLiteDataBase =
class(TfrxCustomDatabase)
private
FDatabase: TASQLite3DB;
protected
procedure SetConnected(Value: Boolean);
override;
procedure SetDatabaseName(
const Value:
String);
override;
function GetConnected: Boolean;
override;
function GetDatabaseName:
String;
override;
function GetDefaultDir:
String;
procedure SetDefaultDir(
const Value:
String);
function GetDriverDLL:
String;
procedure SetDriverDLL(
const Value:
String);
function GetVersion:
String;
procedure SetVersion(
const Value:
String);
public
constructor Create(AOwner: TComponent);
override;
class function GetDescription:
String;
override;
property Database: TASQLite3DB
read FDatabase;
published
property DatabaseName:
String read GetDatabaseName
write SetDatabaseName;
property DatabaseDir :
String read GetDefaultDir
write SetDefaultDir;
property DriverDLL :
String read GetDriverDLL
write SetDriverDLL;
property Version :
String read GetVersion
write SetVersion;
property Connected;
end;
TfrxamaSQLiteQuery =
class(TfrxCustomQuery)
private
FDatabase: TfrxamaSQLiteDataBase;
amaActive : Boolean;
FQuery: TASQLite3Query;
procedure SetDatabase(Value: TfrxamaSQLiteDataBase);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
procedure SetMasterFields(Value:
String);
procedure SetMaster(
const Value: TDataSource);
override;
procedure SetSQL(Value: TStrings);
override;
function GetSQL: TStrings;
override;
function GetActive: Boolean;
procedure SetActive(
const Value: Boolean);
procedure SetMasterDetailFields(
const Value:
String);
function GetMasterDetailFields:
String;
procedure SetAutoCalcFields(
const Value: Boolean);
function GetAutoCalcFields:Boolean;
procedure SetAutoCommit(
const Value: Boolean);
function GetAutoCommit:Boolean;
procedure SetMaxResults(
const Value: Integer);
function GetMaxResults:Integer;
procedure SetRawSQL(
const Value: Boolean);
function GetRawSQL:Boolean;
procedure SetReadOnly(
const Value: Boolean);
function GetReadOnly:Boolean;
procedure SetSQLCursor(
const Value: Boolean);
function GetSQLCursor:Boolean;
procedure SetSQLiteDateFormat(
const Value: Boolean);
function GetSQLiteDateFormat:Boolean;
procedure SetStartResult(
const Value: Integer);
function GetStartResult:Integer;
procedure SetTableDateFormat(
const Value:
String);
function GetTableDateFormat:
String;
procedure SetUnidirectional(
const Value: Boolean);
function GetUnidirectional:Boolean;
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
class function GetDescription:
String;
override;
procedure BeforeStartReport;
override;
procedure UpdateParams;
override;
property Query: TASQLite3Query
read FQuery;
published
property Database: TfrxamaSQLiteDataBase
read FDatabase
write SetDatabase;
property Active : Boolean
read GetActive
write SetActive;
property AutoCalcFields : Boolean
read GetAutoCalcFields
write SetAutoCalcFields;
property AutoCommit : Boolean
read GetAutoCommit
write SetAutoCommit;
property MaxResults : Integer
read GetMaxResults
write SetMaxResults;
property RawSQL : Boolean
read GetRawSQL
write SetRawSQL;
property Read_Only : Boolean
read GetReadOnly
write SetReadOnly;
property SQLCursor : Boolean
read GetSQLCursor
write SetSQLCursor;
property SQLiteDateFormat : Boolean
read GetSQLiteDateFormat
write SetSQLiteDateFormat;
property StartResult : Integer
read GetStartResult
write SetStartResult;
property TableDateFormat :
String read GetTableDateFormat
write SetTableDateFormat;
property UniDirectional : Boolean
read GetUnidirectional
write SetUnidirectional;
end;
var
amaSQLiteComponents: TfrxamaSQLiteComponents;
implementation
{$R *.res}
uses
graphics,
frxDsgnIntf,
frxRes;
var
CatBmp: TBitmap;
{ TfrxamaSQLiteComponents }
constructor TfrxamaSQLiteComponents.Create(AOwner: TComponent);
begin
inherited;
FOldComponents := amaSQLiteComponents;
amaSQLiteComponents := Self;
end;
destructor TfrxamaSQLiteComponents.Destroy;
begin
if amaSQLiteComponents = Self
then
amaSQLiteComponents := FOldComponents;
inherited;
end;
function TfrxamaSQLiteComponents.GetDescription:
String;
begin
Result := '
amaSQLite';
end;
{ TfrxamaSQLiteDataBase }
constructor TfrxamaSQLiteDataBase.Create(AOwner: TComponent);
begin
inherited;
FDatabase := TASQLite3DB.Create(
nil);
Component := FDatabase;
end;
class function TfrxamaSQLiteDataBase.GetDescription:
String;
begin
Result := '
amaSQLite Database';
end;
function TfrxamaSQLiteDataBase.GetConnected: Boolean;
begin
Result := FDatabase.Connected;
end;
function TfrxamaSQLiteDataBase.GetDatabaseName:
String;
begin
Result := FDatabase.Database;
end;
procedure TfrxamaSQLiteDataBase.SetConnected(Value: Boolean);
begin
BeforeConnect(Value);
FDatabase.Connected := Value;
end;
procedure TfrxamaSQLiteDataBase.SetDatabaseName(
const Value:
String);
begin
FDatabase.Database := Value;
end;
function TfrxamaSQLiteDataBase.GetDefaultDir:
String;
begin
Result := FDatabase.DefaultDir;
end;
procedure TfrxamaSQLiteDataBase.SetDefaultDir(
const Value:
String);
begin
FDatabase.DefaultDir := Value;
end;
function TfrxamaSQLiteDataBase.GetDriverDLL:
String;
begin
Result := FDatabase.DriverDLL;
end;
procedure TfrxamaSQLiteDataBase.SetDriverDLL(
const Value:
String);
begin
FDatabase.DriverDLL := Value;
end;
function TfrxamaSQLiteDataBase.GetVersion:
String;
begin
Result := FDatabase.Version;
end;
procedure TfrxamaSQLiteDataBase.SetVersion(
const Value:
String);
begin
FDatabase.Version := Value;
end;
{ TfrxamaSQLiteQuery }
constructor TfrxamaSQLiteQuery.Create(AOwner: TComponent);
begin
FQuery := TASQLite3Query.Create(
nil);
Dataset := FQuery;
SetDatabase(
nil);
inherited;
end;
destructor TfrxamaSQLiteQuery.Destroy;
begin
// FStrings.Free;
inherited;
end;
class function TfrxamaSQLiteQuery.GetDescription:
String;
begin
Result := '
amaSQLiteQuery';
end;
procedure TfrxamaSQLiteQuery.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if (Operation = opRemove)
and (AComponent = FDatabase)
then
SetDatabase(
nil);
end;
procedure TfrxamaSQLiteQuery.SetMasterFields(Value:
String);
begin
FQuery.MasterFields := Value;
end;
function TfrxamaSQLiteQuery.GetSQL: TStrings;
begin
Result := FQuery.SQL;
end;
procedure TfrxamaSQLiteQuery.SetSQL(Value: TStrings);
begin
FQuery.SQL := Value;
end;
procedure TfrxamaSQLiteQuery.SetDatabase(Value: TfrxamaSQLiteDataBase);
begin
if not IsLoading
then
Active := False;
FDatabase := Value;
if Value <>
nil then
FQuery.Connection := Value.Database
else if amaSQLiteComponents <>
nil then
FQuery.Connection := amaSQLiteComponents.DefaultDatabase
else
FQuery.Connection :=
nil;
DBConnected := FQuery.Connection <>
nil;
if DBConnected
and IsLoading
then
FQuery.Active := amaActive;
end;
procedure TfrxamaSQLiteQuery.SetMaster(
const Value: TDataSource);
begin
FQuery.MasterSource := Value;
end;
procedure TfrxamaSQLiteQuery.UpdateParams;
begin
frxParamsToTParams(Self, FQuery.Params);
end;
procedure TfrxamaSQLiteQuery.BeforeStartReport;
begin
SetDatabase(FDatabase);
end;
function TfrxamaSQLiteQuery.GetActive: Boolean;
begin
Result := FQuery.Active;
end;
procedure TfrxamaSQLiteQuery.SetActive(
const Value: Boolean);
begin
if IsLoading
then
amaActive := Value
else
FQuery.Active := Value;
end;
procedure TfrxamaSQLiteQuery.SetMasterDetailFields(
const Value:
String);
begin
FQuery.MasterFields := Value;
end;
function TfrxamaSQLiteQuery.GetMasterDetailFields:
String;
begin
Result := FQuery.MasterFields;
end;
procedure TfrxamaSQLiteQuery.SetAutoCalcFields(
const Value: Boolean);
begin
FQuery.AutoCalcFields := Value;
end;
function TfrxamaSQLiteQuery.GetAutoCalcFields:Boolean;
begin
Result := FQuery.AutoCalcFields;
end;
procedure TfrxamaSQLiteQuery.SetAutoCommit(
const Value: Boolean);
begin
FQuery.AutoCommit := Value;
end;
function TfrxamaSQLiteQuery.GetAutoCommit:Boolean;
begin
Result := FQuery.AutoCommit;
end;
procedure TfrxamaSQLiteQuery.SetMaxResults(
const Value: Integer);
begin
FQuery.MaxResults := Value;
end;
function TfrxamaSQLiteQuery.GetMaxResults:Integer;
begin
Result := FQuery.MaxResults;
end;
procedure TfrxamaSQLiteQuery.SetRawSQL(
const Value: Boolean);
begin
FQuery.RawSQL := Value;
end;
function TfrxamaSQLiteQuery.GetRawSQL:Boolean;
begin
Result := FQuery.RawSQL;
end;
procedure TfrxamaSQLiteQuery.SetReadOnly(
const Value: Boolean);
begin
FQuery.
ReadOnly := Value;
end;
function TfrxamaSQLiteQuery.GetReadOnly:Boolean;
begin
Result := FQuery.
ReadOnly;
end;
procedure TfrxamaSQLiteQuery.SetSQLCursor(
const Value: Boolean);
begin
FQuery.SQLCursor := Value;
end;
function TfrxamaSQLiteQuery.GetSQLCursor:Boolean;
begin
Result := FQuery.SQLCursor;
end;
procedure TfrxamaSQLiteQuery.SetSQLiteDateFormat(
const Value: Boolean);
begin
FQuery.SQLiteDateFormat := Value;
end;
function TfrxamaSQLiteQuery.GetSQLiteDateFormat:Boolean;
begin
Result := FQuery.SQLiteDateFormat;
end;
procedure TfrxamaSQLiteQuery.SetStartResult(
const Value: Integer);
begin
FQuery.StartResult := Value;
end;
function TfrxamaSQLiteQuery.GetStartResult:Integer;
begin
Result := FQuery.StartResult;
end;
procedure TfrxamaSQLiteQuery.SetTableDateFormat(
const Value:
String);
begin
FQuery.TableDateFormat := Value;
end;
function TfrxamaSQLiteQuery.GetTableDateFormat:
String;
begin
Result := FQuery.TableDateFormat;
end;
procedure TfrxamaSQLiteQuery.SetUnidirectional(
const Value: Boolean);
begin
FQuery.UniDirectional := Value;
end;
function TfrxamaSQLiteQuery.GetUnidirectional:Boolean;
begin
Result := FQuery.UniDirectional;
end;
initialization
CatBmp := TBitmap.Create;
CatBmp.LoadFromResourceName(hInstance, '
TFRXAMASQLITECOMPONENTS');
frxObjects.RegisterCategory('
amaSQLite', CatBmp, '
amaSQLiteComponents');
frxObjects.RegisterObject1(TfrxamaSQLiteDataBase,
nil, '
', '
amaSQLite', 0);
frxObjects.RegisterObject1(TfrxamaSQLiteQuery,
nil, '
', '
amaSQLite', 0);
finalization
CatBmp.Free;
frxObjects.UnRegister(TfrxamaSQLiteDataBase);
frxObjects.UnRegister(TfrxamaSQLiteQuery);
end.