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

LazReport, crosstab component and demo + refactoring and fixes, from Alexey Lagunov

Browse Source 
git-svn-id: trunk@46125 -
This commit is contained in:
jesus 2014-09-04 19:28:33 +00:00
parent 6a05eb38c7
commit e6b5d35159
39 changed files with 6523 additions and 688 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
.gitattributes vendored
View File

@ -2198,6 +2198,14 @@ components/lazreport/images/package_images.bat svneol=native#text/x-msdos-progra
components/lazreport/license-lazreport.txt svneol=native#text/plain components/lazreport/license-lazreport.txt svneol=native#text/plain
components/lazreport/license-rus.txt svneol=native#text/plain components/lazreport/license-rus.txt svneol=native#text/plain
components/lazreport/license.txt svneol=native#text/plain components/lazreport/license.txt svneol=native#text/plain
components/lazreport/samples/Demo_CrossTab/demo_cross.lrf svneol=LF#text/xml eol=lf
components/lazreport/samples/Demo_CrossTab/project1.ico -text
components/lazreport/samples/Demo_CrossTab/project1.lpi svneol=native#text/plain
components/lazreport/samples/Demo_CrossTab/project1.lpr svneol=native#text/pascal
components/lazreport/samples/Demo_CrossTab/project1.lps svneol=native#text/xml
components/lazreport/samples/Demo_CrossTab/project1.res -text
components/lazreport/samples/Demo_CrossTab/unit1.lfm svneol=native#text/plain
components/lazreport/samples/Demo_CrossTab/unit1.pas svneol=native#text/pascal
components/lazreport/samples/barcode/cb.lpi svneol=native#text/plain components/lazreport/samples/barcode/cb.lpi svneol=native#text/plain
components/lazreport/samples/barcode/cb.lpr svneol=native#text/pascal components/lazreport/samples/barcode/cb.lpr svneol=native#text/pascal
components/lazreport/samples/barcode/cb.res -text components/lazreport/samples/barcode/cb.res -text
@ -2320,6 +2328,8 @@ components/lazreport/source/addons/DialogControls/resources/tlrlistbox.bmp -text
components/lazreport/source/addons/DialogControls/resources/tlrmemo.bmp -text components/lazreport/source/addons/DialogControls/resources/tlrmemo.bmp -text
components/lazreport/source/addons/DialogControls/resources/tlrradiobutton.bmp -text components/lazreport/source/addons/DialogControls/resources/tlrradiobutton.bmp -text
components/lazreport/source/addons/DialogControls/resources/tlrradiogroup.bmp -text components/lazreport/source/addons/DialogControls/resources/tlrradiogroup.bmp -text
components/lazreport/source/addons/SqlDB/lr_editsqldbparamsunit.lfm svneol=native#text/plain
components/lazreport/source/addons/SqlDB/lr_editsqldbparamsunit.pas svneol=native#text/pascal
components/lazreport/source/addons/SqlDB/lr_ibconnection.pas svneol=native#text/plain components/lazreport/source/addons/SqlDB/lr_ibconnection.pas svneol=native#text/plain
components/lazreport/source/addons/SqlDB/lr_pqconnection.pas svneol=native#text/plain components/lazreport/source/addons/SqlDB/lr_pqconnection.pas svneol=native#text/plain
components/lazreport/source/addons/SqlDB/lr_sqldb.lpk svneol=native#text/plain components/lazreport/source/addons/SqlDB/lr_sqldb.lpk svneol=native#text/plain
@ -2466,6 +2476,11 @@ components/lazreport/source/lr_checkbox.res -text
components/lazreport/source/lr_class.pas svneol=native#text/pascal components/lazreport/source/lr_class.pas svneol=native#text/pascal
components/lazreport/source/lr_color.pas svneol=native#text/pascal components/lazreport/source/lr_color.pas svneol=native#text/pascal
components/lazreport/source/lr_const.pas svneol=native#text/pascal components/lazreport/source/lr_const.pas svneol=native#text/pascal
components/lazreport/source/lr_crossarray.pas svneol=native#text/pascal
components/lazreport/source/lr_crosstab.pas svneol=native#text/pascal
components/lazreport/source/lr_crosstab.res -text
components/lazreport/source/lr_crosstabeditor.lfm svneol=native#text/plain
components/lazreport/source/lr_crosstabeditor.pas svneol=native#text/pascal
components/lazreport/source/lr_ctrls.pas svneol=native#text/pascal components/lazreport/source/lr_ctrls.pas svneol=native#text/pascal
components/lazreport/source/lr_dbcomponent.pas svneol=native#text/plain components/lazreport/source/lr_dbcomponent.pas svneol=native#text/plain
components/lazreport/source/lr_dbop.pas svneol=native#text/pascal components/lazreport/source/lr_dbop.pas svneol=native#text/pascal

1663
components/lazreport/samples/Demo_CrossTab/demo_cross.lrf Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
components/lazreport/samples/Demo_CrossTab/project1.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

92
components/lazreport/samples/Demo_CrossTab/project1.lpi Normal file
View File

@ -0,0 +1,92 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<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"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="lazreport"/>
</Item1>
<Item2>
<PackageName Value="SQLDBLaz"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</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="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="5">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="EPropertyError"/>
</Item4>
<Item5>
<Name Value="EStringListError"/>
</Item5>
</Exceptions>
</Debugging>
</CONFIG>

21
components/lazreport/samples/Demo_CrossTab/project1.lpr Normal file
View File

