paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-20 12:59:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazReport, Implemented the possibility of navigation on the report, similar to the html page. And sample, Patch from Aleksey Lagunov

Browse Source 
git-svn-id: trunk@40752 -
This commit is contained in:
jesus 2013-04-08 19:02:28 +00:00
parent 4470a5e9f0
commit b6c62107a1
10 changed files with 1418 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitattributes vendored
View File

@ -1868,6 +1868,12 @@ components/lazreport/samples/enduser_reports/sql_demo/sql_demo.lpr svneol=native
components/lazreport/samples/enduser_reports/sql_demo/unit1.lfm svneol=native#text/plain components/lazreport/samples/enduser_reports/sql_demo/unit1.lfm svneol=native#text/plain
components/lazreport/samples/enduser_reports/sql_demo/unit1.pas svneol=native#text/plain components/lazreport/samples/enduser_reports/sql_demo/unit1.pas svneol=native#text/plain
components/lazreport/samples/index.txt svneol=native#text/plain components/lazreport/samples/index.txt svneol=native#text/plain
components/lazreport/samples/report_url/report_url.lpi svneol=native#text/plain
components/lazreport/samples/report_url/report_url.lpr svneol=native#text/pascal
components/lazreport/samples/report_url/report_url.lps svneol=native#text/xml
components/lazreport/samples/report_url/unit1.lfm svneol=native#text/plain
components/lazreport/samples/report_url/unit1.pas svneol=native#text/pascal
components/lazreport/samples/report_url/url_demo.lrf svneol=LF#text/xml eol=lf
components/lazreport/samples/stringgrid/project1.lpi svneol=native#text/plain components/lazreport/samples/stringgrid/project1.lpi svneol=native#text/plain
components/lazreport/samples/stringgrid/project1.lpr svneol=native#text/pascal components/lazreport/samples/stringgrid/project1.lpr svneol=native#text/pascal
components/lazreport/samples/stringgrid/sample.lrf svneol=LF#text/xml eol=lf components/lazreport/samples/stringgrid/sample.lrf svneol=LF#text/xml eol=lf

92
components/lazreport/samples/report_url/report_url.lpi Normal file
View File

@ -0,0 +1,92 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="report_url"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="lazreport"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="report_url.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="report_url"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="report_url"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
components/lazreport/samples/report_url/report_url.lpr Normal file
View File

@ -0,0 +1,21 @@
program report_url;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

117
components/lazreport/samples/report_url/report_url.lps Normal file
View File

@ -0,0 +1,117 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectSession>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="4">
<Unit0>
<Filename Value="report_url.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="report_url"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="24"/>
<CursorPos X="6" Y="54"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../../lazutils/fileutil.pas"/>
<UnitName Value="FileUtil"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="44"/>
<CursorPos X="4" Y="84"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="../../source/lr_class.pas"/>
<UnitName Value="LR_Class"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="70"/>
<CursorPos X="57" Y="106"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit3>
</Units>
<General>
<ActiveWindowIndexAtStart Value="0"/>
</General>
<JumpHistory Count="15" HistoryIndex="14">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="15" Column="39" TopLine="1"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="19" Column="39" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="unit1.pas"/>
<Caret Line="21" Column="39" TopLine="1"/>
</Position3>
<Position4>
<Filename Value="unit1.pas"/>
<Caret Line="22" Column="39" TopLine="1"/>
</Position4>
<Position5>
<Filename Value="unit1.pas"/>
<Caret Line="24" Column="39" TopLine="1"/>
</Position5>
<Position6>
<Filename Value="unit1.pas"/>
<Caret Line="41" Column="73" TopLine="16"/>
</Position6>
<Position7>
<Filename Value="unit1.pas"/>
<Caret Line="51" Column="24" TopLine="32"/>
</Position7>
<Position8>
<Filename Value="unit1.pas"/>
<Caret Line="62" Column="26" TopLine="60"/>
</Position8>
<Position9>
<Filename Value="unit1.pas"/>
<Caret Line="54" Column="24" TopLine="51"/>
</Position9>
<Position10>
<Filename Value="unit1.pas"/>
<Caret Line="60" Column="48" TopLine="45"/>
</Position10>
<Position11>
<Filename Value="unit1.pas"/>
<Caret Line="23" Column="60" TopLine="2"/>
</Position11>
<Position12>
<Filename Value="unit1.pas"/>
<Caret Line="56" Column="1" TopLine="33"/>
</Position12>
<Position13>
<Filename Value="unit1.pas"/>
<Caret Line="55" Column="1" TopLine="51"/>
</Position13>
<Position14>
<Filename Value="unit1.pas"/>
<Caret Line="53" Column="1" TopLine="24"/>
</Position14>
<Position15>
<Filename Value="unit1.pas"/>
<Caret Line="54" Column="5" TopLine="24"/>
</Position15>
</JumpHistory>
</ProjectSession>
<EditorMacros Count="0"/>
</CONFIG>

