paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-18 07:29:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Refactored report designer, so the report design file can be loaded using report data manager class without visual components. Default support for CSV, DBF, JSON, SQLDB

Browse Source 
git-svn-id: trunk@57522 -
This commit is contained in:
michael 2018-03-17 16:46:36 +00:00
parent 9e2c7686af
commit b075f5ee87
12 changed files with 134 additions and 1360 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1663,7 +1663,6 @@ components/fpreport/design/reportdesign.lpi svneol=native#text/plain
components/fpreport/design/reportdesign.lpr svneol=native#text/plain
components/fpreport/design/reportdesign.res -text
components/fpreport/design/reportdesignbaseforms.pp svneol=native#text/plain
components/fpreport/design/reportdesigndatasql.pp svneol=native#text/plain
components/fpreport/design/testimage.png -text svneol=unset#image/png
components/fpreport/dlginputcombo.pp svneol=native#text/plain
components/fpreport/fpreportformexport.pas svneol=native#text/plain

362
components/fpreport/design/fpreportdesignreportdata.pp
View File

@ -20,10 +20,10 @@ unit fpreportdesignreportdata;
interface
uses
Classes, SysUtils, db, forms, fpjson, fpreport;
Classes, SysUtils, db, forms, fpjson, fpreport, fpreportData;
Type
EDesignReportData = Class(Exception);
EDesignReportData = Class(EReportDataError);
{ TDesignReportDataHandler }
@ -36,93 +36,20 @@ Type
Function SaveNotOKMessage : String; virtual;
end;
TDesignReportDataHandler = Class(TObject)
Protected
Class Function TypeList : TStrings;
Public
Class Procedure RegisterHandler;
Class Procedure UnRegisterHandler;
Class Function GetRegisteredTypes(AList : Tstrings) : Integer;
Class Function GetTypeHandler(aTypeName : String) : TDesignReportDataHandler;
// Override this to return a dataset which is owned by AOwner, and configured by AConfig.
// The dataset must not be opened.
Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; virtual; abstract;
// Override this to return a frame which can be used to configure the dataset.
Function CreateConfigFrame(AOwner : TComponent) : TReportDataConfigFrame; virtual; abstract;
// Check if the configuration is valid. Return a string that describes the error(s)
// If the return is an empty string, the data designer will not close.
Class Function CheckConfig(AConfig : TJSONObject) : String; virtual;
Class Function DataType : String; virtual; abstract;
Class Function DataTypeDescription : String; virtual;
end;
TDesignReportDataHandlerClass = Class of TDesignReportDataHandler;
{ TDesignReportDataManager }
{ TDesignReportData }
TDesignReportData = Class(TCollectionItem)
TDesignReportDataManager = class(TFPCustomReportDataManager)
private
FConfig: TJSONObject;
FDataType: String;
FName: String;
procedure SetConfig(AValue: TJSONObject);
procedure SetName(AValue: String);
Public
Constructor Create(ACollection: TCollection); override;
Destructor Destroy; override;
Procedure Assign(Source : TPersistent); override;
Procedure SaveToJSON(O : TJSONObject); virtual;
procedure LoadFromJSON(O: TJSONObject); virtual;
// Clone this
Function Clone(aNewName : String) : TDesignReportData;
// Create a dataset.
Function CreateDataSet(AOwner : TComponent) : TDataset;
// Create a configuration frame for this data.
Function CreateConfigFrame(AOwner : TComponent) : TReportDataConfigFrame;
// Check if the configuration is OK.
Function Check : String;
Published
property Name : String Read FName Write SetName;
Property DataType : String Read FDataType Write FDataType;
Property Config : TJSONObject Read FConfig Write SetConfig;
class function HasDesignTypeHandler(aTypeName: String) : Boolean;
class function CreateConfigFrame(aTypeName: String; AOwner: TComponent): TReportDataConfigFrame;
Property DataDefinitions;
end;
{ TDesignReportDataCollection }
TDesignReportDataCollection = Class(TCollection)
private
function GetD(Aindex : Integer): TDesignReportData;
procedure SetD(Aindex : Integer; AValue: TDesignReportData);
Public
Function IndexOfName(const aName : String): Integer;
Function FindDataByName(const aName : String): TDesignReportData;
Function AddData(const aName : String) : TDesignReportData;
Procedure SaveToJSON(O : TJSONObject);
Procedure LoadFromJSON(O : TJSONObject);
Property Data [Aindex : Integer] : TDesignReportData Read GetD Write SetD; default;
end;
implementation
{ TDesignReportDataHandler }
Resourcestring
SErrDuplicateData = 'Duplicate data set name: "%s"';
SErrInvalidDataName = 'Invalid data set name: "%s"';
SErrNeedName = 'Data set needs a name';
SErrNeedDataType = 'Data set needs a type';
SErrInvalidDataType = 'Invalid data type: "%s"';
Var
FTypesList : TStrings;
Type
{ THDef }
THDef = Class(TObject)
TheClass : TDesignReportDataHandlerClass;
Constructor Create(aClass : TDesignReportDataHandlerClass);
end;
SErrNotDesignData = 'The handler for data type %s is registered, but cannot handle visual configuration';
{ TReportDataConfigFrame }
@ -131,284 +58,31 @@ begin
Result:='';
end;
{ THDef }
constructor THDef.Create(aClass: TDesignReportDataHandlerClass);
begin
TheClass:=AClass;
end;
{ TDesignReportDataCollection }
function TDesignReportDataCollection.GetD(Aindex : Integer): TDesignReportData;
begin
Result:=Items[Aindex] as TDesignReportData;
end;
procedure TDesignReportDataCollection.SetD(Aindex : Integer; AValue: TDesignReportData);
begin
Items[Aindex]:=AValue;
end;
function TDesignReportDataCollection.IndexOfName(const aName: String): Integer;
begin
Result:=Count-1;
While (Result>=0) and (CompareText(AName,GetD(Result).Name)<>0) do
Dec(Result);
end;
function TDesignReportDataCollection.FindDataByName(const aName: String): TDesignReportData;
var
I : Integer;
begin
I:=indexOfname(aName);
if I=-1 then
Result:=Nil
else
Result:=GetD(I);
end;
function TDesignReportDataCollection.AddData(const aName: String): TDesignReportData;
begin
if (IndexOfName(aName)<>-1) then
raise EReportError.CreateFmt(SErrDuplicateData, [aName]);
Result:=add as TDesignReportData;
Result.Name:=aName;
end;
procedure TDesignReportDataCollection.SaveToJSON(O: TJSONObject);
class function TDesignReportDataManager.HasDesignTypeHandler(aTypeName: String): Boolean;
Var
A : TJSONArray;
DS : TJSONObject;
I : Integer;
C: TComponentClass;
begin
A:=TJSONArray.Create;
O.Add('datasets',a);
For I:=0 to Count-1 do
begin
DS:=TJSONObject.Create;
A.Add(DS);
Data[i].SaveToJSON(DS);
end;
C:=GetConfigFrameClass(aTypeName);
Result:=C.InheritsFrom(TReportDataConfigFrame);
end;
procedure TDesignReportDataCollection.LoadFromJSON(O: TJSONObject);
Var
A : TJSONArray;
DS : TDesignReportData;
I : Integer;
begin
Clear;
A:=O.Get('datasets',TJSONArray(Nil));
if Assigned(A) then
For I:=0 to A.Count-1 do
if A.Types[i]=jtObject then
begin
DS:=Add as TDesignReportData;
DS.LoadFromJSON(A.Objects[i]);
end;
end;
Class function TDesignReportDataHandler.TypeList: TStrings;
Class function TDesignReportDataManager.CreateConfigFrame(aTypeName : String; AOwner: TComponent): TReportDataConfigFrame;
Var
SL : TStringList;
C: TComponentClass;
begin
If (FTypesList=nil) then
begin
SL:=TStringList.Create;
SL.Sorted:=True;
SL.Duplicates:=dupError;
SL.OwnsObjects:=True;
FTypesList:=SL;
end;
Result:=FTypesList;
C:=GetConfigFrameClass(aTypeName);
if not C.InheritsFrom(TReportDataConfigFrame) then
Raise EDesignReportData.CreateFmt(SErrNotDesignData,[aTypeName]);
Result:=TReportDataConfigFrame(C.Create(aOwner));
end;
class procedure TDesignReportDataHandler.RegisterHandler;
begin
TypeList.AddObject(Self.DataType, THDef.Create(Self));
end;
class procedure TDesignReportDataHandler.UnRegisterHandler;
Var
I : integer;
begin
I:=TypeList.IndexOf(Self.DataType);
if I<>-1 then
TypeList.Delete(I);
end;
class function TDesignReportDataHandler.GetRegisteredTypes(AList: Tstrings): Integer;
begin
// Don't use assign or addstrings, it will copy the THRefs too, possibly leading to errors
AList.Text:=TypeList.Text;
Result:=AList.Count;
end;
class function TDesignReportDataHandler.GetTypeHandler(aTypeName: String): TDesignReportDataHandler;
Var
I : Integer;
H : THDef;
begin
I:=TypeList.IndexOf(ATypeName);
if (I=-1) then
Raise EDesignReportData.CreateFmt('Unknown report data type: %s',[aTypeName]);
H:=THDef(TypeList.Objects[i]);
Result:=H.TheClass.Create;
end;
class function TDesignReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
begin
Result:='';
end;
class function TDesignReportDataHandler.DataTypeDescription: String;
begin
Result:=DataType
end;
{ TDesignReportData }
procedure TDesignReportData.SetConfig(AValue: TJSONObject);
begin
if FConfig=AValue then Exit;
FreeAndNil(FConfig);
FConfig:=AValue.Clone as TJSONObject;
end;
procedure TDesignReportData.SetName(AValue: String);
begin
if FName=AValue then Exit;
{$IF FPC_FULLVERSION < 30002}
if Not IsValidIdent(aValue) then
{$ELSE}
if Not IsValidIdent(aValue,True,true) then
{$ENDIF}
raise EReportError.CreateFmt(SErrInvalidDataName, [aValue]);
if (Collection is TFPReportVariables) then
If ((Collection as TFPReportVariables).FindVariable(AValue)<>Nil) then
raise EReportError.CreateFmt(SErrDuplicateData, [aValue]);
FName:=AValue;
end;
procedure TDesignReportData.Assign(Source: TPersistent);
Var
D : TDesignReportData;
begin
if (Source is TDesignReportData) then
begin
D:=Source as TDesignReportData;
Config:=D.Config;
Name:=D.Name;
DataType:=D.DataType;
end
else
inherited Assign(Source);
end;
procedure TDesignReportData.SaveToJSON(O: TJSONObject);
begin
O.Add('name',Name);
O.Add('type',DataType);
O.Add('config',Config.Clone);
end;
procedure TDesignReportData.LoadFromJSON(O: TJSONObject);
Var
C : TJSONObject;
begin
Name:=O.Get('name',Name);
DataType:=O.Get('type',DataType);
C:=O.Get('config',TJSONObject(Nil));
if Assigned(C) then
Config:=C;
end;
function TDesignReportData.Clone(aNewName: String): TDesignReportData;
begin
Result:=Collection.Add as TDesignReportData;
Result.Assign(Self);
Result.Name:=aNewName;
end;
function TDesignReportData.CreateDataSet(AOwner: TComponent): TDataset;
Var
H : TDesignReportDataHandler;
begin
H:=TDesignReportDataHandler.GetTypeHandler(DataType);
try
Result:=H.CreateDataset(AOwner,Config);
finally
H.Free;
end;
end;
function TDesignReportData.CreateConfigFrame(AOwner: TComponent): TReportDataConfigFrame;
Var
H : TDesignReportDataHandler;
begin
H:=TDesignReportDataHandler.GetTypeHandler(DataType);
try
Result:=H.CreateConfigFrame(AOwner);
finally
H.Free;
end;
end;
function TDesignReportData.Check: String;
Var
H : TDesignReportDataHandler;
begin
If (Name='') then
Result:=SErrNeedName
else if (DataType='') then
Result:=SErrNeedDataType
else
begin
H:=TDesignReportDataHandler.GetTypeHandler(DataType);
if H=Nil then
Result:=Format(SErrInvalidDataType,[DataType])
else
Result:=H.CheckConfig(Config);
end;
end;
constructor TDesignReportData.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
FConfig:=TJSONObject.Create;
end;
destructor TDesignReportData.Destroy;
begin
FreeAndNil(FConfig);
inherited Destroy;
end;
Finalization
FreeAndNil(FTypesList)
end.