@ -0,0 +1,21 @@
program project1;
{$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.

171
components/lazreport/samples/Demo_CrossTab/project1.lps Normal file
View File

@ -0,0 +1,171 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="17">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos Y="20"/>
<UsageCount Value="35"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<CursorPos X="38" Y="21"/>
<UsageCount Value="35"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="/usr/local/share/lazarus/components/lazreport/source/lr_class.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="104"/>
<CursorPos X="6" Y="120"/>
<UsageCount Value="14"/>
</Unit2>
<Unit3>
<Filename Value="/usr/local/share/lazarus/components/lazreport/source/lr_desgn.pas"/>
<ComponentName Value="frDesignerForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="-1"/>
<TopLine Value="5627"/>
<CursorPos Y="5649"/>
<UsageCount Value="9"/>
</Unit3>
<Unit4>
<Filename Value="/usr/local/share/lazarus/components/lazreport/source/lr_crosstab.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="152"/>
<CursorPos X="15" Y="168"/>
<UsageCount Value="16"/>
<Bookmarks Count="1">
<Item0 Y="393" ID="1"/>
</Bookmarks>
</Unit4>
<Unit5>
<Filename Value="../../../install/source/fpcsrc/rtl/objpas/classes/classesh.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="243"/>
<CursorPos X="3" Y="218"/>
<UsageCount Value="10"/>
</Unit5>
<Unit6>
<Filename Value="/usr/local/share/lazarus/components/lazreport/source/lr_barc.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="471"/>
<CursorPos X="35" Y="490"/>
<UsageCount Value="9"/>
</Unit6>
<Unit7>
<Filename Value="/usr/local/share/lazarus/components/lazreport/source/lr_rrect.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="566"/>
<CursorPos X="56" Y="568"/>
<UsageCount Value="9"/>
</Unit7>
<Unit8>
<Filename Value="/usr/local/share/lazarus/components/lazreport/source/lr_shape.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="25"/>
<CursorPos X="15" Y="46"/>
<UsageCount Value="9"/>
</Unit8>
<Unit9>
<Filename Value="/usr/local/share/lazarus/components/lazreport/source/lr_chbox.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="145"/>
<CursorPos X="43" Y="168"/>
<UsageCount Value="9"/>
</Unit9>
<Unit10>
<Filename Value="C:/lazarus/components/lazreport/source/lr_class.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="4341"/>
<CursorPos Y="4355"/>
<UsageCount Value="9"/>
</Unit10>
<Unit11>
<Filename Value="C:/lazarus/components/lazutils/lazutf8.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="3198"/>
<CursorPos Y="3212"/>
<UsageCount Value="9"/>
</Unit11>
<Unit12>
<Filename Value="C:/lazarus/components/lazreport/source/lr_crosstab.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="951"/>
<CursorPos Y="965"/>
<UsageCount Value="9"/>
</Unit12>
<Unit13>
<Filename Value="C:/lazarus/components/lazreport/source/lr_desgn.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="5512"/>
<CursorPos Y="5526"/>
<UsageCount Value="10"/>
</Unit13>
<Unit14>
<Filename Value="/usr/local/share/lazarus/components/lazreport/source/lr_crosstabeditor.pas"/>
<ComponentName Value="lrCrossTabEditorForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="-1"/>
<TopLine Value="171"/>
<CursorPos X="25" Y="184"/>
<UsageCount Value="16"/>
<LoadedDesigner Value="True"/>
</Unit14>
<Unit15>
<Filename Value="/usr/local/share/lazarus/components/lazreport/source/lr_crossarray.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="187"/>
<CursorPos X="3" Y="193"/>
<UsageCount Value="10"/>
</Unit15>
<Unit16>
<Filename Value="../../source/lr_class.pas"/>
<UnitName Value="LR_Class"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<CursorPos X="41" Y="12"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit16>
</Units>
<JumpHistory Count="2" HistoryIndex="1">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="16" Column="26" TopLine="2"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="21" Column="38"/>
</Position2>
</JumpHistory>
</ProjectSession>
<Debugging>
<Watches Count="4">
<Item1>
<Expression Value="SR"/>
</Item1>
<Item2>
<Expression Value="SC"/>
</Item2>
<Item3>
<Expression Value="V"/>
</Item3>
<Item4>
<Expression Value="S"/>
</Item4>
</Watches>
</Debugging>
</CONFIG>

BIN
components/lazreport/samples/Demo_CrossTab/project1.res Normal file
View File

Binary file not shown.

125
components/lazreport/samples/Demo_CrossTab/unit1.lfm Normal file
View File

@ -0,0 +1,125 @@
object Form1: TForm1
Left = 667
Height = 368
Top = 217
Width = 320
Caption = 'Croo-tab report demo'
ClientHeight = 368
ClientWidth = 320
OnCreate = FormCreate
LCLVersion = '1.3'
object Button1: TButton
Left = 112
Height = 25
Top = 56
Width = 92
AutoSize = True
Caption = 'Design report'
OnClick = Button1Click
TabOrder = 0
end
object Button2: TButton
Left = 112
Height = 25
Top = 120
Width = 84
AutoSize = True
Caption = 'Show report'
OnClick = Button2Click
TabOrder = 1
end
object Label1: TLabel
Left = 16
Height = 15
Top = 8
Width = 130
Caption = 'Croo-tab report demo'
ParentColor = False
end
object Label2: TLabel
Left = 16
Height = 15
Top = 24
Width = 245
Caption = 'Report used standart demo from firebird'
ParentColor = False
end
object SQLQuery1: TSQLQuery
FieldDefs = <
item
Name = 'CUST_NO'
DataType = ftInteger
Precision = -1
Size = 0
end
item
Name = 'CUSTOMER'
DataType = ftString
Precision = -1
Size = 25
end
item
Name = 'ORDER_YEAR'
DataType = ftSmallint
Precision = -1
Size = 0
end
item
Name = 'TOTAL_VALUE'
DataType = ftBCD
Precision = 9
Size = 2
end>
Database = IBConnection1
Transaction = SQLTransaction1
SQL.Strings = (
'select'
' CUSTOMER.CUST_NO,'
' CUSTOMER.CUSTOMER,'
' EXTRACT(year from sales.order_date) as order_year,'
' sales.total_value'
'from'
' SALES'
' inner join CUSTOMER on (CUSTOMER.CUST_NO = SALES.CUST_NO)'
''
)
Params = <>
left = 24
top = 288
end
object SQLTransaction1: TSQLTransaction
Active = False
Database = IBConnection1
left = 56
top = 248
end
object IBConnection1: TIBConnection
Connected = True
LoginPrompt = False
DatabaseName = 'employee'
KeepConnection = False
Password = 'masterkey'
Transaction = SQLTransaction1
UserName = 'sysdba'
CharSet = 'utf8'
HostName = '127.0.0.1'
left = 24
top = 248
end
object frReport1: TfrReport
InitialZoom = pzDefault
Options = []
PreviewButtons = [pbZoom, pbLoad, pbSave, pbPrint, pbFind, pbHelp, pbExit]
DataType = dtDataSet
left = 66
top = 183
end
object frDesigner1: TfrDesigner
left = 104
top = 183
end
object lrCrossObject1: TlrCrossObject
left = 144
top = 184
end
end

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

@ -0,0 +1,74 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LR_Class, LR_Desgn, lr_CrossTab, Forms, Controls,
Graphics, Dialogs, StdCtrls, sqldb, IBConnection;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
frDesigner1: TfrDesigner;
frReport1: TfrReport;
IBConnection1: TIBConnection;
Label1: TLabel;
Label2: TLabel;
lrCrossObject1: TlrCrossObject;
SQLQuery1: TSQLQuery;
SQLTransaction1: TSQLTransaction;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
function RepName:string;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
if FileExistsUTF8(RepName) then
frReport1.LoadFromFile(RepName)
else
frReport1.FileName:=RepName;
frReport1.DesignReport;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if FileExistsUTF8(RepName) then
begin
frReport1.LoadFromFile(RepName);
frReport1.ShowReport;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IBConnection1.Connected:=true;
SQLQuery1.Open;
end;
function TForm1.RepName: string;
begin
Result:=AppendPathDelim(ExtractFileDir(ParamStrUTF8(0)))+'demo_cross.lrf';
end;
end.

24
components/lazreport/source/addons/DialogControls/lrdialogcontrols.pas
View File

@ -1,6 +1,6 @@
{ LazReport dialogs control { LazReport dialogs control
Copyright (C) 2012-2013 alexs alexs75.at.hotbox.ru Copyright (C) 2012-2014 alexs alexs75.at.yandex.ru
This library is free software; you can redistribute it and/or modify it This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by under the terms of the GNU Library General Public License as published by
@ -75,7 +75,7 @@ type
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override; procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
procedure UpdateControlPosition; override; procedure UpdateControlPosition; override;
procedure AttachToParent; override; procedure AttachToParent; override;
procedure Assign(From: TfrView); override; procedure Assign(Source: TPersistent); override;
property Control: TControl read FControl write FControl; property Control: TControl read FControl write FControl;
property AutoSize: Boolean read GetAutoSize write SetAutoSize; property AutoSize: Boolean read GetAutoSize write SetAutoSize;
@ -1433,18 +1433,18 @@ begin
FControl.Parent := OwnerForm; FControl.Parent := OwnerForm;
end; end;
procedure TlrVisualControl.Assign(From: TfrView); procedure TlrVisualControl.Assign(Source: TPersistent);
begin begin
inherited Assign(From); inherited Assign(Source);
if From is TlrVisualControl then if Source is TlrVisualControl then
begin begin
AutoSize:=TlrVisualControl(From).AutoSize; AutoSize:=TlrVisualControl(Source).AutoSize;
Color:=TlrVisualControl(From).Color; Color:=TlrVisualControl(Source).Color;
Caption:=TlrVisualControl(From).Caption; Caption:=TlrVisualControl(Source).Caption;
Text:=TlrVisualControl(From).Text; Text:=TlrVisualControl(Source).Text;
Font:=TlrVisualControl(From).Font; Font:=TlrVisualControl(Source).Font;
Hint:=TlrVisualControl(From).Hint; Hint:=TlrVisualControl(Source).Hint;
OnClick:=TlrVisualControl(From).OnClick; OnClick:=TlrVisualControl(Source).OnClick;
end; end;
end; end;

151
components/lazreport/source/addons/SqlDB/lr_editsqldbparamsunit.lfm Normal file
View File

@ -0,0 +1,151 @@
object lr_EditSQLDBParamsForm: Tlr_EditSQLDBParamsForm
Left = 592
Height = 358
Top = 442
Width = 622
Caption = 'Edit query param list'
ClientHeight = 358
ClientWidth = 622
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
Position = poScreenCenter
LCLVersion = '1.3'
object ButtonPanel1: TButtonPanel
Left = 6
Height = 41
Top = 311
Width = 610
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton'
HelpButton.DefaultCaption = True
CloseButton.Name = 'CloseButton'
CloseButton.DefaultCaption = True
CancelButton.Name = 'CancelButton'
CancelButton.DefaultCaption = True
TabOrder = 0
ShowButtons = [pbOK, pbCancel, pbHelp]
end
object GroupBox1: TGroupBox
Left = 0
Height = 305
Top = 0
Width = 239
Align = alLeft
Caption = 'Param values'
ClientHeight = 282
ClientWidth = 235
TabOrder = 1
object ListBox1: TListBox
Left = 0
Height = 282
Top = 0
Width = 235
Align = alClient
ItemHeight = 0
OnClick = ListBox1Click
ScrollWidth = 233
TabOrder = 0
TopIndex = -1
end
end
object GroupBox2: TGroupBox
Left = 244
Height = 305
Top = 0
Width = 378
Align = alClient
Caption = 'Param value'
ClientHeight = 282
ClientWidth = 374
TabOrder = 2
object Label1: TLabel
AnchorSideLeft.Control = GroupBox2
AnchorSideTop.Control = GroupBox2
Left = 6
Height = 21
Top = 6
Width = 74
BorderSpacing.Around = 6
Caption = 'Param type'
ParentColor = False
end
object ComboBox1: TComboBox
AnchorSideLeft.Control = Label1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 12
Height = 29
Top = 33
Width = 356
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
ItemHeight = 0
ItemIndex = 0
Items.Strings = (
'String'
'Integer'
'Float'
'DateTime'
)
Style = csDropDownList
TabOrder = 0
Text = 'String'
end
object Label2: TLabel
AnchorSideLeft.Control = GroupBox2
AnchorSideTop.Control = ComboBox1
AnchorSideTop.Side = asrBottom
Left = 6
Height = 21
Top = 68
Width = 78
BorderSpacing.Around = 6
Caption = 'Param value'
ParentColor = False
end
object Memo1: TMemo
AnchorSideLeft.Control = Label2
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = BitBtn1
Left = 12
Height = 142
Top = 95
Width = 356
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 6
Lines.Strings = (
'Memo1'
)
TabOrder = 1
end
object BitBtn1: TBitBtn
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = GroupBox2
AnchorSideBottom.Side = asrBottom
Left = 247
Height = 33
Top = 243
Width = 121
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Select expresion'
OnClick = BitBtn1Click
TabOrder = 2
end
end
object Splitter1: TSplitter
Left = 239
Height = 305
Top = 0
Width = 5
end
end

150
components/lazreport/source/addons/SqlDB/lr_editsqldbparamsunit.pas Normal file
View File

@ -0,0 +1,150 @@
unit lr_EditSQLDBParamsUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
StdCtrls, Buttons, ExtCtrls, lr_SQLQuery, DB;
type
{ Tlr_EditSQLDBParamsForm }
Tlr_EditSQLDBParamsForm = class(TForm)
BitBtn1: TBitBtn;
ButtonPanel1: TButtonPanel;
ComboBox1: TComboBox;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Label1: TLabel;
Label2: TLabel;
ListBox1: TListBox;
Memo1: TMemo;
Splitter1: TSplitter;
procedure BitBtn1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
private
FParams:TQueryParamList;
EditItem:integer;
public
procedure LoadParamList(AParams:TQueryParamList);
procedure SaveParamList(AParams:TQueryParamList);
end;
implementation
uses lr_expres;
{$R *.lfm}
{ Tlr_EditSQLDBParamsForm }
procedure Tlr_EditSQLDBParamsForm.ListBox1Click(Sender: TObject);
var
P:TQueryParam;
begin
if (ListBox1.Items.Count>0) and (ListBox1.ItemIndex > -1) and (ListBox1.ItemIndex<ListBox1.Items.Count) then
begin
if EditItem>-1 then
begin
P:=TQueryParam(FParams[EditItem]);
case ComboBox1.ItemIndex of
0:P.ParamType:=ftString; //String
1:P.ParamType:=ftInteger; //Integer
2:P.ParamType:=ftFloat; //Float
3:P.ParamType:=ftDateTime; //DateTime
else
P.ParamType:=ftUnknown;
end;
P.ParamValue:=Memo1.Text;
end;
EditItem:=ListBox1.ItemIndex;
P:=TQueryParam(FParams[EditItem]);
case P.ParamType of
ftString:ComboBox1.ItemIndex:=0; //String
ftInteger:ComboBox1.ItemIndex:=1; //Integer
ftFloat:ComboBox1.ItemIndex:=2; //Float
ftDateTime:ComboBox1.ItemIndex:=3; //DateTime
else
ComboBox1.ItemIndex:=-1;
end;
Memo1.Text:=P.ParamValue;
end;
end;
procedure Tlr_EditSQLDBParamsForm.BitBtn1Click(Sender: TObject);
var
EF:TlrExpresionEditorForm;
begin
EF:=TlrExpresionEditorForm.Create(Application);
if EF.ShowModal = mrOk then
Memo1.Text:=EF.ResultExpresion;
EF.Free;
end;
procedure Tlr_EditSQLDBParamsForm.FormCloseQuery(Sender: TObject;
var CanClose: boolean);
begin
if ModalResult = mrOk then
ListBox1Click(nil);
end;
procedure Tlr_EditSQLDBParamsForm.FormCreate(Sender: TObject);
begin
{ Caption:=slrEditParamsForm_Caption;
GroupBox1.Caption:=slrEditParamsForm_ParamsList;
GroupBox2.Caption:=slrEditParamsForm_ParamValue;
Label1.Caption:=slrEditParamsForm_ParamType;
Label2.Caption:=slrEditParamsForm_ParamValue;
BitBtn1.Caption:=slrEditParamsForm_SelectExpresion;}
//
FParams:=TQueryParamList.Create;
end;
procedure Tlr_EditSQLDBParamsForm.FormDestroy(Sender: TObject);
begin
FreeAndNil(FParams);
end;
procedure Tlr_EditSQLDBParamsForm.LoadParamList(AParams: TQueryParamList);
var
i:integer;
P:TQueryParam;
begin
FParams.Clear;
ListBox1.Items.Clear;
for i:=0 to AParams.Count - 1 do
begin
P:=TQueryParam(AParams[i]);
FParams.Add(P.ParamType, P.ParamName, P.ParamValue);
ListBox1.Items.Add(P.ParamName);
end;
EditItem:=-1;
if ListBox1.Items.Count > 0 then
begin
ListBox1.ItemIndex:=0;
ListBox1Click(nil);
end;
end;
procedure Tlr_EditSQLDBParamsForm.SaveParamList(AParams: TQueryParamList);
var
i:integer;
P, P1:TQueryParam;
begin
for i:=0 to FParams.Count - 1 do
begin
P:=TQueryParam(FParams[i]);
P1:=TQueryParam(AParams[i]);
P1.ParamType:=P.ParamType;
P1.ParamName:=P.ParamName;
P1.ParamValue:=P.ParamValue;
end;
end;
end.

12
components/lazreport/source/addons/SqlDB/lr_sqldb.lpk
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<Package Version="4"> <Package Version="4">
<Name Value="LR_SqlDB"/> <Name Value="LR_SqlDB"/>
@ -8,12 +8,6 @@
<SearchPaths> <SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions> </CompilerOptions>
<Description Value="Add support to FCL SQLdb components for designing LazReport dialogs at runtime with lr_dialogdesign package"/> <Description Value="Add support to FCL SQLdb components for designing LazReport dialogs at runtime with lr_dialogdesign package"/>
<License Value="modified LGPL-2 <License Value="modified LGPL-2
@ -35,8 +29,8 @@
<UnitName Value="LR_IBConnection"/> <UnitName Value="LR_IBConnection"/>
</Item3> </Item3>
<Item4> <Item4>
<Filename Value="lrsqldb_img.inc"/> <Filename Value="lr_editsqldbparamsunit.pas"/>
<Type Value="Include"/> <UnitName Value="lr_editsqldbparamsunit"/>
</Item4> </Item4>
</Files> </Files>
<Type Value="RunAndDesignTime"/> <Type Value="RunAndDesignTime"/>

3
components/lazreport/source/addons/SqlDB/lr_sqldb.pas
View File

@ -7,7 +7,8 @@ unit LR_SqlDB;
interface interface
uses uses
LR_PQConnection, lr_SQLQuery, LR_IBConnection, LazarusPackageIntf; LR_PQConnection, lr_SQLQuery, LR_IBConnection, lr_EditSQLDBParamsUnit,
LazarusPackageIntf;
implementation implementation

207
components/lazreport/source/addons/SqlDB/lr_sqlquery.pas
View File

@ -5,18 +5,33 @@ unit lr_SQLQuery;
interface interface
uses uses
Classes, SysUtils, Graphics, LR_Class, LR_DBComponent, sqldb, DB; Classes, SysUtils, Graphics, LR_Class, LR_DBComponent, sqldb, DB, contnrs;
type type
TQueryParam = class
ParamType:TFieldType;
ParamName:string;
ParamValue:string;
end;
{ TQueryParamList }
TQueryParamList = class(TFPObjectList)
function ParamByName(AParamName:string):TQueryParam;
function Add(AParamType:TFieldType; const AParamName, AParamValue:string):TQueryParam;
end;
{ TLRSQLQuery } { TLRSQLQuery }
TLRSQLQuery = class(TLRDataSetControl) TLRSQLQuery = class(TLRDataSetControl)
private private
FDatabase: string; FDatabase: string;
FParams: TQueryParamList;
procedure SetDatabase(AValue: string); procedure SetDatabase(AValue: string);
procedure DoMakeParams; procedure DoMakeParams;
procedure DoEditParams; procedure DoEditParams;
procedure SQLQueryBeforeOpen(ADataSet: TDataSet);
protected protected
function GetSQL: string; function GetSQL: string;
procedure SetSQL(AValue:string); procedure SetSQL(AValue:string);
@ -24,12 +39,14 @@ type
procedure AfterLoad;override; procedure AfterLoad;override;
public public
constructor Create(AOwnerPage:TfrPage); override; constructor Create(AOwnerPage:TfrPage); override;
destructor Destroy; override;
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override; procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override; procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
published published
property SQL:string read GetSQL write SetSQL; property SQL:string read GetSQL write SetSQL;
property Database:string read FDatabase write SetDatabase; property Database:string read FDatabase write SetDatabase;
property Params:TQueryParamList read FParams write FParams;
end; end;
{ TLRSQLConnection } { TLRSQLConnection }
@ -77,7 +94,8 @@ implementation
{$R lrsqldb_img.res} {$R lrsqldb_img.res}
uses LR_Utils, DBPropEdits, PropEdits, Controls; uses LR_Utils, DBPropEdits, PropEdits, Controls, Forms,
lr_EditSQLDBParamsUnit;
var var
lrBMP_SQLQuery:TBitmap = nil; lrBMP_SQLQuery:TBitmap = nil;
@ -92,6 +110,34 @@ begin
end; end;
end; end;
{ TQueryParamList }
function TQueryParamList.ParamByName(AParamName: string): TQueryParam;
var
i:integer;
begin
Result:=nil;
AParamName:=UpperCase(AParamName);
for i:=0 to Count - 1 do
begin
if UpperCase(TQueryParam(Items[i]).ParamName) = AParamName then
begin
Result:=TQueryParam(Items[i]);
exit;
end;
end;
end;
function TQueryParamList.Add(AParamType: TFieldType; const AParamName,
AParamValue: string): TQueryParam;
begin
Result:=TQueryParam.Create;
inherited Add(Result);
Result.ParamType:=AParamType;
Result.ParamName:=AParamName;
Result.ParamValue:=AParamValue;
end;
{ TLRSQLConnection } { TLRSQLConnection }
function TLRSQLConnection.GetCharSet: string; function TLRSQLConnection.GetCharSet: string;
@ -235,13 +281,89 @@ begin
end; end;
procedure TLRSQLQuery.DoMakeParams; procedure TLRSQLQuery.DoMakeParams;
var
Q:TSQLQuery;
i:integer;
begin begin
{ TODO : Необходимо реализовать параметры по аналогии с ZEOS } Q:=TSQLQuery(DataSet);
if Q.Params.Count > 0 then
begin
//Add new params...
for i:=0 to Q.Params.Count-1 do
begin
if not Assigned(FParams.ParamByName(Q.Params[i].Name)) then
FParams.Add(ftUnknown, Q.Params[i].Name, '');
end;
//Delete not exists params
for i:=FParams.Count-1 downto 0 do
begin
if not Assigned(Q.Params.FindParam(TQueryParam(FParams[i]).ParamName)) then
FParams.Delete(i);
end;
end
else
FParams.Clear;
end; end;
procedure TLRSQLQuery.DoEditParams; procedure TLRSQLQuery.DoEditParams;
var
lrEditParamsForm: Tlr_EditSQLDBParamsForm;
begin begin
{ TODO : Необходимо реализовать параметры по аналогии с ZEOS } lrEditParamsForm:=Tlr_EditSQLDBParamsForm.Create(Application);
lrEditParamsForm.LoadParamList(FParams);
if lrEditParamsForm.ShowModal = mrOk then
begin
lrEditParamsForm.SaveParamList(FParams);
if Assigned(frDesigner) then
frDesigner.Modified:=true;
end;
lrEditParamsForm.Free;
end;
procedure TLRSQLQuery.SQLQueryBeforeOpen(ADataSet: TDataSet);
var
i: Integer;
s: String;
SaveView: TfrView;
SavePage: TfrPage;
SaveBand: TfrBand;
Q:TSQLQuery;
P:TQueryParam;
begin
Q:=TSQLQuery(DataSet);
SaveView := CurView;
SavePage := CurPage;
SaveBand := CurBand;
CurView := Self;
CurPage := OwnerPage;
CurBand := nil;
for i := 0 to Q.Params.Count - 1 do
begin
S:=Q.Params[i].Name;
P:=FParams.ParamByName(S);
if Assigned(P) and (P.ParamValue <> '') and (DocMode = dmPrinting) then
begin
case P.ParamType of
ftDate,
ftDateTime:Q.Params[i].AsDateTime := frParser.Calc(P.ParamValue);
ftInteger:Q.Params[i].AsInteger := frParser.Calc(P.ParamValue);
ftFloat:Q.Params[i].AsFloat := frParser.Calc(P.ParamValue);
ftString:Q.Params[i].AsString := frParser.Calc(P.ParamValue);
else
Q.Params[i].Value := frParser.Calc(P.ParamValue);
end;
end;
end;
if Assigned(Q.DataBase) then
if not Q.DataBase.Connected then Q.DataBase.Connected:=true;
CurView := SaveView;
CurPage := SavePage;
CurBand := SaveBand;
end; end;
function TLRSQLQuery.GetSQL: string; function TLRSQLQuery.GetSQL: string;
@ -289,25 +411,80 @@ begin
inherited Create(AOwnerPage); inherited Create(AOwnerPage);
BaseName := 'lrSQLQuery'; BaseName := 'lrSQLQuery';
DataSet:=TSQLQuery.Create(OwnerForm); DataSet:=TSQLQuery.Create(OwnerForm);
DataSet.BeforeOpen:=@SQLQueryBeforeOpen;
FParams:=TQueryParamList.Create;
end;
destructor TLRSQLQuery.Destroy;
begin
FreeAndNil(FParams);
inherited Destroy;
end;
function StrToFieldType(AStrTypeName:string):TFieldType;
var
i:TFieldType;
begin
Result:=ftUnknown;
AStrTypeName:=UpperCase(AStrTypeName);
for i in TFieldType do
begin
if UpperCase(Fieldtypenames[i]) = AStrTypeName then
begin
Result:=i;
exit;
end;
end;
end; end;
procedure TLRSQLQuery.LoadFromXML(XML: TLrXMLConfig; const Path: String); procedure TLRSQLQuery.LoadFromXML(XML: TLrXMLConfig; const Path: String);
var
C: Integer;
i: Integer;
begin begin
inherited LoadFromXML(XML, Path); inherited LoadFromXML(XML, Path);
TSQLQuery(DataSet).SQL.Text := XML.GetValue(Path+'SQL/Value'{%H-}, ''); TSQLQuery(DataSet).SQL.Text := XML.GetValue(Path+'SQL/Value'{%H-}, '');
FDatabase:= XML.GetValue(Path+'Database/Value'{%H-}, ''); FDatabase:= XML.GetValue(Path+'Database/Value'{%H-}, '');
C:=XML.GetValue(Path+'Params/Count/Value', 0);
for i:=0 to C-1 do
FParams.Add(
StrToFieldType(XML.GetValue(Path+'Params/Item'+IntToStr(i)+'/ParamType', '')),
XML.GetValue(Path+'Params/Item'+IntToStr(i)+'/Name', ''),
XML.GetValue(Path+'Params/Item'+IntToStr(i)+'/Value', '')
);
end; end;
procedure TLRSQLQuery.SaveToXML(XML: TLrXMLConfig; const Path: String); procedure TLRSQLQuery.SaveToXML(XML: TLrXMLConfig; const Path: String);
var
i: Integer;
P: TQueryParam;
begin begin
inherited SaveToXML(XML, Path); inherited SaveToXML(XML, Path);
XML.SetValue(Path+'SQL/Value', TSQLQuery(DataSet).SQL.Text); XML.SetValue(Path+'SQL/Value', TSQLQuery(DataSet).SQL.Text);
XML.SetValue(Path+'Database/Value', FDatabase); XML.SetValue(Path+'Database/Value', FDatabase);
XML.SetValue(Path+'Params/Count/Value', FParams.Count);
for i:=0 to FParams.Count-1 do
begin
P:=TQueryParam(FParams[i]);
XML.SetValue(Path+'Params/Item'+IntToStr(i)+'/Name', P.ParamName);
XML.SetValue(Path+'Params/Item'+IntToStr(i)+'/Value', P.ParamValue);
XML.SetValue(Path+'Params/Item'+IntToStr(i)+'/ParamType', Fieldtypenames[P.ParamType]);
end;
end; end;
type type
{ TLRZConnectionProtocolProperty } { TLRSQLQueryParamsProperty }
TLRSQLQueryParamsProperty = class(TPropertyEditor)
public
function GetAttributes: TPropertyAttributes; override;
function GetValue: ansistring; override;
procedure Edit; override;
end;
TLRSQLConnectionProtocolProperty = class(TFieldProperty) TLRSQLConnectionProtocolProperty = class(TFieldProperty)
public public
@ -324,6 +501,24 @@ type
procedure Edit; override; procedure Edit; override;
end; end;
{ TLRSQLQueryParamsProperty }
function TLRSQLQueryParamsProperty.GetAttributes: TPropertyAttributes;
begin
Result:=[paDialog, paReadOnly];
end;
function TLRSQLQueryParamsProperty.GetValue: ansistring;
begin
Result:='(Params)';
end;
procedure TLRSQLQueryParamsProperty.Edit;
begin
if (GetComponent(0) is TLRSQLQuery) then
TLRSQLQuery(GetComponent(0)).DoEditParams;
end;
{ TLRSQLQuerySQLProperty } { TLRSQLQuerySQLProperty }
function TLRSQLQuerySQLProperty.GetAttributes: TPropertyAttributes; function TLRSQLQuerySQLProperty.GetAttributes: TPropertyAttributes;
@ -373,6 +568,8 @@ initialization
RegisterPropertyEditor(TypeInfo(string), TLRSQLQuery, 'Database', TLRSQLConnectionProtocolProperty); RegisterPropertyEditor(TypeInfo(string), TLRSQLQuery, 'Database', TLRSQLConnectionProtocolProperty);
RegisterPropertyEditor(TypeInfo(string), TLRSQLQuery, 'SQL', TLRSQLQuerySQLProperty); RegisterPropertyEditor(TypeInfo(string), TLRSQLQuery, 'SQL', TLRSQLQuerySQLProperty);
RegisterPropertyEditor(TypeInfo(TQueryParamList), TLRSQLQuery, 'Params', TLRSQLQueryParamsProperty);
finalization finalization
if Assigned(lrBMP_SQLQuery) then if Assigned(lrBMP_SQLQuery) then
FreeAndNil(lrBMP_SQLQuery); FreeAndNil(lrBMP_SQLQuery);

14
components/lazreport/source/addons/TDbfDB/lr_tdbf.lpk
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<Package Version="4"> <Package Version="4">
<Name Value="LR_TDbf"/> <Name Value="LR_TDbf"/>
@ -8,27 +8,17 @@
<SearchPaths> <SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions> </CompilerOptions>
<Description Value="Add support to DBF components for designing LazReport dialogs at runtime with lr_dialogdesign package"/> <Description Value="Add support to DBF components for designing LazReport dialogs at runtime with lr_dialogdesign package"/>
<License Value="modified LGPL-2 <License Value="modified LGPL-2
"/> "/>
<Version Minor="1" Release="1"/> <Version Minor="1" Release="1"/>
<Files Count="2"> <Files Count="1">
<Item1> <Item1>
<Filename Value="lrtdbfdata.pas"/> <Filename Value="lrtdbfdata.pas"/>
<HasRegisterProc Value="True"/> <HasRegisterProc Value="True"/>
<UnitName Value="lrTDbfData"/> <UnitName Value="lrTDbfData"/>
</Item1> </Item1>
<Item2>
<Filename Value="lrtdbfdata_img.inc"/>
<Type Value="Include"/>
</Item2>
</Files> </Files>
<Type Value="RunAndDesignTime"/> <Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3"> <RequiredPkgs Count="3">

2
components/lazreport/source/addons/lrOfficeImport/lrspreadsheetimportunit.pas
View File

@ -167,7 +167,7 @@ begin
T.MonitorFontChanges; T.MonitorFontChanges;
T.Memo.Text:=FWorksheet.ReadAsUTF8Text(Cell); T.Memo.Text:=FWorksheet.ReadAsUTF8Text(Cell);
frDesigner.Page.Objects.Add(t); // frDesigner.Page.Objects.Add(t);
end end
else else

8
components/lazreport/source/fr3tolrf.pas
View File

@ -513,14 +513,16 @@ var
View: TfrView; View: TfrView;
begin begin
View := CreateView(Page, Node.NodeName); View := CreateView(Page, Node.NodeName);
if View<>nil then begin if View<>nil then
begin
View.BeginUpdate; View.BeginUpdate;
Page.Objects.Add(View); // Page.Objects.Add(View);
LoadView(Node, Page, View, ParentView); LoadView(Node, Page, View, ParentView);
View.EndUpdate; View.EndUpdate;
// process any child // process any child
cNode := Node.FirstChild; cNode := Node.FirstChild;
while cNode<>nil do begin while cNode<>nil do
begin
ProcessObject(Page, cNode, View); ProcessObject(Page, cNode, View);
cNode := cNode.NextSibling; cNode := cNode.NextSibling;
end; end;

14
components/lazreport/source/lazreport.lpk
View File

@ -24,7 +24,7 @@ Lazarus Port: Olivier Guilbaud, Jesus Reyes A.
See license.txt and license-lazreport.txt for details. See license.txt and license-lazreport.txt for details.
"/> "/>
<Version Minor="9" Release="9"/> <Version Minor="9" Release="9"/>
<Files Count="67"> <Files Count="70">
<Item1> <Item1>
<Filename Value="lr_about.pas"/> <Filename Value="lr_about.pas"/>
<UnitName Value="LR_About"/> <UnitName Value="LR_About"/>
@ -294,6 +294,18 @@ See license.txt and license-lazreport.txt for details.
<Filename Value="lr_previewtoolsabstract.pas"/> <Filename Value="lr_previewtoolsabstract.pas"/>
<UnitName Value="lr_previewtoolsabstract"/> <UnitName Value="lr_previewtoolsabstract"/>
</Item67> </Item67>
<Item68>
<Filename Value="lr_crossarray.pas"/>
<UnitName Value="lr_CrossArray"/>
</Item68>
<Item69>
<Filename Value="lr_crosstab.pas"/>
<UnitName Value="lr_CrossTab"/>
</Item69>
<Item70>
<Filename Value="lr_crosstabeditor.pas"/>
<UnitName Value="lr_crosstabeditor"/>
</Item70>
</Files> </Files>
<i18n> <i18n>
<EnableI18N Value="True"/> <EnableI18N Value="True"/>

2
components/lazreport/source/lazreport.pas
View File

@ -14,7 +14,7 @@ uses
LR_Prntr, LR_progr, lr_propedit, LR_Register, LR_RRect, LR_Shape, LR_Utils, LR_Prntr, LR_progr, lr_propedit, LR_Register, LR_RRect, LR_Shape, LR_Utils,
LR_Var, LR_Vared, LR_View, LR_Newrp, Barcode, LR_DBRel, LR_DBComponent, LR_Var, LR_Vared, LR_View, LR_Newrp, Barcode, LR_DBRel, LR_DBComponent,
lr_hyphen, LR_Intrp, fr3tolrf, lr_design_ins_filed, lr_previewtoolsabstract, lr_hyphen, LR_Intrp, fr3tolrf, lr_design_ins_filed, lr_previewtoolsabstract,
LazarusPackageIntf; lr_CrossArray, lr_CrossTab, lr_CrossTabEditor, LazarusPackageIntf;
implementation implementation

10
components/lazreport/source/lr_barc.pas
View File

@ -91,7 +91,7 @@ type
constructor Create(AOwnerPage:TfrPage);override; constructor Create(AOwnerPage:TfrPage);override;
destructor Destroy; override; destructor Destroy; override;
procedure Assign(From: TfrView); override; procedure Assign(Source: TPersistent); override;
function GenerateBitmap: TBitmap; function GenerateBitmap: TBitmap;
procedure LoadFromStream(Stream: TStream); override; procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override; procedure SaveToStream(Stream: TStream); override;
@ -112,6 +112,7 @@ type
property FrameColor; property FrameColor;
property FrameStyle; property FrameStyle;
property FrameWidth; property FrameWidth;
property Restrictions;
end; end;
{ TfrBarCodeForm } { TfrBarCodeForm }
@ -484,10 +485,11 @@ begin
inherited Destroy; inherited Destroy;
end; end;
procedure TfrBarCodeView.Assign(From:TfrView); procedure TfrBarCodeView.Assign(Source: TPersistent);
begin begin
inherited Assign(From); inherited Assign(Source);
Param := (From as TfrBarCodeView).Param; if Source is TfrBarCodeView then
Param := TfrBarCodeView(Source).Param;
end; end;
function TfrBarCodeView.GenerateBitmap: TBitmap; function TfrBarCodeView.GenerateBitmap: TBitmap;

23
components/lazreport/source/lr_chbox.pas
View File

@ -43,20 +43,22 @@ type
procedure Print(Stream: TStream); override; procedure Print(Stream: TStream); override;
procedure ExportData; override; procedure ExportData; override;
procedure DefinePopupMenu(Popup: TPopupMenu); override; procedure DefinePopupMenu(Popup: TPopupMenu); override;
procedure Assign(Source: TPersistent); override;
procedure LoadFromStream(Stream: TStream); override; procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override; procedure SaveToStream(Stream: TStream); override;
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override; procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override; procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
published published
property Checked : Boolean read fChecked write fChecked; property Checked : Boolean read fChecked write fChecked;
property DataField;
property FillColor; property FillColor;
property FrameColor; property FrameColor;
property Frames; property Frames;
property FrameStyle; property FrameStyle;
property FrameWidth; property FrameWidth;
property Script; property Script;
property Restrictions;
end; end;
@ -111,12 +113,18 @@ begin
end; end;
procedure TfrCheckBoxView.Draw(aCanvas: TCanvas); procedure TfrCheckBoxView.Draw(aCanvas: TCanvas);
var
IsChecked: Boolean;
begin begin
BeginDraw(aCanvas); BeginDraw(aCanvas);
Memo1.Assign(Memo); Memo1.Assign(Memo);
CalcGaps; CalcGaps;
ShowBackground; ShowBackground;
DrawCheck(DRect, Self.Checked); IsChecked := Self.Checked;
if Memo1.Count > 0 then
IsChecked := Memo1[0] = '1';
DrawCheck(DRect, IsChecked);
// DrawCheck(DRect, Self.Checked);
ShowFrame; ShowFrame;
RestoreCoord; RestoreCoord;
end; end;
@ -153,10 +161,16 @@ begin
if Popup=nil then; if Popup=nil then;
end; end;
procedure TfrCheckBoxView.Assign(Source: TPersistent);
begin
inherited Assign(Source);
if Source is TfrCheckBoxView then
Self.Checked := TfrCheckBoxView(Source).Checked;
end;
procedure TfrCheckBoxView.LoadFromStream(Stream: TStream); procedure TfrCheckBoxView.LoadFromStream(Stream: TStream);
begin begin
inherited LoadFromStream(Stream); inherited LoadFromStream(Stream);
Stream.Read(fChecked, SizeOf(fChecked)); Stream.Read(fChecked, SizeOf(fChecked));
end; end;
@ -169,7 +183,6 @@ end;
procedure TfrCheckBoxView.LoadFromXML(XML: TLrXMLConfig; const Path: String); procedure TfrCheckBoxView.LoadFromXML(XML: TLrXMLConfig; const Path: String);
begin begin
inherited LoadFromXML(XML, Path); inherited LoadFromXML(XML, Path);
RestoreProperty('Checked',XML.GetValue(Path+'Data/Checked/Value','')); RestoreProperty('Checked',XML.GetValue(Path+'Data/Checked/Value',''));
end; end;

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

File diff suppressed because it is too large Load Diff

325
components/lazreport/source/lr_crossarray.pas Normal file
View File

@ -0,0 +1,325 @@
{ LazReport cross-tab control
Copyright (C) 2014 alexs alexs75.at.yandex.ru
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit lr_CrossArray;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, DB;
type
TExItem = class
FCelCol:string;
FValue:Variant;
Bookmark:TBookMark;
end;
type
{ TExRow }
TExRow = class(TFPList)
private
FRow:string;
function GetCell(ACol: Variant): Variant;
function GetCellData(ACol: Variant): TExItem;
procedure SetCell(ACol: Variant; AValue: Variant);
function Find(ACol:Variant; out Index: Integer): Boolean;
public
destructor Destroy; override;
property Cell[ACol:Variant]:Variant read GetCell write SetCell; default;
property CellData[ACol:Variant]:TExItem read GetCellData;
end;
{ TExVarArray }
TExVarArray = class
private
FColCount: integer;
FRowCount: integer;
FRows:TFPList;
FColHeader:TStringList;
FRowHeader:TStringList;
function GetCell(ACol, ARow: variant): variant;
function GetCellData(ACol, ARow : variant): TExItem;
function GetColCount: integer;
function GetColHeader(ACol: integer): string;
function GetRowCount: integer;
function GetRowHeader(ARow: integer): string;
procedure SetCell(ACol, ARow: variant; AValue: variant);
function Find(ARow:variant; out Index: Integer): Boolean;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
property Cell[ACol, ARow : variant]:variant read GetCell write SetCell;default;
property CellData[ACol, ARow : variant]:TExItem read GetCellData;
property ColCount:integer read GetColCount;
property RowCount:integer read GetRowCount;
property ColHeader[ACol:integer]:string read GetColHeader;
property RowHeader[ARow:integer]:string read GetRowHeader;
end;
implementation
uses math, variants;
{ TExRow }
function TExRow.GetCell(ACol: Variant): Variant;
var
i:integer;
begin
if Find(ACol, i) then
Result:=TExItem(Items[i]).FValue
else
Result:=null;
end;
function TExRow.GetCellData(ACol: Variant): TExItem;
var
i:integer;
begin
if Find(ACol, i) then
Result:=TExItem(Items[i])
else
Result:=nil;
end;
procedure TExRow.SetCell(ACol: Variant; AValue: Variant);
var
R:TExItem;
i:integer;
begin
if Find(ACol, i) then
TExItem(Items[i]).FValue:=AValue
else
begin
R:=TExItem.Create;
R.FValue:=AValue;
R.FCelCol:=ACol;
Insert(i, R);
end;
end;
function TExRow.Find(ACol: Variant; out Index: Integer): Boolean;
var
I,L,R,Dir: Integer;
S1, S2:string;
begin
Result := false;
// Use binary search.
L := 0;
R := Count - 1;
while L<=R do
begin
I := (L+R) div 2;
// Dir := CompareStr(TExItem(Items[i]).FCelCol, VarToStr(ACol));
S1:=TExItem(Items[i]).FCelCol;
S2:=VarToStr(ACol);
Dir := CompareStr(S1, S2);
if Dir < 0 then
L := I+1
else
begin
R := I-1;
if Dir = 0 then
begin
Result := true;
L := I;
end;
end;
end;
Index := L;
end;
destructor TExRow.Destroy;
var
i: Integer;
begin
for i:=0 to Count-1 do
begin
TExItem(Items[i]).Free;
Items[i]:=nil;
end;
inherited Destroy;
end;
{ TExVarArray }
function TExVarArray.GetCell(ACol, ARow: variant): variant;
var
i:integer;
begin
if Find(ARow, i) then
Result:=TExRow(FRows[i]).Cell[ACol]
else
Result:=null;
end;
function TExVarArray.GetCellData(ACol, ARow: variant): TExItem;
var
i:integer;
begin
if Find(ARow, i) then
Result:=TExRow(FRows[i]).CellData[ACol]
else
Result:=nil;
end;
function TExVarArray.GetColCount: integer;
begin
Result:=FColHeader.Count;
end;
function TExVarArray.GetColHeader(ACol: integer): string;
begin
if (ACol>=0) and (ACol<FColHeader.Count) then
Result:=FColHeader[ACol]
else
Result:='';
end;
function TExVarArray.GetRowCount: integer;
begin
Result:=FRowHeader.Count;
end;
function TExVarArray.GetRowHeader(ARow: integer): string;
begin
if (ARow>=0) and (ARow<FRowHeader.Count) then
Result:=FRowHeader[ARow]
else
Result:='';
end;
procedure TExVarArray.SetCell(ACol, ARow: variant; AValue: variant);
var
R:TExRow;
i:integer;
begin
if Find(ARow, i) then
R:=TExRow(FRows[i])
else
begin
R:=TExRow.Create;
R.FRow:=ARow;
FRows.Insert(i, R);
end;
R.Cell[ACol]:=AValue;
FRowCount:=Max(FRowCount, FRows.Count);
FColCount:=Max(FColCount, R.Count);
i:=FColHeader.IndexOf(VarToStr(ACol));
if i<0 then
FColHeader.Add(VarToStr(ACol));
i:=FRowHeader.IndexOf(VarToStr(ARow));
if i<0 then
FRowHeader.Add(VarToStr(ARow));
end;
function TExVarArray.Find(ARow: variant; out Index: Integer): Boolean;
var
I,L,R,Dir: Integer;
S1, S2:string;
begin
Result := false;
// Use binary search.
L := 0;
R := FRows.Count - 1;
S2:=VarToStr(ARow);
while L<=R do
begin
I := (L+R) div 2;
// Dir := CompareStr(TExRow(FRows[i]).FRow, VarToStr(ARow));
S1:=TExRow(FRows[i]).FRow;
Dir := CompareStr(S1, S2);
if Dir < 0 then
L := I+1
else
begin
R := I-1;
if Dir = 0 then
begin
Result := true;
L := I;
end;
end;
end;
Index := L;
end;
constructor TExVarArray.Create;
begin
inherited Create;
FRows:=TFPList.Create;
FColHeader:=TStringList.Create;
FColHeader.Sorted:=true;
FRowHeader:=TStringList.Create;
FRowHeader.Sorted:=true;
end;
destructor TExVarArray.Destroy;
var
i: Integer;
begin
for i:=0 to FRows.Count - 1 do
begin
TExRow(FRows.Items[i]).Free;
FRows.Items[i]:=nil;
end;
FRows.Free;
FreeAndNil(FColHeader);
FreeAndNil(FRowHeader);
inherited Destroy;
end;
procedure TExVarArray.Clear;
var
i: Integer;
begin
FColHeader.Clear;
FRowHeader.Clear;
for i:=0 to FRows.Count - 1 do
begin
TExRow(FRows.Items[i]).Free;
FRows.Items[i]:=nil;
end;
FRows.Clear;
end;
end.

1090
components/lazreport/source/lr_crosstab.pas Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
components/lazreport/source/lr_crosstab.res Normal file
View File

Binary file not shown.

1153
components/lazreport/source/lr_crosstabeditor.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

659
components/lazreport/source/lr_crosstabeditor.pas Normal file
View File

@ -0,0 +1,659 @@
{ LazReport cross-tab control
Copyright (C) 2014 alexs alexs75.at.yandex.ru
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit lr_CrossTabEditor;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, types, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ButtonPanel, ExtCtrls, Menus, DB, LR_Class, lr_CrossTab;
type
TCrossCellType = (cctData, cctColHdr, cctRowHdr, cctColTotal,
cctRowTotal, cctGrandTotal, cctCorner1, cctCorner2);
TCrossColorStyle = record
DataCell:TColor;
DataCellAlt:TColor;
RowTitleCell:TColor;
RowTotalCell:TColor;
ColTitleCell:TColor;
ColTotalCell:TColor;
GrandTotalCell:TColor;
TotalCHCell:TColor;
TotalRHCell:TColor;
end;
{ TlrCrossTabEditorForm }
TlrCrossTabEditorForm = class(TForm)
ButtonPanel1: TButtonPanel;
CheckGroup1: TCheckGroup;
ComboBox1: TComboBox;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
ImageList1: TImageList;
Label1: TLabel;
Label2: TLabel;
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
ListBox4: TListBox;
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
MenuItem12: TMenuItem;
MenuItem13: TMenuItem;
MenuItem14: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
PaintBox1: TPaintBox;
PopupMenu1: TPopupMenu;
PopupMenu2: TPopupMenu;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
procedure CheckGroup1ItemClick(Sender: TObject; Index: integer);
procedure ComboBox1Change(Sender: TObject);
procedure ListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ListBox3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MenuItem1Click(Sender: TObject);
procedure MenuItem9Click(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
private
FCross:TlrCrossView;
FCurStyle:TCrossColorStyle;
procedure FillDataSets;
procedure Localize;
//preview paint
procedure ShowBackGround;
procedure ShowFrame(AView:TfrStretcheable; ARect:TRect; AFillColor:TColor);
function IsCellShow(ACellType:TCrossCellType):boolean;
procedure UpdateStilesPopup;
public
constructor CreateEditForm(lrObj: TfrView);
procedure SaveData;
end;
function lrCrossTabEditor(lrObj: TfrView) : boolean;
implementation
uses LR_Utils, LR_DBRel, PropEdits, strutils;
const
CT2Ind : array [TCrossCellType] of integer = (
0, //cctData
0, //cctColHdr,
3, //cctRowHdr,
1, //cctColTotal,
4, //cctRowTotal
6, //cctGrandTotal
2, //cctCorner1,
7 //cctCorner2
);
CountStyles = 8;
CrossStyles : array [0..CountStyles - 1] of TCrossColorStyle =
(
//White
(DataCell:clNone;
DataCellAlt:clNone;
RowTitleCell:clNone; RowTotalCell:clNone;
ColTitleCell:clNone; ColTotalCell:clNone; GrandTotalCell:clNone;
TotalCHCell:clNone; TotalRHCell:clNone),
//Gray
(DataCell:clInfoBk;
DataCellAlt:clNone;
RowTitleCell:clGray; RowTotalCell:clWhite;
ColTitleCell:clGray; ColTotalCell:clWhite; GrandTotalCell:clGray;
TotalCHCell:clGray; TotalRHCell:clGray),
//Orange
(DataCell:$9BEBFF;
DataCellAlt:clNone;
RowTitleCell:$46DAFF; RowTotalCell:$46DAFF;
ColTitleCell:$46DAFF; ColTotalCell:$9BEBFF; GrandTotalCell:$9BEBFF;
TotalCHCell:$46DAFF; TotalRHCell:$46DAFF),
//Green
(DataCell:$00D29E;
DataCellAlt:clNone;
RowTitleCell:$00A47B; RowTotalCell:$00D29E;
ColTitleCell:$00A47B; ColTotalCell:$00D29E; GrandTotalCell:$00D29E;
TotalCHCell:$00A47B; TotalRHCell:$00A47B),
//Green and Orange
(DataCell:$9BEBFF;
DataCellAlt:clNone;
RowTitleCell:$00A47B; RowTotalCell:$9BEBFF;
ColTitleCell:$00A47B; ColTotalCell:$9BEBFF; GrandTotalCell:$9BEBFF;
TotalCHCell:$00A47B; TotalRHCell:$00A47B),
//Blue
(DataCell:$FED3BA;
DataCellAlt:clNone;
RowTitleCell:$FDBD97; RowTotalCell:$FED3BA;
ColTitleCell:$FDBD97; ColTotalCell:$FED3BA; GrandTotalCell:$FED3BA;
TotalCHCell:$FDBD97; TotalRHCell:$FDBD97),
//Blue and White
(DataCell:clWhite;
DataCellAlt:$FDBD97;
RowTitleCell:$FDBD97; RowTotalCell:clWhite;
ColTitleCell:$FDBD97; ColTotalCell:clWhite; GrandTotalCell:clWhite;
TotalCHCell:$FDBD97; TotalRHCell:$FDBD97),
//Сyan
(DataCell:$E6E6E6;
DataCellAlt:clMoneyGreen;
RowTitleCell:$4A4A00; RowTotalCell:$8A8A19;
ColTitleCell:$4A4A00; ColTotalCell:$8A8A19; GrandTotalCell:$8A8A19;
TotalCHCell:$4A4A00; TotalRHCell:$4A4A00)
);
function lrCrossTabEditor(lrObj: TfrView): boolean;
var
lrCrossTabEditorForm: TlrCrossTabEditorForm;
begin
Result:=false;
lrCrossTabEditorForm:=TlrCrossTabEditorForm.CreateEditForm(lrObj);
if lrCrossTabEditorForm.ShowModal = mrOk then
begin
lrCrossTabEditorForm.SaveData;
Result:=true;
end;
lrCrossTabEditorForm.Free;
end;
{$R *.lfm}
type
{ TlrCrossViewDataSetProperty }
TlrCrossViewDataSetProperty = class(TStringProperty)
private
public
function GetAttributes: TPropertyAttributes; override;
procedure Edit; override;
procedure GetValues(Proc: TGetStrProc); override;
end;
{ TlrCrossViewDataSetProperty }
function TlrCrossViewDataSetProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes + [paDialog, paValueList, paSortList];
end;
procedure TlrCrossViewDataSetProperty.Edit;
begin
if (GetComponent(0) is TlrCrossView) then
lrCrossTabEditor(TlrCrossView(GetComponent(0)))
end;
procedure TlrCrossViewDataSetProperty.GetValues(Proc: TGetStrProc);
var
I: Integer;
Values: TStringList;
var
Lst : TStringList;
begin
Lst := TStringList.Create;
try
if Curreport.DataType = dtDataSet then
frGetComponents(CurReport.Owner, TDataSet, Lst, nil)
else
frGetComponents(CurReport.Owner, TDataSource, Lst, nil);
for i:=0 to Lst.Count-1 do
Proc(Lst[i]);
finally
Lst.Free;
end;
end;
{ TlrCrossTabEditorForm }
procedure TlrCrossTabEditorForm.ComboBox1Change(Sender: TObject);
var
DataSet: TfrTDataSet;
begin
ListBox1.Items.Clear;
if ComboBox1.Items.Count>0 then
begin
DataSet := nil;
DataSet := frGetDataSet(ComboBox1.Items[ComboBox1.ItemIndex]);
if Assigned(DataSet) then
begin
try
frGetFieldNames(DataSet, ListBox1.Items);
except
end;
end;
end;
end;
procedure TlrCrossTabEditorForm.CheckGroup1ItemClick(Sender: TObject;
Index: integer);
begin
PaintBox1.Refresh;
end;
procedure TlrCrossTabEditorForm.ListBox2DragDrop(Sender, Source: TObject; X,
Y: Integer);
var
LB2: TListBox;
LB1: TListBox;
begin
if (Source is TListBox) and (Sender <> Source) then
begin
LB1:=TListBox(Source);
LB2:=TListBox(Sender);
if (LB1.ItemIndex>-1) and (LB1.Items.Count>LB1.ItemIndex) then
begin
if (LB2 <> ListBox1) then
begin
if LB2 = ListBox3 then
LB2.Items.Add(LB1.Items[LB1.ItemIndex]+'|SUM')
else
LB2.Items.Add(LB1.Items[LB1.ItemIndex]);
end;
if (LB1<>ListBox1) then
LB1.Items.Delete(LB1.ItemIndex);
end;
end;
end;
procedure TlrCrossTabEditorForm.ListBox2DragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
if Source is TListBox then
Accept := (Sender <> Source) and
(
(TListBox(Sender) = ListBox1)
or
((TListBox(Sender) = ListBox2) and (ListBox2.Items.Count<1)) //temp fix - not create cross-tab for multiple fields
or
((TListBox(Sender) = ListBox3) and (ListBox3.Items.Count<1)) //temp fix - not create cross-tab for multiple fields
or
((TListBox(Sender) = ListBox4) and (ListBox4.Items.Count<1)) //temp fix - not create cross-tab for multiple fields
)
end;
procedure TlrCrossTabEditorForm.ListBox3MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
begin
if X > ListBox3.Width - ListBox3.Width div 4 then
begin
P:=ListBox3.ClientToScreen(Point(X, Y));
PopupMenu2.PopUp(P.X, P.Y);
end;
end;
procedure TlrCrossTabEditorForm.MenuItem1Click(Sender: TObject);
var
T:integer;
begin
T:=TMenuItem(Sender).Tag;
if (T>=0) and (T<CountStyles) then
begin
FCurStyle:=CrossStyles[t];
PaintBox1.Invalidate;
end;
UpdateStilesPopup;
end;
procedure TlrCrossTabEditorForm.MenuItem9Click(Sender: TObject);
begin
if ListBox3.Items.Count>0 then
ListBox3.Items[0]:=Copy2Symb(ListBox3.Items[0], '|') + '|' + CrossFuncList[TMenuItem(Sender).Tag];
end;
procedure TlrCrossTabEditorForm.PaintBox1Paint(Sender: TObject);
var
X, Y:integer;
YY, DY: Integer;
XX, DX: Integer;
begin
ShowBackGround;
ShowFrame(FCross, Rect(0, 0, PaintBox1.Width - 4, PaintBox1.Height -4), FCross.FillColor);
DX:=90;
DY:=Canvas.TextHeight('Wg');
X:=10;
Y:=SpeedButton2.Top + SpeedButton2.Height + 20;
if IsCellShow(cctCorner2) then
ShowFrame(FCross.TotalRHCell, Rect(X, Y, X + DX, Y + DY), FCurStyle.TotalRHCell);
if IsCellShow(cctRowHdr) then
begin
if IsCellShow(cctColHdr) then
YY:=Y + DY
else
YY:=Y;
ShowFrame(FCross.RowTitleCell, Rect(X, YY, X + DX, YY + DY), FCurStyle.RowTitleCell);
X := X + DX;
end;
if IsCellShow(cctCorner1) then
begin
if IsCellShow(cctRowHdr) then
XX:=X + DX
else
XX:= X;
ShowFrame(FCross.TotalCHCell, Rect(XX, Y, XX + DX, Y + DY), FCurStyle.TotalCHCell);
end;
if IsCellShow(cctColHdr) or IsCellShow(cctCorner1) then
begin
if IsCellShow(cctColHdr) then
ShowFrame(FCross.ColTitleCell, Rect(X, Y, X + DX, Y + DY), FCurStyle.ColTitleCell);
Y:=Y + DY;
end;
ShowFrame(FCross.DataCell, Rect(X, Y, X + DX, Y + DY), FCurStyle.DataCell);
if IsCellShow(cctRowTotal) then
begin
if IsCellShow(cctRowHdr) then
XX:=X + DX
else
XX:=X;
ShowFrame(FCross.RowTotalCell, Rect(XX, Y, XX + DX, Y + DY), FCurStyle.RowTotalCell);
end;
Y:=Y + DY;
if IsCellShow(cctColTotal) then
begin
ShowFrame(FCross.ColTotalCell, Rect(X, Y, X + DX, Y + DY), FCurStyle.ColTotalCell);
X:=X + DX;
end;
if IsCellShow(cctGrandTotal) then
ShowFrame(FCross.GrandTotalCell, Rect(X, Y, X + DX, Y + DY), FCurStyle.GrandTotalCell);
end;
procedure TlrCrossTabEditorForm.SpeedButton1Click(Sender: TObject);
var
S:string;
begin
S:=ListBox2.Items.Text;
ListBox2.Items.Text:=ListBox4.Items.Text;
ListBox4.Items.Text:=S;
end;
procedure TlrCrossTabEditorForm.SpeedButton2Click(Sender: TObject);
var
R: types.TPoint;
begin
R:=GroupBox3.ClientToScreen(Point(SpeedButton2.Left, SpeedButton2.Top + SpeedButton2.Height));
PopupMenu1.PopUp(R.X, R.Y);
end;
procedure TlrCrossTabEditorForm.FillDataSets;
var
Lst : TStringList;
begin
Lst := TStringList.Create;
try
if Curreport.DataType = dtDataSet then
frGetComponents(CurReport.Owner, TDataSet, Lst, nil)
else
frGetComponents(CurReport.Owner, TDataSource, Lst, nil);
Lst.Sort;
ComboBox1.Items.Assign(Lst);
ComboBox1.Enabled:=(Lst.Count>0);
finally
Lst.Free;
end;
end;
procedure TlrCrossTabEditorForm.Localize;
begin
Caption:='Cross tab editor';
end;
procedure TlrCrossTabEditorForm.ShowBackGround;
var
fp: TColor;
begin
fp := FCross.FillColor;
if (fp = clNone) then
fp := clWhite;
PaintBox1.Canvas.Brush.Bitmap := nil;
PaintBox1.Canvas.Brush.Style := bsSolid;
PaintBox1.Canvas.Brush.Color := fp;
PaintBox1.Canvas.FillRect(Rect(0,0, Width, Height))
end;
procedure TlrCrossTabEditorForm.ShowFrame(AView: TfrStretcheable; ARect: TRect;
AFillColor: TColor);
procedure Line1(x, y, x1, y1: Integer);
var
i, w: Integer;
begin
if PaintBox1.Canvas.Pen.Style = psSolid then
begin
if AView.FrameStyle<>frsDouble then
begin
PaintBox1.Canvas.MoveTo(x, y);
PaintBox1.Canvas.LineTo(x1, y1);
end
else
begin
if x = x1 then
begin
PaintBox1.Canvas.MoveTo(x - Round(AView.FrameWidth), y);
PaintBox1.Canvas.LineTo(x1 - Round(AView.FrameWidth), y1);
PaintBox1.Canvas.Pen.Color := AView.FillColor;
PaintBox1.Canvas.MoveTo(x, y);
PaintBox1.Canvas.LineTo(x1, y1);
PaintBox1.Canvas.Pen.Color := AView.FrameColor;
PaintBox1.Canvas.MoveTo(x + Round(AView.FrameWidth), y);
PaintBox1.Canvas.LineTo(x1 + Round(AView.FrameWidth), y1);
end
else
begin
PaintBox1.Canvas.MoveTo(x, y - Round(AView.FrameWidth));
PaintBox1.Canvas.LineTo(x1, y1 - Round(AView.FrameWidth));
PaintBox1.Canvas.Pen.Color := AView.FillColor;
PaintBox1.Canvas.MoveTo(x, y);
PaintBox1.Canvas.LineTo(x1, y1);
PaintBox1.Canvas.Pen.Color := AView.FrameColor;
PaintBox1.Canvas.MoveTo(x, y + Round(AView.FrameWidth));
PaintBox1.Canvas.LineTo(x1, y1 + Round(AView.FrameWidth));
end;
end
end
else
begin
PaintBox1.Canvas.Brush.Color:=AView.FillColor;
w := PaintBox1.Canvas.Pen.Width;
PaintBox1.Canvas.Pen.Width := 1;
if x = x1 then
begin
for i := 0 to w - 1 do
begin
PaintBox1.Canvas.MoveTo(x - w div 2 + i, y);
PaintBox1.Canvas.LineTo(x - w div 2 + i, y1);
end
end
else
begin
for i := 0 to w - 1 do
begin
PaintBox1.Canvas.MoveTo(x, y - w div 2 + i);
PaintBox1.Canvas.LineTo(x1, y - w div 2 + i);
end;
end;
PaintBox1.Canvas.Pen.Width := w;
end;
end;
begin
if AFillColor<>clNone then
begin
PaintBox1.Canvas.Brush.Bitmap := nil;
PaintBox1.Canvas.Brush.Style := bsSolid;
PaintBox1.Canvas.Brush.Color := AFillColor;
PaintBox1.Canvas.FillRect(ARect)
end;
if AView.FrameStyle<>frsDouble then
PaintBox1.Canvas.Pen.Style := TPenStyle(AView.FrameStyle);
if (frbRight in FCross.Frames) then
Line1(ARect.Right, ARect.Top, ARect.Right, ARect.Bottom);
if (frbLeft in FCross.Frames) then
Line1(ARect.Left, ARect.Top, ARect.Left, ARect.Bottom);
if (frbBottom in FCross.Frames) then
Line1(ARect.Left, ARect.Bottom, ARect.Right, ARect.Bottom);
if (frbTop in FCross.Frames) then
Line1(ARect.Left, ARect.Top, ARect.Right, ARect.Top);
if AView.Memo.Count>0 then
PaintBox1.Canvas.TextRect(ARect, ARect.Left + 2, ARect.Top, AView.Memo[0]);
end;
function TlrCrossTabEditorForm.IsCellShow(ACellType: TCrossCellType): boolean;
begin
if ACellType = cctData then
Result := true
else
Result:=CheckGroup1.Checked[CT2Ind[ACellType]];
end;
procedure TlrCrossTabEditorForm.UpdateStilesPopup;
var
i: Integer;
begin
for i:=0 to CountStyles-1 do
PopupMenu1.Items[i].Checked :=
(FCurStyle.DataCell = CrossStyles[i].DataCell) and
(FCurStyle.RowTitleCell = CrossStyles[i].RowTitleCell) and
(FCurStyle.RowTotalCell = CrossStyles[i].RowTotalCell) and
(FCurStyle.ColTitleCell = CrossStyles[i].ColTitleCell) and
(FCurStyle.ColTotalCell = CrossStyles[i].ColTotalCell) and
(FCurStyle.GrandTotalCell = CrossStyles[i].GrandTotalCell) and
(FCurStyle.TotalCHCell = CrossStyles[i].TotalCHCell) and
(FCurStyle.TotalRHCell = CrossStyles[i].TotalRHCell);
end;
constructor TlrCrossTabEditorForm.CreateEditForm(lrObj: TfrView);
begin
inherited Create(Application);
Localize;
FCross:=TlrCrossView(lrObj);
FillDataSets;
ComboBox1.Text:=FCross.DataSet;
if ComboBox1.ItemIndex>-1 then
ComboBox1Change(nil);
ListBox2.Items.Assign(FCross.RowFields);
ListBox3.Items.Assign(FCross.CellFields);
ListBox4.Items.Assign(FCross.ColumnFields);
CheckGroup1.Checked[0]:=FCross.ShowColumnHeader;
CheckGroup1.Checked[1]:=FCross.ShowColumnTotal;
CheckGroup1.Checked[2]:=FCross.ShowTotalCHCell;
CheckGroup1.Checked[7]:=FCross.ShowTotalRHCell;
CheckGroup1.Checked[3]:=FCross.ShowRowHeader;
CheckGroup1.Checked[4]:=FCross.ShowRowTotal;
CheckGroup1.Checked[5]:=FCross.ShowTitle;
CheckGroup1.Checked[6]:=FCross.ShowGrandTotal;
FCurStyle.DataCell:=FCross.DataCell.FillColor;
FCurStyle.DataCellAlt:=FCross.DataCell.AlternativeColor;
FCurStyle.RowTitleCell:=FCross.RowTitleCell.FillColor;
FCurStyle.RowTotalCell:=FCross.RowTotalCell.FillColor;
FCurStyle.ColTitleCell:=FCross.ColTitleCell.FillColor;
FCurStyle.ColTotalCell:=FCross.ColTotalCell.FillColor;
FCurStyle.GrandTotalCell:=FCross.GrandTotalCell.FillColor;
FCurStyle.TotalCHCell:=FCross.TotalCHCell.FillColor;
FCurStyle.TotalRHCell:=FCross.TotalRHCell.FillColor;
UpdateStilesPopup;
end;
procedure TlrCrossTabEditorForm.SaveData;
begin
FCross.DataSet:=ComboBox1.Text;
FCross.RowFields.Assign(ListBox2.Items);
FCross.CellFields.Assign(ListBox3.Items);
FCross.ColumnFields.Assign(ListBox4.Items);
FCross.ShowColumnHeader := CheckGroup1.Checked[0];
FCross.ShowColumnTotal := CheckGroup1.Checked[1];
FCross.ShowTotalCHCell := CheckGroup1.Checked[2];
FCross.ShowTotalRHCell := CheckGroup1.Checked[7];
FCross.ShowRowHeader := CheckGroup1.Checked[3];
FCross.ShowRowTotal := CheckGroup1.Checked[4];
FCross.ShowTitle := CheckGroup1.Checked[5];
FCross.ShowGrandTotal := CheckGroup1.Checked[6];
FCross.DataCell.FillColor := FCurStyle.DataCell;
FCross.DataCell.AlternativeColor:= FCurStyle.DataCellAlt;
FCross.RowTitleCell.FillColor := FCurStyle.RowTitleCell;
FCross.RowTotalCell.FillColor := FCurStyle.RowTotalCell;
FCross.ColTitleCell.FillColor := FCurStyle.ColTitleCell;
FCross.ColTotalCell.FillColor := FCurStyle.ColTotalCell;
FCross.GrandTotalCell.FillColor := FCurStyle.GrandTotalCell;
FCross.TotalCHCell.FillColor := FCurStyle.TotalCHCell;
FCross.TotalRHCell.FillColor := FCurStyle.TotalRHCell;
end;
initialization
RegisterPropertyEditor(TypeInfo(String), TlrCrossView, 'DataSet', TlrCrossViewDataSetProperty);
end.

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

@ -1398,7 +1398,7 @@ begin
end; end;
//Show indicator if hightlight it's not empty //Show indicator if hightlight it's not empty
if (t is TfrMemoView) and (Trim(TfrmemoView(t).HighlightStr)<>'') then if (t is TfrCustomMemoView) and (Trim(TfrCustomMemoView(t).HighlightStr)<>'') then
FDesigner.ImgIndic.Draw(Canvas, t.x+1, t.y+iy, 1); FDesigner.ImgIndic.Draw(Canvas, t.x+1, t.y+iy, 1);
end; end;
end; end;
@ -1745,10 +1745,11 @@ var
procedure AddObject(ot: Byte); procedure AddObject(ot: Byte);
begin begin
Objects.Add(frCreateObject(ot, '', FDesigner.Page)); { Objects.Add(frCreateObject(ot, '', FDesigner.Page));
t := TfrView(Objects.Last); t := TfrView(Objects.Last);}
if t is TfrMemoView then t:=frCreateObject(ot, '', FDesigner.Page);
TfrMemoView(t).MonitorFontChanges; if t is TfrCustomMemoView then
TfrCustomMemoView(t).MonitorFontChanges;
end; end;
procedure CreateSection; procedure CreateSection;
@ -1760,8 +1761,9 @@ var
ObjectInserted := frBandTypesForm.ShowModal = mrOk; ObjectInserted := frBandTypesForm.ShowModal = mrOk;
if ObjectInserted then if ObjectInserted then
begin begin
Objects.Add(TfrBandView.Create(FDesigner.Page)); { Objects.Add(TfrBandView.Create(FDesigner.Page));
t := TfrView(Objects.Last); t := TfrView(Objects.Last);}
t:=TfrBandView.Create(FDesigner.Page);
(t as TfrBandView).BandType := frBandTypesForm.SelectedTyp; (t as TfrBandView).BandType := frBandTypesForm.SelectedTyp;
s := frGetBandName(frBandTypesForm.SelectedTyp); s := frGetBandName(frBandTypesForm.SelectedTyp);
THackView(t).BaseName := s; THackView(t).BaseName := s;
@ -1774,8 +1776,9 @@ var
procedure CreateSubReport; procedure CreateSubReport;
begin begin
Objects.Add(TfrSubReportView.Create(FDesigner.Page)); { Objects.Add(TfrSubReportView.Create(FDesigner.Page));
t := TfrView(Objects.Last); t := TfrView(Objects.Last);}
t:=TfrSubReportView.Create(FDesigner.Page);
(t as TfrSubReportView).SubPage := CurReport.Pages.Count; (t as TfrSubReportView).SubPage := CurReport.Pages.Count;
CurReport.Pages.Add; CurReport.Pages.Add;
end; end;
@ -1846,8 +1849,9 @@ begin
if Tag >= gtAddIn then if Tag >= gtAddIn then
begin begin
k := Tag - gtAddIn; k := Tag - gtAddIn;
Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page)); { Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page));
t := TfrView(Objects.Last); t := TfrView(Objects.Last);}
t:=frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page);
end end
else else
AddObject(Tag); AddObject(Tag);
@ -1874,8 +1878,9 @@ begin
if Tag >= gtAddIn then if Tag >= gtAddIn then
begin begin
k := Tag - gtAddIn; k := Tag - gtAddIn;
Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page)); { Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page));
t := TfrView(Objects.Last); t := TfrView(Objects.Last);}
t:=frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page);
end end
else else
AddObject(Tag); AddObject(Tag);
@ -1901,7 +1906,7 @@ begin
begin begin
dx := 40; dx := 40;
dy := 40; dy := 40;
if t is TfrMemoView then if t is TfrCustomMemoView then
FDesigner.GetDefaultSize(dx, dy); FDesigner.GetDefaultSize(dx, dy);
OldRect := Rect(Left, Top, Left + dx, Top + dy); OldRect := Rect(Left, Top, Left + dx, Top + dy);
end; end;
@ -1927,9 +1932,9 @@ begin
if t.Typ <> gtBand then if t.Typ <> gtBand then
t.Frames:=LastFrames; t.Frames:=LastFrames;
if t is TfrMemoView then if t is TfrCustomMemoView then
begin begin
with t as TfrMemoView do with t as TfrCustomMemoView do
begin begin
Font.Name := LastFontName; Font.Name := LastFontName;
Font.Size := LastFontSize; Font.Size := LastFontSize;
@ -2426,7 +2431,7 @@ begin
for i := 0 to Objects.Count - 1 do for i := 0 to Objects.Count - 1 do
begin begin
t := TfrView(Objects[i]); t := TfrView(Objects[i]);
if t.Selected then if (t.Selected) and not (lrrDontSize in T.Restrictions) then
begin begin
if FDesigner.ShapeMode = smAll then if FDesigner.ShapeMode = smAll then
AddRgn(hr, t); AddRgn(hr, t);
@ -2526,6 +2531,9 @@ begin
end; end;
t := TfrView(Objects[TopSelected]); t := TfrView(Objects[TopSelected]);
if (lrrDontSize in T.Restrictions) then
exit;
if FDesigner.ShapeMode = smFrame then if FDesigner.ShapeMode = smFrame then
DrawPage(dmShape) DrawPage(dmShape)
else else
@ -2680,7 +2688,10 @@ begin
for i := 0 to Objects.Count - 1 do for i := 0 to Objects.Count - 1 do
begin begin
t := TfrView(Objects[i]); t := TfrView(Objects[i]);
if not t.Selected then continue; if (not t.Selected) or (AResize and (lrrDontSize in T.Restrictions)) or
((lrrDontMove in T.Restrictions) and not AResize) then
continue;
if FDesigner.ShapeMode = smAll then if FDesigner.ShapeMode = smAll then
AddRgn(hr, t); AddRgn(hr, t);
if aResize then if aResize then
@ -2948,11 +2959,11 @@ begin
end; end;
{$ENDIF} {$ENDIF}
if (SelNum>0) and (FirstSelected is TfrMemoView) then if (SelNum>0) and (FirstSelected is TfrCustomMemoView) then
begin begin
// font of selected memo has preference, select it // font of selected memo has preference, select it
LastFontname := TfrMemoView(FirstSelected).Font.Name; LastFontname := TfrCustomMemoView(FirstSelected).Font.Name;
LastFontSize := TfrMemoView(FirstSelected).Font.Size; LastFontSize := TfrCustomMemoView(FirstSelected).Font.Size;
end else end else
if C2.Items.IndexOf(LastFontName)>=0 then if C2.Items.IndexOf(LastFontName)>=0 then
// last font name remains valid, keep it together with lastFontSize // last font name remains valid, keep it together with lastFontSize
@ -3839,13 +3850,13 @@ end;
procedure TfrDesignerForm.CutToClipboard; procedure TfrDesignerForm.CutToClipboard;
var var
i: Integer; i: Integer;
t: TfrView; T: TfrView;
begin begin
ClearClipBoard; ClearClipBoard;
for i := 0 to Objects.Count - 1 do for i := 0 to Objects.Count - 1 do
begin begin
t := TfrView(Objects[i]); t := TfrView(Objects[i]);
if t.Selected then if (t.Selected) and not (lrrDontDelete in T.Restrictions) and not (doChildComponent in T.DesignOptions) then
begin begin
ClipBd.Add(frCreateObject(t.Typ, t.ClassName, Page)); ClipBd.Add(frCreateObject(t.Typ, t.ClassName, Page));
TfrView(ClipBd.Last).Assign(t); TfrView(ClipBd.Last).Assign(t);
@ -3854,9 +3865,11 @@ begin
for i := Objects.Count - 1 downto 0 do for i := Objects.Count - 1 downto 0 do
begin begin
t := TfrView(Objects[i]); t := TfrView(Objects[i]);
if t.Selected then Page.Delete(i); if t.Selected and not (lrrDontDelete in T.Restrictions) and not (doChildComponent in T.DesignOptions) then
Page.Delete(i);
end; end;
SelNum := 0; SelNum := 0;
PageView.Invalidate;
end; end;
procedure TfrDesignerForm.CopyToClipboard; procedure TfrDesignerForm.CopyToClipboard;
@ -3868,9 +3881,9 @@ begin
for i := 0 to Objects.Count - 1 do for i := 0 to Objects.Count - 1 do
begin begin
t := TfrView(Objects[i]); t := TfrView(Objects[i]);
if t.Selected then if t.Selected and not (doChildComponent in T.DesignOptions) then
begin begin
ClipBd.Add(frCreateObject(t.Typ, t.ClassName, Page)); ClipBd.Add(frCreateObject(t.Typ, t.ClassName, nil));
TfrView(ClipBd.Last).Assign(t); TfrView(ClipBd.Last).Assign(t);
end; end;
end; end;
@ -4146,7 +4159,7 @@ begin
for i := Objects.Count - 1 downto 0 do for i := Objects.Count - 1 downto 0 do
begin begin
t := TfrView(Objects[i]); t := TfrView(Objects[i]);
if t.Selected then if t.Selected and not (lrrDontDelete in T.Restrictions) then
Page.Delete(i); Page.Delete(i);
end; end;
SetPageTitles; SetPageTitles;
@ -4166,10 +4179,11 @@ begin
t := TfrView(Objects[TopSelected]); t := TfrView(Objects[TopSelected]);
if t.Typ = gtBand then if t.Typ = gtBand then
Result := [ssBand] Result := [ssBand]
else if t is TfrMemoView then else
Result := [ssMemo] if t is TfrCustomMemoView then
else Result := [ssMemo]
Result := [ssOther]; else
Result := [ssOther];
end end
else if SelNum > 1 then else if SelNum > 1 then
Result := [ssMultiple]; Result := [ssMultiple];
@ -4183,250 +4197,9 @@ begin
ScrollBox1.Autoscroll := False; ScrollBox1.Autoscroll := False;
ScrollBox1.Autoscroll := True; ScrollBox1.Autoscroll := True;
ScrollBox1.VertScrollBar.Range := ScrollBox1.VertScrollBar.Range + 10; ScrollBox1.VertScrollBar.Range := ScrollBox1.VertScrollBar.Range + 10;
//ScrollBox1.VertScrollBar.Range := ScrollBox1.VertScrollBar.Range + 10;
end; end;
{$HINTS OFF} {$HINTS OFF}
{
procedure TfrDesignerForm.InsertDbFields;
var
i, x, y, dx, dy, pdx, adx, tdx, tdy: Integer;
HeaderL, DataL: TFpList;
t, t1: TfrView;
b: TfrBandView;
f: TfrTField;
f1: TFieldDef;
fSize: Integer;
fName: String;
function FindDataset(DataSet: TfrTDataSet): String;
var
i,j: Integer;
function EnumComponents(f: TComponent): String;
var
i: Integer;
c: TComponent;
d: TfrDBDataSet;
begin
Result := '';
for i := 0 to f.ComponentCount - 1 do
begin
c := f.Components[i];
if c is TfrDBDataSet then
begin
d := c as TfrDBDataSet;
if d.GetDataSet = DataSet then
begin
if d.Owner = CurReport.Owner then
Result := d.Name else
Result := d.Owner.Name + '.' + d.Name;
break;
end;
end;
end;
end;
begin
Result := '';
for i := 0 to Screen.FormCount - 1 do
begin
Result := EnumComponents(Screen.Forms[i]);
if Result <> '' then Exit;
end;
with Screen do
begin
for i := 0 to CustomFormCount - 1 do
with CustomForms[i] do
if (ClassName = 'TDataModuleForm') then
for j := 0 to ComponentCount - 1 do
begin
if (Components[j] is TDataModule) then
Result:=EnumComponents(Components[j]);
if Result <> '' then Exit;
end;
end;
end;
begin
if frInsertFieldsForm=nil then
exit;
with frInsertFieldsForm do
begin
if (DataSet=nil) or (FieldsL.Items.Count = 0) or (FieldsL.SelCount = 0) then
exit;
HeaderL := TFpList.Create;
DataL := TFpList.Create;
try
x := Page.LeftMargin; y := Page.TopMargin;
Unselect;
SelNum := 0;
for i := 0 to FieldsL.Items.Count - 1 do
if FieldsL.Selected[i] then
begin
f := TfrTField(DataSet.FindField(FieldsL.Items[i]));
fSize := 0;
if f <> nil then
begin
fSize := f.DisplayWidth;
fName := f.DisplayName;
end
else
begin
f1 := DataSet.FieldDefs[i];
fSize := f1.Size;
fName := f1.Name;
end;
if (fSize = 0) or (fSize > 255) then
fSize := 6;
t := frCreateObject(gtMemo, '', Page);
t.CreateUniqueName;
t.x := x;
t.y := y;
GetDefaultSize(t.dx, t.dy);
with t as TfrMemoView do
begin
Font.Name := LastFontName;
Font.Size := LastFontSize;
if HeaderCB.Checked then
Font.Style := [fsBold];
MonitorFontChanges;
end;
PageView.Canvas.Font.Assign(TfrMemoView(t).Font);
t.Selected := True;
Inc(SelNum);
if HeaderCB.Checked then
begin
t.Memo.Add(fName);
t.dx := PageView.Canvas.TextWidth(fName + ' ') div GridSize * GridSize;
end
else
begin
t.Memo.Add('[' + DatasetCB.Items[DatasetCB.ItemIndex] +
'."' + FieldsL.Items[i] + '"]');
t.dx := (fSize * PageView.Canvas.TextWidth('=')) div GridSize * GridSize;
end;
dx := t.dx;
Page.Objects.Add(t);
if HeaderCB.Checked then
HeaderL.Add(t) else
DataL.Add(t);
if HeaderCB.Checked then
begin
t := frCreateObject(gtMemo, '', Page);
t.CreateUniqueName;
t.x := x;
t.y := y;
GetDefaultSize(t.dx, t.dy);
if HorzRB.Checked then
Inc(t.y, 72) else
Inc(t.x, dx + GridSize * 2);
with t as TfrMemoView do
begin
Font.Name := LastFontName;
Font.Size := LastFontSize;
MonitorFontChanges;
end;
t.Selected := True;
Inc(SelNum);
t.Memo.Add('[' + DatasetCB.Items[DatasetCB.ItemIndex] +
'."' + FieldsL.Items[i] + '"]');
t.dx := (fSize * PageView.Canvas.TextWidth('=')) div GridSize * GridSize;
Page.Objects.Add(t);
DataL.Add(t);
end;
if HorzRB.Checked then
Inc(x, t.dx + GridSize) else
Inc(y, t.dy + GridSize);
if t is TfrControl then
TfrControl(T).UpdateControlPosition;
end;
if HorzRB.Checked then
begin
t := TfrView(DataL[DataL.Count - 1]);
adx := t.x + t.dx;
pdx := Page.RightMargin - Page.LeftMargin;
x := Page.LeftMargin;
if adx > pdx then
begin
for i := 0 to DataL.Count - 1 do
begin
t := TfrView(DataL[i]);
t.x := Round((t.x - x) / (adx / pdx)) + x;
t.dx := Round(t.dx / (adx / pdx));
end;
if HeaderCB.Checked then
for i := 0 to DataL.Count - 1 do
begin
t := TfrView(HeaderL[i]);
t1 := TfrView(DataL[i]);
t.x := Round((t.x - x) / (adx / pdx)) + x;
if t.dx > t1.dx then
t.dx := t1.dx;
end;
end;
end;
if BandCB.Checked then
begin
if HeaderCB.Checked then
t := TfrView(HeaderL[DataL.Count - 1])
else
t := TfrView(DataL[DataL.Count - 1]);
dy := t.y + t.dy - Page.TopMargin;
b := frCreateObject(gtBand, '', Page) as TfrBandView;
b.CreateUniqueName;
b.y := Page.TopMargin;
b.dy := dy;
b.Selected := True;
Inc(SelNum);
if not HeaderCB.Checked or not HorzRB.Checked then
begin
Page.Objects.Add(b);
b.BandType := btMasterData;
b.DataSet := FindDataset(DataSet);
end
else
begin
if frCheckBand(btPageHeader) then
begin
Dec(SelNum);
b.Free;
end
else
begin
b.BandType := btPageHeader;
Page.Objects.Add(b);
end;
b := frCreateObject(gtBand, '', Page) as TfrBandView;
b.BandType := btMasterData;
b.DataSet := FindDataset(DataSet);
b.CreateUniqueName;
b.y := Page.TopMargin + 72;
b.dy := dy;
b.Selected := True;
Inc(SelNum);
Page.Objects.Add(b);
end;
end;
SelectionChanged;
SendBandsToDown;
PageView.GetMultipleSelected;
RedrawPage;
AddUndoAction(acInsert);
finally
HeaderL.Free;
DataL.Free;
end;
end;
end;
}
{$ifdef sbod} {$ifdef sbod}
procedure TfrDesignerForm.DrawStatusPanel(const ACanvas: TCanvas; procedure TfrDesignerForm.DrawStatusPanel(const ACanvas: TCanvas;
const rect: TRect); const rect: TRect);
@ -4660,7 +4433,7 @@ begin
if CurReport.FindObject(t.Name) <> nil then if CurReport.FindObject(t.Name) <> nil then
t.CreateUniqueName; t.CreateUniqueName;
Objects.Add(t); // Objects.Add(t);
end; end;
procedure TfrDesignerForm.ResetDuplicateCount; procedure TfrDesignerForm.ResetDuplicateCount;
@ -4804,8 +4577,8 @@ begin
E1.Text := FloatToStrF(FrameWidth, ffGeneral, 2, 2); E1.Text := FloatToStrF(FrameWidth, ffGeneral, 2, 2);
frSetGlyph(FillColor, ClB1, 1); frSetGlyph(FillColor, ClB1, 1);
frSetGlyph(FrameColor, ClB3, 2); frSetGlyph(FrameColor, ClB3, 2);
if t is TfrMemoView then if t is TfrCustomMemoView then
with t as TfrMemoView do with t as TfrCustomMemoView do
begin begin
frSetGlyph(Font.Color, ClB2, 0); frSetGlyph(Font.Color, ClB2, 0);
if C2.ItemIndex <> C2.Items.IndexOf(Font.Name) then if C2.ItemIndex <> C2.Items.IndexOf(Font.Name) then
@ -4915,8 +4688,8 @@ begin
if t.Selected and ((t.Typ <> gtBand) or (b = 16)) then if t.Selected and ((t.Typ <> gtBand) or (b = 16)) then
with t do with t do
begin begin
if t is TfrMemoView then if t is TfrCustomMemoView then
with t as TfrMemoView do with t as TfrCustomMemoView do
case b of case b of
7: if C2.ItemIndex >= 0 then 7: if C2.ItemIndex >= 0 then
begin begin
@ -5058,9 +4831,9 @@ end;
procedure TfrDesignerForm.HlB1Click(Sender: TObject); procedure TfrDesignerForm.HlB1Click(Sender: TObject);
var var
t: TfrMemoView; t: TfrCustomMemoView;
begin begin
t := TfrMemoView(Objects[TopSelected]); t := TfrCustomMemoView(Objects[TopSelected]);
frHilightForm := TfrHilightForm.Create(nil); frHilightForm := TfrHilightForm.Create(nil);
with frHilightForm do with frHilightForm do
begin begin
@ -5317,8 +5090,8 @@ begin
CL:=clNone; CL:=clNone;
if Sender=ClB1 then if Sender=ClB1 then
CL:=t.FillColor; CL:=t.FillColor;
if (Sender=ClB2) and (t is TfrMemoView) then if (Sender=ClB2) and (t is TfrCustomMemoView) then
CL:=TfrMemoView(t).Font.Color; CL:=TfrCustomMemoView(t).Font.Color;
if Sender=ClB3 then if Sender=ClB3 then
CL:=t.FrameColor; CL:=t.FrameColor;
ColorSelector.Color:=CL; ColorSelector.Color:=CL;
@ -5455,6 +5228,10 @@ var
begin begin
SetCaptureControl(nil); SetCaptureControl(nil);
t := TfrView(Objects[TopSelected]); t := TfrView(Objects[TopSelected]);
if lrrDontModify in T.Restrictions then
exit;
if t.Typ = gtMemo then if t.Typ = gtMemo then
ShowMemoEditor ShowMemoEditor
else else
@ -5510,6 +5287,12 @@ begin
for i := 0 to frAddInsCount - 1 do for i := 0 to frAddInsCount - 1 do
if frAddIns[i].ClassRef.ClassName = t.ClassName then if frAddIns[i].ClassRef.ClassName = t.ClassName then
begin begin
if Assigned(frAddIns[i].EditorProc) then
begin
if frAddIns[i].EditorProc(t) then
Modified:=true;
end
else
if frAddIns[i].EditorForm <> nil then if frAddIns[i].EditorForm <> nil then
begin begin
PageView.NPEraseSelection; PageView.NPEraseSelection;
@ -5681,7 +5464,7 @@ begin
acInsert: p^.ObjID := t.ID; acInsert: p^.ObjID := t.ID;
acDelete, acEdit: acDelete, acEdit:
begin begin
t1 := frCreateObject(t.Typ, t.ClassName, Page); t1 := frCreateObject(t.Typ, t.ClassName, nil);
t1.Assign(t); t1.Assign(t);
t1.ID := t.ID; t1.ID := t.ID;
p^.ObjID := t.ID; p^.ObjID := t.ID;
@ -5717,6 +5500,7 @@ var
i,j: Integer; i,j: Integer;
t: TfrView; t: TfrView;
List: TFpList; List: TFpList;
F:boolean;
procedure AddCurrent; procedure AddCurrent;
var var
@ -5742,7 +5526,13 @@ begin
for i := j to Objects.Count - 1 do for i := j to Objects.Count - 1 do
begin begin
t := TfrView(Objects[i]); t := TfrView(Objects[i]);
if (not (doUndoDisable in T.DesignOptions)) and ((AUndoAction in [acDuplication, acZOrder]) or t.Selected) then F:= ((AUndoAction = acDelete) and not (lrrDontDelete in t.Restrictions))
or
((AUndoAction = acEdit) and not (lrrDontModify in t.Restrictions))
or
(not (AUndoAction in [acDelete, acEdit]));
if (not (doUndoDisable in T.DesignOptions)) and ((AUndoAction in [acDuplication, acZOrder]) or t.Selected) and F then
AddCurrent; AddCurrent;
end; end;
@ -5894,7 +5684,6 @@ begin
t1.Assign(t); t1.Assign(t);
if CurReport.FindObject(t1.Name) <> nil then if CurReport.FindObject(t1.Name) <> nil then
t1.CreateUniqueName; t1.CreateUniqueName;
Objects.Add(t1);
end; end;
SelectionChanged; SelectionChanged;
SendBandsToDown; SendBandsToDown;
@ -6175,15 +5964,16 @@ procedure TfrDesignerForm.ScrollBox1DragDrop(Sender, Source: TObject; X,
Y: Integer); Y: Integer);
var var
Control :TControl; Control :TControl;
t : TfrMemoView; t : TfrCustomMemoView;
dx, dy:integer; dx, dy:integer;
begin begin
Control:=lrDesignAcceptDrag(Source); Control:=lrDesignAcceptDrag(Source);
if Assigned(lrFieldsList) and ((Control = lrFieldsList.lbFieldsList) or (Control = lrFieldsList.ValList)) then if Assigned(lrFieldsList) and ((Control = lrFieldsList.lbFieldsList) or (Control = lrFieldsList.ValList)) then
begin begin
Objects.Add(frCreateObject(gtMemo, '', Page)); { Objects.Add(frCreateObject(gtMemo, '', Page));
t:=TfrMemoView(Objects.Last); t:=TfrCustomMemoView(Objects.Last);}
t:=frCreateObject(gtMemo, '', Page) as TfrCustomMemoView;
if Assigned(t) then if Assigned(t) then
begin begin
t.MonitorFontChanges; t.MonitorFontChanges;
@ -6315,7 +6105,7 @@ begin
begin begin
t1 := TfrView(Objects[i]); t1 := TfrView(Objects[i]);
if t1.Selected then if t1.Selected then
if not (((t is TfrMemoView) and (t1 is TfrMemoView)) or if not (((t is TfrCustomMemoView) and (t1 is TfrCustomMemoView)) or
((t.Typ <> gtAddIn) and (t.Typ = t1.Typ)) or ((t.Typ <> gtAddIn) and (t.Typ = t1.Typ)) or
((t.Typ = gtAddIn) and (t.ClassName = t1.ClassName))) then ((t.Typ = gtAddIn) and (t.ClassName = t1.ClassName))) then
begin begin
@ -7233,8 +7023,8 @@ begin
Case Sb.Tag of Case Sb.Tag of
5 : t.FillColor:=aColor; {ClB1} 5 : t.FillColor:=aColor; {ClB1}
17 : if (t is TfrMemoView) then {ClB2} 17 : if (t is TfrCustomMemoView) then {ClB2}
TfrMemoView(t).Font.Color:=aColor; TfrCustomMemoView(t).Font.Color:=aColor;
19 : t.FrameColor:=aColor; {ClB3} 19 : t.FrameColor:=aColor; {ClB3}
end; end;
end; end;
@ -7804,12 +7594,12 @@ begin
end; end;
type type
{ TfrMemoViewDetailReportProperty } { TfrCustomMemoViewDetailReportProperty }
TfrMemoViewDetailReportProperty = class(TStringProperty) TfrCustomMemoViewDetailReportProperty = class(TStringProperty)
private private
FSaveRep:TfrReport; FSaveRep:TfrReport;
FEditView:TfrMemoView; FEditView:TfrCustomMemoView;
FDetailRrep: TlrDetailReport; FDetailRrep: TlrDetailReport;
procedure DoSaveReportEvent(Report: TfrReport; var ReportName: String; procedure DoSaveReportEvent(Report: TfrReport; var ReportName: String;
SaveAs: Boolean; var Saved: Boolean); SaveAs: Boolean; var Saved: Boolean);
@ -7819,7 +7609,41 @@ type
procedure GetValues(Proc: TGetStrProc); override; procedure GetValues(Proc: TGetStrProc); override;
end; end;
procedure TfrMemoViewDetailReportProperty.DoSaveReportEvent(Report: TfrReport;
TfrViewDataFieldProperty = class(TStringProperty)
public
function GetAttributes: TPropertyAttributes; override;
procedure Edit; override;
end;
{ TfrPictureViewDataFieldProperty }
function TfrViewDataFieldProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes + [paDialog{, paValueList, paSortList}];
end;
type
TfrHackView = class(TfrView);
procedure TfrViewDataFieldProperty.Edit;
begin
if (GetComponent(0) is TfrView) and Assigned(CurReport) then
begin
frFieldsForm := TfrFieldsForm.Create(Application);
try
if frFieldsForm.ShowModal = mrOk then
begin
TfrHackView(GetComponent(0)).DataField:=frFieldsForm.DBField;
frDesigner.Modified:=true;
end;
finally
frFieldsForm.Free;
end;
end;
end;
procedure TfrCustomMemoViewDetailReportProperty.DoSaveReportEvent(Report: TfrReport;
var ReportName: String; SaveAs: Boolean; var Saved: Boolean); var ReportName: String; SaveAs: Boolean; var Saved: Boolean);
begin begin
if Assigned(FDetailRrep) then if Assigned(FDetailRrep) then
@ -7833,12 +7657,12 @@ begin
Saved:=false; Saved:=false;
end; end;
function TfrMemoViewDetailReportProperty.GetAttributes: TPropertyAttributes; function TfrCustomMemoViewDetailReportProperty.GetAttributes: TPropertyAttributes;
begin begin
Result := inherited GetAttributes + [paDialog, paValueList, paSortList]; Result := inherited GetAttributes + [paDialog, paValueList, paSortList];
end; end;
procedure TfrMemoViewDetailReportProperty.Edit; procedure TfrCustomMemoViewDetailReportProperty.Edit;
var var
FSaveDesigner:TfrReportDesigner; FSaveDesigner:TfrReportDesigner;
FSaveView:TfrView; FSaveView:TfrView;
@ -7851,9 +7675,9 @@ var
///***DocMode: (dmDesigning, dmPrinting); // current mode ///***DocMode: (dmDesigning, dmPrinting); // current mode
begin begin
if (GetComponent(0) is TfrMemoView) and Assigned(CurReport) then if (GetComponent(0) is TfrCustomMemoView) and Assigned(CurReport) then
begin begin
FEditView:=GetComponent(0) as TfrMemoView; FEditView:=GetComponent(0) as TfrCustomMemoView;
if FEditView.DetailReport = '' then if FEditView.DetailReport = '' then
FEditView.DetailReport:=FEditView.Name + '_DetailReport'; FEditView.DetailReport:=FEditView.Name + '_DetailReport';
@ -7922,7 +7746,7 @@ begin
end; end;
end; end;
procedure TfrMemoViewDetailReportProperty.GetValues(Proc: TGetStrProc); procedure TfrCustomMemoViewDetailReportProperty.GetValues(Proc: TGetStrProc);
var var
I: Integer; I: Integer;
Values: TStringList; Values: TStringList;
@ -8073,7 +7897,7 @@ begin
t.x := x; t.x := x;
t.y := y; t.y := y;
TfrDesignerForm(frDesigner).GetDefaultSize(t.dx, t.dy); TfrDesignerForm(frDesigner).GetDefaultSize(t.dx, t.dy);
with t as TfrMemoView do with t as TfrCustomMemoView do
begin begin
Font.Name := LastFontName; Font.Name := LastFontName;
Font.Size := LastFontSize; Font.Size := LastFontSize;
@ -8081,7 +7905,7 @@ begin
Font.Style := [fsBold]; Font.Style := [fsBold];
MonitorFontChanges; MonitorFontChanges;
end; end;
TfrDesignerForm(frDesigner).PageView.Canvas.Font.Assign(TfrMemoView(t).Font); TfrDesignerForm(frDesigner).PageView.Canvas.Font.Assign(TfrCustomMemoView(t).Font);
t.Selected := True; t.Selected := True;
Inc(TfrDesignerForm(frDesigner).SelNum); Inc(TfrDesignerForm(frDesigner).SelNum);
if HeaderCB.Checked then if HeaderCB.Checked then
@ -8096,7 +7920,7 @@ begin
t.dx := (fSize * TfrDesignerForm(frDesigner).PageView.Canvas.TextWidth('=')) div TfrDesignerForm(frDesigner).GridSize * TfrDesignerForm(frDesigner).GridSize; t.dx := (fSize * TfrDesignerForm(frDesigner).PageView.Canvas.TextWidth('=')) div TfrDesignerForm(frDesigner).GridSize * TfrDesignerForm(frDesigner).GridSize;
end; end;
dx := t.dx; dx := t.dx;
TfrDesignerForm(frDesigner).Page.Objects.Add(t); // TfrDesignerForm(frDesigner).Page.Objects.Add(t);
if HeaderCB.Checked then if HeaderCB.Checked then
HeaderL.Add(t) else HeaderL.Add(t) else
DataL.Add(t); DataL.Add(t);
@ -8110,7 +7934,7 @@ begin
if HorzRB.Checked then if HorzRB.Checked then
Inc(t.y, 72) else Inc(t.y, 72) else
Inc(t.x, dx + TfrDesignerForm(frDesigner).GridSize * 2); Inc(t.x, dx + TfrDesignerForm(frDesigner).GridSize * 2);
with t as TfrMemoView do with t as TfrCustomMemoView do
begin begin
Font.Name := LastFontName; Font.Name := LastFontName;
Font.Size := LastFontSize; Font.Size := LastFontSize;
@ -8121,7 +7945,7 @@ begin
t.Memo.Add('[' + DatasetCB.Items[DatasetCB.ItemIndex] + t.Memo.Add('[' + DatasetCB.Items[DatasetCB.ItemIndex] +
'."' + FieldsL.Items[i] + '"]'); '."' + FieldsL.Items[i] + '"]');
t.dx := (fSize * TfrDesignerForm(frDesigner).PageView.Canvas.TextWidth('=')) div TfrDesignerForm(frDesigner).GridSize * TfrDesignerForm(frDesigner).GridSize; t.dx := (fSize * TfrDesignerForm(frDesigner).PageView.Canvas.TextWidth('=')) div TfrDesignerForm(frDesigner).GridSize * TfrDesignerForm(frDesigner).GridSize;
TfrDesignerForm(frDesigner).Page.Objects.Add(t); // TfrDesignerForm(frDesigner).Page.Objects.Add(t);
DataL.Add(t); DataL.Add(t);
end; end;
if HorzRB.Checked then if HorzRB.Checked then
@ -8174,7 +7998,7 @@ begin
Inc(TfrDesignerForm(frDesigner).SelNum); Inc(TfrDesignerForm(frDesigner).SelNum);
if not HeaderCB.Checked or not HorzRB.Checked then if not HeaderCB.Checked or not HorzRB.Checked then
begin begin
TfrDesignerForm(frDesigner).Page.Objects.Add(b); // TfrDesignerForm(frDesigner).Page.Objects.Add(b);
b.BandType := btMasterData; b.BandType := btMasterData;
b.DataSet := FindDataset(DataSet); b.DataSet := FindDataset(DataSet);
end end
@ -8188,7 +8012,7 @@ begin
else else
begin begin
b.BandType := btPageHeader; b.BandType := btPageHeader;
TfrDesignerForm(frDesigner).Page.Objects.Add(b); // TfrDesignerForm(frDesigner).Page.Objects.Add(b);
end; end;
b := frCreateObject(gtBand, '', TfrDesignerForm(frDesigner).Page) as TfrBandView; b := frCreateObject(gtBand, '', TfrDesignerForm(frDesigner).Page) as TfrBandView;
b.BandType := btMasterData; b.BandType := btMasterData;
@ -8198,7 +8022,7 @@ begin
b.dy := dy; b.dy := dy;
b.Selected := True; b.Selected := True;
Inc(TfrDesignerForm(frDesigner).SelNum); Inc(TfrDesignerForm(frDesigner).SelNum);
TfrDesignerForm(frDesigner).Page.Objects.Add(b); // TfrDesignerForm(frDesigner).Page.Objects.Add(b);
end; end;
end; end;
TfrDesignerForm(frDesigner).SelectionChanged; TfrDesignerForm(frDesigner).SelectionChanged;
@ -8241,7 +8065,8 @@ initialization
LastAdjust := 0; LastAdjust := 0;
//** RegRootKey := 'Software\FastReport\' + Application.Title; //** RegRootKey := 'Software\FastReport\' + Application.Title;
RegisterPropertyEditor(TypeInfo(String), TfrMemoView, 'DetailReport', TfrMemoViewDetailReportProperty); RegisterPropertyEditor(TypeInfo(String), TfrCustomMemoView, 'DetailReport', TfrCustomMemoViewDetailReportProperty);
RegisterPropertyEditor(TypeInfo(String), TfrView, 'DataField', TfrViewDataFieldProperty);
FlrInternalTools:=TlrInternalTools.Create; FlrInternalTools:=TlrInternalTools.Create;
finalization finalization