53
components/lazreport/samples/report_url/unit1.lfm Normal file
View File

@ -0,0 +1,53 @@
object Form1: TForm1
Left = 936
Height = 240
Top = 324
Width = 320
Caption = 'Form1'
ClientHeight = 240
ClientWidth = 320
OnCreate = FormCreate
LCLVersion = '1.1'
object Button1: TButton
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 118
Height = 27
Top = 96
Width = 85
AutoSize = True
Caption = 'Show Demo'
OnClick = Button1Click
TabOrder = 0
end
object Button2: TButton
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 123
Height = 27
Top = 136
Width = 74
AutoSize = True
Caption = 'Edit Demo'
OnClick = Button2Click
TabOrder = 1
end
object frReport1: TfrReport
DefaultCopies = 0
InitialZoom = pzDefault
Options = []
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbHelp, pbExit]
DataType = dtDataSet
OnObjectClick = frReport1ObjectClick
OnMouseOverObject = frReport1MouseOverObject
left = 24
top = 17
ReportForm = {
1A000000
}
end
object frDesigner1: TfrDesigner
left = 72
top = 17
end
end

74
components/lazreport/samples/report_url/unit1.pas Normal file
View File

@ -0,0 +1,74 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LR_Class, LR_Desgn, Forms, Controls, Graphics,
Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
frDesigner1: TfrDesigner;
frReport1: TfrReport;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure frReport1MouseOverObject(View: TfrView; var ACursor: TCursor);
procedure frReport1ObjectClick(View: TfrView);
private
FRepFileName:string;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
uses LazUTF8;
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
FRepFileName:=AppendPathDelim(ExtractFileDir(ParamStrUTF8(0))) + 'url_demo.lrf';
if FileExistsUTF8(FRepFileName) then
frReport1.LoadFromFile(FRepFileName)
else
frReport1.FileName:=FRepFileName;
end;
procedure TForm1.frReport1MouseOverObject(View: TfrView; var ACursor: TCursor);
begin
if Pos('url', UTF8LowerCase(View.Tag))>0 then
ACursor:=crHandPoint;
end;
procedure TForm1.frReport1ObjectClick(View: TfrView);
begin
if Pos('url_ext', UTF8LowerCase(View.Tag))>0 then
ShowMessage('Selected adres: '+View.URLInfo);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
frReport1.ShowReport;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
frReport1.DesignReport;
end;
end.

891
components/lazreport/samples/report_url/url_demo.lrf Normal file
View File

