TAChart: Add demo to show sorting of series based on the new XCount=0 feature.

git-svn-id: trunk@60996 -
This commit is contained in:
wp 2019-04-16 14:20:44 +00:00
parent ac880dd4b9
commit 5d5d933bd5
5 changed files with 580 additions and 0 deletions

4
.gitattributes vendored
View File

@ -5238,6 +5238,10 @@ components/tachart/demo/script/Main.lfm svneol=native#text/plain
components/tachart/demo/script/Main.pas svneol=native#text/pascal
components/tachart/demo/script/scriptdemo.lpi svneol=native#text/plain
components/tachart/demo/script/scriptdemo.lpr svneol=native#text/pascal
components/tachart/demo/sorted_source/main.lfm svneol=native#text/plain
components/tachart/demo/sorted_source/main.pas svneol=native#text/pascal
components/tachart/demo/sorted_source/sort_demo.lpi svneol=native#text/xml
components/tachart/demo/sorted_source/sort_demo.lpr svneol=native#text/pascal
components/tachart/demo/tools/main.lfm svneol=native#text/plain
components/tachart/demo/tools/main.pas svneol=native#text/pascal
components/tachart/demo/tools/toolsdemo.lpi svneol=native#text/plain

View File

@ -0,0 +1,187 @@
object MainForm: TMainForm
Left = 326
Height = 515
Top = 127
Width = 795
Caption = 'MainForm'
ClientHeight = 515
ClientWidth = 795
OnCreate = FormCreate
LCLVersion = '2.1.0.0'
object SettingsPanel: TPanel
Left = 6
Height = 23
Top = 486
Width = 783
Align = alBottom
AutoSize = True
BorderSpacing.Around = 6
BevelOuter = bvNone
ClientHeight = 23
ClientWidth = 783
TabOrder = 0
object cbSortBy: TComboBox
AnchorSideLeft.Control = Label1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = SettingsPanel
Left = 45
Height = 23
Top = 0
Width = 208
BorderSpacing.Left = 8
ItemHeight = 15
Items.Strings = (
'Population (descending)'
'Population (ascending)'
'Name'
)
OnChange = cbSortByChange
Style = csDropDownList
TabOrder = 0
end
object Label1: TLabel
AnchorSideLeft.Control = SettingsPanel
AnchorSideTop.Control = cbSortBy
AnchorSideTop.Side = asrCenter
Left = 0
Height = 15
Top = 4
Width = 37
Caption = 'Sort by'
ParentColor = False
end
object cbXCount0: TCheckBox
AnchorSideLeft.Control = cbSortBy
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbSortBy
AnchorSideTop.Side = asrCenter
Left = 277
Height = 19
Top = 2
Width = 80
BorderSpacing.Left = 24
Caption = 'XCount = 0'
Checked = True
OnChange = cbXCount0Change
State = cbChecked
TabOrder = 1
end
end
object TabControl: TTabControl
Left = 0
Height = 480
Top = 0
Width = 795
OnChange = TabControlChange
Align = alClient
TabOrder = 1
object Chart: TChart
Left = 2
Height = 475
Top = 3
Width = 527
AxisList = <
item
Grid.Color = 15066597
Grid.Style = psSolid
Marks.LabelBrush.Style = bsClear
Marks.Range.UseMin = True
Minors = <>
Title.LabelFont.Orientation = 900
Title.LabelFont.Style = [fsBold]
Title.Visible = True
Title.Caption = 'Population (in millions)'
Title.LabelBrush.Style = bsClear
end
item
Grid.Visible = False
Intervals.MaxLength = 80
Intervals.MinLength = 30
Alignment = calBottom
Marks.LabelBrush.Style = bsClear
Minors = <>
Title.LabelFont.Style = [fsBold]
Title.Visible = True
Title.Caption = 'Continent'
Title.LabelBrush.Style = bsClear
end>
BackColor = clWhite
Foot.Alignment = taLeftJustify
Foot.Brush.Color = clBtnFace
Foot.Brush.Style = bsClear
Foot.Font.Color = clGray
Foot.Font.Style = [fsItalic]
Foot.Text.Strings = (
'Source: https://en.wikipedia.org/wiki/World_population'
)
Foot.Visible = True
Frame.Color = clGray
Margins.Left = 32
Margins.Right = 32
Title.Brush.Color = clBtnFace
Title.Font.Color = clBlue
Title.Text.Strings = (
'TAChart'
)
Toolset = ChartToolset
Align = alClient
Color = clNone
end
object Grid: TStringGrid
Left = 529
Height = 475
Top = 3
Width = 264
Align = alRight
ColCount = 4
TabOrder = 2
OnPrepareCanvas = GridPrepareCanvas
ColWidths = (
34
37
64
124
)
Cells = (
3
1
0
'x'
2
0
'y'
3
0
'Text'
)
end
end
object Button1: TButton
Left = 508
Height = 25
Top = 484
Width = 75
Caption = 'Button1'
OnClick = Button1Click
TabOrder = 2
end
object ListChartSource: TListChartSource
left = 192
top = 112
end
object ChartToolset: TChartToolset
left = 192
top = 184
object ZoomDragTool: TZoomDragTool
Shift = [ssLeft]
Brush.Style = bsClear
end
object PanDragTool: TPanDragTool
Shift = [ssRight]
end
object DataPointClickTool: TDataPointClickTool
Shift = [ssCtrl, ssLeft]
OnPointClick = DataPointClickToolPointClick
end
end
end

