LazStats: New unit ChartUnit: beginning to introduce TAChart.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7625 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-08-22 17:30:06 +00:00
parent 53e90e5a82
commit 2379dbcfef
4 changed files with 404 additions and 15 deletions
--- a/applications/lazstats/source/LazStats.lpi
+++ b/applications/lazstats/source/LazStats.lpi
@ -24,26 +24,32 @@
    <RunParams>
      <FormatVersion Value="2"/>
    </RunParams>
-    <RequiredPackages Count="5">
+    <RequiredPackages Count="7">
      <Item1>
-        <PackageName Value="lhelpcontrolpkg"/>
+        <PackageName Value="TAChartPrint"/>
      </Item1>
      <Item2>
-        <PackageName Value="LazControls"/>
+        <PackageName Value="TAChartLazarusPkg"/>
      </Item2>
      <Item3>
-        <PackageName Value="FCL"/>
-        <MinVersion Major="1" Valid="True"/>
+        <PackageName Value="lhelpcontrolpkg"/>
      </Item3>
      <Item4>
-        <PackageName Value="Printer4Lazarus"/>
-        <MinVersion Minor="5" Valid="True"/>
+        <PackageName Value="LazControls"/>
      </Item4>
      <Item5>
-        <PackageName Value="LCL"/>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
      </Item5>
+      <Item6>
+        <PackageName Value="Printer4Lazarus"/>
+        <MinVersion Minor="5" Valid="True"/>
+      </Item6>
+      <Item7>
+        <PackageName Value="LCL"/>
+      </Item7>
    </RequiredPackages>
-    <Units Count="171">
+    <Units Count="172">
      <Unit0>
        <Filename Value="LazStats.lpr"/>
        <IsPartOfProject Value="True"/>
@ -1386,6 +1392,13 @@
        <Filename Value="LazStats.inc"/>
        <IsPartOfProject Value="True"/>
      </Unit170>
+      <Unit171>
+        <Filename Value="forms\misc\chartunit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="ChartForm"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="ChartUnit"/>
+      </Unit171>
    </Units>
  </ProjectOptions>
  <CompilerOptions>
@ -1418,7 +1431,7 @@
    </Linking>
  </CompilerOptions>
  <Debugging>
-    <Exceptions Count="7">
+    <Exceptions Count="8">
      <Item1>
        <Name Value="EAbort"/>
      </Item1>
@ -1443,6 +1456,9 @@
        <Name Value="Exception"/>
        <Enabled Value="False"/>
      </Item7>
+      <Item8>
+        <Name Value="EFreeType"/>
+      </Item8>
    </Exceptions>
  </Debugging>
 </CONFIG>
--- a/applications/lazstats/source/LazStats.lpr
+++ b/applications/lazstats/source/LazStats.lpr
@ -7,8 +7,8 @@ uses
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
-  Forms, lhelpcontrolpkg,
-  Globals, LicenseUnit, OptionsUnit, MainDM, MainUnit, utils;
+  Forms, tachartlazaruspkg, tachartprint, lhelpcontrolpkg,
+  Globals, LicenseUnit, OptionsUnit, MainDM, MainUnit, utils, chartunit;

 {$R LazStats.res}

@ -26,9 +26,8 @@ begin
    else
      Application.Terminate;
  end;
-
-  Application.CreateForm(TMainDataModule, MainDataModule);
-  Application.CreateForm(TOS3MainFrm, OS3MainFrm);
+Application.CreateForm(TMainDataModule, MainDataModule);
+Application.CreateForm(TOS3MainFrm, OS3MainFrm);
  Application.Run;
 end.

