paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-04 04:38:13 +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-rus.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.lpr svneol=native#text/pascal
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/tlrradiobutton.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_pqconnection.pas 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_color.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_dbcomponent.pas svneol=native#text/plain
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
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
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 UpdateControlPosition; override;
procedure AttachToParent; override;
procedure Assign(From: TfrView); override;
procedure Assign(Source: TPersistent); override;
property Control: TControl read FControl write FControl;
property AutoSize: Boolean read GetAutoSize write SetAutoSize;
@ -1433,18 +1433,18 @@ begin
FControl.Parent := OwnerForm;
end;
procedure TlrVisualControl.Assign(From: TfrView);
procedure TlrVisualControl.Assign(Source: TPersistent);
begin
inherited Assign(From);
if From is TlrVisualControl then
inherited Assign(Source);
if Source is TlrVisualControl then
begin
AutoSize:=TlrVisualControl(From).AutoSize;
Color:=TlrVisualControl(From).Color;
Caption:=TlrVisualControl(From).Caption;
Text:=TlrVisualControl(From).Text;
Font:=TlrVisualControl(From).Font;
Hint:=TlrVisualControl(From).Hint;
OnClick:=TlrVisualControl(From).OnClick;
AutoSize:=TlrVisualControl(Source).AutoSize;
Color:=TlrVisualControl(Source).Color;
Caption:=TlrVisualControl(Source).Caption;
Text:=TlrVisualControl(Source).Text;
Font:=TlrVisualControl(Source).Font;
Hint:=TlrVisualControl(Source).Hint;
OnClick:=TlrVisualControl(Source).OnClick;
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>
<Package Version="4">
<Name Value="LR_SqlDB"/>
@ -8,12 +8,6 @@
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="Add support to FCL SQLdb components for designing LazReport dialogs at runtime with lr_dialogdesign package"/>
<License Value="modified LGPL-2
@ -35,8 +29,8 @@
<UnitName Value="LR_IBConnection"/>
</Item3>
<Item4>
<Filename Value="lrsqldb_img.inc"/>
<Type Value="Include"/>
<Filename Value="lr_editsqldbparamsunit.pas"/>
<UnitName Value="lr_editsqldbparamsunit"/>
</Item4>
</Files>
<Type Value="RunAndDesignTime"/>

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

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

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

