pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazStats: Add and use ReportFrame

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7670 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-09-19 14:33:02 +00:00
parent 70b833905c
commit a06c6498ba
20 changed files with 295 additions and 361 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
applications/lazstats/source/LazStats.lpi
View File

@ -49,7 +49,7 @@
<PackageName Value="LCL"/>
</Item7>
</RequiredPackages>
<Units Count="175">
<Units Count="176">
<Unit0>
<Filename Value="LazStats.lpr"/>
<IsPartOfProject Value="True"/>
@ -1421,6 +1421,14 @@
<ResourceBaseClass Value="Form"/>
<UnitName Value="CUSUMUnit"/>
</Unit174>
<Unit175>
<Filename Value="frames\reportframeunit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="ReportFrame"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="ReportFrameUnit"/>
</Unit175>
</Units>
</ProjectOptions>
<CompilerOptions>

2
applications/lazstats/source/LazStats.lpr
View File

@ -8,7 +8,7 @@ uses
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, tachartlazaruspkg, tachartprint, lhelpcontrolpkg,
Globals, LicenseUnit, OptionsUnit, MainDM, MainUnit;
Globals, LicenseUnit, OptionsUnit, MainDM, MainUnit, ReportFrameUnit;
{$R LazStats.res}

79
applications/lazstats/source/forms/analysis/statistical_process_control/basicspcunit.lfm
View File

@ -276,94 +276,19 @@ object BasicSPCForm: TBasicSPCForm
Height = 426
Top = 6
Width = 545
ActivePage = ReportPage
ActivePage = ChartPage
Align = alClient
BorderSpacing.Left = 3
BorderSpacing.Top = 6
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
TabIndex = 0
TabIndex = 1
TabOrder = 2
object ReportPage: TTabSheet
Caption = 'Report'
ClientHeight = 398
ClientWidth = 537
object Panel1: TPanel
Left = 6
Height = 358
Top = 34
Width = 525
Align = alClient
BorderSpacing.Around = 6
BevelOuter = bvNone
BorderStyle = bsSingle
ClientHeight = 354
ClientWidth = 521
TabOrder = 0
object ReportMemo: TMemo
Left = 4
Height = 346
Top = 4
Width = 513
Align = alClient
BorderSpacing.Around = 4
BorderStyle = bsNone
Font.Height = -11
Font.Name = 'Courier New'
ParentFont = False
ScrollBars = ssAutoBoth
TabOrder = 0
end
end
object ReportToolBar: TToolBar
Left = 0
Height = 22
Top = 6
Width = 537
AutoSize = True
BorderSpacing.Top = 6
BorderSpacing.Bottom = 6
Caption = 'ReportToolBar'
EdgeBorders = []
Images = MainDataModule.ImageList
TabOrder = 1
Transparent = True
object tbSaveReport: TToolButton
Left = 1
Hint = 'Save report to file'
Top = 0
Caption = 'Save'
ImageIndex = 4
OnClick = tbSaveReportClick
end
object tbPrintReport: TToolButton
Left = 24
Hint = 'Print report'
Top = 0
Caption = 'Print'
ImageIndex = 5
OnClick = tbPrintReportClick
end
object tbCopyReport: TToolButton
Left = 47
Hint = 'Copy report to clipboard'
Top = 0
Caption = 'Copy'
ImageIndex = 7
OnClick = tbCopyReportClick
end
end
end
object ChartPage: TTabSheet
Caption = 'Chart'
end
end
object SaveDialog: TSaveDialog
Left = 399
Top = 88
end
object PrintDialog: TPrintDialog
Left = 399
Top = 146
end
end

