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