1 unit unit1;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   SysUtils, Forms, Graphics, ExtCtrls,
9   TAGraph, TASeries, TATools, Buttons, StdCtrls, Spin, Classes;
10 
11 type
12   { TForm1 }
13 
14   TForm1 = class(TForm)
15     Bevel1: TBevel;
16     btnClearArea: TButton;
17     btnClearBar: TButton;
18     btnClearLine: TButton;
19     btnClearAll: TButton;
20     btnClearPie: TButton;
21     btnAddBar: TButton;
22     btnAddPie: TButton;
23     btnAddLine: TButton;
24     btnAddArea: TButton;
25     cbShowAxisTitles: TCheckBox;
26     Chart1: TChart;
27     cbBottomAxis: TCheckBox;
28     cbLeftAxis: TCheckBox;
29     cbTitle: TCheckBox;
30     cbFooter: TCheckBox;
31     cbInverted: TCheckBox;
32     cbLegend: TCheckBox;
33     cbShowGridCheckBox: TCheckBox;
34     Chart1LineHor: TConstantLine;
35     Chart1LineVert: TConstantLine;
36     cbMarkStyle: TComboBox;
37     ChartToolset1: TChartToolset;
38     DataPointCrosshairTool: TDataPointCrosshairTool;
39     cbCrosshairTool: TComboBox;
40     lblCrossHairTool: TLabel;
41     lblAddCount: TLabel;
42     lblAdd: TLabel;
43     lblMarkStyle: TLabel;
44     lblClear: TLabel;
45     Panel1: TPanel;
46     edAddCount: TSpinEdit;
47     procedure btnClearAllClick(Sender: TObject);
48     procedure btnClearAreaClick(Sender: TObject);
49     procedure btnClearBarClick(Sender: TObject);
50     procedure btnClearLineClick(Sender: TObject);
51     procedure btnClearPieClick(Sender: TObject);
52     procedure cbCrosshairToolChange(Sender: TObject);
53     procedure cbInvertedChange(Sender: TObject);
54     procedure btnAddAreaClick(Sender: TObject);
55     procedure btnAddBarClick(Sender: TObject);
56     procedure btnAddLineClick(Sender: TObject);
57     procedure btnAddPieClick(Sender: TObject);
58     procedure cbBottomAxisChange(Sender: TObject);
59     procedure cbLeftAxisChange(Sender: TObject);
60     procedure cbShowAxisTitlesChange(Sender: TObject);
61     procedure cbTitleChange(Sender: TObject);
62     procedure cbFooterChange(Sender: TObject);
63     procedure cbLegendChange(Sender: TObject);
64     procedure cbShowGridCheckBoxChange(Sender: TObject);
65   private
66     FArea: TAreaSeries;
67     FBar: TBarSeries;
68     FLine: TLineSeries;
69     FPie: TPieSeries;
70     x, y, x1, y1, x3, y3: Double;
71     procedure InitBar;
72     procedure InitLine;
73     procedure InitPie;
74     procedure InitArea;
75     procedure BringToFront(ASeries: TBasicChartSeries);
76     procedure UpdateAffectedSeries;
77   end;
78 
79 var
80   Form1: TForm1;
81 
82 implementation
83 
84 {$R *.lfm}
85 
86 uses
87   GraphUtil, TAChartUtils, TATextElements, TATypes;
88 
89 { TForm1 }
90 
91 procedure TForm1.BringToFront(ASeries: TBasicChartSeries);
92 var
93   s: TBasicChartSeries;
94 begin
95   for s in Chart1.Series do
96     s.ZPosition := Ord(s = ASeries);
97 end;
98 
99 procedure TForm1.btnAddAreaClick(Sender: TObject);
100 var
101   i: integer;
102 begin
103   if FArea = nil then InitArea;
104   BringToFront(FArea);
105   FArea.Marks.Style := TSeriesMarksStyle(cbMarkStyle.ItemIndex);
106   for i := 1 to edAddCount.Value do begin
107     X3 := X3 + 1;
108     if random(2) >= 0.7 then Y3 := Y3 + random(5)
109     else if random(2) >= 0.7 then Y3 := 0
110     else Y3 := Y3 - random(5);
111     FArea.AddXY(x3, y3, Format('Area%d', [i]));
112   end;
113 end;
114 
115 procedure TForm1.btnAddBarClick(Sender: TObject);
116 var
117   i: integer;
118 begin
119   if FBar = nil then InitBar;
120   BringToFront(FBar);
121   FBar.Marks.Style := TSeriesMarksStyle(cbMarkStyle.ItemIndex);
122   for i := 1 to edAddCount.Value do begin
123     FBar.AddXY(x, y, Format('Bar%d', [i]));
124     X := X + 1;
125     if random(2) >= 0.7 then Y := Y + random(5)
126     else if random(2) >= 0.7 then Y := 0
127     else Y := Y - random(5);
128   end;
129 end;
130 
131 procedure TForm1.btnAddLineClick(Sender: TObject);
132 var
133   i: integer;
134 begin
135   if FLine = nil then InitLine;
136   BringToFront(FLine);
137   FLine.Marks.Style := TSeriesMarksStyle(cbMarkStyle.ItemIndex);
138   for i := 1 to edAddCount.Value do begin
139     FLine.AddXY(x1, y1, Format('Line%d', [i]));
140     X1 := X1 + 1.5;
141     if random(2) >= 0.5 then Y1 := Y1 + random(10)
142     else Y1 := Y1 - random(5);
143   end;
144 end;
145 
146 procedure TForm1.btnAddPieClick(Sender: TObject);
147 var
148   i: integer;
149 begin
150   if FPie = nil then InitPie;
151   BringToFront(FPie);
152   FPie.Marks.Style := TSeriesMarksStyle(cbMarkStyle.ItemIndex);
153   for i := 1 to edAddCount.Value do begin
154     FPie.AddPie(3.4234235235, 'sde21312', clTAColor);
155     FPie.AddPie(0.2323, 'adassssssdddddd', clTAColor);
156     FPie.AddPie(30, 'filipe romao', clTAColor);
157     FPie.AddPie(40, '234eds sa', clTAColor);
158   end;
159 end;
160 
161 procedure TForm1.btnClearAllClick(Sender: TObject);
162 begin
163   Chart1.ClearSeries;
164   FArea := nil;
165   FBar := nil;
166   FLine := nil;
167   FPie := nil;
168   UpdateAffectedSeries;
169 end;
170 
171 procedure TForm1.btnClearAreaClick(Sender: TObject);
172 begin
173   FreeAndNil(FArea);
174   UpdateAffectedSeries;
175 end;
176 
177 procedure TForm1.btnClearBarClick(Sender: TObject);
178 begin
179   FreeAndNil(FBar);
180   UpdateAffectedSeries;
181 end;
182 
183 procedure TForm1.btnClearLineClick(Sender: TObject);
184 begin
185   FreeAndNil(FLine);
186   UpdateAffectedSeries;
187 end;
188 
189 procedure TForm1.btnClearPieClick(Sender: TObject);
190 begin
191   FreeAndNil(FPie);
192   UpdateAffectedSeries;
193 end;
194 
195 procedure TForm1.cbCrosshairToolChange(Sender: TObject);
196 begin
197   case cbCrosshairTool.ItemIndex of
198     1: begin
199          DatapointCrosshairTool.Shape := ccsVertical;
200          DatapointCrosshairTool.DistanceMode := cdmOnlyX;
201        end;
202     2: begin
203          DatapointCrosshairTool.Shape := ccsHorizontal;
204          DatapointCrosshairTool.DistanceMode := cdmOnlyY;
205        end;
206     3: begin
207          DatapointCrosshairTool.Shape := ccsCross;
208          DatapointCrosshairTool.DistanceMode := cdmXY;
209        end;
210   end;
211   DataPointCrosshairTool.Enabled := CbCrosshairTool.ItemIndex > 0;
212   Chart1.Invalidate;  // Remove residues of previous crosshair shape
213 end;
214 
215 procedure TForm1.cbBottomAxisChange(Sender: TObject);
216 begin
217   Chart1.BottomAxis.Visible := cbBottomAxis.Checked;
218 end;
219 
220 procedure TForm1.cbFooterChange(Sender: TObject);
221 begin
222   Chart1.Foot.Visible := cbFooter.Checked;
223 end;
224 
225 procedure TForm1.cbInvertedChange(Sender: TObject);
226 begin
227   Chart1.BottomAxis.Inverted := cbInverted.Checked;
228   Chart1.LeftAxis.Inverted := cbInverted.Checked;
229 end;
230 
231 procedure TForm1.cbLegendChange(Sender: TObject);
232 begin
233   Chart1.Legend.Visible := cbLegend.Checked;
234 end;
235 
236 procedure TForm1.cbShowAxisTitlesChange(Sender: TObject);
237 begin
238   with Chart1.BottomAxis.Title do
239     if cbShowAxisTitles.Checked then Caption := 'X axis' else Caption := '';
240   with Chart1.LeftAxis.Title do
241     if cbShowAxisTitles.Checked then Caption := 'Y axis' else Caption := '';
242 end;
243 
244 procedure TForm1.cbShowGridCheckBoxChange(Sender: TObject);
245 begin
246   Chart1.LeftAxis.Grid.Visible := cbShowGridCheckBox.Checked;
247   Chart1.BottomAxis.Grid.Visible := cbShowGridCheckBox.Checked;
248 end;
249 
250 procedure TForm1.cbLeftAxisChange(Sender: TObject);
251 begin
252   Chart1.LeftAxis.Visible := cbLeftAxis.Checked;
253 end;
254 
255 procedure TForm1.cbTitleChange(Sender: TObject);
256 begin
257   Chart1.Title.Visible := cbTitle.Checked;
258 end;
259 
260 procedure TForm1.InitArea;
261 begin
262   FArea := TAreaSeries.Create(Chart1);
263   FArea.SeriesColor := clFuchsia;
264   FArea.Title := 'area';
265   FArea.Marks.LabelBrush.Color := GetHighlightColor(FArea.SeriesColor, 100);
266   Chart1.AddSeries(FArea);
267   UpdateAffectedSeries;
268 end;
269 
270 procedure TForm1.InitBar;
271 begin
272   FBar := TBarSeries.Create(Chart1);
273   FBar.Title := 'bars';
274   FBar.BarBrush.Color := clGreen;
275   FBar.Marks.LabelBrush.Color := GetHighlightColor(FBar.BarBrush.Color, 100);
276   Chart1.AddSeries(FBar);
277   UpdateAffectedSeries;
278 end;
279 
280 procedure TForm1.InitLine;
281 begin
282   FLine := TLineSeries.Create(Chart1);
283   FLine.ShowLines := true;
284   FLine.ShowPoints := true;
285   FLine.Pointer.Style := psRectangle;
286   FLine.Pointer.Brush.Color := clRed;
287   FLine.Title := 'line';
288   FLine.SeriesColor := clRed;
289   FLine.Marks.LabelBrush.Color := GetHighlightColor(FLine.SeriesColor, 100);
290   Chart1.AddSeries(FLine);
291   UpdateAffectedSeries;
292 end;
293 
294 procedure TForm1.InitPie;
295 begin
296   FPie := TPieSeries.Create(Chart1);
297   FPie.Title := 'pie';
298   FPie.Marks.LabelBrush.Color := $80FFFF;
299   FPie.Marks.LinkPen.Width := 2;
300   FPie.Marks.OverlapPolicy := opHideNeighbour;
301   Chart1.AddSeries(FPie);
302   UpdateAffectedSeries;
303 end;
304 
305 // The chart contains two constant lines which should not interact with the
306 // DatapointCrosshairTool - we use the Affectedseries property to exclude them.
307 procedure TForm1.UpdateAffectedSeries;
308 var
309   s: String;
310   i: Integer;
311 begin
312   if Chart1.SeriesCount < 2 then
313     exit;
314   s := '2';
315   for i := 3 to Chart1.SeriesCount - 1 do
316     s := s + ',' + IntToStr(i);
317   DatapointCrossHairTool.AffectedSeries := s;
318 end;
319 
320 end.
321 
322