paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 22:14:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Second grouping demo, showing fieldkind for user data loop and simple aggregates

Browse Source 
git-svn-id: trunk@37664 -
This commit is contained in:
michael 2017-12-03 10:24:34 +00:00
parent cec9667eb3
commit f0ad28ae4a
1 changed files with 27 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
packages/fcl-report/src/fpreport.pp
View File

@ -231,6 +231,7 @@ type
TFPReportBeginReportEvent = procedure of object; TFPReportBeginReportEvent = procedure of object;
TFPReportEndReportEvent = procedure of object; TFPReportEndReportEvent = procedure of object;
TFPReportGetValueNamesEvent = procedure(Sender: TObject; List: TStrings) of object; TFPReportGetValueNamesEvent = procedure(Sender: TObject; List: TStrings) of object;
TFPReportGetFieldKindEvent = Procedure(Sender: TObject; aName : String; var AKind : TFPReportFieldKind) of object;
TFPReportBeforePrintEvent = procedure(Sender: TFPReportElement) of object; TFPReportBeforePrintEvent = procedure(Sender: TFPReportElement) of object;
TFPReportQueryUsePrevValue = function: Boolean of object; TFPReportQueryUsePrevValue = function: Boolean of object;
@ -459,17 +460,22 @@ type
end; end;
{ TFPReportUserData }
TFPReportUserData = class(TFPReportData) TFPReportUserData = class(TFPReportData)
private private
FOnGetFieldKind: TFPReportGetFieldKindEvent;
FOnGetValue: TFPReportGetValueEvent; FOnGetValue: TFPReportGetValueEvent;
FOnGetNames: TFPReportGetValueNamesEvent; FOnGetNames: TFPReportGetValueNamesEvent;
protected protected
function GetFieldDataType(const AFieldName: String): TFPReportFieldKind; virtual;
procedure DoGetValue(const AFieldName: string; var AValue: variant); override; procedure DoGetValue(const AFieldName: string; var AValue: variant); override;
procedure DoInitDataFields; override; procedure DoInitDataFields; override;
published published
property DataFields; property DataFields;
property OnGetValue: TFPReportGetValueEvent read FOnGetValue write FOnGetValue; property OnGetValue: TFPReportGetValueEvent read FOnGetValue write FOnGetValue;
property OnGetNames: TFPReportGetValueNamesEvent read FOnGetNames write FOnGetNames; property OnGetNames: TFPReportGetValueNamesEvent read FOnGetNames write FOnGetNames;
property OnGetFieldKind: TFPReportGetFieldKindEvent read FOnGetFieldKind write FOnGetFieldKind;
end; end;
{ TFPReportDataItem } { TFPReportDataItem }
@ -5021,22 +5027,34 @@ begin
FOnGetValue(Self, AFieldName, AValue); FOnGetValue(Self, AFieldName, AValue);
end; end;
Function TFPReportUserData.GetFieldDataType(Const AFieldName : String) : TFPReportFieldKind;
begin
Result:=rfkString;
If Assigned(OnGetFieldKind) then
OnGetFieldKind(Self,AFieldName,Result);
end;
procedure TFPReportUserData.DoInitDataFields; procedure TFPReportUserData.DoInitDataFields;
var var
sl: TStringList; sl: TStringList;
i: integer; i: integer;
begin begin
inherited DoInitDataFields; inherited DoInitDataFields;
if Assigned(FOnGetNames) then if Assigned(FOnGetNames) then
begin begin
sl := TStringList.Create; sl:= TStringList.Create;
FOnGetNames(self, sl); try
for i := 0 to sl.Count-1 do FOnGetNames(self, sl);
if (Datafields.IndexOfField(sl[i])=-1) then for i := 0 to sl.Count-1 do
DataFields.AddField(sl[i], rfkString); if (Datafields.IndexOfField(sl[i])=-1) then
sl.Free; DataFields.AddField(sl[i],GetFieldDataType(sl[i]));
end; finally
SL.Free;
end;
end;
end; end;