paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-04 06:20:29 +01:00
Code Issues Packages Projects Releases Wiki Activity

Patch form Aleksey Lagunov implementing:

Browse Source 
1. In frReport added property BeforePrintScript - script executable before generating the report. 
 2. Added to designer "File" menu an editor for the BeforePrintScript property. 
 3. In the example report_url added an example for BeforePrintScript. 
 4. Process LazReport variables in Tags of all TMemoView objects before creating a report.
 

git-svn-id: trunk@40812 -
This commit is contained in:
jesus 2013-04-15 04:46:07 +00:00
parent 83942fc439
commit 53774998ef
7 changed files with 326 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

207
components/lazreport/samples/report_url/url_demo.lrf
View File

@ -7,12 +7,13 @@
<KeyWords Value=""/>
<Comments Value=""/>
<ReportCreateDate Value="1899-12-30 00:00:00"/>
<ReportLastChange Value="2013-04-08 16:32:04"/>
<ReportLastChange Value="2013-04-12 16:58:40"/>
<ReportVersionBuild Value=""/>
<ReportVersionMajor Value=""/>
<ReportVersionMinor Value=""/>
<ReportVersionRelease Value=""/>
<ReportAutor Value=""/>
<Script Value="begin&#xA; MESSAGEBOX('Message before print script', 'Message', 1);&#xA;end&#xA;"/>
<Pages>
<PrintToDefault Value="False"/>
<DoublePass Value="False"/>
@ -38,7 +39,7 @@
<ColCount Value="1"/>
<ColGap Value="0"/>
<LayoutOrder Value="loColumns"/>
<ObjectCount Value="14"/>
<ObjectCount Value="18"/>
<Object1>
<Name Value="ReportTitle1"/>
<ClassName Value="TfrBandView"/>
@ -106,6 +107,28 @@
<DatasetStr Value="1"/>
</Object3>
<Object4>
<Name Value="MasterData3"/>
<ClassName Value="TfrBandView"/>
<Visible Value="True"/>
<Typ Value="gtBand"/>
<StreamMode Value="0"/>
<Size>
<Left Value="0"/>
<Top Value="468"/>
<Width Value="752"/>
<Height Value="20"/>
</Size>
<Flags Value="48"/>
<Data>
<Script Value=""/>
</Data>
<Tag Value=""/>
<FURLInfo Value=""/>
<BandType Value="btMasterData"/>
<Condition Value=""/>
<DatasetStr Value="3"/>
</Object4>
<Object5>
<Name Value="Memo4"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
@ -150,8 +173,8 @@
<Layout Value="tlCenter"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object4>
<Object5>
</Object5>
<Object6>
<Name Value="Memo5"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
@ -196,8 +219,8 @@
<Layout Value="tlCenter"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object5>
<Object6>
</Object6>
<Object7>
<Name Value="Memo6"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
@ -242,8 +265,8 @@
<Layout Value="tlCenter"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object6>
<Object7>
</Object7>
<Object8>
<Name Value="Memo7"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
@ -288,8 +311,8 @@
<Layout Value="tlCenter"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object7>
<Object8>
</Object8>
<Object9>
<Name Value="Memo8"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
@ -334,8 +357,8 @@
<Layout Value="tlCenter"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object8>
<Object9>
</Object9>
<Object10>
<Name Value="Memo9"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
@ -380,8 +403,8 @@
<Layout Value="tlCenter"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object9>
<Object10>
</Object10>
<Object11>
<Name Value="Memo10"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
@ -426,8 +449,8 @@
<Layout Value="tlCenter"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object10>
<Object11>
</Object11>
<Object12>
<Name Value="Memo11"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
@ -472,8 +495,8 @@
<Layout Value="tlTop"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object11>
<Object12>
</Object12>
<Object13>
<Name Value="Memo12"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
@ -518,8 +541,8 @@
<Layout Value="tlTop"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object12>
<Object13>
</Object13>
<Object14>
<Name Value="Memo13"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
@ -564,8 +587,8 @@
<Layout Value="tlTop"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object13>
<Object14>
</Object14>
<Object15>
<Name Value="Memo14"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
@ -610,7 +633,145 @@
<Layout Value="tlTop"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object14>
</Object15>
<Object16>
<Name Value="Memo15"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="328"/>
<Top Value="244"/>
<Width Value="208"/>
<Height Value="18"/>
</Size>
<Flags Value="3"/>
<FillColor Value="clNone"/>
<Frames>
<FrameColor Value="clBlack"/>
<FrameStyle Value="frsSolid"/>
<FrameWidth Value="1"/>
<FrameBorders Value=""/>
</Frames>
<Data>
<Format Value="556"/>
<FormatStr Value=""/>
<Memo Value="www&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="aaa_[DATE]"/>
<FURLInfo Value=""/>
<Font>
<Name Value="helvetica [urw]"/>
<Size Value="10"/>
<Color Value="clBlack"/>
<Charset Value="0"/>
<Style Value=""/>
</Font>
<Highlight>
<FontStyle Value="2"/>
<FontColor Value="clBlack"/>
<FillColor Value="clWhite"/>
<HighlightStr Value=""/>
</Highlight>
<Alignment Value="taLeftJustify"/>
<Layout Value="tlTop"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object16>
<Object17>
<Name Value="Memo16"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="40"/>
<Top Value="468"/>
<Width Value="604"/>
<Height Value="18"/>
</Size>
<Flags Value="3"/>
<FillColor Value="clNone"/>
<Frames>
<FrameColor Value="clBlack"/>
<FrameStyle Value="frsDash"/>
<FrameWidth Value="1"/>
<FrameBorders Value="frbBottom"/>
</Frames>
<Data>
<Format Value="556"/>
<FormatStr Value=""/>
<Memo Value="Page [[LINE#]+1]&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="url"/>
<FURLInfo Value="@[[LINE#]+1]"/>
<Font>
<Name Value="Arial"/>
<Size Value="10"/>
<Color Value="clBlack"/>
<Charset Value="0"/>
<Style Value="fsItalic"/>
</Font>
<Highlight>
<FontStyle Value="2"/>
<FontColor Value="clBlack"/>
<FillColor Value="clWhite"/>
<HighlightStr Value=""/>
</Highlight>
<Alignment Value="taLeftJustify"/>
<Layout Value="tlCenter"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object17>
<Object18>
<Name Value="Memo17"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="644"/>
<Top Value="468"/>
<Width Value="72"/>
<Height Value="18"/>
</Size>
<Flags Value="3"/>
<FillColor Value="clNone"/>
<Frames>
<FrameColor Value="clBlack"/>
<FrameStyle Value="frsDash"/>
<FrameWidth Value="1"/>
<FrameBorders Value="frbBottom"/>
</Frames>
<Data>
<Format Value="556"/>
<FormatStr Value=""/>
<Memo Value="[[LINE#]+1]&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="url"/>
<FURLInfo Value="@[[LINE#]+1]"/>
<Font>
<Name Value="Arial"/>
<Size Value="10"/>
<Color Value="clBlack"/>
<Charset Value="0"/>
<Style Value="fsItalic"/>
</Font>
<Highlight>
<FontStyle Value="2"/>
<FontColor Value="clBlack"/>
<FillColor Value="clWhite"/>
<HighlightStr Value=""/>
</Highlight>
<Alignment Value="taCenter"/>
<Layout Value="tlCenter"/>
<Angle Value="0"/>
<Justify Value="False"/>
</Object18>
</Page1>
<Page2>
<Name Value="Page2"/>

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