14
components/lazreport/source/lr_pgrid.pas
View File

@ -303,13 +303,13 @@ begin
b := TfrBandView(frCreateObject(gtBand, '', Page)); b := TfrBandView(frCreateObject(gtBand, '', Page));
b.SetBounds(10, 20, 1000, 25); b.SetBounds(10, 20, 1000, 25);
b.BandType := btReportTitle; b.BandType := btReportTitle;
Page.Objects.Add(b); // Page.Objects.Add(b);
v := frCreateObject(gtMemo, '', Page); v := frCreateObject(gtMemo, '', Page);
v.SetBounds(20, 20, Page.PrnInfo.PgW - 40, 25); v.SetBounds(20, 20, Page.PrnInfo.PgW - 40, 25);
TfrMemoView(v).Alignment:=taCenter; TfrMemoView(v).Alignment:=taCenter;
TfrMemoView(v).Font.Assign(FTitleFont); TfrMemoView(v).Font.Assign(FTitleFont);
v.Memo.Add(FCaption); v.Memo.Add(FCaption);
Page.Objects.Add(v); // Page.Objects.Add(v);
end; end;
// if we have a template we need to be sure that bands on template // if we have a template we need to be sure that bands on template
@ -323,7 +323,7 @@ begin
b.Flags:=b.Flags+flBandRepeatHeader; b.Flags:=b.Flags+flBandRepeatHeader;
b.SetBounds(XPos, YPos, 1000, 20); b.SetBounds(XPos, YPos, 1000, 20);
b.Flags:=b.Flags or flStretched; b.Flags:=b.Flags or flStretched;
Page.Objects.Add(b); // Page.Objects.Add(b);
v := frCreateObject(gtMemo, '', Page); v := frCreateObject(gtMemo, '', Page);
v.SetBounds(XPos, YPos, 20, 20); v.SetBounds(XPos, YPos, 20, 20);
@ -333,7 +333,7 @@ begin
TfrMemoView(v).Frames:=frAllFrames; TfrMemoView(v).Frames:=frAllFrames;
TfrMemoView(v).Layout:=tlTop; TfrMemoView(v).Layout:=tlTop;
v.Memo.Add('[Header]'); v.Memo.Add('[Header]');
Page.Objects.Add(v); // Page.Objects.Add(v);
YPos := YPos + 22; YPos := YPos + 22;
@ -342,13 +342,13 @@ begin
b.Dataset := FReportDataSet.Name; b.Dataset := FReportDataSet.Name;
b.SetBounds(0, YPos, 1000, 18); b.SetBounds(0, YPos, 1000, 18);
b.Flags:=b.Flags or flStretched; b.Flags:=b.Flags or flStretched;
Page.Objects.Add(b); // Page.Objects.Add(b);
b := TfrBandView(frCreateObject(gtBand, '', Page)); b := TfrBandView(frCreateObject(gtBand, '', Page));
b.BandType := btCrossData; b.BandType := btCrossData;
b.Dataset := FColumnDataSet.Name; b.Dataset := FColumnDataSet.Name;
b.SetBounds(XPos, 0, 20, 1000); b.SetBounds(XPos, 0, 20, 1000);
Page.Objects.Add(b); // Page.Objects.Add(b);
v := frCreateObject(gtMemo, '', Page); v := frCreateObject(gtMemo, '', Page);
v.SetBounds(XPos, YPos, 20, 18); v.SetBounds(XPos, YPos, 20, 18);
@ -357,7 +357,7 @@ begin
TfrMemoView(v).Font.Assign(FFont); TfrMemoView(v).Font.Assign(FFont);
TfrMemoView(v).Frames:=frAllFrames; TfrMemoView(v).Frames:=frAllFrames;
TfrMemoView(v).Layout:=tlTop; TfrMemoView(v).Layout:=tlTop;
Page.Objects.Add(v); // Page.Objects.Add(v);
FDataSet.DisableControls; FDataSet.DisableControls;
BM:=FDataSet.GetBookmark; BM:=FDataSet.GetBookmark;

