lazstats: Move chart to frame for more versatile usage. Adapt ChartUnit, PlotXYUnit, MultXvsYUnit, XvxMultYUnit, BoxPlotUnit.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7646 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-09-06 10:47:23 +00:00
parent 3f6128bd76
commit 51bbe3ba02
9 changed files with 351 additions and 195 deletions

View File

@ -49,7 +49,7 @@
<PackageName Value="LCL"/>
</Item7>
</RequiredPackages>
<Units Count="173">
<Units Count="174">
<Unit0>
<Filename Value="LazStats.lpr"/>
<IsPartOfProject Value="True"/>
@ -1405,6 +1405,14 @@
<IsPartOfProject Value="True"/>
<UnitName Value="MathUnit"/>
</Unit172>
<Unit173>
<Filename Value="frames\chartframeunit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="ChartFrame"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="ChartFrameUnit"/>
</Unit173>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -1415,7 +1423,7 @@
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="forms;forms\analysis;forms\analysis\cross-classification;forms\analysis\financial;forms\analysis\descriptive;forms\analysis\one_sample_tests;forms\analysis\comparisons;forms\analysis\correlation;forms\analysis\matrix_manipulation;forms\analysis\measurement_programs;forms\analysis\measurement_programs\item_banking;forms\analysis\multiple_regression;forms\analysis\multivariate;forms\analysis\nonparametric;forms\analysis\statistical_process_control;forms\help;forms\options;forms\misc;forms\simulations;forms\tools;forms\variables;units"/>
<OtherUnitFiles Value="forms;forms\analysis;forms\analysis\cross-classification;forms\analysis\financial;forms\analysis\descriptive;forms\analysis\one_sample_tests;forms\analysis\comparisons;forms\analysis\correlation;forms\analysis\matrix_manipulation;forms\analysis\measurement_programs;forms\analysis\measurement_programs\item_banking;forms\analysis\multiple_regression;forms\analysis\multivariate;forms\analysis\nonparametric;forms\analysis\statistical_process_control;forms\help;forms\options;forms\misc;forms\simulations;forms\tools;forms\variables;units;frames"/>
<UnitOutputDirectory Value="..\ppu\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>

View File

@ -445,9 +445,9 @@ begin
clr := BOX_COLORS[i mod Length(BOX_COLORS)];
ser.AddXY(i+1, TenPcnt[i], LowQrtl[i], Medians[i], HiQrtl[i], NinetyPcnt[i], '', clr);
end;
ChartForm.Chart.BottomAxis.Marks.Source := ser.ListSource;
ChartForm.Chart.BottomAxis.Marks.Style := smsXValue;
ChartForm.Chart.AddSeries(ser);
ChartForm.ChartFrame.Chart.BottomAxis.Marks.Source := ser.ListSource;
ChartForm.ChartFrame.Chart.BottomAxis.Marks.Style := smsXValue;
ChartForm.ChartFrame.Chart.AddSeries(ser);
ChartForm.Show;
end;

View File

@ -83,7 +83,7 @@ implementation
uses
{$IFDEF USE_TACHART}
TATypes,
ChartUnit,
ChartFrameUnit, ChartUnit,
{$ELSE}
BlankFrmUnit,
{$ENDIF}

View File

@ -76,7 +76,7 @@ implementation
uses
{$IFDEF USE_TACHART}
TAChartUtils,
ChartUnit,
ChartFrameUnit, ChartUnit,
{$ELSE}
BlankFrmUnit,
{$ENDIF}

View File

@ -73,7 +73,7 @@ implementation
uses
{$IFDEF USE_TACHART}
TAChartUtils,
ChartUnit,
ChartFrameUnit, ChartUnit,
{$ELSE}
BlankFrmUnit,
{$ENDIF}

View File

@ -79,7 +79,7 @@ object ChartForm: TChartForm
TabOrder = 2
end
end
object Panel1: TPanel
object ChartPanel: TPanel
Left = 6
Height = 444
Top = 6
@ -88,67 +88,9 @@ object ChartForm: TChartForm
BorderSpacing.Around = 6
BevelOuter = bvNone
BorderStyle = bsSingle
Caption = 'Panel1'
ClientHeight = 440
ClientWidth = 684
Caption = 'ChartPanel'
Color = clWhite
ParentColor = False
TabOrder = 1
object Chart: TChart
Left = 6
Height = 428
Top = 6
Width = 672
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
Intervals.MaxLength = 80
Intervals.MinLength = 30
Alignment = calBottom
Marks.LabelBrush.Style = bsClear
Minors = <>
Title.LabelFont.Style = [fsBold]
Title.LabelBrush.Style = bsClear
end>
BackColor = clWhite
Foot.Brush.Color = clBtnFace
Foot.Brush.Style = bsClear
Foot.Font.Color = clBlue
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Title.Brush.Color = clBtnFace
Title.Brush.Style = bsClear
Title.Font.Color = clBlue
Title.Font.Style = [fsBold]
Title.Text.Strings = (
'TAChart'
)
Align = alClient
BorderSpacing.Around = 6
Color = clWhite
end
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

