PageRenderTime 20ms CodeModel.GetById 14ms app.highlight 3ms RepoModel.GetById 1ms app.codeStats 0ms

/components/tachart/demo/chartsource/main.pas

http://github.com/graemeg/lazarus
Pascal | 148 lines | 123 code | 21 blank | 4 comment | 7 complexity | f06abe93be1b03473f93783699382db6 MD5 | raw file
  1unit Main;
  2
  3{$mode objfpc}{$H+}
  4
  5interface
  6
  7uses
  8  ComCtrls, ExtCtrls, Spin, StdCtrls, Forms, TAGraph, TASeries, TASources,
  9  Classes;
 10
 11type
 12
 13  { TForm1 }
 14
 15  TForm1 = class(TForm)
 16    cbAccDirDerivative: TComboBox;
 17    ccsDerivative: TCalculatedChartSource;
 18    cbCumulative: TCheckBox;
 19    ccsAvg: TCalculatedChartSource;
 20    ccsSum: TCalculatedChartSource;
 21    Chart1: TChart;
 22    Chart1BarSeries1: TBarSeries;
 23    Chart1LineSeries1: TLineSeries;
 24    chDerivativeLineOrig: TLineSeries;
 25    chDerivativeLineDeriv: TLineSeries;
 26    Chart1LineSeries4: TLineSeries;
 27    Chart1LineSeries5: TLineSeries;
 28    Chart2: TChart;
 29    Chart2AreaSeries1: TAreaSeries;
 30    Chart2LineSeries1: TLineSeries;
 31    chDerivative: TChart;
 32    chCalc: TChart;
 33    chCalcLineSeries1: TLineSeries;
 34    chCalcLineSeriesAvg: TLineSeries;
 35    chCalcLineSeriesSum: TLineSeries;
 36    cbAccDirStatistics: TComboBox;
 37    cbSmooth: TCheckBox;
 38    seAccumulationRange: TSpinEdit;
 39    lblAccumulationRange: TLabel;
 40    ListChartSource1: TListChartSource;
 41    lcsDerivative: TListChartSource;
 42    Memo1: TMemo;
 43    PageControl1: TPageControl;
 44    Panel1: TPanel;
 45    Panel2: TPanel;
 46    rgDataShape: TRadioGroup;
 47    RandomChartSource1: TRandomChartSource;
 48    RandomChartSource2: TRandomChartSource;
 49    Splitter1: TSplitter;
 50    tsDerivative: TTabSheet;
 51    tsStatistics: TTabSheet;
 52    tsBasic: TTabSheet;
 53    procedure cbAccDirDerivativeChange(Sender: TObject);
 54    procedure cbAccDirStatisticsChange(Sender: TObject);
 55    procedure cbCumulativeChange(Sender: TObject);
 56    procedure cbSmoothChange(Sender: TObject);
 57    procedure CreateData;
 58    procedure seAccumulationRangeChange(Sender: TObject);
 59    procedure FormCreate(Sender: TObject);
 60    procedure rgDataShapeClick(Sender: TObject);
 61  end;
 62
 63var
 64  Form1: TForm1; 
 65
 66implementation
 67
 68{$R *.lfm}
 69
 70uses
 71  Math;
 72
 73{ TForm1 }
 74
 75procedure TForm1.cbAccDirDerivativeChange(Sender: TObject);
 76begin
 77  ccsDerivative.AccumulationDirection :=
 78    TChartAccumulationDirection(cbAccDirDerivative.ItemIndex);
 79end;
 80
 81procedure TForm1.cbAccDirStatisticsChange(Sender: TObject);
 82begin
 83  ccsAvg.AccumulationDirection :=
 84    TChartAccumulationDirection(cbAccDirStatistics.ItemIndex);
 85  ccsSum.AccumulationDirection := ccsAvg.AccumulationDirection;
 86end;
 87
 88procedure TForm1.cbCumulativeChange(Sender: TObject);
 89begin
 90  chCalcLineSeriesSum.Active := cbCumulative.Checked;
 91end;
 92
 93procedure TForm1.cbSmoothChange(Sender: TObject);
 94begin
 95  if cbSmooth.Checked then
 96    ccsDerivative.AccumulationMethod := camSmoothDerivative
 97  else
 98    ccsDerivative.AccumulationMethod := camDerivative;
 99end;
100
101procedure TForm1.CreateData;
102const
103  N = 100;
104  MIN_X = -10;
105  MAX_X = 10;
106  EPS = 1e-6;
107var
108  i: Integer;
109  x, y: Double;
110begin
111  lcsDerivative.Clear;
112  if rgDataShape.ItemIndex = 6 then
113    for i := 0 to 9 do
114      lcsDerivative.Add(i - IfThen(i > 6, 1, 0), i)
115  else
116    for i := 0 to N - 1 do begin
117      x := MIN_X + (MAX_X - MIN_X) / (N - 1) * i;
118      if SameValue(x, 0.0, EPS) then x := 0;
119      case rgDataShape.ItemIndex of
120        0: y := x;
121        1: y := Sin(x);
122        2: if x = 0 then y := 1 else y := Sin(x) / x;
123        3: y := Exp(-x / 3);
124        4: y := Exp(-Sqr((x - 2.5) / 2.5));
125        5: y := Exp(-Sqr((x - 2.5) / 2.5)) + 0.05 * (Random - 0.5);
126      end;
127      lcsDerivative.Add(x, y);
128    end;
129end;
130
131procedure TForm1.FormCreate(Sender: TObject);
132begin
133  Randomize;
134  CreateData;
135end;
136
137procedure TForm1.rgDataShapeClick(Sender: TObject);
138begin
139  CreateData;
140end;
141
142procedure TForm1.seAccumulationRangeChange(Sender: TObject);
143begin
144  ccsDerivative.AccumulationRange := seAccumulationRange.Value;
145end;
146
147end.
148