@ -5,18 +5,33 @@ unit lr_SQLQuery;
interface
uses
Classes, SysUtils, Graphics, LR_Class, LR_DBComponent, sqldb, DB;
Classes, SysUtils, Graphics, LR_Class, LR_DBComponent, sqldb, DB, contnrs;
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 = class(TLRDataSetControl)
private
FDatabase: string;
FParams: TQueryParamList;
procedure SetDatabase(AValue: string);
procedure DoMakeParams;
procedure DoEditParams;
procedure SQLQueryBeforeOpen(ADataSet: TDataSet);
protected
function GetSQL: string;
procedure SetSQL(AValue:string);
@ -24,12 +39,14 @@ type
procedure AfterLoad;override;
public
constructor Create(AOwnerPage:TfrPage); override;
destructor Destroy; override;
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
published
property SQL:string read GetSQL write SetSQL;
property Database:string read FDatabase write SetDatabase;
property Params:TQueryParamList read FParams write FParams;
end;
{ TLRSQLConnection }
@ -77,7 +94,8 @@ implementation
{$R lrsqldb_img.res}
uses LR_Utils, DBPropEdits, PropEdits, Controls;
uses LR_Utils, DBPropEdits, PropEdits, Controls, Forms,
lr_EditSQLDBParamsUnit;
var
lrBMP_SQLQuery:TBitmap = nil;
@ -92,6 +110,34 @@ begin
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 }
function TLRSQLConnection.GetCharSet: string;
@ -235,13 +281,89 @@ begin
end;
procedure TLRSQLQuery.DoMakeParams;
var
Q:TSQLQuery;
i:integer;
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;
procedure TLRSQLQuery.DoEditParams;
var
lrEditParamsForm: Tlr_EditSQLDBParamsForm;
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;
function TLRSQLQuery.GetSQL: string;
@ -289,25 +411,80 @@ begin
inherited Create(AOwnerPage);
BaseName := 'lrSQLQuery';
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;
procedure TLRSQLQuery.LoadFromXML(XML: TLrXMLConfig; const Path: String);
var
C: Integer;
i: Integer;
begin
inherited LoadFromXML(XML, Path);
TSQLQuery(DataSet).SQL.Text := XML.GetValue(Path+'SQL/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;
procedure TLRSQLQuery.SaveToXML(XML: TLrXMLConfig; const Path: String);
var
i: Integer;
P: TQueryParam;
begin
inherited SaveToXML(XML, Path);
XML.SetValue(Path+'SQL/Value', TSQLQuery(DataSet).SQL.Text);
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;
type
{ TLRZConnectionProtocolProperty }
{ TLRSQLQueryParamsProperty }
TLRSQLQueryParamsProperty = class(TPropertyEditor)
public
function GetAttributes: TPropertyAttributes; override;
function GetValue: ansistring; override;
procedure Edit; override;
end;
TLRSQLConnectionProtocolProperty = class(TFieldProperty)
public
@ -324,6 +501,24 @@ type
procedure Edit; override;
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 }
function TLRSQLQuerySQLProperty.GetAttributes: TPropertyAttributes;
@ -373,6 +568,8 @@ initialization
RegisterPropertyEditor(TypeInfo(string), TLRSQLQuery, 'Database', TLRSQLConnectionProtocolProperty);
RegisterPropertyEditor(TypeInfo(string), TLRSQLQuery, 'SQL', TLRSQLQuerySQLProperty);
RegisterPropertyEditor(TypeInfo(TQueryParamList), TLRSQLQuery, 'Params', TLRSQLQueryParamsProperty);
finalization
if Assigned(lrBMP_SQLQuery) then
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>
<Package Version="4">
<Name Value="LR_TDbf"/>
@ -8,27 +8,17 @@
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="Add support to DBF components for designing LazReport dialogs at runtime with lr_dialogdesign package"/>
<License Value="modified LGPL-2
"/>
<Version Minor="1" Release="1"/>
<Files Count="2">
<Files Count="1">
<Item1>
<Filename Value="lrtdbfdata.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="lrTDbfData"/>
</Item1>
<Item2>
<Filename Value="lrtdbfdata_img.inc"/>
<Type Value="Include"/>
</Item2>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">

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

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

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

@ -513,14 +513,16 @@ var
View: TfrView;
begin
View := CreateView(Page, Node.NodeName);
if View<>nil then begin
if View<>nil then
begin
View.BeginUpdate;
Page.Objects.Add(View);
// Page.Objects.Add(View);
LoadView(Node, Page, View, ParentView);
View.EndUpdate;
// process any child
cNode := Node.FirstChild;
while cNode<>nil do begin
while cNode<>nil do
begin
ProcessObject(Page, cNode, View);
cNode := cNode.NextSibling;
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.
"/>
<Version Minor="9" Release="9"/>
<Files Count="67">
<Files Count="70">
<Item1>
<Filename Value="lr_about.pas"/>
<UnitName Value="LR_About"/>
@ -294,6 +294,18 @@ See license.txt and license-lazreport.txt for details.
<Filename Value="lr_previewtoolsabstract.pas"/>
<UnitName Value="lr_previewtoolsabstract"/>
</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>
<i18n>
<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_Var, LR_Vared, LR_View, LR_Newrp, Barcode, LR_DBRel, LR_DBComponent,
lr_hyphen, LR_Intrp, fr3tolrf, lr_design_ins_filed, lr_previewtoolsabstract,
LazarusPackageIntf;
lr_CrossArray, lr_CrossTab, lr_CrossTabEditor, LazarusPackageIntf;
implementation

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

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

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

