1 unit main; 2 3 {$mode objfpc}{$H+} 4 5 interface 6 7 uses 8 Classes, SysUtils, FileUtil, TAGraph, TAChartListbox, TAChartCombos, TASeries, 9 TASources, TATools, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, 10 ColorBox, Spin, Types; 11 12 type 13 14 { TForm1 } 15 16 TForm1 = class(TForm) 17 Bevel2: TBevel; 18 CbAreaSerBrushColor: TColorBox; 19 CbAreaSerBrushStyle: TChartComboBox; 20 CbAreaSerContourColor: TColorBox; 21 CbAreaSerLinesColor: TColorBox; 22 CbAreaSerLinesStyle: TChartComboBox; 23 CbAreaSerLinesWidth: TChartComboBox; 24 CbBarSerPenStyle: TChartComboBox; 25 CbAreaSerContourStyle: TChartComboBox; 26 CbBarSerPenWidth: TChartComboBox; 27 CbBarSerPenColor: TColorBox; 28 CbAreaSerContourWidth: TChartComboBox; 29 CbLineSerPointerBorderColor: TColorBox; 30 CbLineSerPointerBrushColor: TColorBox; 31 CbBarSerBrushColor: TColorBox; 32 CbShowLines: TCheckBox; 33 Chart1: TChart; 34 CbLineSerLinePenStyle: TChartComboBox; 35 CbLineSerLinePenWidth: TChartComboBox; 36 CbLineSerPointerStyle: TChartComboBox; 37 Chart1AreaSeries1: TAreaSeries; 38 Chart1BarSeries1: TBarSeries; 39 Chart1LineSeries1: TLineSeries; 40 CbBarSerBrushStyle: TChartComboBox; 41 ChartListbox1: TChartListbox; 42 CbShow: TCheckBox; 43 CbLineSerLinePenColor: TColorBox; 44 ChartToolset1: TChartToolset; 45 ChartToolset1DataPointClickTool1: TDataPointClickTool; 46 CbShowPoints: TCheckBox; 47 GbAreaSerBrush: TGroupBox; 48 GbAreaSerContour: TGroupBox; 49 GbAreaSerLines: TGroupBox; 50 GbLineSerLines: TGroupBox; 51 GbBarSerPen: TGroupBox; 52 GbLineSerPointer: TGroupBox; 53 GbBarSerBrush: TGroupBox; 54 Label1: TLabel; 55 Label10: TLabel; 56 Label11: TLabel; 57 Label12: TLabel; 58 Label13: TLabel; 59 Label14: TLabel; 60 Label15: TLabel; 61 Label16: TLabel; 62 Label17: TLabel; 63 Label18: TLabel; 64 Label19: TLabel; 65 Label2: TLabel; 66 Label20: TLabel; 67 Label21: TLabel; 68 Label3: TLabel; 69 Label4: TLabel; 70 Label5: TLabel; 71 Label6: TLabel; 72 Label7: TLabel; 73 Label8: TLabel; 74 Label9: TLabel; 75 LblSeries: TLabel; 76 Notebook1: TNotebook; 77 Page1: TPage; 78 Page2: TPage; 79 Page3: TPage; 80 Panel1: TPanel; 81 RandomChartSource1: TRandomChartSource; 82 RandomChartSource2: TRandomChartSource; 83 RandomChartSource3: TRandomChartSource; 84 EdLineSerPointerSize: TSpinEdit; 85 Splitter1: TSplitter; 86 procedure AreaBrushChange(Sender: TObject); 87 procedure AreaContourChange(Sender: TObject); 88 procedure AreaLinesChange(Sender: TObject); 89 procedure BarBrushChange(Sender: TObject); 90 procedure BarPenChange(Sender: TObject); 91 procedure FormCreate(Sender: TObject); 92 procedure LinePenChange(Sender: TObject); 93 procedure LinePointerChange(Sender: TObject); 94 procedure CbShowChange(Sender: TObject); 95 procedure ChartListbox1Click(Sender: TObject); 96 procedure ChartToolset1DataPointClickTool1PointClick(ATool: TChartTool; 97 APoint: TPoint); 98 procedure FormShow(Sender: TObject); 99 private 100 FLockChanges: Integer; 101 102 public 103 104 end; 105 106 var 107 Form1: TForm1; 108 109 implementation 110 111 {$R *.lfm} 112 113 uses 114 FPCanvas, TAChartUtils, TACustomSeries; 115 116 117 { TAreaSeries } 118 119 procedure TForm1.AreaBrushChange(Sender: TObject); 120 var 121 ser: TAreaSeries; 122 begin 123 if FLockChanges > 0 then 124 exit; 125 ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; 126 ser.AreaBrush.Color := CbAreaSerBrushColor.Selected; 127 ser.AreaBrush.Style := CbAreaserBrushStyle.BrushStyle; 128 if CbAreaSerBrushStyle.BrushStyle in [bsImage, bsPattern] then 129 // Must be AFTER assigning brush style because that sets Brush.Bitmap to nil 130 ser.AreaBrush.Bitmap := CbAreaSerBrushStyle.BrushBitmap; 131 end; 132 133 procedure TForm1.AreaContourChange(Sender: TObject); 134 var 135 ser: TAreaSeries; 136 begin 137 if FLockChanges > 0 then 138 exit; 139 ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; 140 ser.AreaContourPen.Color := CbAreaSerContourColor.Selected; 141 ser.AreaContourPen.Width := CbAreaSerContourWidth.PenWidth; 142 ser.AreaContourPen.Style := CbAreaSerContourStyle.PenStyle; 143 if ser.AreaContourPen.Style = psPattern then 144 CbAreaSerContourStyle.SetPenPattern(ser.AreaContourPen); 145 end; 146 147 procedure TForm1.AreaLinesChange(Sender: TObject); 148 var 149 ser: TAreaSeries; 150 begin 151 if FLockChanges > 0 then 152 exit; 153 ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; 154 ser.AreaLinesPen.Color := CbAreaSerLinesColor.Selected; 155 ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TAreaSeries; 156 ser.AreaLinesPen.Width := CbAreaSerLinesWidth.PenWidth; 157 ser.AreaLinesPen.Style := CbAreaSerLinesStyle.PenStyle; 158 if ser.AreaLinesPen.Style = psPattern then 159 CbAreaSerLinesStyle.SetPenPattern(ser.AreaLinesPen); 160 end; 161 162 163 { TBarSeries } 164 165 procedure TForm1.BarBrushChange(Sender: TObject); 166 var 167 ser: TbarSeries; 168 begin 169 if FLockChanges > 0 then 170 exit; 171 ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TBarSeries; 172 ser.BarBrush.Color := CbBarSerBrushColor.Selected; 173 ser.BarBrush.Style := CbBarSerBrushStyle.BrushStyle; 174 if CbBarSerBrushStyle.BrushStyle in [bsImage, bsPattern] then 175 // Must be AFTER assigning brush style 176 ser.BarBrush.Bitmap := CbBarSerBrushStyle.BrushBitmap; 177 end; 178 179 procedure TForm1.BarPenChange(Sender: TObject); 180 var 181 ser: TBarSeries; 182 begin 183 if FLockChanges > 0 then 184 exit; 185 ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TBarSeries; 186 ser.BarPen.Color := CbBarSerPenColor.Selected; 187 ser.BarPen.Width := CbBarSerPenWidth.PenWidth; 188 ser.BarPen.Style := CbBarSerPenStyle.PenStyle; 189 if ser.BarPen.Style = psPattern then 190 CbBarSerPenStyle.SetPenPattern(ser.BarPen); 191 end; 192 193 { Line series } 194 195 procedure TForm1.LinePenChange(Sender: TObject); 196 var 197 ser: TLineSeries; 198 begin 199 if FLockChanges > 0 then 200 exit; 201 ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TLineSeries; 202 ser.LinePen.Color := CbLineSerLinePenColor.Selected; 203 ser.LinePen.Width := CbLineSerLinePenWidth.PenWidth; 204 ser.LinePen.Style := CbLineSerLinePenStyle.PenStyle; 205 if ser.LinePen.Style = psPattern then 206 CbLineSerLinePenStyle.SetPenPattern(ser.LinePen); 207 ser.ShowLines := cbShowLines.Checked; 208 end; 209 210 procedure TForm1.LinePointerChange(Sender: TObject); 211 var 212 ser: TLineSeries; 213 begin 214 if FLockChanges > 0 then 215 exit; 216 ser := ChartListbox1.Series[ChartListbox1.ItemIndex] as TLineSeries; 217 ser.Pointer.Pen.Color := CbLineSerPointerBorderColor.Selected; 218 ser.Pointer.Brush.Color := CbLineSerPointerBrushColor.Selected; 219 ser.Pointer.Style := CbLineSerPointerStyle.PointerStyle; 220 ser.Pointer.HorizSize := EdLineSerPointerSize.Value; 221 ser.Pointer.VertSize := EdLineSerPointerSize.Value; 222 ser.ShowPoints := CbShowPoints.Checked; 223 end; 224 225 226 { Other events } 227 228 procedure TForm1.CbShowChange(Sender: TObject); 229 var 230 ser: TCustomChartSeries; 231 begin 232 ser := ChartListbox1.Series[ChartListbox1.ItemIndex]; 233 ser.Active := CbShow.Checked; 234 end; 235 236 procedure TForm1.ChartListbox1Click(Sender: TObject); 237 var 238 ser: TCustomChartSeries; 239 begin 240 ser := ChartListbox1.Series[ChartListbox1.ItemIndex]; 241 if ser is TLineSeries then begin 242 Notebook1.PageIndex := 0; 243 CbShowLines.Checked := TLineSeries(ser).ShowLines; 244 CbLineSerLinePenStyle.SetPenPattern(TLineSeries(ser).LinePen); 245 CbLineSerLinePenStyle.Cosmetic := TLineSeries(ser).LinePen.Cosmetic; 246 CbLineSerLinePenStyle.PenStyle := TLineSeries(ser).LinePen.Style; 247 CbLineSerLinePenWidth.PenWidth := TLineSeries(ser).LinePen.Width; 248 CbLineSerLinePenColor.Selected := TLineSeries(ser).LinePen.Color; 249 250 inc(FLockChanges); 251 CbShowPoints.Checked := TLineSeries(ser).ShowPoints; 252 EdLineSerPointerSize.Value := TLineSeries(ser).Pointer.HorizSize; 253 CbLineSerPointerStyle.PointerStyle := TLineSeries(ser).Pointer.Style; 254 CbLineSerPointerBorderColor.Selected := TLineSeries(ser).Pointer.Pen.Color; 255 CblineSerPointerBrushColor.Selected := TLineSeries(ser).Pointer.Brush.Color; 256 dec(FLockChanges); // Not clear why this is necessary - should work without it 257 // LinePointerChange(nil); 258 end 259 else 260 if ser is TBarSeries then begin 261 Notebook1.PageIndex := 1; 262 CbBarSerPenStyle.PenStyle := TBarSeries(ser).BarPen.Style; 263 CbBarSerPenWidth.PenWidth := TBarseries(ser).BarPen.Width; 264 CbBarSerPenColor.Selected := TBarSeries(ser).BarPen.Color; 265 CbBarSerBrushColor.Selected := TBarSeries(ser).BarBrush.Color; 266 CbBarSerBrushStyle.BrushStyle := TBarSeries(ser).BarBrush.Style; 267 end 268 else if ser is TAreaSeries then begin 269 Notebook1.PageIndex := 2; 270 CbAreaSerBrushColor.Selected := TAreaSeries(ser).AreaBrush.Color; 271 CbAreaSerBrushStyle.BrushStyle := TAreaSeries(ser).AreaBrush.Style; 272 CbAreaSerContourStyle.PenStyle := TAreaSeries(ser).AreaContourPen.Style; 273 CbAreaSerContourWidth.PenWidth := TAreaSeries(ser).AreaContourPen.Width; 274 CbAreaSerContourColor.Selected := TAreaSeries(ser).AreaContourPen.Color; 275 CbAreaSerLinesStyle.PenStyle := TAreaSeries(ser).AreaLinesPen.Style; 276 CbAreaSerLinesWidth.PenWidth := TAreaSeries(ser).AreaLinesPen.Width; 277 CbAreaSerLinesColor.Selected := TAreaSeries(ser).AreaLinesPen.Color; 278 end; 279 LblSeries.Caption := ser.Title; 280 CbShow.Checked := ser.Active; 281 end; 282 283 procedure TForm1.ChartToolset1DataPointClickTool1PointClick(ATool: TChartTool; 284 APoint: TPoint); 285 var 286 ser: TChartSeries; 287 begin 288 Unused(APoint); 289 ser := TChartSeries(TDataPointClickTool(ATool).Series); 290 if ser <> nil then begin 291 ChartListbox1.ItemIndex := ChartListbox1.FindSeriesIndex(ser); 292 ChartListbox1Click(nil); 293 end; 294 end; 295 296 procedure TForm1.FormCreate(Sender: TObject); 297 var 298 i: Integer; 299 begin 300 for i:=0 to ComponentCount - 1 do 301 if Components[i] is TCustomCombobox then 302 TCustomCombobox(Components[i]).DropDownCount := DEFAULT_DROPDOWN_COUNT; 303 end; 304 305 procedure TForm1.FormShow(Sender: TObject); 306 const 307 DEFAULT_PATTERN = '2|1|1|1|1|1|1|1'; 308 var 309 bmp: TBitmap; 310 begin 311 // Prepare the application's icon as a brush fill picture 312 bmp := TBitmap.Create; 313 try 314 bmp.SetSize(Application.Icon.Width, Application.Icon.Height); 315 bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height); 316 bmp.Transparent := true; 317 bmp.canvas.Draw(0, 0, Application.Icon); 318 CbBarSerBrushStyle.BrushBitmap.Assign(bmp); 319 CbAreaSerBrushStyle.BrushBitmap.Assign(bmp); 320 finally 321 bmp.Free; 322 end; 323 { 324 bmp := TBitmap.Create; 325 try 326 bmp.SetSize(2, 2); 327 bmp.Canvas.Pixels[0, 0] := clWhite; 328 bmp.Canvas.Pixels[1, 0] := clBlack; 329 bmp.Canvas.Pixels[0, 1] := clBlack; 330 bmp.Canvas.Pixels[1, 1] := clWhite; 331 finally 332 CbBarSerBrushStyle.BrushBitmap.Assign(bmp); 333 CbAreaserBrushStyle.BrushBitmap.Assign(bmp); 334 end; 335 } 336 337 // Prepare user-defined line pattern 338 CbLineSerLinePenStyle.PenPattern := DEFAULT_PATTERN; 339 CbBarSerPenStyle.PenPattern := DEFAULT_PATTERN; 340 CbAreaSerLinesStyle.PenPattern := DEFAULT_PATTERN; 341 CbAreaSerContourStyle.PenPattern := DEFAULT_PATTERN; 342 343 ChartListbox1.ItemIndex := 0; 344 ChartListbox1Click(nil); 345 end; 346 347 end. 348 349