1 unit main;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Controls, ExtCtrls, Graphics, Spin, StdCtrls, Forms, ComCtrls,
9   TAGraph, TASeries, TASources, Classes, TALegend, TAFuncSeries, TADrawUtils;
10 
11 type
12 
13   { TForm1 }
14 
15   TForm1 = class(TForm)
16     cbByRows: TCheckBox;
17     cbGrid: TCheckBox;
18     Chart1: TChart;
19     Chart1AreaSeries1: TAreaSeries;
20     Chart1FuncSeries1: TFuncSeries;
21     Chart1LineSeries1: TLineSeries;
22     Chart1PieSeries1: TPieSeries;
23     cbUseSidebar: TCheckBox;
24     cbSeries: TComboBox;
25     Chart2: TChart;
26     GradientLineSeries: TLineSeries;
27     lblColumnCount: TLabel;
28     lblSpacing: TLabel;
29     lblMarginX: TLabel;
30     lblSymbolWidth: TLabel;
31     lblMarginY: TLabel;
32     ListChartSource1: TListChartSource;
33     ListChartSource2: TListChartSource;
34     PageControl1: TPageControl;
35     pnControls: TPanel;
36     rgAlignment: TRadioGroup;
37     RandomChartSource1: TRandomChartSource;
38     seSpacing: TSpinEdit;
39     seMarginX: TSpinEdit;
40     seColumnCount: TSpinEdit;
41     seSymbolWidth: TSpinEdit;
42     seMarginY: TSpinEdit;
43     TabSheet1: TTabSheet;
44     TabSheet2: TTabSheet;
45     procedure cbByRowsChange(Sender: TObject);
46     procedure cbGridChange(Sender: TObject);
47     procedure cbSeriesDrawItem(Control: TWinControl; Index: Integer;
48       ARect: TRect; State: TOwnerDrawState);
49     procedure cbUseSidebarChange(Sender: TObject);
50     procedure Chart1FuncSeries1Calculate(const AX: Double; out AY: Double);
51     procedure Chart1FuncSeries1DrawLegend(
52       ACanvas: TCanvas; const ARect: TRect; AIndex: Integer; AItem: TLegendItem);
53     procedure Chart1FuncSeries1LegendCreate(
54       AItem: TLegendItem; AIndex: Integer);
55     procedure Chart2DrawLegend(ASender: TChart; ADrawer: IChartDrawer;
56       {%H-}ALegendItems: TChartLegendItems; {%H-}ALegendItemSize: TPoint;
57       const ALegendRect: TRect; {%H-}AColCount, {%H-}ARowCount: Integer);
58     procedure FormCreate(Sender: TObject);
59     procedure FormDestroy(Sender: TObject);
60     procedure rgAlignmentClick(Sender: TObject);
61     procedure seMarginXChange(Sender: TObject);
62     procedure seMarginYChange(Sender: TObject);
63     procedure seSpacingChange(Sender: TObject);
64     procedure seSymbolWidthChange(Sender: TObject);
65     procedure seColumnCountChange(Sender: TObject);
66   private
67     FItems: TChartLegendItems;
68     FGradientMinValue: Double;
69     FGradientMaxValue: Double;
70   end;
71 
72 var
73   Form1: TForm1;
74 
75 implementation
76 
77 {$R *.lfm}
78 
79 uses
80   SysUtils, Math, TAChartUtils, TADrawerCanvas;
81 
82 const
83   START_COLOR = $007777FF;
84   END_COLOR = $00FF7777;
85 
86 { Helper for ownerdrawn legend }
87 procedure DrawGradient(ADrawer: IChartDrawer; ARect: TRect;
88   AStartColor, AEndColor: TColor);
89 var
90   h: Integer;
91   y: Integer;
92   c: TColor;
93 begin
94   h := ARect.Bottom - ARect.Top;
95   if h <= 0 then exit;
96   for y := ARect.Bottom-1 downto ARect.Top do begin
97     c := InterpolateRGB(AStartColor, AEndColor, (ARect.Bottom - y) / h);
98     ADrawer.SetPenParams(psSolid, c);
99     ADrawer.Line(ARect.Left, y, ARect.Right, y);
100   end;
101 end;
102 
103 
104 { TForm1 }
105 
106 procedure TForm1.cbByRowsChange(Sender: TObject);
107 begin
108   with Chart1.Legend do
109     if cbByRows.Checked then
110       ItemFillOrder := lfoRowCol
111     else
112       ItemFillOrder := lfoColRow;
113 end;
114 
115 procedure TForm1.cbGridChange(Sender: TObject);
116 begin
117   Chart1.Legend.GridHorizontal.Visible := cbGrid.Checked;
118   Chart1.Legend.GridVertical.Visible := cbGrid.Checked;
119 end;
120 
121 procedure TForm1.cbSeriesDrawItem(
122   Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState);
123 var
124   id: IChartDrawer;
125   r: TRect;
126 begin
127   Unused(Control, State);
128   {
129   if Index = cbSeries.ItemIndex then
130     cbSeries.Canvas.Brush.Color := clHighlight
131   else
132     cbSeries.Canvas.Brush.Color := clWindow;
133     }
134   cbSeries.Canvas.FillRect(ARect);
135   id := TCanvasDrawer.Create(cbSeries.Canvas);
136   r := Bounds(
137     ARect.Left + 2, ARect.Top, Chart1.Legend.SymbolWidth, cbSeries.ItemHeight);
138   id.Pen := Chart1.Legend.SymbolFrame;
139   FItems[Index].Draw(id, r);
140 end;
141 
142 procedure TForm1.cbUseSidebarChange(Sender: TObject);
143 begin
144   Chart1.Legend.UseSidebar := cbUseSidebar.Checked;
145 end;
146 
147 procedure TForm1.Chart1FuncSeries1Calculate(const AX: Double; out AY: Double);
148 begin
149   AY := Sin(AX * 2) + 7;
150 end;
151 
152 procedure TForm1.Chart1FuncSeries1LegendCreate(
153   AItem: TLegendItem; AIndex: Integer);
154 begin
155   AItem.Text := 'Function ' + IntToStr(AIndex);
156   if AIndex = 1 then
157     AItem.Order := 0;
158 end;
159 
160 procedure TForm1.Chart1FuncSeries1DrawLegend(
161   ACanvas: TCanvas; const ARect: TRect; AIndex: Integer; AItem: TLegendItem);
162 var
163   x, y0, w: Integer;
164 begin
165   Unused(AIndex, AItem);
166   ACanvas.Pen := Chart1FuncSeries1.Pen;
167   y0 := (ARect.Top + ARect.Bottom) div 2;
168   ACanvas.MoveTo(ARect.Left, y0);
169   w := ARect.Right - ARect.Left;
170   for x := 0 to w do
171     ACanvas.LineTo(
172       ARect.Left + x,
173       Round(Sin(x / w * 2 * Pi) * (ARect.Bottom - ARect.Top) / 2) + y0);
174 end;
175 
176 { This event handler draws the legend completely on its own.
177   You can draw anything here - it's your responsibility...
178   Here we draw a color gradient to explain the symbol colors of the datapoints. }
179 procedure TForm1.Chart2DrawLegend(ASender: TChart; ADrawer: IChartDrawer;
180   ALegendItems: TChartLegendItems; ALegendItemSize: TPoint;
181   const ALegendRect: TRect; AColCount, ARowCount: Integer);
182 var
183   xg1, xg2, yg1, yg2, y: Integer;
184   s: String;
185   yval: Double;
186   i: Integer;
187   ts: TPoint;
188 begin
189   xg1 := ALegendRect.Left + 4;              // left edge of gradient
190   xg2 := xg1 + ASender.Legend.SymbolWidth;  // right edge of gradient
191   yg1 := ASender.ClipRect.Top;              // top edge of gradient
192   yg2 := ASender.ClipRect.Bottom;           // bottom edge of gradient
193 
194   // Draw border around gradient bar
195   ADrawer.SetPenParams(psSolid, clBlack);
196   ADrawer.Rectangle(xg1-1, yg1-1, xg2+1, yg2+1);
197 
198   // Draw gradient bar
199   DrawGradient(ADrawer, Rect(xg1, yg1, xg2, yg2), START_COLOR, END_COLOR);
200 
201   // Draw axis labels along gradient bar, with a short marker line
202   ADrawer.SetBrushParams(bsSolid, clBlack);
203   ADrawer.SetPenParams(psSolid, clBlack);
204   ADrawer.SetFont(ASender.Legend.Font);
205   ts := ADrawer.TextExtent('1');
206   for i:=0 to ASender.LeftAxis.ValueCount-1 do begin
207     // Read y axis labels
208     yval := ASender.LeftAxis.Value[i].FValue;
209     // make sure that label is visible
210     if InRange(yval, FGradientMinValue, FGradientMaxValue) then begin
211       s := Format('%.1f', [yval]);
212       { or:
213       s := ASender.LeftAxis.Value[i].FText; }
214       y := ASender.YGraphToImage(yval);
215       ADrawer.Line(xg2-2, y, xg2+4, y);
216       // draw label text
217       ADrawer.TextOut.Pos(xg2+12, y-ts.y div 2).Text(s).Done;
218     end;
219   end;
220 end;
221 
222 procedure TForm1.FormCreate(Sender: TObject);
223 
224   procedure PrepareData;
225   const
226     XMIN = -10;
227     XMAX = +10;
228     N = 30;
229   var
230     i: Integer;
231     x, y: Double;
232     ynorm: Double;
233     c: TColor;
234   begin
235     // Create some data and store in series' internal listsource
236     for i:=0 to N-1 do begin
237       x := XMIN + (XMAX - XMIN) * i / (N-1) + (random - 0.5) * 0.5;
238       y := exp(-0.2*sqr(x)) + (random-0.5) * 0.1;
239       GradientLineSeries.AddXY(x, y);
240     end;
241     // Here we define the value range mapped to the gradient
242     FGradientMinValue := GradientLineSeries.ListSource.Extent.a.y;
243     FGradientMaxValue := GradientLineSeries.ListSource.Extent.b.y;
244     // Colorize the data points
245     for i:=0 to N-1 do begin
246       y := GradientLineSeries.ListSource.Item[i]^.Y;
247       ynorm := (y - FGradientMinValue) / (FGradientMaxValue - FGradientMinValue);
248       c := InterpolateRGB(START_COLOR, END_COLOR, ynorm);
249       GradientLineSeries.ListSource.Item[i]^.Color := c;
250     end;
251   end;
252 
253 var
254   li: TLegendItem;
255 begin
256   // Workaround for issue #19632
257   Chart1FuncSeries1.Legend.OnCreate := @Chart1FuncSeries1LegendCreate;
258   FItems := Chart1.GetLegendItems;
259   Chart1.Legend.SortItemsByOrder(FItems);
260   for li in FItems do
261     cbSeries.AddItem('', nil);
262 
263   // Prepare data for chart with owner-drawn legend
264   PrepareData;
265 end;
266 
267 procedure TForm1.FormDestroy(Sender: TObject);
268 begin
269   FreeAndNil(FItems);
270 end;
271 
272 procedure TForm1.rgAlignmentClick(Sender: TObject);
273 begin
274   with Chart1.Legend do
275     case rgAlignment.ItemIndex of
276       0: Alignment := laTopLeft;
277       1: Alignment := laCenterLeft;
278       2: Alignment := laBottomLeft;
279       3: Alignment := laTopCenter;
280       4: Abort;
281       5: Alignment := laBottomCenter;
282       6: Alignment := laTopRight;
283       7: Alignment := laCenterRight;
284       8: Alignment := laBottomRight;
285     end;
286 end;
287 
288 procedure TForm1.seMarginXChange(Sender: TObject);
289 begin
290   Chart1.Legend.MarginX := seMarginX.Value;
291 end;
292 
293 procedure TForm1.seMarginYChange(Sender: TObject);
294 begin
295   Chart1.Legend.MarginY := seMarginY.Value;
296 end;
297 
298 procedure TForm1.seSpacingChange(Sender: TObject);
299 begin
300   Chart1.Legend.Spacing := seSpacing.Value;
301 end;
302 
303 procedure TForm1.seSymbolWidthChange(Sender: TObject);
304 begin
305   Chart1.Legend.SymbolWidth := seSymbolWidth.Value;
306 end;
307 
308 procedure TForm1.seColumnCountChange(Sender: TObject);
309 begin
310   Chart1.Legend.ColumnCount := seColumnCount.Value;
311 end;
312 
313 end.
314 
315