--- a/applications/lazstats/source/forms/misc/chartunit.lfm
+++ b/applications/lazstats/source/forms/misc/chartunit.lfm
@ -0,0 +1,131 @@
+object ChartForm: TChartForm
+  Left = 299
+  Height = 518
+  Top = 133
+  Width = 860
+  ActiveControl = CloseBtn
+  Caption = 'Plot window'
+  ClientHeight = 518
+  ClientWidth = 860
+  OnCreate = FormCreate
+  LCLVersion = '2.1.0.0'
+  object ButtonBevel: TBevel
+    Left = 0
+    Height = 8
+    Top = 468
+    Width = 860
+    Align = alBottom
+    Shape = bsBottomLine
+  end
+  object ButtonPanel: TPanel
+    Left = 8
+    Height = 26
+    Top = 484
+    Width = 844
+    Align = alBottom
+    AutoSize = True
+    BorderSpacing.Around = 8
+    BevelOuter = bvNone
+    ClientHeight = 26
+    ClientWidth = 844
+    TabOrder = 1
+    object PrintBtn: TButton
+      AnchorSideLeft.Control = ButtonPanel
+      AnchorSideLeft.Side = asrCenter
+      AnchorSideTop.Control = ButtonPanel
+      AnchorSideTop.Side = asrCenter
+      Left = 397
+      Height = 25
+      Top = 1
+      Width = 51
+      AutoSize = True
+      BorderSpacing.Left = 12
+      BorderSpacing.Right = 12
+      Caption = 'Print'
+      OnClick = PrintBtnClick
+      TabOrder = 1
+    end
+    object SaveBtn: TButton
+      AnchorSideTop.Control = ButtonPanel
+      AnchorSideTop.Side = asrCenter
+      AnchorSideRight.Control = PrintBtn
+      Left = 299
+      Height = 25
+      Top = 1
+      Width = 86
+      Anchors = [akTop, akRight]
+      AutoSize = True
+      Caption = 'Save Image'
+      OnClick = SaveBtnClick
+      TabOrder = 0
+    end
+    object CloseBtn: TButton
+      AnchorSideLeft.Control = PrintBtn
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = ButtonPanel
+      AnchorSideTop.Side = asrCenter
+      AnchorSideRight.Side = asrBottom
+      Left = 460
+      Height = 25
+      Top = 1
+      Width = 55
+      AutoSize = True
+      Cancel = True
+      Caption = 'Close'
+      Default = True
+      ModalResult = 11
+      TabOrder = 2
+    end
+  end
+  object Chart: TChart
+    Left = 6
+    Height = 456
+    Top = 6
+    Width = 848
+    AxisList = <    
+      item
+        Grid.Color = clSilver
+        Grid.Style = psSolid
+        Grid.Visible = False
+        Marks.LabelBrush.Style = bsClear
+        Minors = <>
+        Title.LabelFont.Orientation = 900
+        Title.LabelFont.Style = [fsBold]
+        Title.LabelBrush.Style = bsClear
+      end    
+      item
+        Grid.Color = clSilver
+        Grid.Style = psSolid
+        Grid.Visible = False
+        Alignment = calBottom
+        Marks.LabelBrush.Style = bsClear
+        Minors = <>
+        Title.LabelFont.Style = [fsBold]
+        Title.LabelBrush.Style = bsClear
+      end>
+    BackColor = clWhite
+    Foot.Brush.Color = clBtnFace
+    Foot.Font.Color = clBlue
+    Margins.Left = 8
+    Margins.Top = 8
+    Margins.Right = 8
+    Margins.Bottom = 8
+    Title.Brush.Color = clBtnFace
+    Title.Font.Color = clBlue
+    Title.Font.Style = [fsBold]
+    Title.Text.Strings = (
+      'TAChart'
+    )
+    Align = alClient
+    BorderSpacing.Around = 6
+  end
+  object SavePictureDialog: TSavePictureDialog
+    Filter = 'Graphic (*.png;*.bmp;*.jpeg;*.jpg;*.jpe;*.jfif;*.svg)|*.png;*.bmp;*.jpeg;*.jpg;*.jpe;*.jfif;*.svg|Portable Network Graphic (*.png)|*.png|Bitmaps (*.bmp)|*.bmp|Joint Picture Expert Group (*.jpeg;*.jpg;*.jpe;*.jfif)|*.jpeg;*.jpg;*.jpe;*.jfif|Scaleable Vector Graphic (*.svg)|*.svg|All Files (*.*)|*.*'
+    Left = 408
+    Top = 136
+  end
+  object PrintDialog: TPrintDialog
+    Left = 408
+    Top = 194
+  end
+end
--- a/applications/lazstats/source/forms/misc/chartunit.pas
+++ b/applications/lazstats/source/forms/misc/chartunit.pas
@ -0,0 +1,243 @@
+unit ChartUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
+  StdCtrls, ExtDlgs, TAGraph, TACustomSeries, TASeries, PrintersDlgs,
+  Globals;
+
+type
+
+  TPlotType = (ptLines, ptSymbols, ptLinesAndSymbols, ptHorBars, ptVertBars,
+    ptArea);
+
+  { TChartForm }
+
+  TChartForm = class(TForm)
+    ButtonBevel: TBevel;
+    Chart: TChart;
+    CloseBtn: TButton;
+    ButtonPanel: TPanel;
+    PrintBtn: TButton;
+    PrintDialog: TPrintDialog;
+    SaveBtn: TButton;
+    SavePictureDialog: TSavePictureDialog;
+    procedure FormCreate(Sender: TObject);
+    procedure PrintBtnClick(Sender: TObject);
+    procedure SaveBtnClick(Sender: TObject);
+  private
+    procedure Constline(xy: Double; ADirection: TLineStyle;
+      AColor: TColor; ALineStyle: TPenStyle; ALegendTitle: String);
+
+  public
+    procedure Clear;
+
+    procedure GetXRange(out XMin, XMax: Double; Logical: Boolean = true);
+    procedure GetYRange(out YMin, YMax: Double; Logical: Boolean = true);
+
+    procedure HorLine(y: Double; AColor: TColor; ALineStyle: TPenStyle; ALegendTitle: String);
+    function PlotXY(AType: TPlotType; x, y: DblDyneVec; LegendTitle: string;
+      AColor: TColor; xTitles: StrDynevec = nil): TChartSeries;
+    procedure Vertline(x: Double; AColor: TColor; ALineStyle: TPenStyle; ALegendTitle: String);
+
+    procedure SetFooter(const ATitle: String);
+    procedure SetTitle(const ATitle: String);
+    procedure SetXTitle(const ATitle: String);
+    procedure SetYTitle(const ATitle: String);
+
+  end;
+
+var
+  ChartForm: TChartForm;
+
+implementation
+
+{$R *.lfm}
+
+uses
+  Math, Printers, //OSPrinters,
+  TAChartUtils, TATypes, TADrawerSVG, TAPrint;
+
+{ TChartForm }
+
+procedure TChartForm.Clear;
+begin
+  Chart.ClearSeries;
+  Chart.Title.Text.Clear;
+  Chart.Foot.Text.Clear;
+  Chart.BottomAxis.Title.Caption := '';
+  Chart.LeftAxis.Title.Caption := '';
+end;
+
+procedure TChartForm.FormCreate(Sender: TObject);
+begin
+  Clear;
+end;
+
+procedure TChartForm.PrintBtnClick(Sender: TObject);
+const
+  MARGIN = 10;
+var
+  R: TRect;
+  d: Integer;
+begin
+  if not PrintDialog.Execute then
+    exit;
+
+  Printer.BeginDoc;
+  try
+    R := Rect(0, 0, Printer.PageWidth, Printer.PageHeight div 2);
+
+    d := R.Right - R.Left;
+    R.Left += d div MARGIN;
+    R.Right -= d div MARGIN;
+
+    d := R.Bottom - R.Top;
+    R.Top += d div MARGIN;
+    R.Bottom -= d div MARGIN;
+
+    Chart.Draw(TPrinterDrawer.Create(Printer, true), R);
+  finally
+    Printer.EndDoc;
+  end;
+end;
+
+procedure TChartForm.GetXRange(out XMin, XMax: Double; Logical: Boolean = true);
+var
+  ext: TDoubleRect;
+begin
+  if Logical then
+    ext := Chart.LogicalExtent
+  else
+    ext := Chart.CurrentExtent;
+  XMin := ext.a.x;
+  XMax := ext.b.x;
+end;
+
+procedure TChartForm.GetYRange(out YMin, YMax: Double; Logical: Boolean = true);
+var
+  ext: TDoubleRect;
+begin
+  if Logical then
+    ext := Chart.LogicalExtent
+  else
+    ext := Chart.CurrentExtent;
+  YMin := ext.a.y;
+  YMax := ext.b.y;
+end;
+
+procedure TChartForm.HorLine(y: Double; AColor: TColor; ALineStyle: TPenStyle;
+  ALegendTitle: String);
+begin
+  ConstLine(y, lsHorizontal, AColor, ALineStyle, ALegendTitle);
+end;
+
+procedure TChartForm.VertLine(x: Double; AColor: TColor; ALineStyle: TPenStyle;
+  ALegendTitle: String);
+begin
+  ConstLine(x, lsVertical, AColor, ALineStyle, ALegendTitle);
+end;
+
+procedure TChartForm.Constline(xy: Double; ADirection: TLineStyle;
+  AColor: TColor; ALineStyle: TPenStyle; ALegendTitle: String);
+var
+  ser: TConstantLine;
+begin
+  ser := TConstantLine.Create(self);
+  ser.Position := xy;
+  ser.LineStyle := ADirection;
+  ser.Pen.Color := AColor;
+  ser.Pen.Style := ALineStyle;
+  ser.Title := ALegendTitle;
+  ser.Legend.Visible := ALegendTitle <> '';
+  Chart.AddSeries(ser);
+end;
+
+function TChartForm.PlotXY(AType: TPlotType; x, y: DblDyneVec;
+  LegendTitle: string; AColor: TColor; xTitles: StrDynevec = nil): TChartSeries;
+var
+  i, n: Integer;
+  s: String;
+begin
+  case AType of
+    ptLines, ptSymbols, ptLinesAndSymbols:
+      begin
+        Result := TLineSeries.Create(self);
+        TLineSeries(Result).ShowPoints := AType in [ptSymbols, ptLinesAndSymbols];
+        TLineSeries(Result).ShowLines := AType in [ptLines, ptLinesAndSymbols];
+        TLineSeries(Result).SeriesColor := AColor;
+        if AType in [ptSymbols, ptLinesAndSymbols] then
+        begin
+          TLineSeries(Result).Pointer.Brush.Color := AColor;
+          TLineSeries(Result).Pointer.Style := psCircle;
+        end;
+      end;
+    ptHorBars, ptVertBars:
+      Result := TBarSeries.Create(self);
+    ptArea:
+      Result := TAreaSeries.Create(self);
+    else
+      raise Exception.Create('Unknown plot type.');
+  end;
+
+  n := Min(Length(x), Length(y));
+  for i := 0 to n-1 do
+  begin
+    if (xTitles <> nil) and (i <= Length(xTitles)) then
+      s := xTitles[i]
+    else
+      s := '';
+    Result.AddXY(x[i], y[i], s);
+  end;
+
+  Result.Title := LegendTitle;
+  Chart.AddSeries(Result);
+  Chart.Legend.Visible := Chart.SeriesCount > 0;
+  Chart.Prepare;
+end;
+
+procedure TChartForm.SaveBtnClick(Sender: TObject);
+var
+  ext: String;
+begin
+  if SavePictureDialog.Execute then
+  begin
+    ext := Lowercase(ExtractFileExt(SavePictureDialog.FileName));
+    case ext of
+      '.bmp': Chart.SaveToFile(TBitmap, SavePictureDialog.Filename);
+      '.png': Chart.SaveToFile(TPortableNetworkGraphic, SavePictureDialog.FileName);
+      '.jpg', '.jpeg', '.jpe', '.jfif': Chart.SaveToFile(TJpegImage, SavePictureDialog.FileName);
+      '.svg': Chart.SaveToSVGFile(SavePictureDialog.FileName);
+    end;
+  end;
+end;
+
+procedure TChartForm.SetFooter(const ATitle: String);
+begin
+  Chart.Foot.Text.Text := ATitle;
+  Chart.Foot.Visible := ATitle <> '';
+end;
+
+procedure TChartForm.SetTitle(const ATitle: String);
+begin
+  Chart.Title.Text.Text := ATitle;
+  Chart.Title.Visible := ATitle <> '';
+end;
+
+procedure TChartForm.SetXTitle(const ATitle: String);
+begin
+  Chart.BottomAxis.Title.Caption := ATitle;
+  Chart.BottomAxis.Title.Visible := ATitle <> '';
+end;
+
+procedure TChartForm.SetYTitle(const ATitle: String);
+begin
+  Chart.LeftAxis.Title.Caption := ATitle;
+  Chart.LeftAxis.Title.Visible := ATitle <> '';
+end;
+
+end.
+