77
components/lazreport/source/lr_prdlg.lfm
View File

@ -15,9 +15,9 @@ object frPrintForm: TfrPrintForm
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '1.3' LCLVersion = '1.3'
object Image1: TImage object Image1: TImage
Left = 192 Left = 336
Height = 16 Height = 16
Top = 64 Top = 176
Width = 18 Width = 18
AutoSize = True AutoSize = True
Picture.Data = { Picture.Data = {
@ -40,9 +40,9 @@ object frPrintForm: TfrPrintForm
AnchorSideBottom.Control = E1 AnchorSideBottom.Control = E1
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 21
Top = 87 Top = 90
Width = 40 Width = 44
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Left = 6 BorderSpacing.Left = 6
Caption = 'Copies' Caption = 'Copies'
@ -56,14 +56,14 @@ object frPrintForm: TfrPrintForm
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 6 Left = 6
Height = 178 Height = 173
Top = 112 Top = 117
Width = 318 Width = 316
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Page range' Caption = 'Page range'
ClientHeight = 158 ClientHeight = 150
ClientWidth = 316 ClientWidth = 312
TabOrder = 0 TabOrder = 0
object Label2: TLabel object Label2: TLabel
AnchorSideLeft.Control = GroupBox2 AnchorSideLeft.Control = GroupBox2
@ -74,9 +74,9 @@ object frPrintForm: TfrPrintForm
AnchorSideBottom.Control = GroupBox2 AnchorSideBottom.Control = GroupBox2
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 6 Left = 6
Height = 51 Height = 43
Top = 101 Top = 101
Width = 304 Width = 300
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
AutoSize = False AutoSize = False
BorderSpacing.Around = 6 BorderSpacing.Around = 6
@ -90,7 +90,7 @@ object frPrintForm: TfrPrintForm
Left = 6 Left = 6
Height = 23 Height = 23
Top = 6 Top = 6
Width = 42 Width = 40
HelpContext = 108 HelpContext = 108
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'All' Caption = 'All'
@ -105,7 +105,7 @@ object frPrintForm: TfrPrintForm
Left = 6 Left = 6
Height = 23 Height = 23
Top = 35 Top = 35
Width = 103 Width = 108
HelpContext = 118 HelpContext = 118
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Current &page' Caption = 'Current &page'
@ -118,7 +118,7 @@ object frPrintForm: TfrPrintForm
Left = 6 Left = 6
Height = 23 Height = 23
Top = 72 Top = 72
Width = 83 Width = 86
HelpContext = 124 HelpContext = 124
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Left = 6 BorderSpacing.Left = 6
@ -133,10 +133,10 @@ object frPrintForm: TfrPrintForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox2 AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 95 Left = 98
Height = 31 Height = 31
Top = 64 Top = 64
Width = 215 Width = 208
HelpContext = 133 HelpContext = 133
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6 BorderSpacing.Around = 6
@ -150,10 +150,10 @@ object frPrintForm: TfrPrintForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 330 Left = 328
Height = 31 Height = 33
Top = 75 Top = 80
Width = 54 Width = 56
HelpContext = 40 HelpContext = 40
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
@ -169,10 +169,10 @@ object frPrintForm: TfrPrintForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 330 Left = 328
Height = 31 Height = 33
Top = 112 Top = 119
Width = 54 Width = 56
HelpContext = 50 HelpContext = 50
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
AutoSize = True AutoSize = True
@ -188,24 +188,24 @@ object frPrintForm: TfrPrintForm
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 6 Left = 6
Height = 63 Height = 68
Top = 6 Top = 6
Width = 378 Width = 378
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Printer' Caption = 'Printer'
ClientHeight = 43 ClientHeight = 45
ClientWidth = 376 ClientWidth = 374
TabOrder = 3 TabOrder = 3
object PropButton: TButton object PropButton: TButton
AnchorSideTop.Control = GroupBox1 AnchorSideTop.Control = GroupBox1
AnchorSideRight.Control = GroupBox1 AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 295 Left = 289
Height = 31 Height = 33
Top = 6 Top = 6
Width = 75 Width = 79
HelpContext = 152 HelpContext = 152
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
AutoSize = True AutoSize = True
@ -219,9 +219,9 @@ object frPrintForm: TfrPrintForm
AnchorSideTop.Control = GroupBox1 AnchorSideTop.Control = GroupBox1
AnchorSideRight.Control = PropButton AnchorSideRight.Control = PropButton
Left = 6 Left = 6
Height = 31 Height = 33
Top = 6 Top = 6
Width = 283 Width = 277
HelpContext = 142 HelpContext = 142
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6 BorderSpacing.Around = 6
@ -229,7 +229,8 @@ object frPrintForm: TfrPrintForm
OnChange = CB1Click OnChange = CB1Click
OnClick = CB1Click OnClick = CB1Click
OnDrawItem = CB1DrawItem OnDrawItem = CB1DrawItem
Style = csDropDownList ReadOnly = True
Style = csOwnerDrawFixed
TabOrder = 1 TabOrder = 1
end end
end end
@ -238,9 +239,9 @@ object frPrintForm: TfrPrintForm
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideBottom.Control = E1 AnchorSideBottom.Control = E1
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 139 Left = 143
Height = 23 Height = 23
Top = 83 Top = 88
Width = 70 Width = 70
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Left = 6 BorderSpacing.Left = 6
@ -252,9 +253,9 @@ object frPrintForm: TfrPrintForm
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = GroupBox1 AnchorSideTop.Control = GroupBox1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 52 Left = 56
Height = 31 Height = 31
Top = 75 Top = 80
Width = 81 Width = 81
BorderSpacing.Around = 6 BorderSpacing.Around = 6
TabOrder = 5 TabOrder = 5

7
components/lazreport/source/lr_prdlg.pas
View File

@ -102,12 +102,13 @@ begin
r := ARect; r := ARect;
r.Right := r.Left + 18; r.Right := r.Left + 18;
r.Bottom := r.Top + 16; r.Bottom := r.Top + 16;
OffsetRect(r, 2, 0);
OffsetRect(r, 2, (ARect.Bottom - ARect.Top) div 2 - 8);
with CB1.Canvas do with CB1.Canvas do
begin begin
FillRect(ARect); FillRect(ARect);
// todo: implement brushcopy BrushCopy(r, Image1.Picture.Bitmap, Rect(0, 0, 18, 16), clOlive);
//BrushCopy(r, Image1.Picture.Bitmap, Rect(0, 0, 18, 16), clOlive);
TextOut(ARect.Left + 24, ARect.Top + 1, CB1.Items[Index]); TextOut(ARect.Left + 24, ARect.Top + 1, CB1.Items[Index]);
end; end;
end; end;

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

@ -792,6 +792,7 @@ begin
// update paper size in std pt units // update paper size in std pt units
PaperWidth := round(fPrinter.PaperSize.Width * 72 / fPrinter.XDPI); PaperWidth := round(fPrinter.PaperSize.Width * 72 / fPrinter.XDPI);
PaperHeight := round(fPrinter.PaperSize.Height * 72 / fPrinter.YDPI); PaperHeight := round(fPrinter.PaperSize.Height * 72 / fPrinter.YDPI);
Orientation := fPrinter.Orientation;
except except
PaperWidth:=1; PaperWidth:=1;
PaperHeight:=1; PaperHeight:=1;

6
components/lazreport/source/lr_register.pas
View File

@ -22,7 +22,8 @@ uses
LR_PGrid, LR_PGrid,
LR_View, LR_View,
lr_CrossTab,
ComponentEditors, ComponentEditors,
LazarusPackageIntf; LazarusPackageIntf;
@ -50,7 +51,8 @@ begin
TfrBarCodeObject,TfrRoundRectObject,TfrShapeObject, TfrBarCodeObject,TfrRoundRectObject,TfrShapeObject,
TfrCheckBoxObject,TfrCompositeReport,TfrUserDataset, TfrCheckBoxObject,TfrCompositeReport,TfrUserDataset,
TfrTextExport,TfrHTMExport,TfrCSVExport, TfrTextExport,TfrHTMExport,TfrCSVExport,
TfrPrintGrid,TfrDesigner,TfrPreview]); TfrPrintGrid,TfrDesigner,TfrPreview,
TlrCrossObject]);
RegisterComponentEditor(TfrReport, TfrRepEditor); RegisterComponentEditor(TfrReport, TfrRepEditor);
end; end;