@ -43,20 +43,22 @@ type
procedure Print(Stream: TStream); override;
procedure ExportData; override;
procedure DefinePopupMenu(Popup: TPopupMenu); override;
procedure Assign(Source: TPersistent); override;
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override;
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
published
property Checked : Boolean read fChecked write fChecked;
property DataField;
property FillColor;
property FrameColor;
property Frames;
property FrameStyle;
property FrameWidth;
property Script;
property Restrictions;
end;
@ -111,12 +113,18 @@ begin
end;
procedure TfrCheckBoxView.Draw(aCanvas: TCanvas);
var
IsChecked: Boolean;
begin
BeginDraw(aCanvas);
Memo1.Assign(Memo);
CalcGaps;
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;
RestoreCoord;
end;
@ -153,10 +161,16 @@ begin
if Popup=nil then;
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);
begin
inherited LoadFromStream(Stream);
Stream.Read(fChecked, SizeOf(fChecked));
end;
@ -169,7 +183,6 @@ end;
procedure TfrCheckBoxView.LoadFromXML(XML: TLrXMLConfig; const Path: String);
begin
inherited LoadFromXML(XML, Path);
RestoreProperty('Checked',XML.GetValue(Path+'Data/Checked/Value',''));
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;
//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);
end;
end;
@ -1745,10 +1745,11 @@ var
procedure AddObject(ot: Byte);
begin
Objects.Add(frCreateObject(ot, '', FDesigner.Page));
t := TfrView(Objects.Last);
if t is TfrMemoView then
TfrMemoView(t).MonitorFontChanges;
{ Objects.Add(frCreateObject(ot, '', FDesigner.Page));
t := TfrView(Objects.Last);}
t:=frCreateObject(ot, '', FDesigner.Page);
if t is TfrCustomMemoView then
TfrCustomMemoView(t).MonitorFontChanges;
end;
procedure CreateSection;
@ -1760,8 +1761,9 @@ var
ObjectInserted := frBandTypesForm.ShowModal = mrOk;
if ObjectInserted then
begin
Objects.Add(TfrBandView.Create(FDesigner.Page));
t := TfrView(Objects.Last);
{ Objects.Add(TfrBandView.Create(FDesigner.Page));
t := TfrView(Objects.Last);}
t:=TfrBandView.Create(FDesigner.Page);
(t as TfrBandView).BandType := frBandTypesForm.SelectedTyp;
s := frGetBandName(frBandTypesForm.SelectedTyp);
THackView(t).BaseName := s;
@ -1774,8 +1776,9 @@ var
procedure CreateSubReport;
begin
Objects.Add(TfrSubReportView.Create(FDesigner.Page));
t := TfrView(Objects.Last);
{ Objects.Add(TfrSubReportView.Create(FDesigner.Page));
t := TfrView(Objects.Last);}
t:=TfrSubReportView.Create(FDesigner.Page);
(t as TfrSubReportView).SubPage := CurReport.Pages.Count;
CurReport.Pages.Add;
end;
@ -1846,8 +1849,9 @@ begin
if Tag >= gtAddIn then
begin
k := Tag - gtAddIn;
Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page));
t := TfrView(Objects.Last);
{ Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page));
t := TfrView(Objects.Last);}
t:=frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page);
end
else
AddObject(Tag);
@ -1874,8 +1878,9 @@ begin
if Tag >= gtAddIn then
begin
k := Tag - gtAddIn;
Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page));
t := TfrView(Objects.Last);
{ Objects.Add(frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page));
t := TfrView(Objects.Last);}
t:=frCreateObject(gtAddIn, frAddIns[k].ClassRef.ClassName, FDesigner.Page);
end
else
AddObject(Tag);
@ -1901,7 +1906,7 @@ begin
begin
dx := 40;
dy := 40;
if t is TfrMemoView then
if t is TfrCustomMemoView then
FDesigner.GetDefaultSize(dx, dy);
OldRect := Rect(Left, Top, Left + dx, Top + dy);
end;
@ -1927,9 +1932,9 @@ begin
if t.Typ <> gtBand then
t.Frames:=LastFrames;
if t is TfrMemoView then
if t is TfrCustomMemoView then
begin
with t as TfrMemoView do
with t as TfrCustomMemoView do
begin
Font.Name := LastFontName;
Font.Size := LastFontSize;
@ -2426,7 +2431,7 @@ begin
for i := 0 to Objects.Count - 1 do
begin
t := TfrView(Objects[i]);
if t.Selected then
if (t.Selected) and not (lrrDontSize in T.Restrictions) then
begin
if FDesigner.ShapeMode = smAll then
AddRgn(hr, t);
@ -2526,6 +2531,9 @@ begin
end;
t := TfrView(Objects[TopSelected]);
if (lrrDontSize in T.Restrictions) then
exit;
if FDesigner.ShapeMode = smFrame then
DrawPage(dmShape)
else
@ -2680,7 +2688,10 @@ begin
for i := 0 to Objects.Count - 1 do
begin
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
AddRgn(hr, t);
if aResize then
@ -2948,11 +2959,11 @@ begin
end;
{$ENDIF}
if (SelNum>0) and (FirstSelected is TfrMemoView) then
if (SelNum>0) and (FirstSelected is TfrCustomMemoView) then
begin
// font of selected memo has preference, select it
LastFontname := TfrMemoView(FirstSelected).Font.Name;
LastFontSize := TfrMemoView(FirstSelected).Font.Size;
LastFontname := TfrCustomMemoView(FirstSelected).Font.Name;
LastFontSize := TfrCustomMemoView(FirstSelected).Font.Size;
end else
if C2.Items.IndexOf(LastFontName)>=0 then
// last font name remains valid, keep it together with lastFontSize
@ -3839,13 +3850,13 @@ end;
procedure TfrDesignerForm.CutToClipboard;
var
i: Integer;
t: TfrView;
T: TfrView;
begin
ClearClipBoard;
for i := 0 to Objects.Count - 1 do
begin
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
ClipBd.Add(frCreateObject(t.Typ, t.ClassName, Page));
TfrView(ClipBd.Last).Assign(t);
@ -3854,9 +3865,11 @@ begin
for i := Objects.Count - 1 downto 0 do
begin
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;
SelNum := 0;
PageView.Invalidate;
end;
procedure TfrDesignerForm.CopyToClipboard;
@ -3868,9 +3881,9 @@ begin
for i := 0 to Objects.Count - 1 do
begin
t := TfrView(Objects[i]);
if t.Selected then
if t.Selected and not (doChildComponent in T.DesignOptions) then
begin
ClipBd.Add(frCreateObject(t.Typ, t.ClassName, Page));
ClipBd.Add(frCreateObject(t.Typ, t.ClassName, nil));
TfrView(ClipBd.Last).Assign(t);
end;
end;
@ -4146,7 +4159,7 @@ begin
for i := Objects.Count - 1 downto 0 do
begin
t := TfrView(Objects[i]);
if t.Selected then
if t.Selected and not (lrrDontDelete in T.Restrictions) then
Page.Delete(i);
end;
SetPageTitles;
@ -4166,10 +4179,11 @@ begin
t := TfrView(Objects[TopSelected]);
if t.Typ = gtBand then
Result := [ssBand]
else if t is TfrMemoView then
Result := [ssMemo]
else
Result := [ssOther];
else
if t is TfrCustomMemoView then
Result := [ssMemo]
else
Result := [ssOther];
end
else if SelNum > 1 then
Result := [ssMultiple];
@ -4183,250 +4197,9 @@ begin
ScrollBox1.Autoscroll := False;
ScrollBox1.Autoscroll := True;
ScrollBox1.VertScrollBar.Range := ScrollBox1.VertScrollBar.Range + 10;
//ScrollBox1.VertScrollBar.Range := ScrollBox1.VertScrollBar.Range + 10;
end;
{$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}
procedure TfrDesignerForm.DrawStatusPanel(const ACanvas: TCanvas;
const rect: TRect);
@ -4660,7 +4433,7 @@ begin
if CurReport.FindObject(t.Name) <> nil then
t.CreateUniqueName;
Objects.Add(t);
// Objects.Add(t);
end;
procedure TfrDesignerForm.ResetDuplicateCount;
@ -4804,8 +4577,8 @@ begin
E1.Text := FloatToStrF(FrameWidth, ffGeneral, 2, 2);
frSetGlyph(FillColor, ClB1, 1);
frSetGlyph(FrameColor, ClB3, 2);
if t is TfrMemoView then
with t as TfrMemoView do
if t is TfrCustomMemoView then
with t as TfrCustomMemoView do
begin
frSetGlyph(Font.Color, ClB2, 0);
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
with t do
begin
if t is TfrMemoView then
with t as TfrMemoView do
if t is TfrCustomMemoView then
with t as TfrCustomMemoView do
case b of
7: if C2.ItemIndex >= 0 then
begin
@ -5058,9 +4831,9 @@ end;
procedure TfrDesignerForm.HlB1Click(Sender: TObject);
var
t: TfrMemoView;
t: TfrCustomMemoView;
begin
t := TfrMemoView(Objects[TopSelected]);
t := TfrCustomMemoView(Objects[TopSelected]);
frHilightForm := TfrHilightForm.Create(nil);
with frHilightForm do
begin
@ -5317,8 +5090,8 @@ begin
CL:=clNone;
if Sender=ClB1 then
CL:=t.FillColor;
if (Sender=ClB2) and (t is TfrMemoView) then
CL:=TfrMemoView(t).Font.Color;
if (Sender=ClB2) and (t is TfrCustomMemoView) then
CL:=TfrCustomMemoView(t).Font.Color;
if Sender=ClB3 then
CL:=t.FrameColor;
ColorSelector.Color:=CL;
@ -5455,6 +5228,10 @@ var
begin
SetCaptureControl(nil);
t := TfrView(Objects[TopSelected]);
if lrrDontModify in T.Restrictions then
exit;
if t.Typ = gtMemo then
ShowMemoEditor
else
@ -5510,6 +5287,12 @@ begin
for i := 0 to frAddInsCount - 1 do
if frAddIns[i].ClassRef.ClassName = t.ClassName then
begin
if Assigned(frAddIns[i].EditorProc) then
begin
if frAddIns[i].EditorProc(t) then
Modified:=true;
end
else
if frAddIns[i].EditorForm <> nil then
begin
PageView.NPEraseSelection;
@ -5681,7 +5464,7 @@ begin
acInsert: p^.ObjID := t.ID;
acDelete, acEdit:
begin
t1 := frCreateObject(t.Typ, t.ClassName, Page);
t1 := frCreateObject(t.Typ, t.ClassName, nil);
t1.Assign(t);
t1.ID := t.ID;
p^.ObjID := t.ID;
@ -5717,6 +5500,7 @@ var
i,j: Integer;
t: TfrView;
List: TFpList;
F:boolean;
procedure AddCurrent;
var
@ -5742,7 +5526,13 @@ begin
for i := j to Objects.Count - 1 do
begin
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;
end;
@ -5894,7 +5684,6 @@ begin
t1.Assign(t);
if CurReport.FindObject(t1.Name) <> nil then
t1.CreateUniqueName;
Objects.Add(t1);
end;
SelectionChanged;
SendBandsToDown;
@ -6175,15 +5964,16 @@ procedure TfrDesignerForm.ScrollBox1DragDrop(Sender, Source: TObject; X,
Y: Integer);
var
Control :TControl;
t : TfrMemoView;
t : TfrCustomMemoView;
dx, dy:integer;
begin
Control:=lrDesignAcceptDrag(Source);
if Assigned(lrFieldsList) and ((Control = lrFieldsList.lbFieldsList) or (Control = lrFieldsList.ValList)) then
begin
Objects.Add(frCreateObject(gtMemo, '', Page));
t:=TfrMemoView(Objects.Last);
{ Objects.Add(frCreateObject(gtMemo, '', Page));
t:=TfrCustomMemoView(Objects.Last);}
t:=frCreateObject(gtMemo, '', Page) as TfrCustomMemoView;
if Assigned(t) then
begin
t.MonitorFontChanges;
@ -6315,7 +6105,7 @@ begin
begin
t1 := TfrView(Objects[i]);
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.ClassName = t1.ClassName))) then
begin
@ -7233,8 +7023,8 @@ begin
Case Sb.Tag of
5 : t.FillColor:=aColor; {ClB1}
17 : if (t is TfrMemoView) then {ClB2}
TfrMemoView(t).Font.Color:=aColor;
17 : if (t is TfrCustomMemoView) then {ClB2}
TfrCustomMemoView(t).Font.Color:=aColor;
19 : t.FrameColor:=aColor; {ClB3}
end;
end;
@ -7804,12 +7594,12 @@ begin
end;
type
{ TfrMemoViewDetailReportProperty }
{ TfrCustomMemoViewDetailReportProperty }
TfrMemoViewDetailReportProperty = class(TStringProperty)
TfrCustomMemoViewDetailReportProperty = class(TStringProperty)
private
FSaveRep:TfrReport;
FEditView:TfrMemoView;
FEditView:TfrCustomMemoView;
FDetailRrep: TlrDetailReport;
procedure DoSaveReportEvent(Report: TfrReport; var ReportName: String;
SaveAs: Boolean; var Saved: Boolean);
@ -7819,7 +7609,41 @@ type
procedure GetValues(Proc: TGetStrProc); override;
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);
begin
if Assigned(FDetailRrep) then
@ -7833,12 +7657,12 @@ begin
Saved:=false;
end;
function TfrMemoViewDetailReportProperty.GetAttributes: TPropertyAttributes;
function TfrCustomMemoViewDetailReportProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes + [paDialog, paValueList, paSortList];
end;
procedure TfrMemoViewDetailReportProperty.Edit;
procedure TfrCustomMemoViewDetailReportProperty.Edit;
var
FSaveDesigner:TfrReportDesigner;
FSaveView:TfrView;
@ -7851,9 +7675,9 @@ var
///***DocMode: (dmDesigning, dmPrinting); // current mode
begin
if (GetComponent(0) is TfrMemoView) and Assigned(CurReport) then
if (GetComponent(0) is TfrCustomMemoView) and Assigned(CurReport) then
begin
FEditView:=GetComponent(0) as TfrMemoView;
FEditView:=GetComponent(0) as TfrCustomMemoView;
if FEditView.DetailReport = '' then
FEditView.DetailReport:=FEditView.Name + '_DetailReport';
@ -7922,7 +7746,7 @@ begin
end;
end;
procedure TfrMemoViewDetailReportProperty.GetValues(Proc: TGetStrProc);
procedure TfrCustomMemoViewDetailReportProperty.GetValues(Proc: TGetStrProc);
var
I: Integer;
Values: TStringList;
@ -8073,7 +7897,7 @@ begin
t.x := x;
t.y := y;
TfrDesignerForm(frDesigner).GetDefaultSize(t.dx, t.dy);
with t as TfrMemoView do
with t as TfrCustomMemoView do
begin
Font.Name := LastFontName;
Font.Size := LastFontSize;
@ -8081,7 +7905,7 @@ begin
Font.Style := [fsBold];
MonitorFontChanges;
end;
TfrDesignerForm(frDesigner).PageView.Canvas.Font.Assign(TfrMemoView(t).Font);
TfrDesignerForm(frDesigner).PageView.Canvas.Font.Assign(TfrCustomMemoView(t).Font);
t.Selected := True;
Inc(TfrDesignerForm(frDesigner).SelNum);
if HeaderCB.Checked then
@ -8096,7 +7920,7 @@ begin
t.dx := (fSize * TfrDesignerForm(frDesigner).PageView.Canvas.TextWidth('=')) div TfrDesignerForm(frDesigner).GridSize * TfrDesignerForm(frDesigner).GridSize;
end;
dx := t.dx;
TfrDesignerForm(frDesigner).Page.Objects.Add(t);
// TfrDesignerForm(frDesigner).Page.Objects.Add(t);
if HeaderCB.Checked then
HeaderL.Add(t) else
DataL.Add(t);
@ -8110,7 +7934,7 @@ begin
if HorzRB.Checked then
Inc(t.y, 72) else
Inc(t.x, dx + TfrDesignerForm(frDesigner).GridSize * 2);
with t as TfrMemoView do
with t as TfrCustomMemoView do
begin
Font.Name := LastFontName;
Font.Size := LastFontSize;
@ -8121,7 +7945,7 @@ begin
t.Memo.Add('[' + DatasetCB.Items[DatasetCB.ItemIndex] +
'."' + FieldsL.Items[i] + '"]');
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);
end;
if HorzRB.Checked then
@ -8174,7 +7998,7 @@ begin
Inc(TfrDesignerForm(frDesigner).SelNum);
if not HeaderCB.Checked or not HorzRB.Checked then
begin
TfrDesignerForm(frDesigner).Page.Objects.Add(b);
// TfrDesignerForm(frDesigner).Page.Objects.Add(b);
b.BandType := btMasterData;
b.DataSet := FindDataset(DataSet);
end
@ -8188,7 +8012,7 @@ begin
else
begin
b.BandType := btPageHeader;
TfrDesignerForm(frDesigner).Page.Objects.Add(b);
// TfrDesignerForm(frDesigner).Page.Objects.Add(b);
end;
b := frCreateObject(gtBand, '', TfrDesignerForm(frDesigner).Page) as TfrBandView;
b.BandType := btMasterData;
@ -8198,7 +8022,7 @@ begin
b.dy := dy;
b.Selected := True;
Inc(TfrDesignerForm(frDesigner).SelNum);
TfrDesignerForm(frDesigner).Page.Objects.Add(b);
// TfrDesignerForm(frDesigner).Page.Objects.Add(b);
end;
end;
TfrDesignerForm(frDesigner).SelectionChanged;
@ -8241,7 +8065,8 @@ initialization
LastAdjust := 0;
//** 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;
finalization

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

