1 unit main;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, SysUtils, FileUtil, TAGraph, TASeries, TASources, Forms, Controls,
9   Graphics, Dialogs, ExtCtrls, StdCtrls, TAChartAxisUtils, TAFuncSeries,
10   TATools, TADataTools;
11 
12 type
13 
14   { TMainForm }
15 
16   TMainForm = class(TForm)
17     BtnCopyToClipboard: TButton;
18     BtnSaveWMF: TButton;
19     BtnSaveSVG: TButton;
20     Chart: TChart;
21     CgHTML: TCheckGroup;
22     CbRTL: TCheckBox;
23     ChartTools: TChartToolset;
24     CbRotateXLabels: TCheckBox;
25     DistanceTool: TDataPointDistanceTool;
26     FitSeries: TFitSeries;
27     Label1: TLabel;
28     ListChartSource: TListChartSource;
29     DataSeries: TLineSeries;
30     BottomPanel: TPanel;
31     ListChartSource_Fit: TListChartSource;
32     procedure BtnCopyToClipboardClick(Sender: TObject);
33     procedure BtnSaveWMFClick(Sender: TObject);
34     procedure BtnSaveSVGClick(Sender: TObject);
35     procedure CbRotateXLabelsChange(Sender: TObject);
36     procedure CgHTMLItemClick(Sender: TObject; Index: integer);
37     procedure ChartAxisList1MarkToText(var AText: String; AMark: Double);
38     procedure CbRTLChange(Sender: TObject);
39     procedure DistanceToolGetDistanceText(ASender: TDataPointDistanceTool;
40       var AText: String);
41     procedure FitSeriesFitComplete(Sender: TObject);
42     procedure FormCreate(Sender: TObject);
43 
44   private
45     procedure CreateData;
46 
47   public
48 
49   end;
50 
51 var
52   MainForm: TMainForm;
53 
54 implementation
55 
56 {$R *.lfm}
57 
58 uses
59   TAChartUtils, {$IFDEF WINDOWS}TADrawerWMF,{$ENDIF} TADrawerSVG;
60 
61 { TMainForm }
62 
63 procedure TMainForm.BtnCopyToClipboardClick(Sender: TObject);
64 begin
65   Chart.CopyToClipboardBitmap;
66 end;
67 
68 procedure TMainForm.BtnSaveWMFClick(Sender: TObject);
69 begin
70   {$IFDEF WINDOWS}
71   with Chart do
72     Draw(TWindowsMetafileDrawer.Create('test.wmf'), Rect(0, 0, Width, Height));
73   ShowMessage('Chart saved to file "test.wmf"');
74   {$ENDIF}
75 end;
76 
77 procedure TMainForm.CbRotateXLabelsChange(Sender: TObject);
78 begin
79   if CbRotateXLabels.Checked then
80     Chart.BottomAxis.Marks.LabelFont.Orientation := 450
81   else
82     Chart.BottomAxis.Marks.LabelFont.Orientation := 0;
83 end;
84 
85 procedure TMainForm.BtnSaveSVGClick(Sender: TObject);
86 begin
87   Chart.SaveToSVGFile('test.svg');
88   ShowMessage('Chart saved to file "test.svg"');
89 end;
90 
91 procedure TMainForm.CgHTMLItemClick(Sender: TObject; Index: integer);
92 var
93   tf: TChartTextFormat;
94 begin
95   if CgHTML.Checked[Index] then tf := tfNormal else tf := tfHTML;
96   case Index of
97     0: Chart.Title.TextFormat := tf;
98     1: Chart.Foot.TextFormat := tf;
99     2: Chart.Legend.TextFormat := tf;
100     3: DataSeries.Marks.TextFormat := tf;
101     4: Chart.BottomAxis.Marks.TextFormat := tf;
102     5: Chart.BottomAxis.Title.TextFormat := tf;
103     6: Chart.LeftAxis.Title.TextFormat := tf;
104     7: DistanceTool.Marks.TextFormat := tf;
105   end;
106 end;
107 
108 procedure TMainForm.ChartAxisList1MarkToText(var AText: String; AMark: Double);
109 begin
110   AText := AText + '°';
111 end;
112 
113 procedure TMainForm.CbRTLChange(Sender: TObject);
114 begin
115   if CbRTL.Checked then
116     Chart.BiDiMode := bdRightToLeft else
117     Chart.BiDiMode := bdLeftToRight;
118 end;
119 
120 procedure TMainForm.CreateData;
121 const
122   N = 20;
123   MIN = 0;
124   MAX = 90;
125   OUTLIER_INDEX = 12;
126 var
127   i: Integer;
128   x, y: Double;
129   s: String;
130 begin
131   for i:=0 to N-1 do begin
132     x := MIN + (MAX - MIN) * i / (N-1) + 5*(random - 0.5);
133     if i = OUTLIER_INDEX then begin
134       y := 631;
135       s := 'Defective device!' + LineEnding + '(α = ' + FormatFloat('0.00', x) + '°)';
136     end else
137     begin
138       y := x*x / 10 + (random - 0.5) * 100;
139       s := '';
140     end;
141     ListChartSource.Add(x, y, s);
142     if i <> OUTLIER_INDEX then
143       ListChartSource_Fit.Add(x, y);
144   end;
145   DataSeries.Source := ListChartSource;
146   FitSeries.Source := ListChartSource_Fit;
147 end;
148 
149 procedure TMainForm.DistanceToolGetDistanceText(
150   ASender: TDataPointDistanceTool; var AText: String);
151 begin
152   AText := '&Delta;&alpha; = ' + FormatFloat('0.00', ASender.Distance) + '&deg;';
153 end;
154 
155 procedure TMainForm.FitSeriesFitComplete(Sender: TObject);
156 var
157   p: Array of Double;
158   i: Integer;
159   s: String;
160 begin
161   SetLength(p, FitSeries.ParamCount);
162   for i:=0 to FitSeries.ParamCount-1 do
163     p[i] := FitSeries.Param[i];
164 
165   s := FitSeries.EquationText.
166     x('&alpha;').
167     y('A').
168     NumFormat('%.2f').
169     DecimalSeparator('.').
170     Params(p).
171     Get;
172   FitSeries.Title := '<font color="blue">Fitted:</font> ' + s;
173 end;
174 
175 procedure TMainForm.FormCreate(Sender: TObject);
176 begin
177   CreateData;
178 
179   CgHTML.Checked[0] := Chart.Title.TextFormat = tfNormal;
180   CgHTML.Checked[1] := Chart.Foot.TextFormat = tfNormal;
181   CgHTML.Checked[2] := Chart.Legend.TextFormat = tfNormal;
182   CgHTML.Checked[3] := DataSeries.Marks.TextFormat = tfNormal;
183   CgHTML.Checked[4] := Chart.BottomAxis.Marks.TextFormat = tfNormal;
184   CgHTML.Checked[5] := Chart.BottomAxis.Title.TextFormat = tfNormal;
185   CgHTML.Checked[6] := Chart.LeftAxis.Title.TextFormat = tfNormal;
186   CgHTML.Checked[7] := DistanceTool.Marks.TextFormat = tfNormal;
187 
188   {$IFDEF WINDOWS}
189   Chart.Foot.Text[1] := '<font name="Times New Roman" color="gray">' + Chart.Foot.Text[1] + '</font>';
190   {$ELSE}
191   BtnSaveWMF.Hide;
192   {$ENDIF}
193 end;
194 
195 end.
196 
197