712 lines
20 KiB
ObjectPascal
712 lines
20 KiB
ObjectPascal
unit reportDMUnit;
|
||
|
||
{$mode ObjFPC}{$H+}
|
||
|
||
interface
|
||
|
||
uses
|
||
Classes, SysUtils, frxClass, frxExportPDF, frxExportODF,
|
||
xpMemParamManagerUnit, AbUnzper, frxDBSet, cgiDM,extTypes;
|
||
|
||
type
|
||
TExportFileType = (ftPDF,ftRTF,ftXLS);//(ftPDF,ftMail,ftRTF,ftXLS,ftHTML);
|
||
{ TReportDM }
|
||
TReportQuery=class;
|
||
|
||
TVariableFillProc=procedure(AVariables: TxpMemParamManager) of object;
|
||
|
||
TReportQuery=class
|
||
private
|
||
fQueries: TList;
|
||
fOwner: TReportQuery;
|
||
fData: TNIDBDM;
|
||
function getQuery(index: integer): TReportQuery;
|
||
function getQueryCount: integer;
|
||
public
|
||
Name,SQL,LinkField,Description: string;
|
||
ID,ParentID: integer;
|
||
Data: TfrxDBDataset;
|
||
property Queries[index: integer]:TReportQuery read getQuery;
|
||
property QueryCount: integer read getQueryCount;
|
||
property MasterQuery: TReportQuery read fOwner;
|
||
constructor Create;
|
||
destructor Destroy; override;
|
||
procedure Clear;
|
||
procedure AddQuery(q: TReportQuery);
|
||
procedure RemoveQuery(q: TReportQuery);
|
||
function Find(QueryID: integer): TReportQuery;
|
||
end;
|
||
|
||
TReportDM = class(TDataModule)
|
||
AbUnZipper1: TAbUnZipper;
|
||
frxODSExport1: TfrxODSExport;
|
||
frxODTExport1: TfrxODTExport;
|
||
frxPDFExport1: TfrxPDFExport;
|
||
frxReport: TfrxReport;
|
||
function frxReportLoadDetailTemplate(Report: TfrxReport;
|
||
const TemplateName: String; const AHyperlink: TfrxHyperlink): Boolean;
|
||
procedure frxReportLoadTemplate(Report: TfrxReport;
|
||
const TemplateName: String);
|
||
private
|
||
TempTableAlreadyCreated : Boolean;
|
||
ComponentContainer : TList;
|
||
MasterDataSets: TStringList; // Список Master-датасетов (TfrxDBDataset) - не забыть создать/удалить как ComponentContainer. Возможно, не нужен???
|
||
DetailDataSets: TStringList; // Список Detail-датасетов. В Objects - TStringList (id query + Detail-датасет(TfrxDBDataset))
|
||
ReportVariables: TxpMemParamManager;
|
||
ReportQueries: TReportQuery;
|
||
fOnVars: TVariableFillProc;
|
||
|
||
procedure CreateDBDataSet(Query:TReportQuery; EditReport: Boolean = False);
|
||
procedure CreateSignaturesDataSet(EditReport: Boolean = False);
|
||
procedure CreateLogosDataSet(EditReport: Boolean = False);
|
||
procedure BuildPodpis(AVariables : TxpMemParamManager);
|
||
// Возвращает имя Master-датасета по id Detail-а (пустую строку если датасет не имеет Master-а)
|
||
function GetMasterDSName(qryID: integer): string;
|
||
// Возвращает имя ключевого поля (для Master-датасета - ключевое поле, для Detail-датасета - поле внешнего ключа)
|
||
function GetLinkFieldName(qryID: integer): string;
|
||
// Возвращает строку для фильтрации Detail-датасета. Параметры:
|
||
// - detail_key_fields, master_key_fields - строки, описывающие поля связи master и detail - датасета,
|
||
// - Link_type - тип связи ("ID" - по id, "BETWEEN" - по диапазону дат, "LIKE" - по подстроке и т.п. - сейчас пока только по id)
|
||
// - MasterDataSet - Master-датасет.
|
||
function GetFilterClause(detail_key_fields, master_key_fields, Link_type: string; MasterDataSet: TfrxDBDataset): string;
|
||
procedure PrepareBuildInfo(AVariables : TxpMemParamManager);
|
||
function GetVariable(AVariables: TxpMemParamManager; VarName: string; DefaultValue: string): string;
|
||
class function maskFRSpecial(value: string): string;
|
||
class function maskFRSpecialPreservingEOLs(value: string): string;
|
||
procedure frxReportPreview(Sender: TObject);
|
||
procedure LoadQueries;
|
||
procedure LoadDefaultVariables(AVariables : TxpMemParamManager);
|
||
procedure LoadLogos(AVariables : TxpMemParamManager);
|
||
procedure LoadVariables(AVariables, AParam : TxpMemParamManager);
|
||
procedure OnMasterRecord(Sender: TObject);
|
||
procedure LoadReportTemplate();
|
||
procedure CopyReportVariables(AVariables, AParam: TxpMemParamManager);
|
||
public
|
||
RecordID: integer;
|
||
NidbData: TNIDBDM;
|
||
procedure ExportReport( ExportType: TExportFileType; Data: TStream; OnStage: TLogger; OnVars: TVariableFillProc);
|
||
|
||
end;
|
||
|
||
var
|
||
ReportDM: TReportDM;
|
||
|
||
implementation
|
||
uses
|
||
xpReportUtil, Variants,DB,lazUTF8, xpUtilUnit,nnz_data_components,frxCross, Graphics, fr_utils;
|
||
{$R *.lfm}
|
||
|
||
{ TReportQuery }
|
||
|
||
function TReportQuery.getQuery(index: integer): TReportQuery;
|
||
begin
|
||
result :=TReportQuery(fQueries[index]);
|
||
end;
|
||
|
||
function TReportQuery.getQueryCount: integer;
|
||
begin
|
||
result := fQueries.Count;
|
||
end;
|
||
|
||
constructor TReportQuery.Create;
|
||
begin
|
||
fQueries := TList.Create;
|
||
fOwner := nil;
|
||
ID := 0;
|
||
ParentID := 0;
|
||
end;
|
||
|
||
destructor TReportQuery.Destroy;
|
||
begin
|
||
Clear;
|
||
fQueries.Free;
|
||
if assigned(Data) then
|
||
FreeAndNil(Data);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TReportQuery.Clear;
|
||
var
|
||
i: integer;
|
||
begin
|
||
for i := 0 to fQueries.Count-1 do
|
||
TReportQuery(fQueries[i]).Free;
|
||
fQueries.Clear;
|
||
end;
|
||
|
||
procedure TReportQuery.AddQuery(q: TReportQuery);
|
||
var
|
||
p: TReportQuery;
|
||
begin
|
||
p := self;
|
||
while assigned(p) do
|
||
begin
|
||
if p=q then exit;
|
||
p := p.MasterQuery;
|
||
end;
|
||
if assigned(q.MasterQuery) then
|
||
q.MasterQuery.RemoveQuery(q);
|
||
fQueries.Add(q);
|
||
q.fOwner := self;
|
||
end;
|
||
|
||
procedure TReportQuery.RemoveQuery(q: TReportQuery);
|
||
begin
|
||
fQueries.Remove(q);
|
||
end;
|
||
|
||
function TReportQuery.Find(QueryID: integer): TReportQuery;
|
||
var
|
||
i: integer;
|
||
begin
|
||
result := nil;
|
||
if self.ID=QueryID then result := self
|
||
else
|
||
for i := 0 to QueryCount-1 do
|
||
begin
|
||
Result := Queries[i].Find(QueryID);
|
||
if assigned(Result) then
|
||
exit;
|
||
end;
|
||
|
||
end;
|
||
|
||
{ TReportDM }
|
||
|
||
procedure TReportDM.frxReportLoadTemplate(Report: TfrxReport;
|
||
const TemplateName: String);
|
||
begin
|
||
NidbData.log(mtDebug,self,'LoadTemplate '+TemplateName);
|
||
end;
|
||
|
||
function TReportDM.frxReportLoadDetailTemplate(Report: TfrxReport;
|
||
const TemplateName: String; const AHyperlink: TfrxHyperlink): Boolean;
|
||
begin
|
||
NidbData.log(mtDebug,self,'LoadDetailTemplate '+TemplateName);
|
||
end;
|
||
|
||
procedure TReportDM.CreateDBDataSet(Query: TReportQuery; EditReport: Boolean);
|
||
var
|
||
i: integer;
|
||
DBQuery: TnnzQuery;
|
||
ds: TfrxDBDataset;
|
||
begin
|
||
if Query.ID>0 then
|
||
begin
|
||
NidbData.log(mtDebug,self,'CreateDBDataSet '+Query.Name);
|
||
ds := TfrxDBDataset.Create(Self);
|
||
Query.Data := ds;
|
||
ds.Tag := PtrInt(Query);
|
||
// Master/Detail
|
||
if Query.ParentID=0 then
|
||
begin // Если это мастер-датасет, добавить его в список и присвоить ему события
|
||
Query.Data.OnFirst := @OnMasterRecord;
|
||
Query.Data.OnNext := @OnMasterRecord;
|
||
end;
|
||
Query.Data.Name := Query.Name;
|
||
|
||
|
||
DBQuery := TnnzQuery.Create(Self);
|
||
DBQuery.Connection := NidbData.connection;
|
||
DBQuery.SQL.Text := Query.SQL;
|
||
try
|
||
DBQuery.Open;
|
||
except on E: Exception do
|
||
begin
|
||
NidbData.logError(self,e,Query.SQL);
|
||
raise Exception.Create(Format('%s::"%s"'#13#10' '#13#10'%s',[e.ClassName,e.Message,Query.SQL]));
|
||
end;
|
||
end;
|
||
Query.Data.DataSet := DBQuery;
|
||
|
||
end;
|
||
for i := 0 to Query.QueryCount-1 do
|
||
begin
|
||
CreateDBDataSet(query.Queries[i],EditReport);
|
||
end;
|
||
end;
|
||
|
||
procedure TReportDM.CreateSignaturesDataSet(EditReport: Boolean);
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TReportDM.CreateLogosDataSet(EditReport: Boolean);
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TReportDM.BuildPodpis(AVariables: TxpMemParamManager);
|
||
begin
|
||
|
||
end;
|
||
|
||
function TReportDM.GetMasterDSName(qryID: integer): string;
|
||
begin
|
||
|
||
end;
|
||
|
||
function TReportDM.GetLinkFieldName(qryID: integer): string;
|
||
begin
|
||
|
||
end;
|
||
|
||
function TReportDM.GetFilterClause(detail_key_fields, master_key_fields,
|
||
Link_type: string; MasterDataSet: TfrxDBDataset): string;
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TReportDM.PrepareBuildInfo(AVariables: TxpMemParamManager);
|
||
begin
|
||
|
||
end;
|
||
|
||
function TReportDM.GetVariable(AVariables: TxpMemParamManager; VarName: string;
|
||
DefaultValue: string): string;
|
||
begin
|
||
|
||
end;
|
||
|
||
class function TReportDM.maskFRSpecial(value: string): string;
|
||
var
|
||
i: integer;
|
||
isSpace: boolean;
|
||
uchar: string;
|
||
begin
|
||
isSpace := false;
|
||
result := '';
|
||
value := UTF8Trim(value);
|
||
for i := 1 to UTF8Length(value) do
|
||
begin
|
||
uchar := UTF8Copy(value,i,1);
|
||
if uchar <= ' ' then // убиваем и заменяем одинарным пробелом все последовательности непечатаемых символов, включая перенос строки
|
||
begin
|
||
if not isSpace then
|
||
result := result + ' ';
|
||
|
||
isSpace := true;
|
||
end
|
||
else
|
||
begin
|
||
if uchar = #39 then // одиночная кавычка, апостроф (')
|
||
result := result + #39#39
|
||
else
|
||
result := result + uchar;
|
||
|
||
isSpace := false;
|
||
end;
|
||
|
||
end;
|
||
|
||
result := #39 + result + #39; // 'result'
|
||
// result :=QuotedStr('');
|
||
end;
|
||
class function TReportDM.maskFRSpecialPreservingEOLs(value: string): string;
|
||
var
|
||
i: integer;
|
||
isSpace, isEOL: boolean;
|
||
uchar: string;
|
||
begin
|
||
isSpace := false;
|
||
isEOL := false;
|
||
result := '';
|
||
value := UTF8Trim(value);
|
||
for i := 1 to UTF8length(value) do
|
||
begin
|
||
uchar := UTF8Copy(value,i,1);
|
||
if inArray(uChar,[#13,#10],false) then // любые последовательности переноса строк, в т.ч. от макоси (#13) и линукса (#10), меняем одним #13#10
|
||
begin
|
||
if not isEOL then
|
||
result := result + sFRBreak;
|
||
isEOL := true;
|
||
isSpace := false;
|
||
end
|
||
else if (uchar <= ' ') then // заменяем одинарным пробелом все последовательности пробелов и непечатаемых символов, КРОМЕ переносов строк
|
||
begin
|
||
if not isSpace then
|
||
result := result + ' ';
|
||
|
||
isSpace := true;
|
||
isEOL := false;
|
||
end
|
||
else
|
||
begin
|
||
if uchar = #39 then // одиночная кавычка, апостроф (')
|
||
result := result + #39#39
|
||
else
|
||
result := result + UTF8Copy(value,i,1);
|
||
|
||
isSpace := false;
|
||
isEOL := false;
|
||
end;
|
||
|
||
end;
|
||
|
||
if (utf8pos(#13, result) = 0) then // в строке result нет символа CR; нужно забрать всё в одинарные кавычки, и FR их не покажет
|
||
result := #39 + result + #39;
|
||
// result := QuotedStr('');
|
||
end;
|
||
|
||
procedure TReportDM.frxReportPreview(Sender: TObject);
|
||
var
|
||
Report: TfrxReport;
|
||
begin
|
||
inherited;
|
||
try
|
||
Report := Sender as TfrxReport;
|
||
Report.PreviewForm.BringToFront;
|
||
except
|
||
end;
|
||
end;
|
||
|
||
procedure TReportDM.LoadQueries;
|
||
var
|
||
SQL: string;
|
||
q: TReportquery;
|
||
i: integer;
|
||
begin
|
||
NidbData.log(mtDebug,self,'LoadQueries');
|
||
SQL := format(
|
||
'select q.xp_rpt_q_id,qp.xp_rpt_q_id as ParentID,q.Link_field, '+
|
||
' q.Name,'+
|
||
' q.Description, q.SQL '+
|
||
'FROM xp_report_query q '+
|
||
' left join xp_report_query qp ON q.Parent_q_id=qp.xp_rpt_q_id AND qp.xp_rpt_id=q.xp_rpt_id '+
|
||
'WHERE q.xp_rpt_id = %0:d '+
|
||
'ORDER BY qp.xp_rpt_q_id is not null, q.Name ',
|
||
[integer(RecordID)]);
|
||
with NidbData.GetData(SQL) do
|
||
try
|
||
while not eof do
|
||
begin
|
||
q := TReportQuery.Create;
|
||
ReportQueries.AddQuery(q);
|
||
q.Name:=fieldbyname('Name').AsString;
|
||
q.SQL:=fieldbyname('SQL').AsString;
|
||
q.LinkField:=fieldbyname('Link_field').AsString;
|
||
q.Description:=fieldbyname('Description').AsString;
|
||
q.ID:=fieldbyname('xp_rpt_q_id').AsInteger;
|
||
q.ParentID:=fieldbyname('ParentID').AsInteger;
|
||
|
||
next;
|
||
end;
|
||
finally
|
||
free;
|
||
end;
|
||
for i := ReportQueries.QueryCount-1 downto 0 do
|
||
if ReportQueries.Queries[i].ParentID>0 then
|
||
begin
|
||
NidbData.log(mtDebug,self,'LoadQueries.'+ReportQueries.Queries[i].Name);
|
||
q := ReportQueries.Find(ReportQueries.Queries[i].ParentID);
|
||
if assigned(q) then
|
||
q.AddQuery(ReportQueries.Queries[i]);
|
||
end;
|
||
NidbData.log(mtDebug,self,'LoadQueries-OK');
|
||
end;
|
||
|
||
procedure TReportDM.LoadDefaultVariables(AVariables: TxpMemParamManager);
|
||
var
|
||
SQL: string;
|
||
l: TStrings;
|
||
i: integer;
|
||
OptionName,
|
||
OptionValue: String;
|
||
begin
|
||
NidbData.log(mtDebug,self,'LoadDefaultVariables');
|
||
|
||
SQL := 'select name,value from options where name in (''GOU_Name'',''Dep_Name'')';
|
||
with NidbData.GetData(sql) do
|
||
try
|
||
while not eof do
|
||
begin
|
||
AVariables[fieldbyname('name').asString] := fieldbyname('value').asString;
|
||
next;
|
||
end;
|
||
finally
|
||
free;
|
||
end;
|
||
for i := 1 to 5 do
|
||
AVariables['GOU_Name'+inttostr(i)] := AVariables['GOU_Name'];
|
||
with NidbData.GetData('SELECT name,value from options WHERE name like ''GOU_Name%'' ') do
|
||
try
|
||
while not eof do
|
||
begin
|
||
OptionName := fieldByName('name').AsString;
|
||
OptionValue := AnsiString(FieldByName('Value').AsString);
|
||
AVariables[OptionName] := trim(OptionValue);
|
||
Next;
|
||
end;
|
||
finally
|
||
Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TReportDM.LoadLogos(AVariables: TxpMemParamManager);
|
||
var
|
||
sql: string;
|
||
img: TJPEGImage;
|
||
p: TPicture;
|
||
s: TStream;
|
||
v: Variant;
|
||
begin
|
||
NidbData.log(mtDebug,self,'LoadLogos');
|
||
SQL := 'select name,value from options where name in (''Dep_Logo'',''GOU_Logo'')';
|
||
with NidbData.GetData(sql) do
|
||
try
|
||
while not eof do
|
||
begin
|
||
s := CreateBlobStream(FieldByName('value'),bmRead);
|
||
p:=TPicture.Create;
|
||
img := TJPEGImage.Create();
|
||
try
|
||
img.LoadFromStream(s);
|
||
p.Graphic:=img;
|
||
// внутри вызывается Assign, поэтому img больше не нужен
|
||
finally
|
||
s.Free();
|
||
img.Free;
|
||
end;
|
||
v := PtrInt(p);
|
||
AVariables[fieldbyname('name').asString] := PtrInt(p);
|
||
p := TPicture(PtrInt(v));
|
||
|
||
next;
|
||
end;
|
||
finally
|
||
free;
|
||
end;
|
||
end;
|
||
|
||
procedure TReportDM.LoadVariables(AVariables, AParam: TxpMemParamManager);
|
||
var
|
||
sql: string;
|
||
begin
|
||
NidbData.log(mtDebug,self,'LoadVariables');
|
||
sql := 'select name,value_string, value_int from tmp_report_variables where var_type=0';
|
||
with NidbData.GetData(sql) do
|
||
try
|
||
while not eof do
|
||
begin
|
||
NidbData.log(mtDebug,self,fieldbyname('name').AsString);
|
||
if not fieldbyname('value_string').IsNull then
|
||
AVariables[fieldbyname('name').AsString] := fieldbyname('value_string').AsString
|
||
else if not fieldbyname('value_int').IsNull then
|
||
AVariables[fieldbyname('name').AsString] := fieldbyname('value_int').AsInteger;
|
||
Next;
|
||
end;
|
||
finally
|
||
free;
|
||
end;
|
||
NidbData.log(mtDebug,self,'LoadParams');
|
||
sql := 'select name,value_string, value_int from tmp_report_variables where var_type=1';
|
||
with NidbData.GetData(sql) do
|
||
try
|
||
while not eof do
|
||
begin
|
||
NidbData.log(mtDebug,self,fieldbyname('name').AsString);
|
||
if not fieldbyname('value_string').IsNull then
|
||
AParam[fieldbyname('name').AsString] := fieldbyname('value_string').AsString
|
||
else if not fieldbyname('value_int').IsNull then
|
||
AParam[fieldbyname('name').AsString] := fieldbyname('value_int').AsInteger;
|
||
Next;
|
||
end;
|
||
finally
|
||
free;
|
||
end;
|
||
//
|
||
|
||
//
|
||
NidbData.log(mtDebug,self,'LoadVariables-OK');
|
||
end;
|
||
|
||
procedure TReportDM.OnMasterRecord(Sender: TObject);
|
||
var MasterDS_Index, i, idx: integer;
|
||
masterDS,detailDS: TfrxDBDataset;
|
||
master_key_field, detail_key_field, FilterClause: string;
|
||
DetailDSList: TStringList;
|
||
q: TReportQuery;
|
||
|
||
begin
|
||
try
|
||
master_key_field := '';
|
||
detail_key_field := '';
|
||
FilterClause := '';
|
||
masterDS := TfrxDBDataset(Sender);
|
||
q := TReportQuery(masterDS.Tag) ;
|
||
master_key_field := q.LinkField;
|
||
for i := 0 to q.QueryCount-1 do
|
||
begin
|
||
detailDS := q.Queries[i].Data;
|
||
detail_key_field := q.Queries[i].LinkField;
|
||
FilterClause := GetFilterClause(detail_key_field, master_key_field, 'ID', masterDS);
|
||
if FilterClause <> '' then
|
||
begin
|
||
detailDS.DataSet.Filter := FilterClause;
|
||
detailDS.DataSet.Filtered := True;
|
||
end;
|
||
end;
|
||
|
||
except on e: Exception do
|
||
begin
|
||
NidbData.logError(self,e,'OnMasterRecord');
|
||
raise;
|
||
end;
|
||
|
||
end;
|
||
end;
|
||
|
||
procedure TReportDM.LoadReportTemplate;
|
||
var
|
||
ReportStream : TMemoryStream;
|
||
BlobStream : TStream;
|
||
|
||
begin
|
||
NidbData.log(mtDebug,self,'ExportReport.TemplateArh');
|
||
ReportStream := TMemoryStream.Create;
|
||
try
|
||
with NidbData.GetData(format('select TemplateArh from xp_report where xp_rpt_id=%d',[RecordID])) do
|
||
try
|
||
BlobStream := CreateBlobStream(FieldByName('TemplateArh'), bmRead);
|
||
try
|
||
UnpackReport(BlobStream, ReportStream,AbUnZipper1);
|
||
finally
|
||
BlobStream.Free;
|
||
end;
|
||
|
||
finally
|
||
free;
|
||
end;
|
||
if ReportStream.Size > 0 then
|
||
begin
|
||
ReportStream.Position := 0;
|
||
try
|
||
frxReport.LoadFromStream(ReportStream);
|
||
|
||
except on e: Exception do
|
||
begin
|
||
NidbData.logError(self,e,'frxReport.LoadFromStream');
|
||
raise;
|
||
end;
|
||
end;
|
||
end;
|
||
finally
|
||
ReportStream.Free;
|
||
end; // try
|
||
end;
|
||
|
||
procedure TReportDM.CopyReportVariables(AVariables, AParam: TxpMemParamManager);
|
||
var
|
||
i: integer;
|
||
v: variant;
|
||
begin
|
||
NidbData.log(mtDebug,self,'CopyReportVariables');
|
||
for I := Low(AVariables.Params) to High(AVariables.Params) do
|
||
begin
|
||
if VarIsStr(AVariables.Params[i][1]) then
|
||
v := maskFRSpecial(VarToStr(AVariables.Params[i][1]))
|
||
else
|
||
v:= AVariables.Params[i][1];
|
||
frxReport.Variables[AVariables.Params[i][0]] := v;
|
||
end;
|
||
for I := Low(AParam.Params) to High(AParam.Params) do
|
||
begin
|
||
if VarIsStr(AParam.Params[i][1]) then
|
||
v := maskFRSpecialPreservingEOLs(VarToStr(AParam.Params[i][1]))
|
||
else
|
||
v := AParam.Params[i][1];
|
||
frxReport.Variables[AParam.Params[i][0]] := v;
|
||
end;
|
||
|
||
end;
|
||
|
||
|
||
|
||
procedure TReportDM.ExportReport(ExportType: TExportFileType; Data: TStream;
|
||
OnStage: TLogger; OnVars: TVariableFillProc);
|
||
var
|
||
I : Integer;
|
||
flt : TfrxCustomExportFilter;
|
||
v : Variant;
|
||
AVariables, AParam: TxpMemParamManager;
|
||
begin
|
||
fOnVars:=OnVars;
|
||
frxReport.EngineOptions.EnableThreadSafe:=true;
|
||
NidbData.log(mtDebug,self,'ExportReport');
|
||
ReportQueries := TReportQuery.Create;
|
||
AVariables := TxpMemParamManager.Create;
|
||
AParam := TxpMemParamManager.Create;
|
||
try
|
||
if assigned(OnStage) then
|
||
OnStage(mtExtra, self,'список запросов');
|
||
LoadQueries;
|
||
LoadDefaultVariables(AVariables);
|
||
LoadLogos(AVariables);
|
||
LoadVariables(AVariables,AParam);
|
||
if assigned(fOnVars) then fOnVars(AVariables);
|
||
frxReport.EngineOptions.DestroyForms := False;
|
||
// Создаём источники данных
|
||
if assigned(OnStage) then
|
||
OnStage(mtExtra,self,'подготовка данных');
|
||
|
||
CreateDBDataSet(ReportQueries);
|
||
if assigned(OnStage) then
|
||
OnStage(mtExtra,self,'загрузка шаблона');
|
||
|
||
LoadReportTemplate;
|
||
CopyReportVariables(AVariables,AParam);
|
||
TxpFRFunctions.SetReport(NidbData,AVariables);
|
||
if assigned(OnStage) then
|
||
OnStage(mtExtra,self,'формирование отчета');
|
||
|
||
begin
|
||
try
|
||
frxReport.PrepareReport(False);
|
||
frxReport.OnPreview := @frxReportPreview;
|
||
|
||
except on e: Exception do
|
||
begin
|
||
NidbData.logError(self,e,'frxReport.PrepareReport');
|
||
raise;
|
||
end;
|
||
end;
|
||
|
||
case ExportType of
|
||
ftPDF: flt := TfrxPDFExport.Create(self);
|
||
ftRTF: flt := TfrxODTExport.Create(self);
|
||
ftXLS: flt := TfrxODSExport.Create(self);
|
||
end;
|
||
try
|
||
if assigned(OnStage) then
|
||
OnStage(mtExtra,self,'выгрузка');
|
||
|
||
flt.ShowDialog := false;
|
||
flt.Stream := Data;
|
||
flt.FileName:='';
|
||
flt.ShowProgress := false;
|
||
try
|
||
frxReport.Export(flt);
|
||
|
||
except on e: Exception do
|
||
begin
|
||
NidbData.logError(self,e,'frxReport.Export');
|
||
raise;
|
||
end;
|
||
end;
|
||
finally
|
||
flt.Free;
|
||
end;
|
||
end;
|
||
//FreeContainer;
|
||
finally
|
||
ReportQueries.Free;
|
||
AVariables.Free;
|
||
AParam.Free;
|
||
end;
|
||
NidbData.log(mtDebug,self,'Report complete');
|
||
end;
|
||
|
||
|
||
end.
|
||
|