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 := 'Δα = ' + FormatFloat('0.00', ASender.Distance) + '°'; 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('α'). 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