@ -0,0 +1,891 @@
<?xml version="1.0" encoding="utf-8"?>
<CONFIG>
<LazReport>
<Version Value="26"/>
<Title Value=""/>
<Subject Value=""/>
<KeyWords Value=""/>
<Comments Value=""/>
<ReportCreateDate Value="1899-12-30 00:00:00"/>
<ReportLastChange Value="2013-04-08 16:32:04"/>
<ReportVersionBuild Value=""/>
<ReportVersionMajor Value=""/>
<ReportVersionMinor Value=""/>
<ReportVersionRelease Value=""/>
<ReportAutor Value=""/>
<Pages>
<PrintToDefault Value="False"/>
<DoublePass Value="False"/>
<SelectedPrinter Value="X264dn"/>
<PageCount Value="4"/>
<Page1>
<Name Value="Page1"/>
<ClassName Value="TfrPageReport"/>
<Visible Value="True"/>
<Width Value="595"/>
<Height Value="842"/>
<Script Value=""/>
<PgSize Value="9"/>
<Margins>
<left Value="36"/>
<Top Value="36"/>
<Right Value="36"/>
<Bottom Value="36"/>
</Margins>
<Orientation Value="poPortrait"/>
<UseMargins Value="True"/>
<PrintToPrevPage Value="False"/>
<ColCount Value="1"/>
<ColGap Value="0"/>
<LayoutOrder Value="loColumns"/>
<ObjectCount Value="14"/>
<Object1>
<Name Value="ReportTitle1"/>
<ClassName Value="TfrBandView"/>
<Visible Value="True"/>
<Typ Value="gtBand"/>
<StreamMode Value="0"/>
<Size>
<Left Value="0"/>
<Top Value="36"/>
<Width Value="752"/>
<Height Value="28"/>
</Size>
<Flags Value="48"/>
<Data>
<Script Value=""/>
</Data>
<Tag Value=""/>
<FURLInfo Value=""/>
<BandType Value="btReportTitle"/>
<Condition Value=""/>
<DatasetStr Value=""/>
</Object1>
<Object2>
<Name Value="MasterData1"/>
<ClassName Value="TfrBandView"/>
<Visible Value="True"/>
<Typ Value="gtBand"/>
<StreamMode Value="0"/>
<Size>
<Left Value="0"/>
<Top Value="76"/>
<Width Value="752"/>
<Height Value="80"/>
</Size>
<Flags Value="48"/>
<Data>
<Script Value=""/>
</Data>
<Tag Value=""/>
<FURLInfo Value=""/>
<BandType Value="btMasterData"/>
<Condition Value=""/>
<DatasetStr Value="1"/>
</Object2>
<Object3>
<Name Value="MasterData2"/>
<ClassName Value="TfrBandView"/>
<Visible Value="True"/>
<Typ Value="gtBand"/>
<StreamMode Value="0"/>
<Size>
<Left Value="0"/>
<Top Value="228"/>
<Width Value="752"/>
<Height Value="112"/>
</Size>
<Flags Value="48"/>
<Data>
<Script Value=""/>
</Data>
<Tag Value=""/>
<FURLInfo Value=""/>
<BandType Value="btMasterData"/>
<Condition Value=""/>
<DatasetStr Value="1"/>
</Object3>
<Object4>
<Name Value="Memo4"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="36"/>
<Top Value="44"/>
<Width Value="680"/>
<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="Table of content&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value=""/>
<FURLInfo Value=""/>
<Font>
<Name Value="Arial"/>
<Size Value="11"/>
<Color Value="clBlack"/>
<Charset Value="0"/>
<Style Value="fsBold"/>
</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"/>
</Object4>
<Object5>
<Name Value="Memo5"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="36"/>
<Top Value="88"/>
<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 2&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="url"/>
<FURLInfo Value="@2"/>
<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"/>
</Object5>
<Object6>
<Name Value="Memo6"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="640"/>
<Top Value="88"/>
<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="2&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="url"/>
<FURLInfo Value="@2"/>
<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"/>
</Object6>
<Object7>
<Name Value="Memo7"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="36"/>
<Top Value="108"/>
<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 3&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="url"/>
<FURLInfo Value="@3"/>
<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"/>
</Object7>
<Object8>
<Name Value="Memo8"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="640"/>
<Top Value="108"/>
<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="3&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="url"/>
<FURLInfo Value="@3"/>
<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"/>
</Object8>
<Object9>
<Name Value="Memo9"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="36"/>
<Top Value="128"/>
<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 4&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="url"/>
<FURLInfo Value="@4"/>
<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"/>
</Object9>
<Object10>
<Name Value="Memo10"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="640"/>
<Top Value="128"/>
<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="4&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="url"/>
<FURLInfo Value="@4"/>
<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"/>
</Object10>
<Object11>
<Name Value="Memo11"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="36"/>
<Top Value="228"/>
<Width Value="96"/>
<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="URL list&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value=""/>
<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"/>
</Object11>
<Object12>
<Name Value="Memo12"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="60"/>
<Top Value="248"/>
<Width Value="188"/>
<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="http://www.google.com&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="url_ext"/>
<FURLInfo Value="http://www.google.com"/>
<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"/>
</Object12>
<Object13>
<Name Value="Memo13"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="60"/>
<Top Value="272"/>
<Width Value="188"/>
<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="http://www.linux.org&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="url_ext"/>
<FURLInfo Value="http://www.linux.org"/>
<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"/>
</Object13>
<Object14>
<Name Value="Memo14"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="60"/>
<Top Value="296"/>
<Width Value="188"/>
<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="http://www.yandex.ru&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value="url_ext"/>
<FURLInfo Value="http://www.yandex.ru"/>
<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"/>
</Object14>
</Page1>
<Page2>
<Name Value="Page2"/>
<ClassName Value="TfrPageReport"/>
<Visible Value="True"/>
<Width Value="595"/>
<Height Value="842"/>
<Script Value=""/>
<PgSize Value="9"/>
<Margins>
<left Value="36"/>
<Top Value="36"/>
<Right Value="36"/>
<Bottom Value="36"/>
</Margins>
<Orientation Value="poPortrait"/>
<UseMargins Value="True"/>
<PrintToPrevPage Value="False"/>
<ColCount Value="1"/>
<ColGap Value="0"/>
<LayoutOrder Value="loColumns"/>
<ObjectCount Value="2"/>
<Object1>
<Name Value="ReportTitle2"/>
<ClassName Value="TfrBandView"/>
<Visible Value="True"/>
<Typ Value="gtBand"/>
<StreamMode Value="0"/>
<Size>
<Left Value="0"/>
<Top Value="52"/>
<Width Value="752"/>
<Height Value="40"/>
</Size>
<Flags Value="48"/>
<Data>
<Script Value=""/>
</Data>
<Tag Value=""/>
<FURLInfo Value=""/>
<BandType Value="btReportTitle"/>
<Condition Value=""/>
<DatasetStr Value=""/>
</Object1>
<Object2>
<Name Value="Memo1"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="36"/>
<Top Value="52"/>
<Width Value="680"/>
<Height Value="26"/>
</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="PAGE 2&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value=""/>
<FURLInfo Value=""/>
<Font>
<Name Value="helvetica [urw]"/>
<Size Value="11"/>
<Color Value="clBlack"/>
<Charset Value="0"/>
<Style Value="fsBold"/>
</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"/>
</Object2>
</Page2>
<Page3>
<Name Value="Page3"/>
<ClassName Value="TfrPageReport"/>
<Visible Value="True"/>
<Width Value="595"/>
<Height Value="842"/>
<Script Value=""/>
<PgSize Value="9"/>
<Margins>
<left Value="36"/>
<Top Value="36"/>
<Right Value="36"/>
<Bottom Value="36"/>
</Margins>
<Orientation Value="poPortrait"/>
<UseMargins Value="True"/>
<PrintToPrevPage Value="False"/>
<ColCount Value="1"/>
<ColGap Value="0"/>
<LayoutOrder Value="loColumns"/>
<ObjectCount Value="2"/>
<Object1>
<Name Value="Band1"/>
<ClassName Value="TfrBandView"/>
<Visible Value="True"/>
<Typ Value="gtBand"/>
<StreamMode Value="0"/>
<Size>
<Left Value="0"/>
<Top Value="36"/>
<Width Value="752"/>
<Height Value="40"/>
</Size>
<Flags Value="48"/>
<Data>
<Script Value=""/>
</Data>
<Tag Value=""/>
<FURLInfo Value=""/>
<BandType Value="btReportTitle"/>
<Condition Value=""/>
<DatasetStr Value=""/>
</Object1>
<Object2>
<Name Value="Memo2"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="36"/>
<Top Value="36"/>
<Width Value="680"/>
<Height Value="26"/>
</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="PAGE 3&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value=""/>
<FURLInfo Value=""/>
<Font>
<Name Value="helvetica [urw]"/>
<Size Value="11"/>
<Color Value="clBlack"/>
<Charset Value="0"/>
<Style Value="fsBold"/>
</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"/>
</Object2>
</Page3>
<Page4>
<Name Value="Page4"/>
<ClassName Value="TfrPageReport"/>
<Visible Value="True"/>
<Width Value="595"/>
<Height Value="842"/>
<Script Value=""/>
<PgSize Value="9"/>
<Margins>
<left Value="36"/>
<Top Value="36"/>
<Right Value="36"/>
<Bottom Value="36"/>
</Margins>
<Orientation Value="poPortrait"/>
<UseMargins Value="True"/>
<PrintToPrevPage Value="False"/>
<ColCount Value="1"/>
<ColGap Value="0"/>
<LayoutOrder Value="loColumns"/>
<ObjectCount Value="2"/>
<Object1>
<Name Value="Band2"/>
<ClassName Value="TfrBandView"/>
<Visible Value="True"/>
<Typ Value="gtBand"/>
<StreamMode Value="0"/>
<Size>
<Left Value="0"/>
<Top Value="84"/>
<Width Value="752"/>
<Height Value="40"/>
</Size>
<Flags Value="48"/>
<Data>
<Script Value=""/>
</Data>
<Tag Value=""/>
<FURLInfo Value=""/>
<BandType Value="btReportTitle"/>
<Condition Value=""/>
<DatasetStr Value=""/>
</Object1>
<Object2>
<Name Value="Memo3"/>
<ClassName Value="TfrMemoView"/>
<Visible Value="True"/>
<Typ Value="gtMemo"/>
<StreamMode Value="0"/>
<Size>
<Left Value="36"/>
<Top Value="84"/>
<Width Value="680"/>
<Height Value="26"/>
</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="PAGE 4&#xA;"/>
<Script Value=""/>
</Data>
<Tag Value=""/>
<FURLInfo Value=""/>
<Font>
<Name Value="helvetica [urw]"/>
<Size Value="11"/>
<Color Value="clBlack"/>
<Charset Value="0"/>
<Style Value="fsBold"/>
</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"/>
</Object2>
</Page4>
<FVal>
<Count Value="0"/>
</FVal>
<ParentVars Value=""/>
</Pages>
</LazReport>
</CONFIG>

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