113
components/fpreport/design/frafpreportcsvdata.pp
View File

@ -19,7 +19,7 @@ unit frafpreportcsvdata;
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, EditBtn, StdCtrls, fpjson, db, fpreportdesignreportdata;
Classes, SysUtils, FileUtil, Forms, Controls, EditBtn, StdCtrls, fpjson, db, fpreportdata, fpreportdesignreportdata;
type
TFrame = TReportDataConfigFrame;
@ -45,124 +45,17 @@ type
Function SaveNotOKMessage: String; override;
end;
{ TCSVReportDataHandler }
TCSVReportDataHandler = Class(TDesignReportDataHandler)
Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
Function CreateConfigFrame(AOwner : TComponent) : TReportDataConfigFrame; override;
Class Function CheckConfig(AConfig: TJSONObject): String; override;
Class Function DataType : String; override;
Class Function DataTypeDescription : String; override;
end;
implementation
uses bufdataset, csvdataset;
uses fpreportdatacsv;
{$R *.lfm}
Resourcestring
SErrNeedFileName = 'Need a CSV file name';
SErrNeedFieldNames = 'Need at least one field name';
SErrInvalidFieldName = 'Invalid field name: "%s"';
SFileNameDoesNotExist = 'Filename does not exist: "%s"';
{ TCSVReportDataHandler }
Const
keyFileName = 'filename';
keyFirstLineHasFieldNames = 'firstLineHasFieldNames';
keyCustomFieldNames = 'customFieldNames';
keyDelimiter = 'delimiter';
keyQuoteChar = 'quoteChar';
DefFirstLineFieldNames = True;
DefDelimiter = ',';
DefQuoteChar = '"';
Type
{ TMyCSVDataset }
TMyCSVDataset = Class(TCSVDataset)
private
FCSVFileName: String;
Protected
function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader; override;
Procedure InternalOpen; override;
Public
Property CSVFileName : String Read FCSVFileName Write FCSVFileName;
end;
{ TMyCSVDataset }
function TMyCSVDataset.GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader;
begin
Result:=inherited GetPacketReader(Format, AStream);
if (Result is TCSVDataPacketReader) and (FieldDefs.Count>0) then
TCSVDataPacketReader(Result).CreateFieldDefs:=FieldDefs;
end;
procedure TMyCSVDataset.InternalOpen;
begin
FileName:=CSVFileName;
Inherited;
FileName:='';
end;
function TCSVReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
Var
C : TMyCSVDataset;
A : TJSONArray;
I : Integer;
begin
C:=TMyCSVDataset.Create(AOWner);
C.CSVOptions.FirstLineAsFieldNames:=AConfig.Get(keyFirstLineHasFieldNames,DefFirstLineFieldNames);
C.CSVOptions.Delimiter:=AConfig.Get(KeyDelimiter,defDelimiter)[1];
C.CSVOptions.quoteChar:=AConfig.Get(KeyQuoteChar,defQuoteChar)[1];
if not C.CSVOptions.FirstLineAsFieldNames then
begin
A:=AConfig.Get(keyCustomFieldNames,TJSONArray(Nil));
If Assigned(A) then
For I:=0 to A.Count-1 do
C.FieldDefs.Add(A.Strings[i],ftString,255);
end;
C.ReadOnly:=True;
C.CSVFileName:=AConfig.Get(KeyFileName,'');
Result:=C;
end;
function TCSVReportDataHandler.CreateConfigFrame(AOwner: TComponent): TReportDataConfigFrame;
begin
Result:=TTCSVReportDataFrame.Create(AOWner);
end;
class function TCSVReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
Var
FN : UTF8String;
begin
Result:='';
FN:=AConfig.Get(KeyFileName,'');
if FN='' then
Result:=SErrNeedFileName
else if not FileExists(FN) then
Result:=Format(SFileNameDoesNotExist,[FN]);
end;
class function TCSVReportDataHandler.DataType: String;
begin
Result:='CSV'
end;
class function TCSVReportDataHandler.DataTypeDescription: String;
begin
Result:='Comma-separated values text file';
end;
{ TTCSVReportDataFrame }
@ -244,6 +137,6 @@ begin
end;
initialization
TCSVReportDataHandler.RegisterHandler;
TCSVReportDataHandler.RegisterConfigClass(TTCSVReportDataFrame);
end.