133
applications/lazstats/source/forms/analysis/statistical_process_control/basicspcunit.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ComCtrls, Buttons, PrintersDlgs,
Globals, MainUnit, ContextHelpUnit, ChartFrameUnit;
Globals, MainUnit, ContextHelpUnit, ReportFrameUnit, ChartFrameUnit;
type
@ -21,14 +21,10 @@ type
GroupLabel: TLabel;
MeasLabel: TLabel;
MeasEdit: TEdit;
PrintDialog: TPrintDialog;
ReportMemo: TMemo;
PageControl: TPageControl;
Panel1: TPanel;
ResetBtn: TButton;
ComputeBtn: TButton;
CloseBtn: TButton;
SaveDialog: TSaveDialog;
SpecsPanel: TPanel;
ButtonPanel: TPanel;
SpecsSplitter: TSplitter;
@ -38,10 +34,6 @@ type
MeasOutBtn: TSpeedButton;
GroupInBtn: TSpeedButton;
GroupOutBtn: TSpeedButton;
tbPrintReport: TToolButton;
tbSaveReport: TToolButton;
ReportToolBar: TToolBar;
tbCopyReport: TToolButton;
VarList: TListBox;
VarListLabel: TLabel;
procedure CloseBtnClick(Sender: TObject);
@ -55,15 +47,11 @@ type
procedure MeasInBtnClick(Sender: TObject);
procedure MeasOutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure tbCopyReportClick(Sender: TObject);
procedure tbPrintReportClick(Sender: TObject);
procedure tbSaveReportClick(Sender: TObject);
procedure VarListClick(Sender: TObject);
private
FNoGroupsAllowed: Boolean;
protected
FPrintY: Integer;
GrpVar: Integer;
MeasVar: Integer;
procedure Compute; virtual;
@ -72,12 +60,12 @@ type
procedure PlotMeans(ATitle, AXTitle, AYTitle, ADataTitle, AGrandMeanTitle: String;
const Groups: StrDyneVec; const Means: DblDyneVec;
UCL, LCL, GrandMean, TargetSpec, LowerSpec, UpperSpec: double); virtual;
procedure PrintText; virtual;
procedure Reset; virtual;
procedure UpdateBtnStates; virtual;
function Validate(out AMsg: String; out AControl: TWinControl): Boolean; virtual;
public
FReportFrame: TReportFrame;
FChartFrame: TChartFrame;
property NoGroupsAllowed: Boolean read FNoGroupsAllowed write FNoGroupsAllowed;
@ -93,16 +81,10 @@ implementation
uses
Math,
Printers, OSPrinters,
TAChartUtils, TALegend, TAChartAxisUtils, TASources, TACustomSeries, TASeries,
Utils, DataProcs;
const
LEFT_MARGIN = 200;
RIGHT_MARGIN = 200;
TOP_MARGIN = 150;
BOTTOM_MARGIN = 200;
FORMAT_MASK = '0.000';
@ -181,10 +163,14 @@ end;
procedure TBasicSPCForm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
FReportFrame := TReportFrame.Create(self);
FReportFrame.Parent := ReportPage;
FReportFrame.Align := alClient;
FChartFrame := TChartFrame.Create(self);
FChartFrame.Parent := ChartPage;
FChartFrame.Align := alClient;
FChartFrame.BorderSpacing.Top := Scale96ToFont(6);
FChartFrame.Chart.Legend.SymbolWidth := Scale96ToFont(30);
FChartFrame.Chart.Legend.Alignment := laBottomCenter;
FChartFrame.Chart.Legend.ColumnCount := 3;
@ -372,54 +358,6 @@ begin
end;
procedure TBasicSPCForm.PrintText;
var
i: Integer;
x: Integer;
xmax, ymax: Integer;
pageNo: Integer;
oldFontSize: Integer;
h: Integer;
begin
with Printer do
begin
x := LEFT_MARGIN;
FPrintY := TOP_MARGIN;
xMax := PaperSize.Width - RIGHT_MARGIN;
yMax := PaperSize.Height - BOTTOM_MARGIN;
pageNo := 1;
try
Canvas.Brush.Style := bsClear; // no text background color
Canvas.Font.Assign(ReportMemo.Font);
if Canvas.Font.Size < 10 then
Canvas.Font.Size := 10;
oldFontSize := Canvas.Font.Size;
for i:=0 to ReportMemo.Lines.Count-1 do begin
// Print page number
if FPrintY = TOP_MARGIN then begin
Canvas.Font.Size := 10;
h := Canvas.TextHeight('Page 9') + 4;
Canvas.TextOut(x+1, FPrintY, 'Page ' + IntToStr(PageNo));
Canvas.Pen.Width := 3;
Canvas.Line(LEFT_MARGIN, FPrintY+h, xmax, FPrintY+h);
inc(FPrintY, 2*h);
Canvas.Font.Size := oldFontSize;
end;
Canvas.TextOut(x, FPrintY, ReportMemo.Lines[i]);
inc(FPrintY, Canvas.TextHeight('Tg'));
if FPrintY > yMax then begin
NewPage;
FPrintY := TOP_MARGIN;
inc(PageNo);
end;
end;
except
on E: EPrinter do ShowMessage('Printer Error: ' + E.Message);
on E: Exception do showMessage('Unexpected error when printing.');
end;
end;
end;
procedure TBasicSPCForm.Reset;
var
i : integer;
@ -429,6 +367,8 @@ begin
MeasEdit.Text := '';
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
FReportFrame.Clear;
FChartFrame.Clear;
(FChartFrame.Chart.AxisList[2].Marks.Source as TListChartSource).Clear;
UpdateBtnStates;
@ -441,41 +381,6 @@ begin
end;
procedure TBasicSPCForm.tbCopyReportClick(Sender: TObject);
begin
with ReportMemo do
begin
SelectAll;
CopyToClipboard;
SelLength := 0;
end;
end;
procedure TBasicSPCForm.tbPrintReportClick(Sender: TObject);
begin
if PrintDialog.Execute then
begin
Printer.BeginDoc;
try
PrintText;
finally
Printer.EndDoc;
end;
end;
end;
procedure TBasicSPCForm.tbSaveReportClick(Sender: TObject);
begin
SaveDialog.Filter := 'LazStats text files (*.txt)|*.txt;*.TXT|All files (*.*)|*.*';
SaveDialog.FilterIndex := 1; {text file}
SaveDialog.Title := 'Save to File';
if SaveDialog.Execute then
ReportMemo.Lines.SaveToFile(SaveDialog.FileName);
end;
procedure TBasicSPCForm.UpdateBtnStates;
begin
MeasInBtn.Enabled := (VarList.ItemIndex <> -1) and (MeasEdit.Text = '');
@ -483,11 +388,8 @@ begin
GroupInBtn.Enabled := (VarList.ItemIndex <> -1) and (GroupEdit.Text = '');
GroupOutBtn.Enabled := (GroupEdit.Text <> '');
tbSaveReport.Enabled := ReportMemo.Lines.Count > 0;
tbPrintReport.Enabled := ReportMemo.Lines.Count > 0;
tbCopyReport.Enabled := ReportMemo.Lines.Count > 0;
FChartFrame.UpdateButtons;
FReportFrame.UpdateBtnStates;
FChartFrame.UpdateBtnStates;
end;
@ -512,21 +414,8 @@ end;
procedure TBasicSPCForm.VarListClick(Sender: TObject);
//var
// index: integer;
begin
UpdateBtnStates;
{
index := VarList.ItemIndex;
if index > -1 then
begin
if GroupEdit.Visible and (GroupEdit.Text = '') then
GroupEdit.Text := VarList.Items[index]
else
MeasEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
}
end;
end.

