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