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
This commit is contained in:
wp_xxyyzz
2020-08-22 17:30:06 +00:00
parent 53e90e5a82
commit 2379dbcfef
4 changed files with 404 additions and 15 deletions

View File

@ -24,26 +24,32 @@
<RunParams> <RunParams>
<FormatVersion Value="2"/> <FormatVersion Value="2"/>
</RunParams> </RunParams>
<RequiredPackages Count="5"> <RequiredPackages Count="7">
<Item1> <Item1>
<PackageName Value="lhelpcontrolpkg"/> <PackageName Value="TAChartPrint"/>
</Item1> </Item1>
<Item2> <Item2>
<PackageName Value="LazControls"/> <PackageName Value="TAChartLazarusPkg"/>
</Item2> </Item2>
<Item3> <Item3>
<PackageName Value="FCL"/> <PackageName Value="lhelpcontrolpkg"/>
<MinVersion Major="1" Valid="True"/>
</Item3> </Item3>
<Item4> <Item4>
<PackageName Value="Printer4Lazarus"/> <PackageName Value="LazControls"/>
<MinVersion Minor="5" Valid="True"/>
</Item4> </Item4>
<Item5> <Item5>
<PackageName Value="LCL"/> <PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item5> </Item5>
<Item6>
<PackageName Value="Printer4Lazarus"/>
<MinVersion Minor="5" Valid="True"/>
</Item6>
<Item7>
<PackageName Value="LCL"/>
</Item7>
</RequiredPackages> </RequiredPackages>
<Units Count="171"> <Units Count="172">
<Unit0> <Unit0>
<Filename Value="LazStats.lpr"/> <Filename Value="LazStats.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -1386,6 +1392,13 @@
<Filename Value="LazStats.inc"/> <Filename Value="LazStats.inc"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit170> </Unit170>
<Unit171>
<Filename Value="forms\misc\chartunit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="ChartForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ChartUnit"/>
</Unit171>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
@ -1418,7 +1431,7 @@
</Linking> </Linking>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>
<Exceptions Count="7"> <Exceptions Count="8">
<Item1> <Item1>
<Name Value="EAbort"/> <Name Value="EAbort"/>
</Item1> </Item1>
@ -1443,6 +1456,9 @@
<Name Value="Exception"/> <Name Value="Exception"/>
<Enabled Value="False"/> <Enabled Value="False"/>
</Item7> </Item7>
<Item8>
<Name Value="EFreeType"/>
</Item8>
</Exceptions> </Exceptions>
</Debugging> </Debugging>
</CONFIG> </CONFIG>

View File

@ -7,8 +7,8 @@ uses
cthreads, cthreads,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset Interfaces, // this includes the LCL widgetset
Forms, lhelpcontrolpkg, Forms, tachartlazaruspkg, tachartprint, lhelpcontrolpkg,
Globals, LicenseUnit, OptionsUnit, MainDM, MainUnit, utils; Globals, LicenseUnit, OptionsUnit, MainDM, MainUnit, utils, chartunit;
{$R LazStats.res} {$R LazStats.res}
@ -26,9 +26,8 @@ begin
else else
Application.Terminate; Application.Terminate;
end; end;
Application.CreateForm(TMainDataModule, MainDataModule);
Application.CreateForm(TMainDataModule, MainDataModule); Application.CreateForm(TOS3MainFrm, OS3MainFrm);
Application.CreateForm(TOS3MainFrm, OS3MainFrm);
Application.Run; Application.Run;
end. end.

View File

@ -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

View File

@ -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.