34
applications/lazstats/source/forms/analysis/statistical_process_control/cchartunit.lfm
View File

@ -122,38 +122,4 @@ inherited CChartForm: TCChartForm
end
end
end
inherited SpecsSplitter: TSplitter
Left = 443
Height = 420
end
inherited PageControl: TPageControl
Left = 451
Height = 408
Width = 470
inherited ReportPage: TTabSheet
ClientHeight = 380
ClientWidth = 462
inherited Panel1: TPanel
Height = 340
Width = 450
ClientHeight = 336
ClientWidth = 446
inherited ReportMemo: TMemo
Height = 328
Width = 438
end
end
inherited ReportToolBar: TToolBar
Width = 458
end
end
end
inherited SaveDialog: TSaveDialog
Left = 536
Top = 96
end
inherited PrintDialog: TPrintDialog
Left = 536
Top = 154
end
end

2
applications/lazstats/source/forms/analysis/statistical_process_control/cchartunit.pas
View File

@ -92,7 +92,7 @@ begin
for i := 1 to NoCases do
lReport.Add('%6d %15.2f', [i, means[i]]);
ReportMemo.Lines.Assign(lReport);
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;

34
applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.lfm
View File

@ -433,38 +433,4 @@ inherited CUSUMChartForm: TCUSUMChartForm
end
end
end
inherited SpecsSplitter: TSplitter
Left = 443
Height = 503
end
inherited PageControl: TPageControl
Left = 451
Height = 491
Width = 543
inherited ReportPage: TTabSheet
ClientHeight = 463
ClientWidth = 535
inherited Panel1: TPanel
Height = 423
Width = 523
ClientHeight = 419
ClientWidth = 519
inherited ReportMemo: TMemo
Height = 411
Width = 511
end
end
inherited ReportToolBar: TToolBar
Width = 531
end
end
end
inherited SaveDialog: TSaveDialog
Left = 600
Top = 112
end
inherited PrintDialog: TPrintDialog
Left = 600
Top = 200
end
end