61
components/fpreport/design/frafpreportdbfdata.pp
View File

@ -38,26 +38,16 @@ type
{ TDBFReportDataHandler }
TDBFReportDataHandler = Class(TDesignReportDataHandler)
Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
Function CreateConfigFrame(AOwner : TComponent) : TReportDataConfigFrame; override;
Class Function CheckConfig(AConfig: TJSONObject): String; override;
Class Function DataType : String; override;
Class Function DataTypeDescription : String; override;
end;
implementation
uses fpreportdatadbf;
{$R *.lfm}
Resourcestring
SErrNeedFileName = 'Need a DBF file name';
SFileNameDoesNotExist = 'Filename does not exist: "%s"';
{ TDBFReportDataFrame }
Const
keyFileName = 'filename';
procedure TDBFReportDataFrame.GetConfig(aConfig: TJSONObject);
begin
aConfig.Strings[keyFileName]:=FEData.FileName;
@ -77,50 +67,7 @@ begin
Result:=Format(SFileNameDoesNotExist,[FEData.FileName]);
end;
{ TMyDBFDataset }
function TDBFReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
Var
C : TDBF;
begin
C:=TDBF.Create(AOWner);
C.TableName:=AConfig.Get(KeyFileName,'');
C.ReadOnly:=True;
Result:=C;
end;
function TDBFReportDataHandler.CreateConfigFrame(AOwner: TComponent): TReportDataConfigFrame;
begin
Result:=TDBFReportDataFrame.Create(AOWner);
end;
class function TDBFReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
Var
FN : UTF8String;
begin
Result:='';
FN:=AConfig.Get(KeyFileName,'');
if FN='' then
Result:=SErrNeedFileName
else if not FileExists(FN) then
Result:=Format(SFileNameDoesNotExist,[FN]);
end;
class function TDBFReportDataHandler.DataType: String;
begin
Result:='DBF'
end;
class function TDBFReportDataHandler.DataTypeDescription: String;
begin
Result:='DBase data file';
end;
initialization
TDBFReportDataHandler.RegisterHandler;
TDBFReportDataHandler.RegisterConfigClass(TDBFReportDataFrame);
end.

446
components/fpreport/design/frafpreportjsondata.pp
View File