@ -967,6 +967,7 @@ type
FReportVersionMajor: string;
FReportVersionMinor: string;
FReportVersionRelease: string;
FScript: TfrScriptStrings;
FVars: TStrings;
FVal: TfrValues;
FDataset: TfrDataset;
@ -1020,9 +1021,11 @@ type
procedure DoPrintReport(const PageNumbers: String; Copies: Integer);
procedure SetComments(const AValue: TStringList);
procedure SetPrinterTo(const PrnName: String);
procedure SetScript(AValue: TfrScriptStrings);
procedure SetVars(Value: TStrings);
procedure ClearAttribs;
function FindObjectByName(AName:string):TfrObject;
procedure ExecScript;
protected
procedure DoBeginBand(Band: TfrBand); virtual;
procedure DoBeginColumn(Band: TfrBand); virtual;
@ -1115,7 +1118,8 @@ type
property EMFPages: TfrEMFPages read FEMFPages write FEMFPages;
property Variables: TStrings read FVars write SetVars;
property Values: TfrValues read FVal write FVal;
property Script : TfrScriptStrings read FScript write SetScript;
published
property Dataset: TfrDataset read FDataset write FDataset;
property DefaultCopies: Integer read FDefaultCopies write FDefaultCopies default 1;
@ -2221,12 +2225,12 @@ begin
frWriteString(Stream, ClassName);
{ FTmpTag:=FTag;
FTmpTag:=FTag;
if (FTag<>'') and (Pos('[', FTag) > 0) then
ExpandVariables(FTag);}
FTag:=lrExpandVariables(FTmpTag);
SaveToStream(Stream);
{ FTag:=FTmpTag;}
FTag:=FTmpTag;
{$IFDEF DebugLR}
DebugLn('%s.TfrView.Print() end',[name]);
{$ENDIF}
@ -2379,6 +2383,7 @@ procedure TfrView.SaveToStream(Stream: TStream);
var
S: Single;
B: Integer;
FTmpS:string;
{$IFDEF DebugLR}
st: string;
{$ENDIF}
@ -2424,8 +2429,18 @@ begin
Write(B, 4);
//Tag property stream format 26
frWriteString(Stream, FTag);
frWriteString(Stream, FURLInfo);
if StreamMode = smDesigning then
begin
frWriteString(Stream, FTag);
frWriteString(Stream, FURLInfo);
end
else
begin
FTmpS:=lrExpandVariables(FTag);
frWriteString(Stream, FTmpS);
FTmpS:=lrExpandVariables(FURLInfo);
frWriteString(Stream, FTmpS);
end;
end;
{$IFDEF DebugLR}
Debugln('%s.SaveToStream end',[name]);
@ -8530,6 +8545,7 @@ begin
FInitialZoom := pzDefault;
FileName := sUntitled;
FComments:=TStringList.Create;
FScript:=TfrScriptStrings.Create;
UpdateObjectStringResources;
end;
@ -8543,6 +8559,7 @@ begin
FEMFPages := nil;
FPages.Free;
FComments.Free;
FreeAndNil(FScript);
inherited Destroy;
end;
@ -8620,8 +8637,16 @@ var
AFormatStr: String;
begin
SubValue := '';
AFormat := CurView.Format;
AFormatStr := CurView.FormatStr;
if Assigned(CurView) then
begin
AFormat := CurView.Format;
AFormatStr := CurView.FormatStr;
end
else
begin
AFormat := 0;
AFormatStr := '';
end;
i := Pos(' #', ParName);
if i <> 0 then
begin
@ -9081,6 +9106,7 @@ begin
FReportVersionMinor:=XML.GetValue(Path+'ReportVersionMinor/Value', '');
FReportVersionRelease:=XML.GetValue(Path+'ReportVersionRelease/Value', '');
FReportAutor:=XML.GetValue(Path+'ReportAutor/Value', '');
FScript.Text:= XML.GetValue(Path+'Script/Value', '');
if frVersion < 21 then
frVersion := 21;
@ -9194,6 +9220,8 @@ begin
XML.SetValue(Path+'ReportVersionRelease/Value', FReportVersionRelease);
XML.SetValue(Path+'ReportAutor/Value', FReportAutor);
XML.SetValue(Path+'Script/Value', FScript.Text);
Pages.SaveToXML(XML, Path+'Pages/');
end;
@ -9736,6 +9764,8 @@ begin
try
if (DoublePass and not FinalPass) or (not DoublePass) then
begin
ExecScript;
for i := 0 to Pages.Count - 1 do
Pages[i].Skip := False;
@ -10111,6 +10141,11 @@ begin
{$endif}
end;
procedure TfrReport.SetScript(AValue: TfrScriptStrings);
begin
fScript.Assign(AValue);
end;
function TfrReport.ChangePrinter(OldIndex, NewIndex: Integer): Boolean;
procedure ChangePages;
@ -10245,6 +10280,26 @@ begin
Result:=FindObject(AName);
end;
procedure TfrReport.ExecScript;
var
CmdList, ErrorList:TStringList;
begin
if DocMode = dmPrinting then
begin
CmdList:=TStringList.Create;
ErrorList:=TStringList.Create;
try
CurView := nil;
CurPage := nil;
frInterpretator.PrepareScript(Script, CmdList, ErrorList);
frInterpretator.DoScript(CmdList);
finally
FreeAndNil(CmdList);
FreeAndNil(ErrorList);
end;
end;
end;
procedure TfrReport.DoBeginBand(Band: TfrBand);
begin
if Assigned(FOnBeginBand) then