2
applications/lazstats/source/forms/analysis/statistical_process_control/cusumunit.pas
View File

@ -306,7 +306,7 @@ begin
end;
end;
ReportMemo.Lines.Assign(lReport);
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;

26
applications/lazstats/source/forms/analysis/statistical_process_control/pchartunit.lfm
View File

@ -175,30 +175,4 @@ inherited PChartForm: TPChartForm
end
end
end
inherited SpecsSplitter: TSplitter
Left = 459
end
inherited PageControl: TPageControl
Left = 467
Width = 454
inherited ReportPage: TTabSheet
ClientWidth = 446
inherited Panel1: TPanel
Width = 434
ClientWidth = 430
inherited ReportMemo: TMemo
Width = 422
end
end
inherited ReportToolBar: TToolBar
Width = 442
end
end
end
inherited SaveDialog: TSaveDialog
Left = 544
end
inherited PrintDialog: TPrintDialog
Left = 544
end
end

2
applications/lazstats/source/forms/analysis/statistical_process_control/pchartunit.pas
View File

@ -105,7 +105,7 @@ begin
lReport.Add('Sample size for each observation: %8d', [N]);
lReport.Add('Average proportion observed %8.4f', [AVG]);
ReportMemo.Lines.Assign(lReport);
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;

2
applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.pas
View File

@ -158,7 +158,7 @@ begin
for i := 0 to numGrps-1 do
lReport.Add('%7d %4d %8.2f %8.2f %8.2f', [i+1, count[i], means[i], stddev[i], ranges[i]]);
ReportMemo.Lines.Assign(lReport);
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;

2
applications/lazstats/source/forms/analysis/statistical_process_control/schartunit.pas
View File

@ -154,7 +154,7 @@ begin
for i := 0 to numGrps - 1 do
lReport.Add('%7d %4d %8.2f %8.2f', [i+1, count[i], means[i], stddev[i]]);
ReportMemo.Lines.Assign(lReport);
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;

29
applications/lazstats/source/forms/analysis/statistical_process_control/uchartunit.lfm
View File

@ -145,33 +145,4 @@ inherited UChartForm: TUChartForm
end
end
end
inherited SpecsSplitter: TSplitter
Left = 435
end
inherited PageControl: TPageControl
Left = 443
Width = 478
inherited ReportPage: TTabSheet
ClientWidth = 470
inherited Panel1: TPanel
Width = 458
ClientWidth = 454
inherited ReportMemo: TMemo
Width = 446
end
end
inherited ReportToolBar: TToolBar
Width = 466
end
end
inherited ChartPage: TTabSheet
ClientWidth = 470
end
end
inherited SaveDialog: TSaveDialog
Left = 544
end
inherited PrintDialog: TPrintDialog
Left = 544
end
end

2
applications/lazstats/source/forms/analysis/statistical_process_control/uchartunit.pas
View File

@ -96,7 +96,7 @@ begin
for i := 0 to numSamples-1 do
lReport.Add('%6d %10.2f %16.2f', [i, means[i], defPerUnit[i]]);
ReportMemo.Lines.Assign(lReport);
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;

22
applications/lazstats/source/forms/analysis/statistical_process_control/xbarchartunit.lfm
View File

@ -236,26 +236,4 @@ inherited XBarChartForm: TXBarChartForm
Left = 390
Height = 476
end
inherited PageControl: TPageControl
Left = 398
Height = 464
Width = 523
inherited ReportPage: TTabSheet
ClientHeight = 436
ClientWidth = 515
inherited Panel1: TPanel
Height = 396
Width = 503
ClientHeight = 392
ClientWidth = 499
inherited ReportMemo: TMemo
Height = 384
Width = 491
end
end
inherited ReportToolBar: TToolBar
Width = 511
end
end
end
end

2
applications/lazstats/source/forms/analysis/statistical_process_control/xbarchartunit.pas
View File

@ -325,7 +325,7 @@ begin
for i := 0 to numGrps-1 do
lReport.Add('%7s %4d %8.2f %8.2f', [groups[i], count[i], means[i], stddev[i]]);
ReportMemo.Lines.Assign(lReport);
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;

3
applications/lazstats/source/frames/chartframeunit.lfm
View File

@ -54,9 +54,8 @@ object ChartFrame: TChartFrame
Left = 0
Height = 24
Top = 0
Width = 616
Width = 620
AutoSize = True
BorderSpacing.Right = 4
BorderSpacing.Bottom = 6
ButtonHeight = 22
ButtonWidth = 25