@ -56,239 +56,12 @@ type
{ TJSONReportDataHandler }
TJSONReportDataHandler = Class(TDesignReportDataHandler)
Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
Function CreateConfigFrame(AOwner : TComponent) : TReportDataConfigFrame; override;
Class Function CheckConfig(AConfig: TJSONObject): String; override;
Class Function DataType : String; override;
Class Function DataTypeDescription : String; override;
Class Function GetDataFromFile(aFileName : String) : TJSONData;
Class Function GetDataFromURL(aURL : String) : TJSONData;
end;
Type
TDataForm = (dfObject,dfArray);
{ TMyJSONDataset }
TMyJSONDataset = class(TBaseJSONDataSet)
private
FDataForm: TDataForm;
FDataPath: String;
FFileNAme: String;
FMaxStringFieldSize: Integer;
FURL: String;
FJSON : TJSONData;
Public
Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override;
procedure InternalClose; override;
Procedure InternalOpen; override;
Procedure MetaDataToFieldDefs; override;
Function CreateFieldMapper : TJSONFieldMapper; override;
property DataForm : TDataForm Read FDataForm Write FDataForm;
Property MetaData;
Property FileName : String Read FFileNAme Write FFileName;
Property URL : String Read FURL Write FURL;
Property DataPath : String Read FDataPath Write FDataPath;
Property MaxStringFieldSize : Integer Read FMaxStringFieldSize Write FMaxStringFieldSize;
end;
Type
TRecordDesc = Record
name : string;
fieldtype : TFieldType;
end;
TRecordDescArray = Array of TRecordDesc;
Function DetectJSONStruct(J : TJSONData; StartPath : String; Out APath : String; Out Records : TRecordDescArray; Out ArrayBased : Boolean) : Boolean;
Function TryStringToFieldType(S : String; out Ft : TFieldType; Strict : Boolean) : Boolean;
implementation
uses typinfo,jsonparser,uriparser, fphttpclient;
uses fpreportdatajson;
{$R *.lfm}
Resourcestring
SErrNeedFileNameOrURL = 'Need a file name or URL';
SErrNeedFileName = 'Need a file name';
SErrNeedURL = 'Need a URL';
SErrNeedFields = 'No fields have been defined';
SErrFileNameDoesNotExist = 'Filename does not exist: "%s"';
SErrInvalidProtocol = 'URL has invalid protocol: "%s". Only http and https are supported';
SErrNotArrayData = 'Data at "%s" does not exist or is not an array.';
SErrNoDataFound = 'JSON data was found, but no valid data structure was detected.';
SErrUnsupportedJSONFieldType = 'Unsupported JSON field type: "%s"';
SErrEmptyFieldsNotAllowed = 'Empty fields are not allowed (field: %d)';
{ TDBFReportDataFrame }
Const
keyFileName = 'filename';
keyMetaData = 'meta';
keyURL = 'url';
keyDataForm = 'dataform';
keyDataPath = 'path';
keyFields = 'fields';
keyFieldType = 'type';
keyFieldName = 'name';
Function FieldTypeToString(Ft : TFieldType; Strict : Boolean) : String;
begin
Case FT of
ftstring : Result:='string';
ftBoolean : Result:='boolean';
ftInteger : Result:='integer';
ftLargeint : Result:='largeint';
ftFloat : Result:='float';
else
if Strict then
Raise EDatabaseError.CreateFmt(SErrUnsupportedJSONFieldType,[GetEnumName(TypeInfo(TFieldType),Ord(FT))]);
result:='string';
end;
end;
Function TryStringToFieldType(S : String; out Ft : TFieldType; Strict : Boolean) : Boolean;
begin
Result:=True;
Case lowercase(s) of
'string' : ft:=ftstring;
'boolean': ft:=ftBoolean;
'integer': ft:=ftInteger;
'bigint' : ft:=ftLargeint;
'largeint' : ft:=ftLargeint ;
'float' : ft:=ftFloat;
else
if Strict then
Result:=False
else
ft:=ftString;
end;
end;
Function DetectJSONStruct(J : TJSONData; StartPath : String; Out APath : String; Out Records : TRecordDescArray; Out ArrayBased : Boolean) : Boolean;
Var
A : TJSONArray;
D : TJSONData;
O : TJSONObject;
I,C : Integer;
begin
J:=J.FindPath(StartPath);
A:=Nil;
if J is TJSONArray then
begin
APath:=StartPath;
A:=J as TJSONArray;
end
else
begin
If J is TJSONObject then
begin
O:=J as TJSONObject;
I:=0;
While (A=Nil) and (I<J.Count) do
begin
If J.Items[i].JSONType=jtArray then
begin
A:= J.Items[i] as TJSONArray;
APath:=O.Names[I];
If StartPath<>'' then
APath:=StartPath+'.'+APath;
end;;
Inc(I);
end;
end;
end;
Result:=Assigned(A) and (A.Count>0) and (A.Items[0].JSONType in [jtArray,jtObject]);
if Result then
begin
D:=A.items[0];
if D is TJSONObject then
O:=D as TJSONObject
else
O:=Nil;
ArrayBased:=O=Nil;
SetLength(Records,D.Count);
C:=0;
for I:=0 to D.Count-1 do
begin
Records[C].FieldType:=ftUnknown;
Case D.Items[C].JSONType of
jtString : Records[C].FieldType:=ftString;
jtNumber :
Case TJSONNumber(D.Items[C]).NumberType of
ntFloat: Records[C].fieldtype:=ftFloat;
ntInteger: Records[C].fieldtype:=ftInteger;
else
Records[C].fieldtype:=ftLargeInt;
end;
jtBoolean : Records[C].fieldtype:=ftBoolean;
jtNull : Records[C].fieldtype:=ftString;
end;
if (Records[C].FieldType<>ftUnknown) then
begin
if Assigned(O) then
Records[C].Name:=O.Names[i]
else
Records[C].Name:='Column'+IntToStr(I);
Inc(C);
end;
end;
SetLength(Records,C);
end
else If J is TJSONObject then
begin
// Check members one by one
O:=J as TJSONObject;
I:=0;
While Not result and (I<J.Count) do
begin
If J.Items[i].JSONType=jtObject then
begin
Result:=DetectJSONStruct(J,O.Names[I],APath,Records,ArrayBased);
end;
Inc(I);
end;
end;
end;
Type
TMyJSONObjectFieldMapper = Class(TJSONFieldMapper)
procedure SetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row,Data : TJSONData); override;
Function GetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row : TJSONData) : TJSONData; override;
Function CreateRow : TJSONData; override;
end;
procedure TMyJSONObjectFieldMapper.SetJSONDataForField(const FieldName: String;
FieldIndex: Integer; Row, Data: TJSONData);
begin
Raise Exception.Create('Read-only data!');
end;
function TMyJSONObjectFieldMapper.GetJSONDataForField(const FieldName: String;
FieldIndex: Integer; Row: TJSONData): TJSONData;
Var
I : integer;
begin
I:=(Row as TJSONObject).IndexOfName(FieldName);
if I=-1 then
Result:=Nil
else
Result:=Row.Items[i];
end;
function TMyJSONObjectFieldMapper.CreateRow: TJSONData;
begin
Result:=TJSONObject.Create;
end;
{ TJSONReportDataConfigFrame }
@ -464,222 +237,7 @@ begin
end;
end;
{ TMyJSONDataset }
constructor TMyJSONDataset.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
MaxStringFieldSize:=1024;
OwnsData:=False;
end;
destructor TMyJSONDataset.Destroy;
begin
FreeAndNil(FJSON);
// We own metadata
Metadata.Free;
inherited Destroy;
end;
procedure TMyJSONDataset.InternalClose;
begin
Inherited;
FreeAndNil(FJSON);
end;
procedure TMyJSONDataset.InternalOpen;
Var
R : TJSONData;
begin
FreeAndNil(FJSON);
if (URL<>'') then
FJSON:=TJSONReportDataHandler.GetDataFromURL(URL)
else
FJSON:=TJSONReportDataHandler.GetDataFromFile(FileName);
R:=FJSON.FindPath(DataPath);
if not (R is TJSONArray) then
Raise EDatabaseError.CreateFmt(SErrNotArrayData,[DataPath]);
Rows:=R as TJSONArray;
inherited InternalOpen;
end;
procedure TMyJSONDataset.MetaDataToFieldDefs;
Var
F : TJSONarray;
I : Integer;
O : TJSONObject;
Ft : TFieldType;
begin
FieldDefs.Clear;
F:=Metadata.get(keyFields,TJSONArray(Nil));
if not Assigned(F) then
exit;
For I:=0 to F.Count-1 do
begin
O:=F.Objects[i];
if TryStringToFieldType(O.strings[keyFieldType],ft,false) then
if ft=ftString then
FieldDefs.Add(O.strings[keyFieldName],FT,MaxStringFieldSize,False)
else
FieldDefs.Add(O.strings[keyFieldName],FT);
end;
end;
function TMyJSONDataset.CreateFieldMapper: TJSONFieldMapper;
begin
if DataForm = dfObject then
begin
Result:=TMyJSONObjectFieldMapper.Create;
end
else
begin
Result:=TJSONArrayFieldMapper.Create;
end
end;
function TJSONReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
Var
C : TMyJSONDataset;
O : TJSONObject;
begin
// Writeln('Starting dataset',aConfig.FormatJSON());
C:=TMyJSONDataset.Create(AOWner);
C.FileName:=AConfig.get(keyFileName,'');
C.URL:=AConfig.get(keyURL,'');
O:=AConfig.get(keyMetaData,TJSONObject(Nil));
if Assigned(O) then
C.MetaData:=O.Clone as TJSONObject
else
Raise EDatabaseError.Create('No metadata');
if AConfig.get(keyDataForm,'object')='object' then
C.DataForm:=dfObject
else
C.DataForm:=dfArray;
C.DataPath:=AConfig.get(keyDataPath,'');;
Result:=C;
end;
function TJSONReportDataHandler.CreateConfigFrame(AOwner: TComponent): TReportDataConfigFrame;
begin
Result:=TJSONReportDataConfigFrame.Create(AOWner);
end;
class function TJSONReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
Var
FN,URL : UTF8String;
URI : TURI;
O : TJSONObject;
A : TJSONArray;
I : Integer;
Ft : TFieldType;
V : String;
begin
Result:='';
FN:=AConfig.Get(KeyFileName,'');
if (FN='') then
begin
URL:=AConfig.Get(KeyURL,'');
URI:=parseuri(URL,'http',80,True);
case lowercase(uri.Protocol) of
'https' : ;
'http' : ;
'' : ;
else
Result:=Format(SErrInvalidProtocol,[URI.Protocol]);
end
end
else if FN='' then
Result:=SErrNeedFileNameOrURL
else if not FileExists(FN) then
Result:=Format(SErrFileNameDoesNotExist,[FN])
else
begin
O:=aConfig.get(keyMetaData,TJSONObject(Nil));
if not Assigned(O) then
Result:=SErrNeedFields
else
begin
A:=O.get(keyFields,TJSONArray(Nil));
if (A=Nil) or (A.Count=0) then
Result:=SErrNeedFields
else
begin
I:=0;
While (Result='') and (I<A.Count) do
begin
if A.Types[i]=jtObject then
begin
O:=A.Objects[i];
if (O.Get(KeyfieldName,'')='') then
Result:=Format(SErrEmptyFieldsNotAllowed,[I+1])
else
begin
V:=O.Get(KeyFieldType,'');
if not TryStringToFieldType(V,ft,True) then
Result:=Format(SErrUnsupportedJSONFieldType,[V]);
end;
end;
Inc(I);
end;
end;
end;
end;
end;
class function TJSONReportDataHandler.DataType: String;
begin
Result:='JSON'
end;
class function TJSONReportDataHandler.DataTypeDescription: String;
begin
Result:='JSON data';
end;
class function TJSONReportDataHandler.GetDataFromFile(aFileName: String): TJSONData;
Var
F : TFileStream;
begin
F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
try
Result:=GetJSON(F);
finally
F.Free;
end;
end;
class function TJSONReportDataHandler.GetDataFromURL(aURL: String): TJSONData;
Var
S : TStringStream;
URI : TURI;
begin
S:=TStringStream.Create('');
try
URI:=ParseURI(aURL,False);
if (URI.protocol='') then
URI.protocol:='http';
TFPHTTPClient.SimpleGet(EncodeURI(URI),S);
S.Position:=0;
Result:=getJSON(S);
finally
S.Free;
end;
end;
initialization
TJSONReportDataHandler.RegisterHandler;
TJSONReportDataHandler.RegisterConfigClass(TJSONReportDataConfigFrame);
end.