BIN
components/lazreport/source/lr_register.res
View File

Binary file not shown.

11
components/lazreport/source/lr_rrect.pas
View File

@ -84,7 +84,7 @@ type
function GetCorners: TCornerSet; function GetCorners: TCornerSet;
public public
constructor Create(AOwnerPage:TfrPage); override; constructor Create(AOwnerPage:TfrPage); override;
procedure Assign(From: TfrView); override; procedure Assign(Source: TPersistent); override;
procedure LoadFromStream(Stream: TStream); override; procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override; procedure SaveToStream(Stream: TStream); override;
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override; procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
@ -565,11 +565,12 @@ begin
end; end;
end; end;
procedure TfrRoundRectView.Assign(From: TfrView); procedure TfrRoundRectView.Assign(Source: TPersistent);
begin begin
inherited Assign(From); inherited Assign(Source);
if from is TfrRoundRectView then
fCadre := TfrRoundRectView(From).fCadre if Source is TfrRoundRectView then
fCadre := TfrRoundRectView(Source).fCadre
else else
begin begin
fCadre.wCurve:=10; fCadre.wCurve:=10;

10
components/lazreport/source/lr_shape.pas
View File

@ -43,7 +43,7 @@ type
procedure DrawShape(aCanvas : TCanvas); procedure DrawShape(aCanvas : TCanvas);
public public
constructor Create(AOwnerPage:TfrPage); override; constructor Create(AOwnerPage:TfrPage); override;
procedure Assign(From: TfrView); override; procedure Assign(Source: TPersistent); override;
procedure Draw(aCanvas: TCanvas); override; procedure Draw(aCanvas: TCanvas); override;
procedure LoadFromStream(Stream: TStream); override; procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override; procedure SaveToStream(Stream: TStream); override;
@ -56,6 +56,7 @@ type
property FrameColor; property FrameColor;
property FrameStyle; property FrameStyle;
property FrameWidth; property FrameWidth;
property Restrictions;
property ShapeType : TfrShapeType Read fShapeType write fShapeType; property ShapeType : TfrShapeType Read fShapeType write fShapeType;
end; end;
@ -127,10 +128,11 @@ begin
fShapeType := frstRectangle; fShapeType := frstRectangle;
end; end;
procedure TfrShapeView.Assign(From: TfrView); procedure TfrShapeView.Assign(Source: TPersistent);
begin begin
inherited Assign(From); inherited Assign(Source);
ShapeType := TfrShapeView(From).ShapeType; if Source is TfrShapeView then
ShapeType := TfrShapeView(Source).ShapeType;
end; end;
procedure TfrShapeView.DrawShape(aCanvas : TCanvas); procedure TfrShapeView.DrawShape(aCanvas : TCanvas);