View File

@ -5,38 +5,33 @@ unit ChartUnit;
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ExtDlgs, PrintersDlgs,
TAGraph, TACustomSeries, TASeries, TATypes,
Globals;
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls,
TAGraph, TATypes, TACustomSeries, TASeries,
Globals, ChartFrameUnit;
type
TPlotType = (ptLines, ptSymbols, ptLinesAndSymbols, ptHorBars, ptVertBars,
ptArea);
{ TChartForm }
TChartForm = class(TForm)
ButtonBevel: TBevel;
Chart: TChart;
CloseBtn: TButton;
ButtonPanel: TPanel;
Panel1: TPanel;
ChartPanel: TPanel;
PrintBtn: TButton;
PrintDialog: TPrintDialog;
SaveBtn: TButton;
SavePictureDialog: TSavePictureDialog;
procedure CloseBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
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);
function GetChart: TChart;
public
ChartFrame: TChartFrame;
procedure Clear;
procedure GetXRange(out XMin, XMax: Double; Logical: Boolean = true);
@ -52,6 +47,8 @@ type
procedure SetXTitle(const ATitle: String);
procedure SetYTitle(const ATitle: String);
property Chart: TChart read GetChart;
end;
var
@ -62,21 +59,18 @@ implementation
{$R *.lfm}
uses
Math, Printers, OSPrinters,
TAChartUtils, TADrawerSVG, TAPrint;
Math;
{ TChartForm }
procedure TChartForm.Clear;
begin
Caption := 'Plot Window';
Chart.ClearSeries;
Chart.Title.Text.Clear;
Chart.Foot.Text.Clear;
Chart.BottomAxis.Title.Caption := '';
Chart.LeftAxis.Title.Caption := '';
ChartFrame.Clear;
end;
procedure TChartForm.FormActivate(Sender: TObject);
var
w: Integer;
@ -87,169 +81,95 @@ begin
CloseBtn.Constraints.MinWidth := w;
end;
procedure TChartForm.CloseBtnClick(Sender: TObject);
begin
Close;
end;
procedure TChartForm.FormCreate(Sender: TObject);
begin
Clear;
ChartFrame := TChartFrame.Create(self);
ChartFrame.parent := ChartPanel;
ChartFrame.Align := alClient;
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;
ChartFrame.Print;
end;
function TChartForm.GetChart: TChart;
begin
Result := ChartFrame.Chart;
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;
ChartFrame.GetXRange(XMin, XMax, Logical);
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;
ChartFrame.GetYRange(YMin, YMax, Logical);
end;
procedure TChartForm.HorLine(y: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String);
begin
ConstLine(y, lsHorizontal, AColor, ALineStyle, ALegendTitle);
ChartFrame.HorLine(y, AColor, ALineStyle, ALegendTitle);
end;
procedure TChartForm.VertLine(x: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String);
begin
ConstLine(x, lsVertical, AColor, ALineStyle, ALegendTitle);
ChartFrame.VertLine(x, 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; ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
var
i, n: Integer;
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 := ASymbol;
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
Result.AddXY(x[i], y[i]);
Result.Title := LegendTitle;
Chart.AddSeries(Result);
Chart.Legend.Visible := Chart.SeriesCount > 0;
Result := ChartFrame.PlotXY(AType, x, y, LegendTitle, AColor, ASymbol);
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;
ChartFrame.Save;
end;
procedure TChartForm.SetFooter(const ATitle: String);
begin
Chart.Foot.Text.Text := ATitle;
Chart.Foot.Visible := ATitle <> '';
ChartFrame.SetFooter(ATitle);
end;
procedure TChartForm.SetTitle(const ATitle: String);
begin
Chart.Title.Text.Text := ATitle;
Chart.Title.Visible := ATitle <> '';
ChartFrame.SetTitle(ATitle);
end;
procedure TChartForm.SetXTitle(const ATitle: String);
begin
Chart.BottomAxis.Title.Caption := ATitle;
Chart.BottomAxis.Title.Visible := ATitle <> '';
ChartFrame.SetXTitle(ATitle);
end;
procedure TChartForm.SetYTitle(const ATitle: String);
begin
Chart.LeftAxis.Title.Caption := ATitle;
Chart.LeftAxis.Title.Visible := ATitle <> '';
ChartFrame.SetYTitle(ATitle);
end;
end.

View File

@ -0,0 +1,56 @@
object ChartFrame: TChartFrame
Left = 0
Height = 403
Top = 0
Width = 620
ClientHeight = 403
ClientWidth = 620
TabOrder = 0
DesignLeft = 353
DesignTop = 156
object Chart: TChart
Left = 0
Height = 403
Top = 0
Width = 620
AxisList = <
item
Grid.Color = clSilver
Marks.LabelBrush.Style = bsClear
Minors = <>
Title.LabelFont.Orientation = 900
Title.LabelFont.Style = [fsBold]
Title.LabelBrush.Style = bsClear
end
item
Grid.Color = clSilver
Alignment = calBottom
Marks.LabelBrush.Style = bsClear
Minors = <>
Title.LabelFont.Style = [fsBold]
Title.LabelBrush.Style = bsClear
end>
BackColor = clWhite
Foot.Brush.Color = clBtnFace
Foot.Brush.Style = bsClear
Foot.Font.Color = clBlue
Title.Brush.Color = clBtnFace
Title.Brush.Style = bsClear
Title.Font.Color = clBlue
Title.Font.Style = [fsBold]
Title.Text.Strings = (
'TAChart'
)
Align = alClient
Color = clWhite
end
object PrintDialog: TPrintDialog
Left = 279
Top = 102
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 = 279
Top = 184
end
end

View File

@ -0,0 +1,230 @@
unit ChartFrameUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, ExtDlgs, PrintersDlgs,
TAGraph, TATypes, TACustomSeries, TASeries,
Globals;
type
TPlotType = (ptLines, ptSymbols, ptLinesAndSymbols, ptHorBars, ptVertBars,
ptArea);
{ TChartFrame }
TChartFrame = class(TFrame)
Chart: TChart;
PrintDialog: TPrintDialog;
SavePictureDialog: TSavePictureDialog;
protected
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; ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
procedure Print;
procedure Save;
procedure SetFooter(const ATitle: String);
procedure SetTitle(const ATitle: String);
procedure SetXTitle(const ATitle: String);
procedure SetYTitle(const ATitle: String);
procedure VertLine(x: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String);
end;
implementation
{$R *.lfm}
uses
Math, Printers, OSPrinters,
TAChartUtils, TADrawerSVG, TAPrint;
procedure TChartFrame.Clear;
begin
Chart.ClearSeries;
Chart.Title.Text.Clear;
Chart.Foot.Text.Clear;
Chart.BottomAxis.Title.Caption := '';
Chart.LeftAxis.Title.Caption := '';
end;
procedure TChartFrame.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;
procedure TChartFrame.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 TChartFrame.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 TChartFrame.HorLine(y: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String);
begin
ConstLine(y, lsHorizontal, AColor, ALineStyle, ALegendTitle);
end;
procedure TChartFrame.VertLine(x: Double; AColor: TColor; ALineStyle: TPenStyle;
ALegendTitle: String);
begin
ConstLine(x, lsVertical, AColor, ALineStyle, ALegendTitle);
end;
function TChartFrame.PlotXY(AType: TPlotType; x, y: DblDyneVec;
LegendTitle: string; AColor: TColor; ASymbol: TSeriesPointerStyle = psCircle): TChartSeries;
var
i, n: Integer;
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 := ASymbol;
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
Result.AddXY(x[i], y[i]);
Result.Title := LegendTitle;
Chart.AddSeries(Result);
Chart.Legend.Visible := Chart.SeriesCount > 0;
end;
procedure TChartFrame.Print;
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 TChartFrame.Save;
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 TChartFrame.SetFooter(const ATitle: String);
begin
Chart.Foot.Text.Text := ATitle;
Chart.Foot.Visible := ATitle <> '';
end;
procedure TChartFrame.SetTitle(const ATitle: String);
begin
Chart.Title.Text.Text := ATitle;
Chart.Title.Visible := ATitle <> '';
end;
procedure TChartFrame.SetXTitle(const ATitle: String);
begin
Chart.BottomAxis.Title.Caption := ATitle;
Chart.BottomAxis.Title.Visible := ATitle <> '';
end;
procedure TChartFrame.SetYTitle(const ATitle: String);
begin
Chart.LeftAxis.Title.Caption := ATitle;
Chart.LeftAxis.Title.Visible := ATitle <> '';
end;
end.