14
applications/lazstats/source/frames/chartframeunit.pas
View File

@ -7,7 +7,8 @@ interface
uses
Classes, SysUtils, LCLVersion, Forms, Controls, Graphics, ExtDlgs, ComCtrls,
PrintersDlgs, TAGraph, TATypes, TACustomSource, TACustomSeries, TASeries,
TATools, Globals;
TATools,
Globals, MainDM;
type
TPlotType = (ptLines, ptSymbols, ptLinesAndSymbols, ptHorBars, ptVertBars,
@ -50,7 +51,7 @@ type
procedure SetTitle(const ATitle: String; Alignment: TAlignment = taCenter);
procedure SetXTitle(const ATitle: String);
procedure SetYTitle(const ATitle: String);
procedure UpdateButtons; virtual;
procedure UpdateBtnStates; virtual;
function VertLine(x: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String): TConstantLine;
end;
@ -71,7 +72,7 @@ begin
ZoomDragTool.LimitToExtent := [zdDown];
PanDragTool.LimitToExtent := [pdDown];
{$IFEND}
UpdateButtons;
UpdateBtnStates;
end;
@ -83,6 +84,7 @@ begin
Chart.BottomAxis.Title.Caption := '';
Chart.LeftAxis.Title.Caption := '';
Chart.Legend.Visible := false;
UpdateBtnStates;
end;
function TChartFrame.Constline(xy: Double; ADirection: TLineStyle;
@ -96,7 +98,7 @@ begin
Result.Title := ALegendTitle;
Result.Legend.Visible := ALegendTitle <> '';
Chart.AddSeries(Result);
UpdateButtons;
UpdateBtnStates;
end;
@ -195,7 +197,7 @@ begin
Result.Title := LegendTitle;
Chart.AddSeries(Result);
Chart.Legend.Visible := Chart.SeriesCount > 0;
UpdateButtons;
UpdateBtnStates;
end;
@ -274,7 +276,7 @@ begin
end;
procedure TChartFrame.UpdateButtons;
procedure TChartFrame.UpdateBtnStates;
begin
tbSaveChart.Enabled := Chart.SeriesCount > 0;
tbPrintChart.Enabled := Chart.SeriesCount > 0;

86
applications/lazstats/source/frames/reportframeunit.lfm Normal file
View File

@ -0,0 +1,86 @@
object ReportFrame: TReportFrame
Left = 0
Height = 240
Top = 0
Width = 310
ClientHeight = 240
ClientWidth = 310
TabOrder = 0
DesignLeft = 998
DesignTop = 330
object ReportToolBar: TToolBar
Left = 0
Height = 24
Top = 0
Width = 306
AutoSize = True
BorderSpacing.Right = 4
BorderSpacing.Bottom = 6
ButtonHeight = 22
ButtonWidth = 25
Caption = 'ReportToolBar'
EdgeBorders = [ebBottom]
Images = MainDataModule.ImageList
TabOrder = 0
Transparent = True
object tbSaveReport: TToolButton
Left = 1
Hint = 'Save report to file'
Top = 0
Caption = 'Save'
ImageIndex = 4
OnClick = tbSaveReportClick
end
object tbPrintReport: TToolButton
Left = 26
Hint = 'Print report'
Top = 0
Caption = 'Print'
ImageIndex = 5
OnClick = tbPrintReportClick
end
object tbCopyReport: TToolButton
Left = 51
Hint = 'Copy report to clipboard'
Top = 0
Caption = 'Copy'
ImageIndex = 7
OnClick = tbCopyReportClick
end
end
object ReportPanel: TPanel
Left = 6
Height = 204
Top = 30
Width = 298
Align = alClient
BorderSpacing.Around = 6
BevelOuter = bvNone
BorderStyle = bsSingle
ClientHeight = 200
ClientWidth = 294
TabOrder = 1
object ReportMemo: TMemo
Left = 4
Height = 192
Top = 4
Width = 286
Align = alClient
BorderSpacing.Around = 4
BorderStyle = bsNone
Font.Height = -11
Font.Name = 'Courier New'
ParentFont = False
ScrollBars = ssAutoBoth
TabOrder = 0
end
end
object SaveDialog: TSaveDialog
Left = 48
Top = 56
end
object PrintDialog: TPrintDialog
Left = 48
Top = 114
end
end

170
applications/lazstats/source/frames/reportframeunit.pas Normal file
View File

@ -0,0 +1,170 @@
unit ReportFrameUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, StdCtrls, Dialogs,
PrintersDlgs, MainDM;
type
{ TReportFrame }
TReportFrame = class(TFrame)
PrintDialog: TPrintDialog;
ReportPanel: TPanel;
ReportMemo: TMemo;
ReportToolBar: TToolBar;
SaveDialog: TSaveDialog;
tbCopyReport: TToolButton;
tbPrintReport: TToolButton;
tbSaveReport: TToolButton;
procedure tbCopyReportClick(Sender: TObject);
procedure tbPrintReportClick(Sender: TObject);
procedure tbSaveReportClick(Sender: TObject);
private
FPrintY: Integer;
protected
procedure PrintText; virtual;
public
constructor Create(AOwner: TComponent); override;
procedure Clear; virtual;
procedure DisplayReport(AReport: TStrings); virtual;
procedure UpdateBtnStates; virtual;
end;
implementation
{$R *.lfm}
uses
Graphics,
Printers, OSPrinters;
const
LEFT_MARGIN = 200;
RIGHT_MARGIN = 200;
TOP_MARGIN = 150;
BOTTOM_MARGIN = 200;
constructor TReportFrame.Create(AOwner: TComponent);
begin
inherited;
UpdateBtnStates;
end;
procedure TReportFrame.Clear;
begin
ReportMemo.Lines.Clear;
UpdateBtnStates;
end;
procedure TReportFrame.DisplayReport(AReport: TStrings);
begin
ReportMemo.Lines.AddStrings(AReport);
UpdateBtnStates;
end;
procedure TReportFrame.PrintText;
var
i: Integer;
x: Integer;
xmax, ymax: Integer;
pageNo: Integer;
oldFontSize: Integer;
h: Integer;
begin
with Printer do
begin
x := LEFT_MARGIN;
FPrintY := TOP_MARGIN;
xMax := PaperSize.Width - RIGHT_MARGIN;
yMax := PaperSize.Height - BOTTOM_MARGIN;
pageNo := 1;
try
Canvas.Brush.Style := bsClear; // no text background color
Canvas.Font.Assign(ReportMemo.Font);
if Canvas.Font.Size < 10 then
Canvas.Font.Size := 10;
oldFontSize := Canvas.Font.Size;
for i:=0 to ReportMemo.Lines.Count-1 do begin
// Print page number
if FPrintY = TOP_MARGIN then begin
Canvas.Font.Size := 10;
h := Canvas.TextHeight('Page 9') + 4;
Canvas.TextOut(x+1, FPrintY, 'Page ' + IntToStr(PageNo));
Canvas.Pen.Width := 3;
Canvas.Line(LEFT_MARGIN, FPrintY+h, xmax, FPrintY+h);
inc(FPrintY, 2*h);
Canvas.Font.Size := oldFontSize;
end;
Canvas.TextOut(x, FPrintY, ReportMemo.Lines[i]);
inc(FPrintY, Canvas.TextHeight('Tg'));
if FPrintY > yMax then begin
NewPage;
FPrintY := TOP_MARGIN;
inc(PageNo);
end;
end;
except
on E: EPrinter do ShowMessage('Printer Error: ' + E.Message);
on E: Exception do ShowMessage('Unexpected error when printing.');
end;
end;
end;
procedure TReportFrame.UpdateBtnStates;
begin
tbCopyReport.Enabled := ReportMemo.Lines.Count > 0;
tbPrintReport.Enabled := ReportMemo.Lines.Count > 0;
tbSaveReport.Enabled := ReportMemo.Lines.Count > 0;
end;
procedure TReportFrame.tbPrintReportClick(Sender: TObject);
begin
if PrintDialog.Execute then
begin
Printer.BeginDoc;
try
PrintText;
finally
Printer.EndDoc;
end;
end;
end;
procedure TReportFrame.tbCopyReportClick(Sender: TObject);
begin
with ReportMemo do
begin
SelectAll;
CopyToClipboard;
SelLength := 0;
end;
end;
procedure TReportFrame.tbSaveReportClick(Sender: TObject);
begin
SaveDialog.Filter := 'LazStats text files (*.txt)|*.txt;*.TXT|All files (*.*)|*.*';
SaveDialog.FilterIndex := 1; {text file}
SaveDialog.Title := 'Save to File';
if SaveDialog.Execute then
ReportMemo.Lines.SaveToFile(SaveDialog.FileName);
end;
end.