116
components/fpreport/design/frafpreportsqldbdata.pp
View File

@ -14,39 +14,12 @@
**********************************************************************}
unit frafpreportsqldbdata;
{$mode objfpc}{$H+}
{$DEFINE HASIBCONNECTION}
{$DEFINE HASMYSQL50CONNECTION}
{$DEFINE HASMYSQL55CONNECTION}
{$DEFINE HASMYSQL4CONNECTION}
{$DEFINE HASPQCONNECTION}
{$DEFINE HASSQLITE3CONNECTION}
{$IF (FPC_FULLVERSION>30302) or not defined(win64)}
{$DEFINE HASORACLECONNECTION}
{$ENDIF}
{$IF FPC_FULLVERSION >= 20601}
// MS SQL Server and Sybase ASE connectors were introduced in the FPC 2.7 development branch,
// and backported to 2.6.1. Operating systems should match FPC packages\fcl-db\fpmake.pp
{$IF DEFINED(BEOS) OR DEFINED(HAIKU) OR DEFINED(LINUX) OR DEFINED(FREEBSD) OR DEFINED (NETBSD) OR DEFINED(OPENBSD) OR DEFINED(WIN32) OR DEFINED(WIN64)}
{$DEFINE HASMSSQLCONNECTION}
{$DEFINE HASSYBASECONNECTION}
{$ENDIF}
{$ENDIF}
{$IF FPC_FULLVERSION >= 20603}
{$DEFINE HASMYSQL56CONNECTION}
{$ENDIF}
{$IF FPC_FULLVERSION >= 20701}
{$DEFINE HASMYSQL57CONNECTION}
{$ENDIF}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, EditBtn, StdCtrls, Buttons, ActnList, SynEdit, SynHighlighterSQL,
fpreportdesignreportdata, fpjson, db, sqldb, reportdesigndatasql, dialogs;
fpreportdesignreportdata, fpjson, db, sqldb, fpreportdatasqldb, dialogs;
type
TFrame = TReportDataConfigFrame;
@ -80,59 +53,12 @@ type
{ TSQLDBReportDataHandler }
TSQLDBReportDataHandler = Class(TDesignReportDataHandler)
Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
Function CreateConfigFrame(AOwner : TComponent) : TReportDataConfigFrame; override;
Class Function CheckConfig(AConfig: TJSONObject): String; override;
Class Function DataType : String; override;
Class Function DataTypeDescription : String; override;
end;
implementation
uses
{$IFDEF HASIBCONNECTION}
ibconnection,
{$ENDIF}
{$IFDEF HASMSSQLCONNECTION}
// mssqlconn provide both MS SQL Server and Sybase ASE connectors.
mssqlconn,
{$ENDIF}
odbcconn,
{$IFDEF HASPQCONNECTION}
pqconnection,
{$IFDEF HASPQEVENT}
pqteventmonitor,
{$ENDIF}
{$ENDIF}
{$IFDEF HASORACLECONNECTION}
oracleconnection,
{$ENDIF}
{$IFDEF HASMYSQL4CONNECTION}
mysql40conn, mysql41conn,
{$ENDIF}
{$IFDEF HASMYSQL50CONNECTION}
mysql50conn,
mysql51conn,
{$ENDIF}
{$IFDEF HASMYSQL55CONNECTION}
mysql55conn,
{$ENDIF}
{$IFDEF HASMYSQL56CONNECTION}
mysql56conn,
{$ENDIF}
{$IFDEF HASMYSQL57CONNECTION}
mysql57conn,
{$ENDIF}
{$IFDEF HASSQLITE3CONNECTION}
sqlite3conn,
{$ENDIF}
frmfpreportdataconnectioneditor;
uses frmfpreportdataconnectioneditor;
resourcestring
SErrNoConnectionData = 'No connection data available';
SErrNoSQL = 'No SQL statement set';
{$R *.lfm}
@ -158,7 +84,6 @@ begin
end;
end;
procedure TSQLReportDataConfigFrame.ATestExecute(Sender: TObject);
Var
@ -216,42 +141,7 @@ begin
Result:=TFPReportConnector.TestConnection(FConnectionData);
end;
{ TSQLDBReportDataHandler }
function TSQLDBReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
begin
Result:=TFPReportConnector.CreateDataset(aOwner,aConfig);
end;
function TSQLDBReportDataHandler.CreateConfigFrame(AOwner: TComponent): TReportDataConfigFrame;
begin
Result:=TSQLReportDataConfigFrame.Create(AOwner);
end;
class function TSQLDBReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
Var
O : TJSONObject;
begin
O:=aConfig.Get(keyConnection,TJSONObject(Nil));
if (O=Nil) or (O.Count=0) then
Result:=SErrNoConnectionData
else if Trim(aConfig.Get(keySQL,''))='' then
Result:=SErrNoSQL
end;
class function TSQLDBReportDataHandler.DataType: String;
begin
Result:='SQLDB';
end;
class function TSQLDBReportDataHandler.DataTypeDescription: String;
begin
Result:='SQL Database server';
end;
initialization
TSQLDBReportDataHandler.RegisterHandler;
TSQLDBReportDataHandler.RegisterConfigClass(TSQLReportDataConfigFrame);
end.