1
components/lazreport/source/lr_const.pas
View File

@ -557,6 +557,7 @@ resourcestring
sFRDesignerForm_Tools3 = 'Too&ls';
sFRDesignerForm_About = '&About ...';
sFRDesignerForm_SaveAs = 'Save &as ...';
sFRDesignerForm_BeforePrintScript = '&Before print script ...';
sFRDesignerForm_Help1 = '&Help contents';
sFRDesignerForm_Help2 = 'Help &tool';
sFRDesignerForm_Line = 'Line style';

8
components/lazreport/source/lr_desgn.lfm
View File

@ -4809,6 +4809,9 @@ object frDesignerForm: TfrDesignerForm
Caption = 'Variables list...'
OnClick = N42Click
end
object MenuItem1: TMenuItem
Action = FileBeforePrintScript
end
object N21: TMenuItem
Caption = '-'
end
@ -5267,6 +5270,11 @@ object frDesignerForm: TfrDesignerForm
ImageIndex = 2
OnExecute = FileOpenExecute
end
object FileBeforePrintScript: TAction
Category = 'File'
Caption = 'Before print script...'
OnExecute = FileBeforePrintScriptExecute
end
end
object ActionsImageList: TImageList
left = 328

21
components/lazreport/source/lr_desgn.pas
View File

