Lazstats: Print, save and copy memo in BasicSPCUnit. Copy chart in BasicSPCUnit.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7661 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-09-09 22:48:48 +00:00
parent 9c7509c4de
commit 0b891471b9
5 changed files with 529 additions and 301 deletions
--- a/applications/lazstats/source/forms/analysis/statistical_process_control/basicspcunit.lfm
+++ b/applications/lazstats/source/forms/analysis/statistical_process_control/basicspcunit.lfm
@ -237,19 +237,19 @@ object BasicSPCForm: TBasicSPCForm
      ClientWidth = 545
      object Panel1: TPanel
        Left = 6
-        Height = 386
-        Top = 6
+        Height = 358
+        Top = 34
        Width = 533
        Align = alClient
        BorderSpacing.Around = 6
        BevelOuter = bvNone
        BorderStyle = bsSingle
-        ClientHeight = 382
+        ClientHeight = 354
        ClientWidth = 529
        TabOrder = 0
        object ReportMemo: TMemo
          Left = 4
-          Height = 374
+          Height = 346
          Top = 4
          Width = 521
          Align = alClient
@ -262,17 +262,55 @@ object BasicSPCForm: TBasicSPCForm
          TabOrder = 0
        end
      end
+      object ToolBar2: TToolBar
+        Left = 0
+        Height = 22
+        Top = 6
+        Width = 541
+        AutoSize = True
+        BorderSpacing.Top = 6
+        BorderSpacing.Right = 4
+        BorderSpacing.Bottom = 6
+        Caption = 'ToolBar2'
+        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'
      ClientHeight = 398
      ClientWidth = 545
      object ToolBar1: TToolBar
-        Left = 517
-        Height = 386
+        Left = 0
+        Height = 22
        Top = 6
-        Width = 24
-        Align = alRight
+        Width = 541
        AutoSize = True
        BorderSpacing.Top = 6
        BorderSpacing.Right = 4
@ -282,23 +320,39 @@ object BasicSPCForm: TBasicSPCForm
        Images = MainDataModule.ImageList
        TabOrder = 0
        Transparent = True
-        object tbSave: TToolButton
+        object tbSaveChart: TToolButton
          Left = 1
          Hint = 'Save chart to file'
          Top = 0
-          Caption = 'tbSave'
+          Caption = 'Save'
          ImageIndex = 4
-          OnClick = tbSaveClick
+          OnClick = tbSaveChartClick
        end
-        object tbPrint: TToolButton
-          Left = 1
+        object tbPrintChart: TToolButton
+          Left = 24
          Hint = 'Print chart'
-          Top = 22
-          Caption = 'tbPrint'
+          Top = 0
+          Caption = 'Print'
          ImageIndex = 5
-          OnClick = tbPrintClick
+          OnClick = tbPrintChartClick
+        end
+        object tbCopyChart: TToolButton
+          Left = 47
+          Hint = 'Copy chart to clipboard'
+          Top = 0
+          Caption = 'Copy'
+          ImageIndex = 7
+          OnClick = tbCopyChartClick
        end
      end
    end
  end
+  object SaveDialog: TSaveDialog
+    Left = 399
+    Top = 88
+  end
+  object PrintDialog: TPrintDialog
+    Left = 399
+    Top = 146
+  end
 end
--- a/applications/lazstats/source/forms/analysis/statistical_process_control/basicspcunit.pas
+++ b/applications/lazstats/source/forms/analysis/statistical_process_control/basicspcunit.pas
@ -6,7 +6,7 @@ interface

 uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
-  StdCtrls, ComCtrls,
+  StdCtrls, ComCtrls, PrintersDlgs,
  Globals, MainUnit, ContextHelpUnit, ChartFrameUnit;

 type
@ -21,20 +21,27 @@ type
    GroupLabel: TLabel;
    MeasLabel: TLabel;
    MeasEdit: TEdit;
+    PrintDialog: TPrintDialog;
    ReportMemo: TMemo;
    PageControl1: TPageControl;
    Panel1: TPanel;
    ResetBtn: TButton;
    ComputeBtn: TButton;
    CloseBtn: TButton;