View File

@ -0,0 +1,286 @@
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls,
StdCtrls, Grids, TAGraph, TASeries, TASources, TATools, TAFuncSeries,
TARadialSeries, Types;
type
{ TMainForm }
TMainForm = class(TForm)
Button1: TButton;
Chart: TChart;
cbSortBy: TComboBox;
cbXCount0: TCheckBox;
ChartToolset: TChartToolset;
DataPointClickTool: TDataPointClickTool;
PanDragTool: TPanDragTool;
Grid: TStringGrid;
ZoomDragTool: TZoomDragTool;
Label1: TLabel;
ListChartSource: TListChartSource;
SettingsPanel: TPanel;
TabControl: TTabControl;
procedure Button1Click(Sender: TObject);
procedure cbSortByChange(Sender: TObject);
procedure cbXCount0Change(Sender: TObject);
procedure DataPointClickToolPointClick(ATool: TChartTool; APoint: TPoint);
procedure FormCreate(Sender: TObject);
procedure GridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
procedure TabControlChange(Sender: TObject);
private
PieSeries: TPieSeries;
BarSeries: TBarSeries;
LineSeries: TLineSeries;
AreaSeries: TAreaSeries;
CubicSplineSeries: TCubicSplineSeries;
BSplineSeries: TBSplineSeries;
FitSeries: TFitSeries;
PolarSeries: TPolarSeries;
private
procedure CreateData;
procedure UpdateGrid;
public
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
uses
TACustomSource, TACustomSeries, TAChartUtils, TATypes, TAFitUtils;
{ TMainForm }
procedure TMainForm.CreateData;
begin
ListChartSource.BeginUpdate;
try
ListChartSource.Clear;
ListChartSource.XCount := 0;
ListChartSource.Add(2, 738, 'Europe', clBlue);
ListChartSource.Add(0, 4436, 'Asia', clYellow);
ListChartSource.Add(5, 39.9, 'Oceania', clAqua);
ListChartSource.Add(1, 1216, 'Africa', clMaroon);
ListChartSource.Add(3, 579, 'North' + LineEnding + 'America', clRed);
ListChartSource.Add(6, 0.004, 'Antarctica', clWhite);
ListChartSource.Add(4, 422, 'South' + LineEnding + 'America', clGreen);
finally
ListChartSource.EndUpdate;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
var
i: Integer;
ser: TChartSeries;
begin
CreateData;
Chart.BottomAxis.Marks.Source := ListChartSource;
Chart.BottomAxis.Marks.Style := smsLabel;
UpdateGrid;
PieSeries := TPieSeries.Create(Chart);
PieSeries.Title := 'Pies';
PieSeries.Marks.Style := smsLabelValue;
Chart.AddSeries(PieSeries);
TabControl.Tabs.Add('Pie series');
BarSeries := TBarSeries.Create(Chart);
BarSeries.Title := 'Bars';
BarSeries.BarWidthStyle := bwPercentMin;
Chart.AddSeries(BarSeries);
TabControl.Tabs.Add('Bar series');
LineSeries := TLineSeries.Create(Chart);
LineSeries.Title := 'Lines';
LineSeries.SeriesColor := clRed;
LineSeries.ShowPoints := true;
LineSeries.Pointer.Style := psCircle;
LineSeries.Pointer.HorizSize := 6;
LineSeries.Pointer.VertSize := 6;
Chart.AddSeries(LineSeries);
TabControl.Tabs.Add('Line series');
AreaSeries := TAreaSeries.Create(Chart);
AreaSeries.Title := 'Areas';
AreaSeries.AreaBrush.Color := clRed;
AreaSeries.AreaLinesPen.Style := psClear;
Chart.AddSeries(AreaSeries);
TabControl.Tabs.Add('Area series');
CubicSplineSeries := TCubicSplineSeries.Create(Chart);
CubicSplineSeries.Title := 'Cubic spline';
CubicSplineSeries.Pen.Color := clBlue;
CubicSplineSeries.Pointer.Visible := true;
CubicSplineSeries.Pointer.Style := psCircle;
CubicSplineSeries.Pointer.HorizSize := 6;
CubicSplineSeries.Pointer.VertSize := 6;
Chart.AddSeries(CubicSplineSeries);
TabControl.Tabs.Add('Cubic spline series');
BSplineSeries := TBSplineSeries.Create(Chart);
BSplineSeries.Title := 'B-Spline';
BSplineSeries.Pen.Color := clBlue;
BSplineSeries.Pointer.Visible := true;
BSplineSeries.Pointer.Style := psCircle;
BSplineSeries.Pointer.HorizSize := 6;
BSplineSeries.Pointer.VertSize := 6;
Chart.AddSeries(BSplineSeries);
TabControl.Tabs.Add('B-Spline series');
FitSeries := TFitSeries.Create(Chart);
FitSeries.Title := 'Fit';
FitSeries.Pen.Color := clBlue;
FitSeries.Pointer.Visible := true;
FitSeries.Pointer.Style := psCircle;
FitSeries.Pointer.HorizSize := 6;
FitSeries.Pointer.VertSize := 6;
FitSeries.FitEquation := feLinear;
Chart.AddSeries(FitSeries);
TabControl.Tabs.Add('Fit series');
PolarSeries := TPolarSeries.Create(Chart);
PolarSeries.Title := 'Polar';
PolarSeries.LinePen.Color := clBlue;
PolarSeries.Pointer.Visible := true;
PolarSeries.Pointer.Style := psCircle;
PolarSeries.Pointer.HorizSize := 6;
PolarSeries.Pointer.VertSize := 6;
Chart.AddSeries(PolarSeries);
TabControl.Tabs.Add('Polar series');
for i:=0 to Chart.SeriesCount-1 do begin
ser := Chart.Series[i] as TChartSeries;
if ser <> PieSeries then
ser.Marks.Style := smsLabel;
ser.Marks.LinkPen.Color := clGray;
end;
TabControlChange(nil);
end;
procedure TMainForm.GridPrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
var
ts: TTextStyle;
begin
if aCol < Grid.ColCount - 1 then begin
ts := Grid.Canvas.TextStyle;
ts.Alignment := taCenter;
Grid.Canvas.TextStyle := ts;
end;
end;
procedure TMainForm.cbSortByChange(Sender: TObject);
begin
case cbSortBy.ItemIndex of
0: begin
ListChartSource.SortBy := sbY;
ListChartSource.SortDir := sdDescending;
end;
1: begin
ListChartSource.SortBy := sbY;
ListChartSource.SortDir := sdAscending;
end;
2: begin
ListChartSource.SortBy := sbText;
ListChartSource.SortDir := sdAscending;
end;
end;
ListChartSource.Sorted := true;
UpdateGrid;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
if ListChartSource[0]^.Text <> 'abc' then
ListChartSource[0]^.Text := 'abc'
else
ListChartSource[0]^.Text := 'ABC';
chart.Invalidate;
end;
procedure TMainForm.cbXCount0Change(Sender: TObject);
begin
if cbXCount0.Checked then
ListChartSource.XCount := 0
else
ListChartSource.XCount := 1;
end;
procedure TMainForm.DataPointClickToolPointClick(ATool: TChartTool;
APoint: TPoint);
var
tool: TDataPointClickTool;
ser: TChartSeries;
begin
tool := ATool as TDataPointClickTool;
ser := tool.Series as TChartSeries;
ShowMessage(Format('Series "%s" clicked at data point #%d, x=%f, y=%f ("%s")', [
ser.Title, tool.PointIndex,
ser.GetXValue(tool.PointIndex), ser.GetYValue(tool.PointIndex),
ser.Source.Item[tool.PointIndex]^.Text
]));
end;
procedure TMainForm.TabControlChange(Sender: TObject);
var
ser: TChartSeries;
i: Integer;
begin
ser := Chart.Series[TabControl.TabIndex] as TChartSeries;
ser.Source := ListChartSource;
for i := 0 to Chart.SeriesCount-1 do
Chart.Series[i].Active := Chart.Series[i] = ser;
Chart.Frame.Visible := ser <> PieSeries;
Chart.BottomAxis.Visible := ser <> PieSeries;
Chart.LeftAxis.Visible := ser <> PieSeries;
Chart.LeftAxis.Title.Visible := ser <> PolarSeries;
Chart.BottomAxis.Title.Visible := ser <> PolarSeries;
DataPointClickTool.AffectedSeries := IntToStr(ser.Index);
if ser = PolarSeries then begin
Chart.BottomAxis.Marks.Source := nil;
Chart.BottomAxis.Marks.Style := smsValue;
Chart.LeftAxis.Marks.Range.UseMin := false;
end else begin
Chart.BottomAxis.Marks.Source := ListChartSource;
if ser = PieSeries then
Chart.BottomAxis.Marks.Style := smsLabelValue
else
Chart.BottomAxis.Marks.Style := smsLabel;
Chart.LeftAxis.Marks.Range.UseMin := true;
end;
end;
procedure TMainForm.UpdateGrid;
var
r, j: Integer;
begin
Grid.RowCount := ListChartSource.Count + 1;
j := 0;
for r := 1 to Grid.RowCount - 1 do begin
Grid.Cells[0, r] := IntToStr(j);
Grid.Cells[1, r] := FormatFloat('0', ListChartSource[j]^.X);
Grid.Cells[2, r] := Format('%.9g', [ListChartSource[j]^.Y]);
Grid.Cells[3, r] := ListChartSource[j]^.Text;
inc(j);
end;
end;
end.

View File

@ -0,0 +1,81 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="sort_demo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="TAChartLazarusPkg"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="sort_demo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="sort_demo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,22 @@
program sort_demo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, main, tachartlazaruspkg
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.