@ -303,13 +303,13 @@ begin
b := TfrBandView(frCreateObject(gtBand, '', Page));
b.SetBounds(10, 20, 1000, 25);
b.BandType := btReportTitle;
Page.Objects.Add(b);
// Page.Objects.Add(b);
v := frCreateObject(gtMemo, '', Page);
v.SetBounds(20, 20, Page.PrnInfo.PgW - 40, 25);
TfrMemoView(v).Alignment:=taCenter;
TfrMemoView(v).Font.Assign(FTitleFont);
v.Memo.Add(FCaption);
Page.Objects.Add(v);
// Page.Objects.Add(v);
end;
// 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.SetBounds(XPos, YPos, 1000, 20);
b.Flags:=b.Flags or flStretched;
Page.Objects.Add(b);
// Page.Objects.Add(b);
v := frCreateObject(gtMemo, '', Page);
v.SetBounds(XPos, YPos, 20, 20);
@ -333,7 +333,7 @@ begin
TfrMemoView(v).Frames:=frAllFrames;
TfrMemoView(v).Layout:=tlTop;
v.Memo.Add('[Header]');
Page.Objects.Add(v);
// Page.Objects.Add(v);
YPos := YPos + 22;
@ -342,13 +342,13 @@ begin
b.Dataset := FReportDataSet.Name;
b.SetBounds(0, YPos, 1000, 18);
b.Flags:=b.Flags or flStretched;
Page.Objects.Add(b);
// Page.Objects.Add(b);
b := TfrBandView(frCreateObject(gtBand, '', Page));
b.BandType := btCrossData;
b.Dataset := FColumnDataSet.Name;
b.SetBounds(XPos, 0, 20, 1000);
Page.Objects.Add(b);
// Page.Objects.Add(b);
v := frCreateObject(gtMemo, '', Page);
v.SetBounds(XPos, YPos, 20, 18);
@ -357,7 +357,7 @@ begin
TfrMemoView(v).Font.Assign(FFont);
TfrMemoView(v).Frames:=frAllFrames;
TfrMemoView(v).Layout:=tlTop;
Page.Objects.Add(v);
// Page.Objects.Add(v);
FDataSet.DisableControls;
BM:=FDataSet.GetBookmark;

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

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

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