31
components/fpreport/design/frmconfigreportdata.pp
View File

@ -19,8 +19,9 @@ unit frmconfigreportdata;
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ButtonPanel, ActnList, ComCtrls, ExtCtrls,
EditBtn, fpreportdesignreportdata, fpjson, reportdesignbaseforms;
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
ButtonPanel, ActnList, ComCtrls, ExtCtrls, EditBtn,
fpreportdata, fpreportdesignreportdata, fpjson, reportdesignbaseforms;
type
TForm = TBaseReportDataForm;
@ -60,13 +61,13 @@ type
procedure FormDestroy(Sender: TObject);
procedure LBReportDataSelectionChange(Sender: TObject; User: boolean);
private
FCurrentHandler : TDesignReportDataHandler;
FCurrentData : TDesignReportData;
FCurrentHandler : TFPReportDataHandler;
FCurrentData : TFPReportDataDefinitionItem;
FCurrentFrame : TReportDataConfigFrame;
Protected
procedure NewItem(CloneFrom: TDesignReportData); virtual;
procedure NewItem(CloneFrom: TFPReportDataDefinitionItem); virtual;
function SaveCurrentItem: Boolean; virtual;
procedure SetData(AValue: TDesignReportDataCollection); override;
procedure SetData(AValue: TFPReportDataDefinitions); override;
procedure ShowData; virtual;
procedure ShowDataFrame; virtual;
procedure ShowSelectedItem;virtual;
@ -89,7 +90,7 @@ Resourcestring
procedure TReportDataConfigForm.FormCreate(Sender: TObject);
begin
TDesignReportDataHandler.GetRegisteredTypes(CBType.Items);
TDesignReportDataManager.GetRegisteredTypes(CBType.Items);
ShowSelectedItem;
end;
@ -105,8 +106,8 @@ begin
FreeAndNil(FCurrentFrame);
if CBType.ItemIndex=-1 then
exit;
FCurrentHandler:=TDesignReportDataHandler.GetTypeHandler(CBType.Text);
FCurrentFrame:=FCurrentHandler.CreateConfigFrame(Self);
FCurrentHandler:=TDesignReportDataManager.GetTypeHandler(CBType.Text);
FCurrentFrame:=TDesignReportDataManager.CreateConfigFrame(FCurrentHandler.DataType,Self);
FCurrentFrame.Parent:=PData;
FCurrentFrame.Align:=alClient;
if Assigned(FCurrentData) then
@ -152,12 +153,12 @@ begin
NewItem(Nil);
end;
procedure TReportDataConfigForm.NewItem(CloneFrom : TDesignReportData);
procedure TReportDataConfigForm.NewItem(CloneFrom : TFPReportDataDefinitionItem);
Var
DOK,VOK : Boolean;
N : String;
D : TDesignReportData;
D : TFPReportDataDefinitionItem;
I : Integer;
begin
@ -283,14 +284,14 @@ end;
procedure TReportDataConfigForm.LBReportDataSelectionChange(Sender: TObject; User: boolean);
Var
D : TDesignReportData;
D : TFPReportDataDefinitionItem;
begin
SaveCurrentItem;
if LBReportData.ItemIndex=-1 then
D:=Nil
else
D:=(LBReportData.Items.Objects[LBReportData.ItemIndex] as TDesignReportData);
D:=(LBReportData.Items.Objects[LBReportData.ItemIndex] as TFPReportDataDefinitionItem);
if D<>FCurrentData then
begin
FCurrentData:=D;
@ -298,7 +299,7 @@ begin
end;
end;
procedure TReportDataConfigForm.SetData(AValue: TDesignReportDataCollection);
procedure TReportDataConfigForm.SetData(AValue: TFPReportDataDefinitions);
begin
if Data=AValue then Exit;
Inherited;
@ -370,7 +371,7 @@ procedure TReportDataConfigForm.ShowData;
Var
I : Integer;
S : TDesignReportData;
S : TFPReportDataDefinitionItem;
begin
LBReportData.Items.Clear;

2
components/fpreport/design/frmfpreportdataconnectioneditor.pp
View File

@ -68,7 +68,7 @@ Resourcestring
implementation
uses strutils, reportdesigndatasql;
uses strutils, fpreportdatasqldb;
{$R *.lfm}

47
components/fpreport/design/frmfpreportdesignermain.pp
View File