+    SaveDialog: TSaveDialog;
    SpecsPanel: TPanel;
    ButtonPanel: TPanel;
    SpecsSplitter: TSplitter;
    ReportPage: TTabSheet;
    ChartPage: TTabSheet;
-    tbPrint: TToolButton;
-    tbSave: TToolButton;
+    tbPrintChart: TToolButton;
+    tbPrintReport: TToolButton;
+    tbSaveChart: TToolButton;
+    tbSaveReport: TToolButton;
    ToolBar1: TToolBar;
+    ToolBar2: TToolBar;
+    tbCopyReport: TToolButton;
+    tbCopyChart: TToolButton;
    VarList: TListBox;
    VarListLabel: TLabel;
    procedure CloseBtnClick(Sender: TObject);
@ -44,12 +51,17 @@ type
    procedure FormShow(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
-    procedure tbPrintClick(Sender: TObject);
-    procedure tbSaveClick(Sender: TObject);
+    procedure tbCopyChartClick(Sender: TObject);
+    procedure tbCopyReportClick(Sender: TObject);
+    procedure tbPrintChartClick(Sender: TObject);
+    procedure tbPrintReportClick(Sender: TObject);
+    procedure tbSaveChartClick(Sender: TObject);
+    procedure tbSaveReportClick(Sender: TObject);
    procedure VarListClick(Sender: TObject);
  private

  protected
+    FPrintY: Integer;
    GrpVar: Integer;
    MeasVar: Integer;
    function GetGroups: StrDyneVec;
@ -57,6 +69,7 @@ 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 Compute; virtual;
    function Validate(out AMsg: String; out AControl: TWinControl): Boolean; virtual;
@ -75,9 +88,16 @@ 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;
+

 { TBasicSPCForm }

@ -288,6 +308,55 @@ begin
  end;
 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;
@ -307,19 +376,59 @@ begin
  Reset;
 end;

+procedure TBasicSPCForm.tbCopyChartClick(Sender: TObject);
+begin
+  FChartFrame.Chart.CopyToClipboardBitmap;
+end;

-procedure TBasicSPCForm.tbPrintClick(Sender: TObject);
+
+procedure TBasicSPCForm.tbCopyReportClick(Sender: TObject);
+begin
+  with ReportMemo do
+  begin
+    SelectAll;
+    CopyToClipboard;
+    SelLength := 0;
+  end;
+end;
+
+
+procedure TBasicSPCForm.tbPrintChartClick(Sender: TObject);
 begin
  FChartFrame.Print;
 end;


-procedure TBasicSPCForm.tbSaveClick(Sender: TObject);
+procedure TBasicSPCForm.tbPrintReportClick(Sender: TObject);
+begin
+  if PrintDialog.Execute then
+  begin
+    Printer.BeginDoc;
+    try
+      PrintText;
+    finally
+      Printer.EndDoc;
+    end;
+  end;
+end;
+
+
+procedure TBasicSPCForm.tbSaveChartClick(Sender: TObject);
 begin
  FChartFrame.Save;
 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;
+
+
 function TBasicSPCForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
 var
   x: Double;
--- a/applications/lazstats/source/forms/analysis/statistical_process_control/uchartunit.lfm
+++ b/applications/lazstats/source/forms/analysis/statistical_process_control/uchartunit.lfm
@ -139,6 +139,15 @@ inherited UChartForm: TUChartForm
          Width = 446
        end
      end
+      inherited ToolBar2: TToolBar
+        Width = 466
+      end
+    end
+    inherited ChartPage: TTabSheet
+      ClientWidth = 470
+      inherited ToolBar1: TToolBar
+        Width = 466
+      end
    end
  end
 end
--- a/applications/lazstats/source/forms/analysis/statistical_process_control/xbarchartunit.lfm
+++ b/applications/lazstats/source/forms/analysis/statistical_process_control/xbarchartunit.lfm
@ -215,6 +215,15 @@ inherited XBarChartForm: TXBarChartForm
          Width = 403
        end
      end
+      inherited ToolBar2: TToolBar
+        Width = 423
+      end
+    end
+    inherited ChartPage: TTabSheet
+      ClientWidth = 427
+      inherited ToolBar1: TToolBar
+        Width = 423
+      end
    end
  end
 end