50
components/lazreport/source/lr_view.lfm
View File

@ -39,18 +39,18 @@ object frPreviewForm: TfrPreviewForm
Left = 0 Left = 0
Height = 30 Height = 30
Top = 0 Top = 0
Width = 687 Width = 683
Align = alTop Align = alTop
BevelInner = bvSpace BevelInner = bvSpace
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 30 ClientHeight = 30
ClientWidth = 687 ClientWidth = 683
FullRepaint = False FullRepaint = False
TabOrder = 0 TabOrder = 0
object ZoomBtn: TBitBtn object ZoomBtn: TBitBtn
Tag = 200 Tag = 200
Left = 182 Left = 182
Height = 28 Height = 24
Top = 1 Top = 1
Width = 76 Width = 76
Align = alLeft Align = alLeft
@ -101,7 +101,7 @@ object frPreviewForm: TfrPreviewForm
object LoadBtn: TBitBtn object LoadBtn: TBitBtn
Tag = 201 Tag = 201
Left = 1 Left = 1
Height = 28 Height = 24
Top = 1 Top = 1
Width = 32 Width = 32
Align = alLeft Align = alLeft
@ -150,7 +150,7 @@ object frPreviewForm: TfrPreviewForm
object SaveBtn: TBitBtn object SaveBtn: TBitBtn
Tag = 202 Tag = 202
Left = 33 Left = 33
Height = 28 Height = 24
Top = 1 Top = 1
Width = 32 Width = 32
Align = alLeft Align = alLeft
@ -199,7 +199,7 @@ object frPreviewForm: TfrPreviewForm
object PrintBtn: TBitBtn object PrintBtn: TBitBtn
Tag = 203 Tag = 203
Left = 101 Left = 101
Height = 28 Height = 24
Top = 1 Top = 1
Width = 28 Width = 28
Align = alLeft Align = alLeft
@ -246,8 +246,8 @@ object frPreviewForm: TfrPreviewForm
end end
object ExitBtn: TBitBtn object ExitBtn: TBitBtn
Tag = 205 Tag = 205
Left = 658 Left = 650
Height = 28 Height = 24
Top = 1 Top = 1
Width = 28 Width = 28
Align = alRight Align = alRight
@ -294,7 +294,7 @@ object frPreviewForm: TfrPreviewForm
end end
object frTBSeparator1: TPanel object frTBSeparator1: TPanel
Left = 76 Left = 76
Height = 28 Height = 24
Top = 1 Top = 1
Width = 25 Width = 25
Align = alLeft Align = alLeft
@ -304,7 +304,7 @@ object frPreviewForm: TfrPreviewForm
end end
object frTBSeparator2: TPanel object frTBSeparator2: TPanel
Left = 129 Left = 129
Height = 28 Height = 24
Top = 1 Top = 1
Width = 25 Width = 25
Align = alLeft Align = alLeft
@ -314,7 +314,7 @@ object frPreviewForm: TfrPreviewForm
end end
object frTBSeparator3: TPanel object frTBSeparator3: TPanel
Left = 286 Left = 286
Height = 28 Height = 24
Top = 1 Top = 1
Width = 25 Width = 25
Align = alLeft Align = alLeft
@ -324,7 +324,7 @@ object frPreviewForm: TfrPreviewForm
end end
object PgUp: TSpeedButton object PgUp: TSpeedButton
Left = 331 Left = 331
Height = 28 Height = 24
Top = 1 Top = 1
Width = 20 Width = 20
Align = alLeft Align = alLeft
@ -370,7 +370,7 @@ object frPreviewForm: TfrPreviewForm
end end
object PgDown: TSpeedButton object PgDown: TSpeedButton
Left = 454 Left = 454
Height = 28 Height = 24
Top = 1 Top = 1
Width = 20 Width = 20
Align = alLeft Align = alLeft
@ -416,7 +416,7 @@ object frPreviewForm: TfrPreviewForm
end end
object LbPanel: TPanel object LbPanel: TPanel
Left = 351 Left = 351
Height = 28 Height = 24
Top = 1 Top = 1
Width = 103 Width = 103
Align = alLeft Align = alLeft
@ -430,7 +430,7 @@ object frPreviewForm: TfrPreviewForm
end end
object BtPgFirst: TSpeedButton object BtPgFirst: TSpeedButton
Left = 311 Left = 311
Height = 28 Height = 24
Top = 1 Top = 1
Width = 20 Width = 20
Align = alLeft Align = alLeft
@ -476,7 +476,7 @@ object frPreviewForm: TfrPreviewForm
end end
object BtPgLast: TSpeedButton object BtPgLast: TSpeedButton
Left = 474 Left = 474
Height = 28 Height = 24
Top = 1 Top = 1
Width = 20 Width = 20
Align = alLeft Align = alLeft
@ -522,7 +522,7 @@ object frPreviewForm: TfrPreviewForm
end end
object BtZoomOut: TBitBtn object BtZoomOut: TBitBtn
Left = 154 Left = 154
Height = 28 Height = 24
Top = 1 Top = 1
Width = 28 Width = 28
Align = alLeft Align = alLeft
@ -569,7 +569,7 @@ object frPreviewForm: TfrPreviewForm
end end
object BtZoomIn: TBitBtn object BtZoomIn: TBitBtn
Left = 258 Left = 258
Height = 28 Height = 24
Top = 1 Top = 1
Width = 28 Width = 28
Align = alLeft Align = alLeft
@ -616,7 +616,7 @@ object frPreviewForm: TfrPreviewForm
end end
object frTBSeparator4: TPanel object frTBSeparator4: TPanel
Left = 494 Left = 494
Height = 28 Height = 24
Top = 1 Top = 1
Width = 25 Width = 25
Align = alLeft Align = alLeft
@ -626,7 +626,7 @@ object frPreviewForm: TfrPreviewForm
end end
object FindBtn: TBitBtn object FindBtn: TBitBtn
Left = 519 Left = 519
Height = 28 Height = 24
Top = 1 Top = 1
Width = 28 Width = 28
Align = alLeft Align = alLeft
@ -672,7 +672,7 @@ object frPreviewForm: TfrPreviewForm
end end
object SpeedButton1: TSpeedButton object SpeedButton1: TSpeedButton
Left = 65 Left = 65
Height = 28 Height = 24
Top = 1 Top = 1
Width = 11 Width = 11
Align = alLeft Align = alLeft
@ -726,8 +726,8 @@ object frPreviewForm: TfrPreviewForm
object HScrollBar: TScrollBar object HScrollBar: TScrollBar
Left = 2 Left = 2
Height = 13 Height = 13
Top = 6 Top = 2
Width = 663 Width = 659
Align = alBottom Align = alBottom
BorderSpacing.Left = 2 BorderSpacing.Left = 2
BorderSpacing.Right = 16 BorderSpacing.Right = 16
@ -752,8 +752,8 @@ object frPreviewForm: TfrPreviewForm
FullRepaint = False FullRepaint = False
TabOrder = 2 TabOrder = 2
object VScrollBar: TScrollBar object VScrollBar: TScrollBar
Left = 6 Left = 2
Height = 465 Height = 461
Top = 0 Top = 0
Width = 13 Width = 13
Align = alRight Align = alRight

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