@ -19,9 +19,9 @@ unit frmfpreportdesignermain;
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, fpreportdata,
Menus, ActnList, ComCtrls, ExtCtrls, IniPropStorage, fpreport, fpreportdesignctrl,
fraReportObjectInspector, fpreportdesignreportdata, frafpreportdata, fpreportdb, mrumanager;
fraReportObjectInspector, fpreportdesignreportdata, frafpreportdata, mrumanager;
type
// If you add something here, do not forget to add to AllReportDesignOptions.
@ -281,7 +281,7 @@ type
FOnNewReport: TNotifyEvent;
FOnOpenReport: TNotifyEvent;
FOnSaveReport: TNotifyEvent;
FReportDesignData : TDesignReportDataCollection;
FReportDesignData : TDesignReportDataManager;
{$IFDEF USEDEMOREPORT}
lReportData : TFPReportUserData;
sl: TStringList;
@ -342,7 +342,7 @@ type
procedure DoElementCreated(Sender: TObject; AElement: TFPReportElement);
Property Report : TFPReport Read FReport Write SetReport;
Property FileName : String Read FFileName Write FFileName;
Property ReportDesignData : TDesignReportDataCollection Read FReportDesignData;
Property ReportDesignData : TDesignReportDataManager Read FReportDesignData;
Property DesignOptions : TFPReportDesignOptions Read FDesignOptions Write SetDesignOptions;
// If these are set, they override the default handling. You must set the modified
Property OnSaveReport : TNotifyEvent Read FOnSaveReport Write FOnSaveReport;
@ -449,7 +449,7 @@ begin
CloseFile(F);
FDataParent:=TComponent.Create(nil);
FreeAndNil(TSDesign); // Remove design-time added page
FReportDesignData:=TDesignReportDataCollection.Create(TDesignReportData);
FReportDesignData:=TDesignReportDataManager.Create(Self);
SetBandActionTags;
// DEMO
{$IFDEF USEDEMOREPORT}
@ -1115,10 +1115,10 @@ begin
F:=ReportDataFormClass.Create(Self);
try
F.Report:=Self.Report;
F.Data:=FReportDesignData;
F.Data:=FReportDesignData.DataDefinitions;
if F.ShowModal=mrOK then
begin
FReportDesignData.Assign(F.Data);
FReportDesignData.DataDefinitions:=F.Data;
CreateReportDataSets(Nil);
Modified:=True;
end;
@ -1134,36 +1134,9 @@ end;
procedure TFPReportDesignerForm.CreateReportDataSets(Errors: TStrings);
Var
I : Integer;
DesignD : TDesignReportData;
DatasetD : TFPReportDatasetData;
L : TFPList;
begin
FReport.SaveDataToNames;
While FDataParent.ComponentCount>0 do
FDataParent.Components[FDataParent.ComponentCount-1].Free;
FReport.ReportData.Clear;
For I:=0 to FReportDesignData.Count-1 do
begin
DesignD:=FReportDesignData[i];
DatasetD:=TFPReportDatasetData.Create(FDataParent);
DatasetD.Dataset:=DesignD.CreateDataSet(DatasetD);
Try
DatasetD.InitFieldDefs;
except
On E : Exception do
If Assigned(Errors) then
Errors.Add(Format('Error opening data "%s" : Exception %s with message %s',[DesignD.Name,E.ClassName,E.Message]))
else
Raise;
end;
DatasetD.Name:=DesignD.Name;
DatasetD.Dataset.Name:=DesignD.Name;
DatasetD.StartDesigning; // set designing flag, or OI will not show reference to it.
FReport.ReportData.AddReportData(DatasetD);
end;
FReportDesignData.ApplyToReport(FReport,Errors);
FReport.RestoreDataFromNames;
FReportData.RefreshData;
end;
@ -1409,7 +1382,7 @@ begin
// Give LCL time to clean up.
Application.ProcessMessages;
FReportData.Report:=Nil;
FReportDesignData.Clear;
FReportDesignData.DataDefinitions.Clear;
FOI.Report:=Nil;
FOI.SelectControls(Nil);
end;
@ -1474,7 +1447,7 @@ begin
try
DD:=lJSON.Get('DesignData',TJSONObject(Nil));
if Assigned(DD) then
FReportDesignData.LoadFromJSON(DD);
FReportDesignData.DataDefinitions.LoadFromJSON(DD);
// We must do this before the report is loaded, so the pages/bands can find their data
Errs:=TStringList.Create;
CreateReportDataSets(Errs);

71
components/fpreport/design/reportdesign.lpr
View File

@ -2,10 +2,77 @@ program reportdesign;
{$mode objfpc}{$H+}
// Connections to be included
{$DEFINE HASIBCONNECTION}
{$DEFINE HASMYSQL50CONNECTION}
{$DEFINE HASMYSQL55CONNECTION}
{$DEFINE HASMYSQL4CONNECTION}
{$DEFINE HASPQCONNECTION}
{$DEFINE HASSQLITE3CONNECTION}
{$IF (FPC_FULLVERSION>30302) or not defined(win64)}
{$DEFINE HASORACLECONNECTION}
{$ENDIF}
{$IF FPC_FULLVERSION >= 20601}
// MS SQL Server and Sybase ASE connectors were introduced in the FPC 2.7 development branch,
// and backported to 2.6.1. Operating systems should match FPC packages\fcl-db\fpmake.pp
{$IF DEFINED(BEOS) OR DEFINED(HAIKU) OR DEFINED(LINUX) OR DEFINED(FREEBSD) OR DEFINED (NETBSD) OR DEFINED(OPENBSD) OR DEFINED(WIN32) OR DEFINED(WIN64)}
{$DEFINE HASMSSQLCONNECTION}
{$DEFINE HASSYBASECONNECTION}
{$ENDIF}
{$ENDIF}
{$IF FPC_FULLVERSION >= 20603}
{$DEFINE HASMYSQL56CONNECTION}
{$ENDIF}
{$IF FPC_FULLVERSION >= 20701}
{$DEFINE HASMYSQL57CONNECTION}
{$ENDIF}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
{$IFDEF HASIBCONNECTION}
ibconnection,
{$ENDIF}
{$IFDEF HASMSSQLCONNECTION}
// mssqlconn provide both MS SQL Server and Sybase ASE connectors.
mssqlconn,
{$ENDIF}
odbcconn,
{$IFDEF HASPQCONNECTION}
pqconnection,
{$IFDEF HASPQEVENT}
pqteventmonitor,
{$ENDIF}
{$ENDIF}
{$IFDEF HASORACLECONNECTION}
oracleconnection,
{$ENDIF}
{$IFDEF HASMYSQL4CONNECTION}
mysql40conn, mysql41conn,
{$ENDIF}
{$IFDEF HASMYSQL50CONNECTION}
mysql50conn,
mysql51conn,
{$ENDIF}
{$IFDEF HASMYSQL55CONNECTION}
mysql55conn,
{$ENDIF}
{$IFDEF HASMYSQL56CONNECTION}
mysql56conn,
{$ENDIF}
{$IFDEF HASMYSQL57CONNECTION}
mysql57conn,
{$ENDIF}
{$IFDEF HASSQLITE3CONNECTION}
sqlite3conn,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms,
runtimetypeinfocontrols,
@ -13,7 +80,9 @@ uses
// These configure various designer factories
regfpdesigner,
frmfpreportdesignermain,
// Various report data
fpreportdatadbf,
fpreportdatasqldb,
fpreportdatajson,
frafpreportcsvdata,
frafpreportdbfdata,
frafpreportjsondata,

13
components/fpreport/design/reportdesignbaseforms.pp
View File

