23
Classes, Contnrs, SysUtils, Graphics, TAChartUtils, TATypes;
23
Classes, Contnrs, FPCanvas, Graphics, SysUtils,
24
TAChartUtils, TADrawUtils, TATypes;
26
27
DEF_LEGEND_SPACING = 4;
27
28
DEF_LEGEND_MARGIN = 4;
28
29
DEF_LEGEND_SYMBOL_WIDTH = 20;
30
LEGEND_ITEM_ORDER_AS_ADDED = -1;
31
LEGEND_ITEM_NO_GROUP = -1;
33
36
TLegendItem = class
42
FOwner: TIndexedComponent;
38
45
constructor Create(const AText: String; AColor: TColor = clTAColor);
39
procedure Draw(ACanvas: TCanvas; const ARect: TRect); virtual;
46
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); virtual;
47
function HasSymbol: Boolean; virtual;
48
procedure UpdateFont(ADrawer: IChartDrawer; var APrevFont: TFont);
41
50
property Color: TColor read FColor write FColor;
51
property Font: TFont read FFont write FFont;
52
property GroupIndex: Integer read FGroupIndex write FGroupIndex;
53
property Order: Integer read FOrder write FOrder;
54
property Owner: TIndexedComponent read FOwner write FOwner;
55
property Text: String read FText write FText;
58
{ TLegendItemGroupTitle }
60
TLegendItemGroupTitle = class(TLegendItem)
62
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
63
function HasSymbol: Boolean; override;
44
66
TLegendItemDrawEvent = procedure (
45
ACanvas: TCanvas; const ARect: TRect; AIndex: Integer; var AText: String
67
ACanvas: TCanvas; const ARect: TRect; AIndex: Integer; AItem: TLegendItem
48
70
{ TLegendItemUserDrawn }
50
72
TLegendItemUserDrawn = class(TLegendItem)
53
75
FOnDraw: TLegendItemDrawEvent;
55
77
constructor Create(
56
78
AIndex: Integer; AOnDraw: TLegendItemDrawEvent; const AText: String);
57
procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
79
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
58
80
property OnDraw: TLegendItemDrawEvent read FOnDraw;
61
83
{ TLegendItemLine }
63
85
TLegendItemLine = class(TLegendItem)
67
constructor Create(APen: TPen; const AText: String);
68
procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
69
property Pen: TPen read FPen;
89
constructor Create(APen: TFPCustomPen; const AText: String);
90
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
72
93
{ TLegendItemLinePointer }
74
95
TLegendItemLinePointer = class(TLegendItemLine)
76
97
FPointer: TSeriesPointer;
78
99
constructor Create(
79
100
APen: TPen; APointer: TSeriesPointer; const AText: String);
80
procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
101
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
83
104
{ TLegendItemBrushRect }
85
106
TLegendItemBrushRect = class(TLegendItem)
89
constructor Create(ABrush: TBrush; const AText: String);
90
procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
93
{ TLegendItemPieSlice }
95
TLegendItemPieSlice = class(TLegendItem)
97
procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
100
TChartLegendItems = TObjectList;
108
FBrush: TFPCustomBrush;
110
constructor Create(ABrush: TFPCustomBrush; const AText: String);
111
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
114
TLegendItemsEnumerator = class(TListEnumerator)
116
function GetCurrent: TLegendItem;
117
property Current: TLegendItem read GetCurrent;
120
{ TChartLegendItems }
122
TChartLegendItems = class(TObjectList)
124
function GetItem(AIndex: Integer): TLegendItem;
125
procedure SetItem(AIndex: Integer; AValue: TLegendItem);
127
function GetEnumerator: TLegendItemsEnumerator;
128
property Items[AIndex: Integer]: TLegendItem
129
read GetItem write SetItem; default;
102
132
TChartLegendBrush = class(TBrush)
104
134
property Color default clWhite;
107
TLegendAlignment = (laTopLeft, laBottomLeft, laTopRight, laBottomRight);
138
laTopLeft, laCenterLeft, laBottomLeft,
139
laTopCenter, laBottomCenter, // laCenterCenter makes no sense.
140
laTopRight, laCenterRight, laBottomRight);
142
TChartLegendDrawingData = record
145
FDrawer: IChartDrawer;
146
FItems: TChartLegendItems;
151
TLegendColumnCount = 1..MaxInt;
152
TLegendItemFillOrder = (lfoColRow, lfoRowCol);
111
156
TChartLegend = class(TChartElement)
113
158
FAlignment: TLegendAlignment;
114
159
FBackgroundBrush: TChartLegendBrush;
160
FColumnCount: TLegendColumnCount;
116
162
FFrame: TChartPen;
164
FGroupTitles: TStrings;
165
FItemFillOrder: TLegendItemFillOrder;
117
166
FMarginX: TChartDistance;
118
167
FMarginY: TChartDistance;
119
168
FSpacing: TChartDistance;
169
FSymbolFrame: TChartPen;
120
170
FSymbolWidth: TChartDistance;
121
171
FUseSidebar: Boolean;
173
// Not includes the margins around item.
174
function MeasureItem(
175
ADrawer: IChartDrawer; AItems: TChartLegendItems): TPoint;
123
176
procedure SetAlignment(AValue: TLegendAlignment);
124
177
procedure SetBackgroundBrush(AValue: TChartLegendBrush);
178
procedure SetColumnCount(AValue: TLegendColumnCount);
125
179
procedure SetFont(AValue: TFont);
126
180
procedure SetFrame(AValue: TChartPen);
181
procedure SetGroupFont(AValue: TFont);
182
procedure SetGroupTitles(AValue: TStrings);
183
procedure SetItemFillOrder(AValue: TLegendItemFillOrder);
127
184
procedure SetMargin(AValue: TChartDistance);
128
185
procedure SetMarginX(AValue: TChartDistance);
129
186
procedure SetMarginY(AValue: TChartDistance);
130
187
procedure SetSpacing(AValue: TChartDistance);
188
procedure SetSymbolFrame(AValue: TChartPen);
131
189
procedure SetSymbolWidth(AValue: TChartDistance);
132
190
procedure SetUseSidebar(AValue: Boolean);
135
193
destructor Destroy; override;
196
procedure AddGroups(AItems: TChartLegendItems);
138
197
procedure Assign(Source: TPersistent); override;
140
ACanvas: TCanvas; AItems: TObjectList; const ABounds: TRect);
142
ACanvas: TCanvas; AItems: TObjectList; var AClipRect: TRect): TRect;
198
procedure Draw(var AData: TChartLegendDrawingData);
199
procedure Prepare(var AData: TChartLegendDrawingData; var AClipRect: TRect);
200
procedure SortItemsByOrder(AItems: TChartLegendItems);
144
202
property Alignment: TLegendAlignment
145
203
read FAlignment write SetAlignment default laTopRight;
146
204
property BackgroundBrush: TChartLegendBrush
147
205
read FBackgroundBrush write SetBackgroundBrush;
206
property ColumnCount: TLegendColumnCount
207
read FColumnCount write SetColumnCount default 1;
148
208
property Font: TFont read FFont write SetFont;
149
209
property Frame: TChartPen read FFrame write SetFrame;
210
property GroupFont: TFont read FGroupFont write SetGroupFont;
211
property GroupTitles: TStrings read FGroupTitles write SetGroupTitles;
212
property ItemFillOrder: TLegendItemFillOrder
213
read FItemFillOrder write SetItemFillOrder default lfoColRow;
150
214
property Margin: TChartDistance
151
215
read FMarginX write SetMargin stored false; deprecated;
152
216
property MarginX: TChartDistance
164
229
TLegendMultiplicity = (lmSingle, lmPoint);
231
TLegendItemCreateEvent = procedure (
232
AItem: TLegendItem; AIndex: Integer) of object;
166
234
{ TChartSeriesLegend }
168
236
TChartSeriesLegend = class(TChartElement)
239
FGroupIndex: Integer;
170
240
FMultiplicity: TLegendMultiplicity;
241
FOnCreate: TLegendItemCreateEvent;
171
242
FOnDraw: TLegendItemDrawEvent;
172
244
FUserItemsCount: Integer;
245
procedure SetFormat(AValue: String);
246
procedure SetGroupIndex(AValue: Integer);
173
247
procedure SetMultiplicity(AValue: TLegendMultiplicity);
248
procedure SetOnCreate(AValue: TLegendItemCreateEvent);
174
249
procedure SetOnDraw(AValue: TLegendItemDrawEvent);
250
procedure SetOrder(AValue: Integer);
175
251
procedure SetUserItemsCount(AValue: Integer);
177
253
constructor Create(AOwner: TCustomChart);
179
255
procedure Assign(Source: TPersistent); override;
257
AItem: TLegendItem; AIndex: Integer; ALegend: TChartLegend);
259
property Format: String read FFormat write SetFormat;
260
property GroupIndex: Integer
261
read FGroupIndex write SetGroupIndex default LEGEND_ITEM_NO_GROUP;
181
262
property Multiplicity: TLegendMultiplicity
182
263
read FMultiplicity write SetMultiplicity default lmSingle;
183
property OnDraw: TLegendItemDrawEvent read FOnDraw write SetOnDraw;
264
property Order: Integer
265
read FOrder write SetOrder default LEGEND_ITEM_ORDER_AS_ADDED;
184
266
property UserItemsCount: Integer
185
267
read FUserItemsCount write SetUserItemsCount default 1;
186
268
property Visible default true;
271
property OnCreate: TLegendItemCreateEvent read FOnCreate write SetOnCreate;
272
property OnDraw: TLegendItemDrawEvent read FOnDraw write SetOnDraw;
192
Math, PropEdits, Types, TADrawUtils;
278
Math, PropEdits, Types, TADrawerCanvas, TAGeometry;
195
281
SYMBOL_TEXT_SPACING = 4;
283
function LegendItemCompare(AItem1, AItem2: Pointer): Integer;
285
li1: TLegendItem absolute AItem1;
286
li2: TLegendItem absolute AItem2;
288
Result := Sign(li1.GroupIndex - li2.GroupIndex);
290
Result := Sign(li1.Order - li2.Order);
293
{ TLegendItemsEnumerator }
295
function TLegendItemsEnumerator.GetCurrent: TLegendItem;
297
Result := TLegendItem(inherited GetCurrent);
300
{ TChartLegendItems }
302
function TChartLegendItems.GetEnumerator: TLegendItemsEnumerator;
304
Result := TLegendItemsEnumerator.Create(Self);
307
function TChartLegendItems.GetItem(AIndex: Integer): TLegendItem;
309
Result := TLegendItem(inherited GetItem(AIndex));
312
procedure TChartLegendItems.SetItem(AIndex: Integer; AValue: TLegendItem);
314
inherited SetItem(AIndex, AValue);
199
319
constructor TLegendItem.Create(const AText: String; AColor: TColor);
201
321
FColor := AColor;
322
FGroupIndex := LEGEND_ITEM_NO_GROUP;
323
FOrder := LEGEND_ITEM_ORDER_AS_ADDED;
205
procedure TLegendItem.Draw(ACanvas: TCanvas; const ARect: TRect);
207
ACanvas.TextOut(ARect.Right + SYMBOL_TEXT_SPACING, ARect.Top, FText);
327
procedure TLegendItem.Draw(ADrawer: IChartDrawer; const ARect: TRect);
330
Pos(ARect.Right + SYMBOL_TEXT_SPACING, ARect.Top).Text(FText).Done;
333
function TLegendItem.HasSymbol: Boolean;
338
procedure TLegendItem.UpdateFont(ADrawer: IChartDrawer; var APrevFont: TFont);
340
if APrevFont = Font then exit;
341
ADrawer.Font := Font;
345
{ TLegendItemGroupTitle }
347
procedure TLegendItemGroupTitle.Draw(ADrawer: IChartDrawer; const ARect: TRect);
349
ADrawer.TextOut.Pos(ARect.Left, ARect.Top).Text(Text).Done;
352
function TLegendItemGroupTitle.HasSymbol: Boolean;
210
357
{ TLegendItemUserDrawn }
217
364
FOnDraw := AOnDraw;
220
procedure TLegendItemUserDrawn.Draw(ACanvas: TCanvas; const ARect: TRect);
367
procedure TLegendItemUserDrawn.Draw(ADrawer: IChartDrawer; const ARect: TRect);
369
ic: IChartTCanvasDrawer;
222
if Assigned(FOnDraw) then
223
FOnDraw(ACanvas, ARect, FIndex, FText);
224
inherited Draw(ACanvas, ARect);
371
if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(FOnDraw) then
372
FOnDraw(ic.Canvas, ARect, FIndex, Self);
373
inherited Draw(ADrawer, ARect);
227
376
{ TLegendItemLine }
229
constructor TLegendItemLine.Create(APen: TPen; const AText: String);
378
constructor TLegendItemLine.Create(APen: TFPCustomPen; const AText: String);
231
380
inherited Create(AText);
235
procedure TLegendItemLine.Draw(ACanvas: TCanvas; const ARect: TRect);
384
procedure TLegendItemLine.Draw(ADrawer: IChartDrawer; const ARect: TRect);
239
inherited Draw(ACanvas, ARect);
388
inherited Draw(ADrawer, ARect);
240
389
if FPen = nil then exit;
241
ACanvas.Pen.Assign(FPen);
242
391
y := (ARect.Top + ARect.Bottom) div 2;
243
ACanvas.Line(ARect.Left, y, ARect.Right, y);
392
ADrawer.Line(ARect.Left, y, ARect.Right, y);
246
395
{ TLegendItemLinePointer }
252
401
FPointer := APointer;
255
procedure TLegendItemLinePointer.Draw(ACanvas: TCanvas; const ARect: TRect);
404
procedure TLegendItemLinePointer.Draw(
405
ADrawer: IChartDrawer; const ARect: TRect);
259
inherited Draw(ACanvas, ARect);
409
inherited Draw(ADrawer, ARect);
260
410
if FPointer = nil then exit;
261
411
c := CenterPoint(ARect);
262
412
// Max width slightly narrower then ARect to leave place for the line.
263
413
sz.X := Min(FPointer.HorizSize, (ARect.Right - ARect.Left) div 3);
264
414
sz.Y := Min(FPointer.VertSize, (ARect.Bottom - ARect.Top) div 2);
265
FPointer.DrawSize(ACanvas, c, sz, Color);
415
FPointer.DrawSize(ADrawer, c, sz, Color);
268
418
{ TLegendItemBrushRect }
270
constructor TLegendItemBrushRect.Create(ABrush: TBrush; const AText: String);
420
constructor TLegendItemBrushRect.Create(
421
ABrush: TFPCustomBrush; const AText: String);
272
423
inherited Create(AText);
273
424
FBrush := ABrush;
276
procedure TLegendItemBrushRect.Draw(ACanvas: TCanvas; const ARect: TRect);
427
procedure TLegendItemBrushRect.Draw(ADrawer: IChartDrawer; const ARect: TRect);
278
inherited Draw(ACanvas, ARect);
429
inherited Draw(ADrawer, ARect);
279
430
if FBrush = nil then
280
ACanvas.Brush.Style := bsSolid
282
ACanvas.Brush.Assign(FBrush);
283
if Color <> clTAColor then
284
ACanvas.Brush.Color := Color;
285
ACanvas.Rectangle(ARect);
288
{ TLegendItemPieSlice }
290
procedure TLegendItemPieSlice.Draw(ACanvas: TCanvas; const ARect: TRect);
294
inherited Draw(ACanvas, ARect);
295
ACanvas.Brush.Style := bsSolid;
296
if Color <> clTAColor then
297
ACanvas.Brush.Color := Color;
299
2 * ARect.Left - ARect.Right, ARect.Top, ARect.Right, ARect.Bottom,
431
ADrawer.SetBrushParams(bsSolid, ColorDef(Color, clRed))
433
ADrawer.Brush := FBrush;
434
if Color <> clTAColor then
435
ADrawer.SetBrushParams(FBrush.Style, Color);
437
ADrawer.Rectangle(ARect);
442
procedure TChartLegend.AddGroups(AItems: TChartLegendItems);
445
g: TLegendItemGroupTitle;
447
for i := AItems.Count - 1 downto 0 do begin
448
gi := AItems[i].GroupIndex;
450
InRange(gi, 0, GroupTitles.Count - 1) and
451
((i = 0) or (AItems[i - 1].GroupIndex <> gi))
453
g := TLegendItemGroupTitle.Create(GroupTitles[gi]);
305
461
procedure TChartLegend.Assign(Source: TPersistent);
307
463
if Source is TChartLegend then
308
with TChartLegend(Source) do
309
Self.FAlignment := FAlignment;
464
with TChartLegend(Source) do begin
465
Self.FAlignment := Alignment;
466
Self.FBackgroundBrush.Assign(BackgroundBrush);
467
Self.FColumnCount := ColumnCount;
468
Self.FFont.Assign(Font);
469
Self.FFrame.Assign(Frame);
470
Self.FGroupFont.Assign(GroupFont);
471
Self.FGroupTitles.Assign(GroupTitles);
472
Self.FMarginX := MarginX;
473
Self.FMarginY := MarginY;
474
Self.FSpacing := Spacing;
475
Self.FSymbolFrame.Assign(SymbolFrame);
476
Self.FSymbolWidth := SymbolWidth;
477
Self.FUseSidebar := UseSidebar;
311
480
inherited Assign(Source);
332
505
FreeAndNil(FBackgroundBrush);
333
506
FreeAndNil(FFont);
334
507
FreeAndNil(FFrame);
508
FreeAndNil(FGroupFont);
509
FreeAndNil(FGroupTitles);
510
FreeAndNil(FSymbolFrame);
339
procedure TChartLegend.Draw(
340
ACanvas: TCanvas; AItems: TObjectList; const ABounds: TRect);
515
procedure TChartLegend.Draw(var AData: TChartLegendDrawingData);
343
pbf: TPenBrushFontRecall;
519
prevFont: TFont = nil;
520
drawer: IChartDrawer;
346
pbf := TPenBrushFontRecall.Create(ACanvas, [pbfPen, pbfBrush, pbfFont]);
348
// Draw the background and the border.
349
ACanvas.Font.Assign(Font);
350
ACanvas.Brush.Assign(BackgroundBrush);
351
if Frame.Visible then
352
ACanvas.Pen.Assign(Frame)
354
ACanvas.Pen.Style := psClear;
355
ACanvas.Rectangle(ABounds);
359
ACanvas.ClipRect := r;
360
ACanvas.Clipping := true;
362
h := TypicalTextHeight(ACanvas);
363
r := Bounds(ABounds.Left + Spacing, ABounds.Top + Spacing, SymbolWidth, h);
364
for i := 0 to AItems.Count - 1 do begin
365
ACanvas.Brush.Assign(BackgroundBrush);
366
ACanvas.Pen.Assign(Frame);
367
(AItems[i] as TLegendItem).Draw(ACanvas, r);
368
OffsetRect(r, 0, h + Spacing);
522
drawer := AData.FDrawer;
523
// Draw the background and the border.
524
drawer.Brush := BackgroundBrush;
525
if Frame.Visible then
528
drawer.SetPenParams(psClear, clTAColor);
531
if AData.FItems.Count = 0 then exit;
534
drawer.ClippingStart(r);
537
for i := 0 to FItems.Count - 1 do begin
538
FItems[i].UpdateFont(drawer, prevFont);
539
drawer.Brush := BackgroundBrush;
540
if SymbolFrame.Visible then
541
drawer.Pen := SymbolFrame
543
drawer.SetPenParams(psClear, clTAColor);
546
case ItemFillOrder of
547
lfoColRow: DivMod(i, FRowCount, x, y);
548
lfoRowCol: DivMod(i, FColCount, y, x);
551
FBounds.Left + Spacing + x * (FItemSize.X + Spacing),
552
FBounds.Top + Spacing + y * (FItemSize.Y + Spacing),
553
SymbolWidth, FItemSize.Y);
554
FItems[i].Draw(drawer, r);
555
OffsetRect(r, 0, FItemSize.Y + Spacing);
372
ACanvas.Clipping := false;
376
function TChartLegend.Prepare(
377
ACanvas: TCanvas; AItems: TObjectList; var AClipRect: TRect): TRect;
379
w, x, y, i, textHeight, legendWidth, legendHeight: Integer;
380
f: TPenBrushFontRecall;
382
f := TPenBrushFontRecall.Create(ACanvas, [pbfFont]);
384
ACanvas.Font.Assign(Font);
386
// Measure the legend.
388
for i := 0 to AItems.Count - 1 do
389
with AItems[i] as TLegendItem do
390
legendWidth := Max(ACanvas.TextWidth(FText), legendWidth);
391
legendWidth += 2 * Spacing + SYMBOL_TEXT_SPACING + SymbolWidth;
394
legendWidth := EnsureRange(legendWidth, 0, Right - Left - w);
397
textHeight := TypicalTextHeight(ACanvas);
398
legendHeight := Spacing + AItems.Count * (textHeight + Spacing);
400
// Determine position according to the alignment.
401
if Alignment in [laTopLeft, laBottomLeft] then begin
562
function TChartLegend.MeasureItem(
563
ADrawer: IChartDrawer; AItems: TChartLegendItems): TPoint;
566
prevFont: TFont = nil;
569
Result := Point(0, 0);
570
for li in AItems do begin
571
li.UpdateFont(ADrawer, prevFont);
573
p := Point(0, ADrawer.TextExtent('I').Y)
575
p := ADrawer.TextExtent(li.Text);
577
p.X += SYMBOL_TEXT_SPACING + SymbolWidth;
578
Result := MaxPoint(p, Result);
582
procedure TChartLegend.Prepare(
583
var AData: TChartLegendDrawingData; var AClipRect: TRect);
586
sidebar, legendSize: TPoint;
589
FColCount := Max(Min(ColumnCount, FItems.Count), 1);
590
FRowCount := (FItems.Count - 1) div FColCount + 1;
591
FItemSize := MeasureItem(FDrawer, FItems);
592
legendSize.X := (FItemSize.X + Spacing) * FColCount + Spacing;
593
legendSize.Y := (FItemSize.Y + Spacing) * FRowCount + Spacing;
596
sidebar.X := 2 * MarginX;
598
legendSize.X := EnsureRange(legendSize.X, 0, Right - Left - sidebar.X);
599
sidebar.X += legendSize.X;
601
sidebar.Y := 2 * MarginX;
603
legendSize.Y := EnsureRange(legendSize.Y, 0, Bottom - Top - sidebar.Y);
604
sidebar.Y += legendSize.Y;
606
// Determine position according to the alignment.
608
laTopLeft, laCenterLeft, laBottomLeft:
402
609
x := AClipRect.Left + MarginX;
407
x := AClipRect.Right - legendWidth - MarginX;
409
AClipRect.Right -= w;
610
laTopRight, laCenterRight, laBottomRight:
611
x := AClipRect.Right - legendSize.X - MarginX;
612
laTopCenter, laBottomCenter:
613
x := (AClipRect.Right + AClipRect.Left - legendSize.X) div 2;
616
laTopLeft, laTopCenter, laTopRight:
617
y := AClipRect.Top + MarginY;
618
laBottomLeft, laBottomCenter, laBottomRight:
619
y := AClipRect.Bottom - MarginY - legendSize.Y;
620
laCenterLeft, laCenterRight:
621
y := (AClipRect.Top + AClipRect.Bottom - legendSize.Y) div 2;
625
laTopLeft, laCenterLeft, laBottomLeft:
626
AClipRect.Left += sidebar.X;
627
laTopRight, laCenterRight, laBottomRight:
628
AClipRect.Right -= sidebar.X;
630
AClipRect.Top += legendSize.Y + 2 * MarginY;
632
AClipRect.Bottom -= legendSize.Y + 2 * MarginY;
411
if Alignment in [laTopLeft, laTopRight] then
412
y := AClipRect.Top + MarginY
414
y := AClipRect.Bottom - MarginY - legendHeight;
416
Result := Bounds(x, y, legendWidth, legendHeight);
634
AData.FBounds := Bounds(x, y, legendSize.X, legendSize.Y);
422
637
procedure TChartLegend.SetAlignment(AValue: TLegendAlignment);