@ -102,12 +102,13 @@ begin
r := ARect;
r.Right := r.Left + 18;
r.Bottom := r.Top + 16;
OffsetRect(r, 2, 0);
OffsetRect(r, 2, (ARect.Bottom - ARect.Top) div 2 - 8);
with CB1.Canvas do
begin
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]);
end;
end;

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

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

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

@ -22,7 +22,8 @@ uses
LR_PGrid,
LR_View,
lr_CrossTab,
ComponentEditors,
LazarusPackageIntf;
@ -50,7 +51,8 @@ begin
TfrBarCodeObject,TfrRoundRectObject,TfrShapeObject,
TfrCheckBoxObject,TfrCompositeReport,TfrUserDataset,
TfrTextExport,TfrHTMExport,TfrCSVExport,
TfrPrintGrid,TfrDesigner,TfrPreview]);
TfrPrintGrid,TfrDesigner,TfrPreview,
TlrCrossObject]);
RegisterComponentEditor(TfrReport, TfrRepEditor);
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;
public
constructor Create(AOwnerPage:TfrPage); override;
procedure Assign(From: TfrView); override;
procedure Assign(Source: TPersistent); override;
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override;
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
@ -565,11 +565,12 @@ begin
end;
end;
procedure TfrRoundRectView.Assign(From: TfrView);
procedure TfrRoundRectView.Assign(Source: TPersistent);
begin
inherited Assign(From);
if from is TfrRoundRectView then
fCadre := TfrRoundRectView(From).fCadre
inherited Assign(Source);
if Source is TfrRoundRectView then
fCadre := TfrRoundRectView(Source).fCadre
else
begin
fCadre.wCurve:=10;

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

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

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

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

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

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