@ -20,7 +20,8 @@ unit reportdesignbaseforms;
interface
uses
Classes, SysUtils, fpreport, forms, db, fpreportdesignobjectlist, fpreportdesignreportdata;
Classes, SysUtils, fpreport, forms, db, fpreportdesignobjectlist,
fpreportdata, fpreportdesignreportdata;
Type
{ TReportEditorForm }
@ -72,13 +73,13 @@ Type
TBaseReportDataForm = Class(TBaseReportEditorForm)
private
FData: TDesignReportDataCollection;
FData: TFPReportDataDefinitions;
Protected
procedure SetData(AValue: TDesignReportDataCollection); virtual;
procedure SetData(AValue: TFPReportDataDefinitions); virtual;
public
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
Property Data : TDesignReportDataCollection Read FData Write SetData;
Property Data : TFPReportDataDefinitions Read FData Write SetData;
end;
TBaseReportDataFormClass = Class of TBaseReportDataForm;
@ -153,7 +154,7 @@ end;
{ TReportDataForm }
procedure TBaseReportDataForm.SetData(AValue: TDesignReportDataCollection);
procedure TBaseReportDataForm.SetData(AValue: TFPReportDataDefinitions);
begin
if FData=AValue then Exit;
FData.Assign(AValue);
@ -162,7 +163,7 @@ end;
constructor TBaseReportDataForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FData:=TDesignReportDataCollection.Create(TDesignReportData);
FData:=TFPReportDataDefinitions.Create(TFPReportDataDefinitionItem);
end;
destructor TBaseReportDataForm.Destroy;

231
components/fpreport/design/reportdesigndatasql.pp
View File

@ -1,231 +0,0 @@
{
This file is part of the Free Component Library.
Copyright (c) 2017 Michael Van Canneyt, member of the Free Pascal development team
Report Designer Data connector for SQLDB based data.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit reportdesigndatasql;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, strutils, sqldb, db, fpjson;
Const
keyConnection = 'connection';
keySQL = 'sql';
keyType = 'dbtype';
keyHostName = 'host';
keyDatabaseName = 'database';
keyUserName = 'user';
keyPassword = 'pwd';
keyRole = 'role';
keyParams = 'params';
KeyCharSet = 'charset';
keyHash = 'FPCRulez';
Resourcestring
SErrNoConnectionData = 'No connection data available';
Type
{ TFPReportConnector }
TFPReportConnector = Class(TSQLConnector)
Private
FRefCount: Integer;
Class procedure init;
class procedure done;
Class var
FPool : TStringList;
Public
Procedure LoadFromConfig(aConfig : TJSONObject);
class function CreateConnection(aConfig: TJSONObject): TFPReportConnector;
Class Function TestConnection (aConfig : TJSONObject) : string;
class function CreateDataset(aOwner: TComponent; aConfig: TJSONObject): TSQLQuery;
class function CreateConfigHash(aConfig: TJSONObject): String;
Class procedure CheckDBRelease;
Property RefCount : Integer Read FRefCount;
end;
{ TFPReportQuery }
TFPReportQuery = class(TSQLQuery)
Public
Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override;
end;
implementation
{ TFPReportQuery }
constructor TFPReportQuery.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ReadOnly:=True;
end;
destructor TFPReportQuery.Destroy;
begin
If Database is TFPReportConnector then
Dec(TFPReportConnector(Database).FRefCount);
inherited Destroy;
TFPReportConnector.CheckDBRelease;
end;
{ TFPReportConnector }
class procedure TFPReportConnector.init;
begin
FPool:=TStringList.Create;
FPool.OwnsObjects:=True;
FPool.Sorted:=True;
FPool.Duplicates:=dupError;
end;
class procedure TFPReportConnector.done;
begin
FreeAndNil(FPool);
end;
Class Function TFPReportConnector.CreateConfigHash(aConfig : TJSONObject) : String;
Procedure AH(N,V : String);
begin
if (V<>'') then
Result:=Result+';'+N+'='+V;
end;
Procedure AH(N : String);
begin
AH(N,aConfig.get(N,''));
end;
Var
A : TJSONArray;
I : Integer;
begin
AH(keyType);
AH(keyHostName);
AH(keyDatabaseName);
AH(keyUserName);
AH(keyPassword);
AH(keyRole);
A:=aConfig.get(keyParams,TJSONArray(Nil));
If Assigned(A) then
For I:=0 to A.Count-1 do
AH(IntToStr(I),A.Strings[i]);
end;
class procedure TFPReportConnector.CheckDBRelease;
Var
I : Integer;
begin
For I:=FPool.Count-1 downto 0 do
begin
Writeln('Connection count for ',FPool[i], ' : ',TFPReportConnector(FPool.Objects[i]).FRefCount);
if TFPReportConnector(FPool.Objects[i]).FRefCount=0 then
FPool.Delete(I);
end;
end;
procedure TFPReportConnector.LoadFromConfig(aConfig: TJSONObject);
Var
S : String;
A : TJSONArray;
I : Integer;
begin
ConnectorType:=aConfig.get(keyType,'');
HostName:=aConfig.get(keyHostName,'');
DatabaseName:=aConfig.get(keyDatabaseName,'');
UserName:=aConfig.get(keyUserName,'');
S:=aConfig.get(keyPassword,'');
if (S<>'') then
Password:=XORDecode(keyHash,S);
Role:=aConfig.get(keyRole,'');
Params.Clear;
A:=aConfig.get(keyParams,TJSONArray(Nil));
If Assigned(A) then
For I:=0 to A.Count-1 do
Params.Add(A.Strings[i]);
end;
class function TFPReportConnector.CreateConnection(aConfig: TJSONObject): TFPReportConnector;
begin
Result:=Self.Create(Nil);
Result.LoadFromConfig(aConfig);
Result.Transaction:=TSQLtransaction.Create(Result);
end;
class function TFPReportConnector.TestConnection(aConfig: TJSONObject): string;
Var
C : TFPReportConnector;
begin
Result:='';
C:=CreateConnection(aConfig);
try
C.Connected:=True;
except
On E : Exception do
Result:=E.Message;
end;
C.free;
end;
class function TFPReportConnector.CreateDataset(aOwner: TComponent; aConfig: TJSONObject): TSQLQuery;
Var
S : String;
C : TFPReportConnector;
I : integer;
O : TJSONObject;
begin
O:=aConfig.Get(keyConnection,TJSONObject(Nil));
if O=Nil then
Raise EDatabaseError.Create(SErrNoConnectionData);
S:=CreateConfigHash(o);
i:=FPool.IndexOf(S);
if (I<>-1) then
C:=FPool.Objects[i] as TFPReportConnector
else
begin
C:=CreateConnection(o);
FPool.AddObject(S,C);
end;
Result:=TFPReportQuery.Create(aOwner);
Result.Database:=C;
Result.SQL.Text:=aConfig.get(keySQL,'');
Inc(C.FRefCount);
end;
initialization
TFPReportConnector.Init;
Finalization
TFPReportConnector.Done;
end.