@ -102,6 +102,8 @@ type
TBeginColumnEvent = procedure(Band: TfrBand) of object; TBeginColumnEvent = procedure(Band: TfrBand) of object;
TPrintColumnEvent = procedure(ColNo: Integer; var Width: Integer) of object; TPrintColumnEvent = procedure(ColNo: Integer; var Width: Integer) of object;
TManualBuildEvent = procedure(Page: TfrPage) of object; TManualBuildEvent = procedure(Page: TfrPage) of object;
TObjectClickEvent = procedure(View: TfrView) of object;
TMouseOverObjectEvent = procedure(View: TfrView; var ACursor: TCursor) of object;
TfrHighlightAttr = packed record TfrHighlightAttr = packed record
FontStyle: Word; FontStyle: Word;
@ -222,6 +224,8 @@ type
fFormat : Integer; fFormat : Integer;
fFormatStr : string; fFormatStr : string;
fFrameTyp : word; fFrameTyp : word;
FTag: string;
FURLInfo: string;
function GetLeft: Double; function GetLeft: Double;
function GetStretched: Boolean; function GetStretched: Boolean;
function GetTop: Double; function GetTop: Double;
@ -316,6 +320,8 @@ type
published published
property Left: double read GetLeft write SetLeft; property Left: double read GetLeft write SetLeft;
property Top: double read GetTop write SetTop; property Top: double read GetTop write SetTop;
property Tag: string read FTag write FTag;
property URLInfo: string read FURLInfo write FURLInfo;
property Width: double read GetWidth write SetWidth; property Width: double read GetWidth write SetWidth;
property Height: double read GetHeight write SetHeight; property Height: double read GetHeight write SetHeight;
end; end;
@ -889,6 +895,10 @@ type
procedure Add(APage: TfrPage); procedure Add(APage: TfrPage);
procedure Insert(Index: Integer; APage: TfrPage); procedure Insert(Index: Integer; APage: TfrPage);
procedure Delete(Index: Integer); procedure Delete(Index: Integer);
function DoMouseClick(Index: Integer; pt: TPoint; var AInfo: String): Boolean;
function DoMouseMove(Index: Integer; pt: TPoint; var Cursor: TCursor; var AInfo: String): Boolean;
procedure LoadFromStream(AStream: TStream); procedure LoadFromStream(AStream: TStream);
procedure AddPagesFromStream(AStream: TStream; AReadHeader: boolean=true); procedure AddPagesFromStream(AStream: TStream; AReadHeader: boolean=true);
procedure LoadFromXML({%H-}XML: TLrXMLConfig; const {%H-}Path: String); procedure LoadFromXML({%H-}XML: TLrXMLConfig; const {%H-}Path: String);
@ -944,6 +954,8 @@ type
private private
FDataType: TfrDataType; FDataType: TfrDataType;
FDefaultCopies: Integer; FDefaultCopies: Integer;
FMouseOverObject: TMouseOverObjectEvent;
FObjectClick: TObjectClickEvent;
FOnExportFilterSetup: TExportFilterSetup; FOnExportFilterSetup: TExportFilterSetup;
FPages: TfrPages; FPages: TfrPages;
FEMFPages: TfrEMFPages; FEMFPages: TfrEMFPages;
@ -1131,6 +1143,8 @@ type
property OnPrintColumn: TPrintColumnEvent read FOnPrintColumn write FOnPrintColumn; property OnPrintColumn: TPrintColumnEvent read FOnPrintColumn write FOnPrintColumn;
property OnManualBuild: TManualBuildEvent read FOnManualBuild write FOnManualBuild; property OnManualBuild: TManualBuildEvent read FOnManualBuild write FOnManualBuild;
property OnExportFilterSetup: TExportFilterSetup read FOnExportFilterSetup write FOnExportFilterSetup; property OnExportFilterSetup: TExportFilterSetup read FOnExportFilterSetup write FOnExportFilterSetup;
property OnObjectClick: TObjectClickEvent read FObjectClick write FObjectClick;
property OnMouseOverObject: TMouseOverObjectEvent read FMouseOverObject write FMouseOverObject;
end; end;
TfrCompositeReport = class(TfrReport) TfrCompositeReport = class(TfrReport)
@ -1240,9 +1254,10 @@ procedure frSelectHyphenDictionary(ADict: string);
const const
lrTemplatePath = 'LazReportTemplate/'; lrTemplatePath = 'LazReportTemplate/';
frCurrentVersion = 25; frCurrentVersion = 26;
// version 2.5: lazreport: added to binary stream ParentBandType variable // version 2.5: lazreport: added to binary stream ParentBandType variable
// on TfrView, used to extend export facilities // on TfrView, used to extend export facilities
// version 2.6: lazreport: added to binary stream Tag property on TfrView
frSpecCount = 9; frSpecCount = 9;
frSpecFuncs: Array[0..frSpecCount - 1] of String = ('PAGE#', '', frSpecFuncs: Array[0..frSpecCount - 1] of String = ('PAGE#', '',
@ -1976,6 +1991,8 @@ begin
fFormatStr := From.FormatStr; fFormatStr := From.FormatStr;
fVisible := From.Visible; fVisible := From.Visible;
fFrames:=From.Frames; fFrames:=From.Frames;
FTag:=From.FTag;
FURLInfo:=From.FURLInfo;
end; end;
procedure TfrView.CalcGaps; procedure TfrView.CalcGaps;
@ -2032,7 +2049,7 @@ begin
fFrameWidth := SaveFW; fFrameWidth := SaveFW;
end; end;
procedure TfrView.ShowBackground; procedure TfrView.ShowBackGround;
var var
fp: TColor; fp: TColor;
begin begin
@ -2182,6 +2199,9 @@ begin
end; end;
procedure TfrView.Print(Stream: TStream); procedure TfrView.Print(Stream: TStream);
var
FTmpTag:string;
begin begin
{$IFDEF DebugLR} {$IFDEF DebugLR}
DebugLn('%s.TfrView.Print()',[name]); DebugLn('%s.TfrView.Print()',[name]);
@ -2195,7 +2215,14 @@ begin
Stream.Write(Typ, 1); Stream.Write(Typ, 1);
if Typ = gtAddIn then if Typ = gtAddIn then
frWriteString(Stream, ClassName); frWriteString(Stream, ClassName);
{ FTmpTag:=FTag;
if (FTag<>'') and (Pos('[', FTag) > 0) then
ExpandVariables(FTag);}
SaveToStream(Stream); SaveToStream(Stream);
{ FTag:=FTmpTag;}
{$IFDEF DebugLR} {$IFDEF DebugLR}
DebugLn('%s.TfrView.Print() end',[name]); DebugLn('%s.TfrView.Print() end',[name]);
{$ENDIF} {$ENDIF}
@ -2285,6 +2312,12 @@ begin
ParentBandType := TfrBandType(I); ParentBandType := TfrBandType(I);
end; end;
if frVersion>25 then
begin
FTag := frReadString(Stream);
FURLInfo := frReadString(Stream);
end;
end; end;
{$IFDEF DebugLR} {$IFDEF DebugLR}
DebugLn('%s.TfrView.LoadFromStream end',[name]); DebugLn('%s.TfrView.LoadFromStream end',[name]);
@ -2331,8 +2364,11 @@ begin
Memo.Text := XML.GetValue(Path+'Data/Memo/Value', ''); // TODO Check default Memo.Text := XML.GetValue(Path+'Data/Memo/Value', ''); // TODO Check default
Script.Text:= XML.GetValue(Path+'Data/Script/Value', ''); // TODO Check default Script.Text:= XML.GetValue(Path+'Data/Script/Value', ''); // TODO Check default
end end
else else
memo1.text := XML.GetValue(Path+'Data/Memo1/Value', ''); // TODO Check default memo1.text := XML.GetValue(Path+'Data/Memo1/Value', ''); // TODO Check default
FTag:=XML.GetValue(Path+'Tag/Value', '');
FURLInfo:=XML.GetValue(Path+'FURLInfo/Value', '');
end; end;
procedure TfrView.SaveToStream(Stream: TStream); procedure TfrView.SaveToStream(Stream: TStream);
@ -2383,6 +2419,9 @@ begin
B := ord(Parent.Typ); B := ord(Parent.Typ);
Write(B, 4); Write(B, 4);
//Tag property stream format 26
frWriteString(Stream, FTag);
frWriteString(Stream, FURLInfo);
end; end;
{$IFDEF DebugLR} {$IFDEF DebugLR}
Debugln('%s.SaveToStream end',[name]); Debugln('%s.SaveToStream end',[name]);
@ -2427,8 +2466,10 @@ begin
XML.SetValue(Path+'Data/Script/Value', TStrings(Script).Text); XML.SetValue(Path+'Data/Script/Value', TStrings(Script).Text);
end end
else else
XML.SetValue(Path+'Data/Memo1/Value', Memo1.Text); XML.SetValue(Path+'Data/Memo1/Value', Memo1.Text);
XML.SetValue(Path+'Tag/Value', FTag);
XML.SetValue(Path+'FURLInfo/Value', FURLInfo);
end; end;
procedure TfrView.Resized; procedure TfrView.Resized;
@ -7998,6 +8039,71 @@ begin
FPages.Delete(Index); FPages.Delete(Index);
end; end;
function TfrEMFPages.DoMouseClick(Index: Integer; pt: TPoint; var AInfo: String
): Boolean;
var
PgInf: PfrPageInfo;
V: TfrView;
i: Integer;
R1:TRect;
begin
Result := False;
PgInf := FPages[Index];
if not Assigned(PgInf) then exit;
AInfo := '';
if not Assigned(PgInf^.Page) then
ObjectsToPage(Index);
for i := 0 to PgInf^.Page.Objects.Count - 1 do
begin
V := TfrView(PgInf^.Page.Objects[i]);
R1:=Rect(Round(V.X), Round(V.Y), Round((V.X + V.DX)), Round((V.Y + V.DY)));
if PtInRect(R1, pt) then
begin
if Assigned(Parent.OnObjectClick) then
begin
Parent.OnObjectClick(V);
Result := True;
AInfo:=V.FURLInfo;
end;
exit;
end;
end;
end;
function TfrEMFPages.DoMouseMove(Index: Integer; pt: TPoint;
var Cursor: TCursor; var AInfo: String): Boolean;
var
PgInf: PfrPageInfo;
V: TfrView;
i: Integer;
R1:TRect;
begin
Result := False;
PgInf := FPages[Index];
if not Assigned(PgInf) then exit;
AInfo := '';
if not Assigned(PgInf^.Page) then
ObjectsToPage(Index);
for i := 0 to PgInf^.Page.Objects.Count - 1 do
begin
V := TfrView(PgInf^.Page.Objects[i]);
R1:=Rect(Round(V.X), Round(V.Y), Round((V.X + V.DX)), Round((V.Y + V.DY)));
if PtInRect(R1, pt) then
begin
if Assigned(Parent.OnMouseOverObject) then
begin
Parent.OnMouseOverObject(V, Cursor);
Result := True;
end;
exit;
end;
end;
end;
procedure TfrEMFPages.LoadFromStream(AStream: TStream); procedure TfrEMFPages.LoadFromStream(AStream: TStream);
var var
i, o, c: Integer; i, o, c: Integer;

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

@ -3192,6 +3192,8 @@ begin
CurReport:=nil; CurReport:=nil;
Rep:=TfrReport.Create(SaveR.Owner); Rep:=TfrReport.Create(SaveR.Owner);
Rep.OnMouseOverObject:=SaveR.OnMouseOverObject;
Rep.OnObjectClick:=SaveR.OnObjectClick;
try try
Rep.LoadFromXMLStream(TestRepStream); Rep.LoadFromXMLStream(TestRepStream);
Rep.ShowReport; Rep.ShowReport;
@ -5824,125 +5826,6 @@ begin
frTemplForm.Free; frTemplForm.Free;
end; end;
{
procedure TfrDesignerForm.N20Click(Sender: TObject); // save as
var
s: String;
begin
WasOk := False;
with SaveDialog1 do
begin
Filter := sFormFile + ' (*.frf)|*.frf|' +
sTemplFile + ' (*.frt)|*.frt|' +
sLazFormFile + ' (*.lrf)|*.lrf' +
'';
InitialDir:=ExtractFilePath(ParamStrUTF8(0));
FileName := CurDocName;
FilterIndex := 3;
if Execute then
FCurDocFileType := FilterIndex;
case FCurDocFileType of
dtFastReportForm:
begin
s := ChangeFileExt(FileName, '.frf');
CurReport.SaveToFile(s);
CurDocName := s;
WasOk := True;
end;
dtFastReportTemplate:
begin
s := ExtractFileName(ChangeFileExt(FileName, '.frt'));
if frTemplateDir <> '' then
s := frTemplateDir + PathDelim + s;
frTemplNewForm := TfrTemplNewForm.Create(nil);
with frTemplNewForm do
if ShowModal = mrOk then
begin
CurReport.SaveTemplate(s, Memo1.Lines, Image1.Picture.Bitmap);
WasOk := True;
end;
frTemplNewForm.Free;
end;
dtLazReportForm: // lasreport form xml format
begin
s := ChangeFileExt(FileName, '.lrf');
CurReport.SaveToXMLFile(s);
CurDocName := s;
WasOk := True;
end;
end;
end;
end;
procedure TfrDesignerForm.FileBtn3Click(Sender: TObject); // save
begin
if CurDocName <> sUntitled then
begin
if FCurDocFileType=dtLazReportForm then
CurReport.SaveToXMLFile(curDocName)
else
CurReport.SaveToFile(CurDocName);
// FileModified := False;
Modified := False;
end
else
N20Click(nil);
end;
procedure TfrDesignerForm.FilePreviewExecute(Sender: TObject); // preview
var
v1, v2: Boolean;
TestRepStream:TMemoryStream;
Rep, SaveR:TfrReport;
procedure DoClearFormsName;
var
i:integer;
begin
for i:=0 to CurReport.Pages.Count - 1 do
if CurReport.Pages[i] is TfrPageDialog then
TfrPageDialog(CurReport.Pages[i]).Form.Name:='';
end;
procedure DoResoreFormsName;
var
i:integer;
begin
for i:=0 to CurReport.Pages.Count - 1 do
if CurReport.Pages[i] is TfrPageDialog then
TfrPageDialog(CurReport.Pages[i]).Form.Name:=TfrPageDialog(CurReport.Pages[i]).Name;
end;
begin
if CurReport is TfrCompositeReport then Exit;
Application.ProcessMessages;
SaveR:=CurReport;
TestRepStream:=TMemoryStream.Create;
CurReport.SaveToXMLStream(TestRepStream);
TestRepStream.Position:=0;
DoClearFormsName;
CurReport:=nil;
Rep:=TfrReport.Create(SaveR.Owner);
try
Rep.LoadFromXMLStream(TestRepStream);
Rep.ShowReport;
FreeAndNil(Rep)
except
on E:Exception do
begin
ShowMessage(E.Message);
if Assigned(Rep) then
FreeAndNil(Rep)
end;
end;
TestRepStream.Free;
CurReport:=SaveR;
CurPage := 0;
DoResoreFormsName;
end;
}
procedure TfrDesignerForm.N42Click(Sender: TObject); // var editor procedure TfrDesignerForm.N42Click(Sender: TObject); // var editor
begin begin
if ShowEvEditor(CurReport) then if ShowEvEditor(CurReport) then

54
components/lazreport/source/lr_view.pas
View File

@ -80,6 +80,8 @@ type
property OnScrollPage:TNotifyEvent read GetOnScrollPage write SetOnScrollPage; property OnScrollPage:TNotifyEvent read GetOnScrollPage write SetOnScrollPage;
end; end;
{ TfrPBox }
TfrPBox = class(TPanel) TfrPBox = class(TPanel)
public public
Preview: TfrPreviewForm; Preview: TfrPreviewForm;
@ -87,6 +89,7 @@ type
procedure Paint; override; procedure Paint; override;
procedure MouseDown(Button: TMouseButton; procedure MouseDown(Button: TMouseButton;
{%H-}Shift: TShiftState; X, Y: Integer); override; {%H-}Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure DblClick; override; procedure DblClick; override;
property OnMouseWheelDown; property OnMouseWheelDown;
@ -215,10 +218,10 @@ type
implementation implementation
uses LR_Class, LR_Prntr, LR_Srch, LR_PrDlg, Printers, strutils;
{$R *.lfm} {$R *.lfm}
uses LR_Class, LR_Prntr, LR_Srch, LR_PrDlg,Printers;
type type
THackControl = class(TWinControl) THackControl = class(TWinControl)
@ -480,16 +483,35 @@ end;
procedure TfrPBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure TfrPBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var var
i: Integer; i, k, PP: Integer;
pt: TPoint; pt: TPoint;
AInfo:string;
begin begin
if Preview.EMFPages = nil then Exit; if Preview.EMFPages = nil then Exit;
with Preview do with Preview do
if Button = mbLeft then if Button = mbLeft then
begin begin
Pt:=Point(X - Preview.ofx, Y - Preview.ofy);
for i := 0 to TfrEMFPages(EMFPages).Count - 1 do for i := 0 to TfrEMFPages(EMFPages).Count - 1 do
if PtInRect(TfrEMFPages(EMFPages)[i]^.r, Point(x - ofx, y - ofy)) then if PtInRect(TfrEMFPages(EMFPages)[i]^.r, Pt) then
begin begin
if TfrEMFPages(EMFPages).DoMouseClick(i, Point(Round((pt.X - TfrEMFPages(EMFPages)[i]^.r.Left) / per), Round((pt.Y - TfrEMFPages(EMFPages)[i]^.r.Top) / per)), AInfo) then
begin
K:=Pos ('@', AInfo);
if (K > 0) then
begin
PP:=StrToIntDef(Copy(AInfo, K+1, 255), -1);
if (PP>0) and (K<TfrEMFPages(EMFPages).Count) then
begin
CurPage := PP;
SetToCurPage;
CurPage := PP;
ShowPageNum;
end;
end;
Exit;
end;
CurPage := i + 1; CurPage := i + 1;
SetToCurPage; SetToCurPage;
CurPage := i + 1; CurPage := i + 1;
@ -497,7 +519,8 @@ begin
break; break;
end; end;
end end
else if Button = mbRight then else
if Button = mbRight then
begin begin
pt := Self.ClientToScreen(Point(X, Y)); pt := Self.ClientToScreen(Point(X, Y));
if frDesigner <> nil then if frDesigner <> nil then
@ -513,6 +536,29 @@ begin
end; end;
end; end;
procedure TfrPBox.MouseMove(Shift: TShiftState; X, Y: Integer);
var
E:TfrEMFPages;
i:integer;
P:TPoint;
C:TCursor;
S:string;
begin
if not Assigned(Preview.EMFPages) then Exit;
E:=TfrEMFPages(Preview.EMFPages);
P:=Point(X - Preview.ofx, Y - Preview.ofy);
for i := 0 to E.Count - 1 do
if PtInRect(E[i]^.R, P) then
begin
if E.DoMouseMove(i, Point(Round((P.X - E[i]^.R.Left) / Preview.per), Round((P.Y - E[i]^.r.Top) / Preview.per)), C, S) then
Cursor:=C
else
Cursor:=crDefault;
Break;
end;
inherited MouseMove(Shift, X, Y);
end;
procedure TfrPBox.DblClick; procedure TfrPBox.DblClick;
begin begin
if Preview.EMFPages = nil then Exit; if Preview.EMFPages = nil then Exit;