@ -817,29 +817,29 @@ begin
frPrintForm := TfrPrintForm.Create(nil); frPrintForm := TfrPrintForm.Create(nil);
frPrintForm.E1.Value:=TfrReport(Doc).DefaultCopies; frPrintForm.E1.Value:=TfrReport(Doc).DefaultCopies;
frPrintForm.cbCollate.Checked:=TfrReport(Doc).DefaultCollate; frPrintForm.cbCollate.Checked:=TfrReport(Doc).DefaultCollate;
with frPrintForm do // with frPrintForm do
begin // begin
if ShowModal = mrOk then if frPrintForm.ShowModal = mrOk then
begin begin
if (Printer.PrinterIndex <> ind) or Prn.UseVirtualPrinter then if TfrReport(Doc).RebuildPrinter and ((Printer.PrinterIndex <> ind) or Prn.UseVirtualPrinter) then
begin begin
if not RebuildReport then if not RebuildReport then
exit; exit;
end; end;
if RB1.Checked then if frPrintForm.RB1.Checked then
Pages := '' Pages := ''
else else
if RB2.Checked then if frPrintForm.RB2.Checked then
Pages := IntToStr(CurPage) Pages := IntToStr(CurPage)
else else
Pages := E2.Text; Pages := frPrintForm.E2.Text;
TfrReport(Doc).DefaultCollate:=frPrintForm.cbCollate.Checked; TfrReport(Doc).DefaultCollate:=frPrintForm.cbCollate.Checked;
PrintReport(E1.Value); PrintReport(frPrintForm.E1.Value);
end; end;
Free; frPrintForm.Free;
end; // end;
{$ENDIF} {$ENDIF}
result := true; result := true;
end; end;