@ -244,6 +244,7 @@ type
TfrDesignerForm = class(TfrReportDesigner)
acDuplicate: TAction;
FileBeforePrintScript: TAction;
FileOpen: TAction;
FilePreview: TAction;
FileSaveAs: TAction;
@ -262,6 +263,7 @@ type
ActionsImageList: TImageList;
ImgIndic: TImageList;
LinePanel: TPanel;
MenuItem1: TMenuItem;
OB7: TSpeedButton;
panTab: TPanel;
panForDlg: TPanel;
@ -427,6 +429,7 @@ type
procedure acDuplicateExecute(Sender: TObject);
procedure acToggleFramesExecute(Sender: TObject);
procedure C2GetItems(Sender: TObject);
procedure FileBeforePrintScriptExecute(Sender: TObject);
procedure FileOpenExecute(Sender: TObject);
procedure FilePreviewExecute(Sender: TObject);
procedure FileSaveAsExecute(Sender: TObject);
@ -3049,6 +3052,7 @@ begin
//N17.Caption := sFRDesignerForm_SaveAs;
FileSaveAs.Caption:= sFRDesignerForm_Save;
FileSaveAs.Caption:= sFRDesignerForm_SaveAs;
FileBeforePrintScript.Caption := sFRDesignerForm_BeforePrintScript;
N42.Caption := sFRDesignerForm_Var;
N8.Caption := sFRDesignerForm_RptOpt;
N25.Caption := sFRDesignerForm_PgOpt;
@ -3108,6 +3112,23 @@ begin
end;
end;
procedure TfrDesignerForm.FileBeforePrintScriptExecute(Sender: TObject);
begin
EditorForm.View := nil;
EditorForm.M2.Lines.Assign(CurReport.Script);
EditorForm.MemoPanel.Visible:=false;
EditorForm.CB1.OnClick:=nil;
EditorForm.CB1.Checked:=true;
EditorForm.CB1.OnClick:=@EditorForm.CB1Click;
EditorForm.ScriptPanel.Align:=alClient;
if EditorForm.ShowModal = mrOk then
begin
CurReport.Script.Assign(EditorForm.M2.Lines);
end;
EditorForm.ScriptPanel.Align:=alBottom;
EditorForm.MemoPanel.Visible:=true;
end;
procedure TfrDesignerForm.FileOpenExecute(Sender: TObject);
var
FRepName:string;

