paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-25 19:29:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazReport, Remember used last export filter class/filename and use them if ExportTo is called with empty parameters

Browse Source 
git-svn-id: trunk@40987 -
This commit is contained in:
jesus 2013-05-02 02:17:21 +00:00
parent 2add03180d
commit 7d008a912d
1 changed files with 33 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
components/lazreport/source/lr_class.pas
View File

@ -1009,6 +1009,8 @@ type
FComments : TStringList; FComments : TStringList;
FDFMStream : TStream; FDFMStream : TStream;
FXMLReport : string; FXMLReport : string;
fDefExportFilterClass: string;
fDefExportFileName: string;
function FormatValue(V: Variant; AFormat: Integer; const AFormatStr: String): String; function FormatValue(V: Variant; AFormat: Integer; const AFormatStr: String): String;
// function GetLRTitle: String; // function GetLRTitle: String;
@ -1099,7 +1101,7 @@ type
// report manipulation methods // report manipulation methods
procedure DesignReport; procedure DesignReport;
function PrepareReport: Boolean; function PrepareReport: Boolean;
procedure ExportTo(FilterClass: TfrExportFilterClass; const aFileName: String); procedure ExportTo(FilterClass: TfrExportFilterClass; aFileName: String);
procedure ShowReport; procedure ShowReport;
procedure ShowPreparedReport; procedure ShowPreparedReport;
procedure PrintPreparedReport(const PageNumbers: String; Copies: Integer); procedure PrintPreparedReport(const PageNumbers: String; Copies: Integer);
@ -1122,6 +1124,9 @@ type
property Variables: TStrings read FVars write SetVars; property Variables: TStrings read FVars write SetVars;
property Values: TfrValues read FVal write FVal; property Values: TfrValues read FVal write FVal;
property Script : TfrScriptStrings read FScript write SetScript; property Script : TfrScriptStrings read FScript write SetScript;
//
property DefExportFilterClass: string read fDefExportFilterClass write fDefExportFilterClass;
property DefExportFileName: string read fDefExportFileName write fDefExportFileName;
published published
property Dataset: TfrDataset read FDataset write FDataset; property Dataset: TfrDataset read FDataset write FDataset;
@ -9687,10 +9692,33 @@ begin
frProgressForm.ModalResult := mrOk; frProgressForm.ModalResult := mrOk;
end; end;
procedure TfrReport.ExportTo(FilterClass: TfrExportFilterClass; const aFileName: String); procedure TfrReport.ExportTo(FilterClass: TfrExportFilterClass; aFileName: String);
var var
s: String; s: String;
i: Integer;
begin begin
// try to find a export filter from registered list
if (FilterClass=nil) and (fDefExportFilterClass<>'') then
begin
for i:=0 to Length(frFilters)-1 do
if (frFilters[i].ClassRef.ClassName=fDefExportFilterClass) then
begin
FilterClass := frFilters[i].ClassRef;
break;
end;
end;
if (aFileName='') and (fDefExportFileName<>'') then
aFileName := fDefExportFileName;
if FilterClass=nil then begin
raise Exception.Create('No valid filterclass was supplied');
end;
if aFilename='' then begin
raise Exception.create('No valid export filename was supplied');
end;
ExportStream := TFileStream.Create(UTF8ToSys(aFileName), fmCreate); ExportStream := TFileStream.Create(UTF8ToSys(aFileName), fmCreate);
FCurrentFilter := FilterClass.Create(ExportStream); FCurrentFilter := FilterClass.Create(ExportStream);
@ -9719,6 +9747,9 @@ begin
end else end else
ExportBeforeModal(nil); ExportBeforeModal(nil);
fDefExportFilterClass := FCurrentFilter.ClassName;
fDefExportFileName := aFileName;
FreeAndNil(FCurrentFilter); FreeAndNil(FCurrentFilter);
ExportStream.Free; ExportStream.Free;
end; end;