30
components/lazreport/source/lr_edit.pas
View File

@ -95,14 +95,21 @@ begin
CB1Click(nil);
CB2Click(nil);
CB3Click(nil);
M1.Lines.Text:=View.Memo.Text;
if not M1.HandleAllocated then
M1.SelStart:=0;
M1.SetFocus;
FActiveMemo := M1;
CB1.Checked:=(View.Script.Count>0) or (View is TfrControl);
M2.Lines.Text:=View.Script.Text;
Button5.Visible := (View is TfrMemoView);
if Assigned(View) then
begin
M1.Lines.Text:=View.Memo.Text;
if not M1.HandleAllocated then
M1.SelStart:=0;
M1.SetFocus;
FActiveMemo := M1;
CB1.Checked:=(View.Script.Count>0) or (View is TfrControl);
M2.Lines.Text:=View.Script.Text;
Button5.Visible := (View is TfrMemoView);
end
else
begin
Button5.Visible := false;
end;
M1.Font.Charset := frCharset;
M2.Font.Charset := frCharset;
{$IFDEF DebugLR}
@ -116,8 +123,11 @@ begin
begin
frDesigner.BeforeChange;
M1.WordWrap := False;
View.Memo.Text := M1.Text;
View.Script.Text := M2.Text;
if Assigned(View) then
begin
View.Memo.Text := M1.Text;
View.Script.Text := M2.Text;
end;
end;
end;

30
components/lazreport/source/lr_utils.pas
View File

@ -66,6 +66,7 @@ function lrGetUnBrackedStr(const S:string):string; //remove '[' from begion of s
function lrValidFieldReference(s: string):boolean;
function lrDateTimeToStr(ADate:TDateTime):string;
function lrStrToDateTime(AValue: string): TDateTime;
function lrExpandVariables(const S:string):string;
// utf8 tools
function UTF8Desc(S:string; var Desc: string): Integer;
@ -79,7 +80,7 @@ function UTF8CountWords(const str:string; out WordCount,SpcCount,SpcSize:Integer
implementation
uses LR_Class, LR_Const;
uses LR_Class, LR_Const, LR_Pars;
procedure frInitFont(aFont : TFont; aColor : TColor; aSize : Integer; aStyle : TFontStyles);
begin
@ -699,6 +700,33 @@ begin
Result:=0;
end;
function lrExpandVariables(const S: string): string;
var
i, j, k:integer;
SP, SV:string;
begin
Result:='';
i:=1;
k:=1;
while i<=Length(S) do
begin
if S[i] = '[' then
begin
SP:=GetBrackedVariable(S, i, j);
SV:='';
CurReport.InternalOnGetValue(SP, SV);
Result:=Result + Copy(S, K, I-K) + SV;
i:=j+1;
k:=j+1;
end
else
Inc(I);
end;
if K<i then
Result:=Result + Copy(S, K, I-K);
end;
function UTF8Desc(S: string; var Desc: string): Integer;
var
i,b: Integer;