1 {
2 *****************************************************************************
3 See the file COPYING.modifiedLGPL.txt, included in this distribution,
4 for details about the license.
5 *****************************************************************************
6
7 Authors: Alexander Klenin
8
9 }
10 unit TALegend;
11
12 {$H+}
13
14 interface
15
16 uses
17 Classes, Contnrs, FPCanvas, Graphics, SysUtils,
18 TAChartUtils, TADrawUtils, TATypes;
19
20 const
21 DEF_LEGEND_SPACING = 4;
22 DEF_LEGEND_MARGIN = 4;
23 DEF_LEGEND_SYMBOL_WIDTH = 20;
24 LEGEND_ITEM_ORDER_AS_ADDED = -1;
25 LEGEND_ITEM_NO_GROUP = -1;
26
27 type
28 { TLegendItem }
29
30 TLegendItem = class
31 strict private
32 FColor: TColor;
33 FFont: TFont;
34 FGroupIndex: Integer;
35 FOrder: Integer;
36 FOwner: TIndexedComponent;
37 FText: String;
38 FTextFormat: TChartTextFormat;
39 public
40 constructor Create(const AText: String; AColor: TColor = clTAColor);
41 procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); virtual;
HasSymbolnull42 function HasSymbol: Boolean; virtual;
43 procedure UpdateFont(ADrawer: IChartDrawer; var APrevFont: TFont);
44 public
45 property Color: TColor read FColor write FColor;
46 property Font: TFont read FFont write FFont;
47 property GroupIndex: Integer read FGroupIndex write FGroupIndex;
48 property Order: Integer read FOrder write FOrder;
49 property Owner: TIndexedComponent read FOwner write FOwner;
50 property Text: String read FText write FText;
51 property TextFormat: TChartTextFormat read FTextFormat write FTextFormat;
52 end;
53
54 { TLegendItemGroupTitle }
55
56 TLegendItemGroupTitle = class(TLegendItem)
57 public
58 procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
HasSymbolnull59 function HasSymbol: Boolean; override;
60 end;
61
62 TLegendItemDrawEvent = procedure (
63 ACanvas: TCanvas; const ARect: TRect; AIndex: Integer; AItem: TLegendItem
64 ) of object;
65
66 { TLegendItemUserDrawn }
67
68 TLegendItemUserDrawn = class(TLegendItem)
69 strict private
70 FIndex: Integer;
71 FOnDraw: TLegendItemDrawEvent;
72 public
73 constructor Create(
74 AIndex: Integer; AOnDraw: TLegendItemDrawEvent; const AText: String);
75 procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
76 property OnDraw: TLegendItemDrawEvent read FOnDraw;
77 end;
78
79 { TLegendItemLine }
80
81 TLegendItemLine = class(TLegendItem)
82 strict protected
83 FPen: TFPCustomPen;
84 public
85 constructor Create(APen: TFPCustomPen; const AText: String);
86 procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
87 end;
88
89 { TLegendItemLinePointer }
90
91 TLegendItemLinePointer = class(TLegendItemLine)
92 strict protected
93 FPointer: TSeriesPointer;
94 FBrush: TBrush;
95 FPresetBrush: Boolean;
96 public
97 constructor Create(
98 APen: TPen; APointer: TSeriesPointer; const AText: String);
99 constructor CreateWithBrush(
100 APen: TPen; ABrush: TBrush; APointer: TSeriesPointer; const AText: String);
101 procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
102 end;
103
104 { TLegendItemBrushRect }
105
106 TLegendItemBrushRect = class(TLegendItem)
107 strict private
108 FBrush: TFPCustomBrush;
109 public
110 constructor Create(ABrush: TFPCustomBrush; const AText: String);
111 procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
112 end;
113
114 { TLegendItemBrushPenRect }
115
116 TLegendItemBrushPenRect = class(TLegendItemBrushRect)
117 strict private
118 FPen: TFPCustomPen;
119 public
120 constructor Create(ABrush: TFPCustomBrush; APen: TFPCustomPen; const AText: String);
121 procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
122 end;
123
124 TLegendItemsEnumerator = class(TListEnumerator)
125 public
GetCurrentnull126 function GetCurrent: TLegendItem;
127 property Current: TLegendItem read GetCurrent;
128 end;
129
130 { TChartLegendItems }
131
132 TChartLegendItems = class(TObjectList)
133 strict private
GetItemnull134 function GetItem(AIndex: Integer): TLegendItem;
135 procedure SetItem(AIndex: Integer; AValue: TLegendItem);
136 public
GetEnumeratornull137 function GetEnumerator: TLegendItemsEnumerator;
138 property Items[AIndex: Integer]: TLegendItem
139 read GetItem write SetItem; default;
140 end;
141
142 TChartLegendBrush = class(TBrush)
143 published
144 constructor Create; override;
145 property Color default clDefault;
146 end;
147
148 TLegendAlignment = (
149 laTopLeft, laCenterLeft, laBottomLeft,
150 laTopCenter, laBottomCenter, // laCenterCenter makes no sense.
151 laTopRight, laCenterRight, laBottomRight);
152
153 TChartLegendDrawingData = record
154 FBounds: TRect;
155 FColCount: Integer;
156 FDrawer: IChartDrawer;
157 FItems: TChartLegendItems;
158 FItemSize: TPoint;
159 FRowCount: Integer;
160 end;
161
162 TLegendColumnCount = 1..MaxInt;
163 TLegendItemFillOrder = (lfoColRow, lfoRowCol);
164
165 TChartLegendGridPen = class(TChartPen)
166 published
167 property Visible default false;
168 end;
169
170 { TChartLegend }
171
172 TChartLegend = class(TChartElement)
173 strict private
174 FAlignment: TLegendAlignment;
175 FBackgroundBrush: TChartLegendBrush;
176 FColumnCount: TLegendColumnCount;
177 FFixedItemWidth: Cardinal;
178 FFixedItemHeight: Cardinal;
179 FFont: TFont;
180 FFrame: TChartPen;
181 FGridHorizontal: TChartLegendGridPen;
182 FGridVertical: TChartLegendGridPen;
183 FGroupFont: TFont;
184 FGroupTitles: TStrings;
185 FInverted: Boolean;
186 FItemFillOrder: TLegendItemFillOrder;
187 FLegendRect: TRect;
188 FMarginX: TChartDistance;
189 FMarginY: TChartDistance;
190 FSpacing: TChartDistance;
191 FSymbolFrame: TChartPen;
192 FSymbolWidth: TChartDistance;
193 FTextFormat: TChartTextFormat;
194 FTransparency: TChartTransparency;
195 FUseSidebar: Boolean;
196
197 // Not includes the margins around item.
MeasureItemnull198 function MeasureItem(
199 ADrawer: IChartDrawer; AItems: TChartLegendItems): TPoint;
200 procedure SetAlignment(AValue: TLegendAlignment);
201 procedure SetBackgroundBrush(AValue: TChartLegendBrush);
202 procedure SetColumnCount(AValue: TLegendColumnCount);
203 procedure SetFixedItemWidth(AValue: Cardinal);
204 procedure SetFixedItemHeight(AValue: Cardinal);
205 procedure SetFont(AValue: TFont);
206 procedure SetFrame(AValue: TChartPen);
207 procedure SetGridHorizontal(AValue: TChartLegendGridPen);
208 procedure SetGridVertical(AValue: TChartLegendGridPen);
209 procedure SetGroupFont(AValue: TFont);
210 procedure SetGroupTitles(AValue: TStrings);
211 procedure SetInverted(AValue: Boolean);
212 procedure SetItemFillOrder(AValue: TLegendItemFillOrder);
213 procedure SetMargin(AValue: TChartDistance);
214 procedure SetMarginX(AValue: TChartDistance);
215 procedure SetMarginY(AValue: TChartDistance);
216 procedure SetSpacing(AValue: TChartDistance);
217 procedure SetSymbolFrame(AValue: TChartPen);
218 procedure SetSymbolWidth(AValue: TChartDistance);
219 procedure SetTextFormat(AValue: TChartTextFormat);
220 procedure SetTransparency(AValue: TChartTransparency);
221 procedure SetUseSidebar(AValue: Boolean);
222 public
223 constructor Create(AOwner: TCustomChart);
224 destructor Destroy; override;
225 public
226 procedure AddGroups(AItems: TChartLegendItems);
227 procedure Assign(Source: TPersistent); override;
228 procedure Draw(var AData: TChartLegendDrawingData);
IsPointInBoundsnull229 function IsPointInBounds(APoint: TPoint): Boolean;
230 procedure Prepare(var AData: TChartLegendDrawingData; var AClipRect: TRect);
231 procedure SortItemsByOrder(AItems: TChartLegendItems);
232 procedure UpdateBidiMode;
233 published
234 property Alignment: TLegendAlignment
235 read FAlignment write SetAlignment default laTopRight;
236 property BackgroundBrush: TChartLegendBrush
237 read FBackgroundBrush write SetBackgroundBrush;
238 property ColumnCount: TLegendColumnCount
239 read FColumnCount write SetColumnCount default 1;
240 property FixedItemWidth: Cardinal
241 read FFixedItemWidth write SetFixedItemWidth default 0;
242 property FixedItemHeight: Cardinal
243 read FFixedItemHeight write SetFixedItemHeight default 0;
244 property Font: TFont read FFont write SetFont;
245 property Frame: TChartPen read FFrame write SetFrame;
246 property GridHorizontal: TChartLegendGridPen
247 read FGridHorizontal write SetGridHorizontal;
248 property GridVertical: TChartLegendGridPen
249 read FGridVertical write SetGridVertical;
250 property GroupFont: TFont read FGroupFont write SetGroupFont;
251 property GroupTitles: TStrings read FGroupTitles write SetGroupTitles;
252 property Inverted: Boolean read FInverted write SetInverted default false;
253 property ItemFillOrder: TLegendItemFillOrder
254 read FItemFillOrder write SetItemFillOrder default lfoColRow;
255 property MarginX: TChartDistance
256 read FMarginX write SetMarginX default DEF_LEGEND_MARGIN;
257 property MarginY: TChartDistance
258 read FMarginY write SetMarginY default DEF_LEGEND_MARGIN;
259 property Spacing: TChartDistance
260 read FSpacing write SetSpacing default DEF_LEGEND_SPACING;
261 property SymbolFrame: TChartPen read FSymbolFrame write SetSymbolFrame;
262 property SymbolWidth: TChartDistance
263 read FSymbolWidth write SetSymbolWidth default DEF_LEGEND_SYMBOL_WIDTH;
264 property TextFormat: TChartTextFormat
265 read FTextFormat write SetTextFormat default tfNormal;
266 property Transparency: TChartTransparency
267 read FTransparency write SetTransparency default 0;
268 property UseSidebar: Boolean read FUseSidebar write SetUseSidebar default true;
269 property Visible default false;
270 end;
271
272 TLegendMultiplicity = (lmSingle, lmPoint, lmStyle);
273
274 TLegendItemCreateEvent = procedure (
275 AItem: TLegendItem; AIndex: Integer) of object;
276
277 { TChartSeriesLegend }
278
279 TChartSeriesLegend = class(TChartElement)
280 strict private
281 FFormat: String;
282 FGroupIndex: Integer;
283 FMultiplicity: TLegendMultiplicity;
284 FOnCreate: TLegendItemCreateEvent;
285 FOnDraw: TLegendItemDrawEvent;
286 FOrder: Integer;
287 FTextFormat: TChartTextFormat;
288 FUserItemsCount: Integer;
289 procedure SetFormat(AValue: String);
290 procedure SetGroupIndex(AValue: Integer);
291 procedure SetMultiplicity(AValue: TLegendMultiplicity);
292 procedure SetOnCreate(AValue: TLegendItemCreateEvent);
293 procedure SetOnDraw(AValue: TLegendItemDrawEvent);
294 procedure SetOrder(AValue: Integer);
295 procedure SetTextFormat(AValue: TChartTextFormat);
296 procedure SetUserItemsCount(AValue: Integer);
297 public
298 constructor Create(AOwner: TCustomChart);
299 public
300 procedure Assign(Source: TPersistent); override;
301 procedure InitItem(
302 AItem: TLegendItem; AIndex: Integer; ALegend: TChartLegend);
303 published
304 property Format: String read FFormat write SetFormat;
305 property GroupIndex: Integer
306 read FGroupIndex write SetGroupIndex default LEGEND_ITEM_NO_GROUP;
307 property Multiplicity: TLegendMultiplicity
308 read FMultiplicity write SetMultiplicity default lmSingle;
309 property Order: Integer
310 read FOrder write SetOrder default LEGEND_ITEM_ORDER_AS_ADDED;
311 property TextFormat: TChartTextFormat
312 read FTextFormat write SetTextFormat default tfNormal;
313 property UserItemsCount: Integer
314 read FUserItemsCount write SetUserItemsCount default 1;
315 property Visible default true;
316
317 published
318 property OnCreate: TLegendItemCreateEvent read FOnCreate write SetOnCreate;
319 property OnDraw: TLegendItemDrawEvent read FOnDraw write SetOnDraw;
320 end;
321
322 implementation
323
324 uses
325 Math, PropEdits, Types, LResources,
326 TADrawerCanvas, TAGeometry;
327
328 const
329 SYMBOL_TEXT_SPACING = 4;
330
LegendItemComparenull331 function LegendItemCompare(AItem1, AItem2: Pointer): Integer;
332 var
333 li1: TLegendItem absolute AItem1;
334 li2: TLegendItem absolute AItem2;
335 begin
336 Result := Sign(li1.GroupIndex - li2.GroupIndex);
337 if Result = 0 then
338 Result := Sign(li1.Order - li2.Order);
339 end;
340
LegendItemCompare_Invertednull341 function LegendItemCompare_Inverted(AItem1, AItem2: Pointer): Integer;
342 var
343 li1: TLegendItem absolute AItem1;
344 li2: TLegendItem absolute AItem2;
345 begin
346 Result := Sign(li1.GroupIndex - li2.GroupIndex);
347 if Result = 0 then
348 Result := Sign(li2.Order - li1.Order);
349 end;
350
351 { TLegendItemsEnumerator }
352
GetCurrentnull353 function TLegendItemsEnumerator.GetCurrent: TLegendItem;
354 begin
355 Result := TLegendItem(inherited GetCurrent);
356 end;
357
358 { TChartLegendItems }
359
TChartLegendItems.GetEnumeratornull360 function TChartLegendItems.GetEnumerator: TLegendItemsEnumerator;
361 begin
362 Result := TLegendItemsEnumerator.Create(Self);
363 end;
364
GetItemnull365 function TChartLegendItems.GetItem(AIndex: Integer): TLegendItem;
366 begin
367 Result := TLegendItem(inherited GetItem(AIndex));
368 end;
369
370 procedure TChartLegendItems.SetItem(AIndex: Integer; AValue: TLegendItem);
371 begin
372 inherited SetItem(AIndex, AValue);
373 end;
374
375 { TChartLegendBrush }
376
377 constructor TChartLegendBrush.Create;
378 begin
379 inherited;
380 Color := clDefault;
381 end;
382
383
384 { TLegendItem }
385
386 constructor TLegendItem.Create(const AText: String; AColor: TColor);
387 begin
388 FColor := AColor;
389 FGroupIndex := LEGEND_ITEM_NO_GROUP;
390 FOrder := LEGEND_ITEM_ORDER_AS_ADDED;
391 FText := AText;
392 end;
393
394 procedure TLegendItem.Draw(ADrawer: IChartDrawer; const ARect: TRect);
395 var
396 symTextSpc: Integer;
397 begin
398 symTextSpc := ADrawer.Scale(SYMBOL_TEXT_SPACING);
399 if ADrawer.GetRightToLeft then
400 ADrawer.TextOut.
401 TextFormat(FTextFormat).
402 Pos(ARect.Left - symTextSpc - ADrawer.TextExtent(FText, FTextFormat).X, ARect.Top).
403 Text(FText).Done
404 else
405 ADrawer.TextOut.
406 TextFormat(FTextFormat).
407 Pos(ARect.Right + symTextSpc, ARect.Top).
408 Text(FText).Done;
409 end;
410
TLegendItem.HasSymbolnull411 function TLegendItem.HasSymbol: Boolean;
412 begin
413 Result := true;
414 end;
415
416 procedure TLegendItem.UpdateFont(ADrawer: IChartDrawer; var APrevFont: TFont);
417 begin
418 if APrevFont = Font then exit;
419 ADrawer.Font := Font;
420 APrevFont := Font;
421 end;
422
423 { TLegendItemGroupTitle }
424
425 procedure TLegendItemGroupTitle.Draw(ADrawer: IChartDrawer; const ARect: TRect);
426 begin
427 if ADrawer.GetRightToLeft then
428 ADrawer.TextOut.
429 TextFormat(TextFormat).
430 Pos(ARect.Right - ADrawer.TextExtent(Text, TextFormat).X, ARect.Top).
431 Text(Text).Done
432 else
433 ADrawer.TextOut.
434 TextFormat(TextFormat).
435 Pos(ARect.Left, ARect.Top).
436 Text(Text).Done;
437 end;
438
TLegendItemGroupTitle.HasSymbolnull439 function TLegendItemGroupTitle.HasSymbol: Boolean;
440 begin
441 Result := false;
442 end;
443
444 { TLegendItemUserDrawn }
445
446 constructor TLegendItemUserDrawn.Create(
447 AIndex: Integer; AOnDraw: TLegendItemDrawEvent; const AText: String);
448 begin
449 inherited Create(AText);
450 FIndex := AIndex;
451 FOnDraw := AOnDraw;
452 end;
453
454 procedure TLegendItemUserDrawn.Draw(ADrawer: IChartDrawer; const ARect: TRect);
455 var
456 ic: IChartTCanvasDrawer;
457 begin
458 if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(FOnDraw) then
459 FOnDraw(ic.Canvas, ARect, FIndex, Self);
460 inherited Draw(ADrawer, ARect);
461 end;
462
463 { TLegendItemLine }
464
465 constructor TLegendItemLine.Create(APen: TFPCustomPen; const AText: String);
466 begin
467 inherited Create(AText);
468 FPen := APen;
469 end;
470
471 procedure TLegendItemLine.Draw(ADrawer: IChartDrawer; const ARect: TRect);
472 var
473 y: Integer;
474 begin
475 inherited Draw(ADrawer, ARect);
476 if FPen = nil then exit;
477 ADrawer.Pen := FPen;
478 y := (ARect.Top + ARect.Bottom) div 2;
479 ADrawer.Line(ARect.Left, y, ARect.Right, y);
480 end;
481
482 { TLegendItemLinePointer }
483
484 constructor TLegendItemLinePointer.Create(
485 APen: TPen; APointer: TSeriesPointer; const AText: String);
486 begin
487 inherited Create(APen, AText);
488 FPointer := APointer;
489 end;
490
491 constructor TLegendItemLinePointer.CreateWithBrush(
492 APen: TPen; ABrush: TBrush; APointer: TSeriesPointer; const AText: String);
493 begin
494 Create(APen, APointer, AText);
495 FBrush := ABrush;
496 FPresetBrush := true;
497 end;
498
499 procedure TLegendItemLinePointer.Draw(
500 ADrawer: IChartDrawer; const ARect: TRect);
501 var
502 c, sz: TPoint;
503 begin
504 inherited Draw(ADrawer, ARect);
505 if FPointer = nil then exit;
506 c := CenterPoint(ARect);
507 // Max width slightly narrower then ARect to leave place for the line.
508 sz.X := Min(ADrawer.Scale(FPointer.HorizSize), (ARect.Right - ARect.Left) div 3);
509 sz.Y := Min(ADrawer.Scale(FPointer.VertSize), (ARect.Bottom - ARect.Top) div 2);
510 if FPresetBrush then
511 ADrawer.SetBrush(FBrush);
512 FPointer.DrawSize(ADrawer, c, sz, Color, 0.0, FPresetBrush);
513 end;
514
515 { TLegendItemBrushRect }
516
517 constructor TLegendItemBrushRect.Create(
518 ABrush: TFPCustomBrush; const AText: String);
519 begin
520 inherited Create(AText);
521 FBrush := ABrush;
522 end;
523
524 procedure TLegendItemBrushRect.Draw(ADrawer: IChartDrawer; const ARect: TRect);
525 begin
526 inherited Draw(ADrawer, ARect);
527 if FBrush = nil then
528 ADrawer.SetBrushParams(bsSolid, ColorDef(Color, clRed))
529 else begin
530 ADrawer.Brush := FBrush;
531 if Color <> clTAColor then
532 ADrawer.SetBrushParams(FBrush.Style, Color);
533 end;
534 ADrawer.Rectangle(ARect);
535 end;
536
537 { TLegendItemBrushPenRect }
538
539 constructor TLegendItemBrushPenRect.Create(
540 ABrush: TFPCustomBrush; APen: TFPCustomPen; const AText: String);
541 begin
542 inherited Create(ABrush, AText);
543 FPen := APen;
544 end;
545
546 procedure TLegendItemBrushPenRect.Draw(ADrawer: IChartDrawer; const ARect: TRect);
547 begin
548 ADrawer.Pen := FPen;
549 inherited Draw(ADrawer, ARect);
550 end;
551
552 { TChartLegend }
553
554 procedure TChartLegend.AddGroups(AItems: TChartLegendItems);
555 var
556 i, gi: Integer;
557 g: TLegendItemGroupTitle;
558 begin
559 for i := AItems.Count - 1 downto 0 do begin
560 gi := AItems[i].GroupIndex;
561 if
562 InRange(gi, 0, GroupTitles.Count - 1) and
563 ((i = 0) or (AItems[i - 1].GroupIndex <> gi))
564 then begin
565 g := TLegendItemGroupTitle.Create(GroupTitles[gi]);
566 g.GroupIndex := gi;
567 g.Font := GroupFont;
568 g.TextFormat := FTextFormat;
569 AItems.Insert(i, g);
570 end;
571 end;
572 end;
573
574 procedure TChartLegend.Assign(Source: TPersistent);
575 begin
576 if Source is TChartLegend then
577 with TChartLegend(Source) do begin
578 Self.FAlignment := Alignment;
579 Self.FBackgroundBrush.Assign(BackgroundBrush);
580 Self.FColumnCount := ColumnCount;
581 Self.FFixedItemWidth := FixedItemWidth;
582 Self.FFixedItemHeight := FixedItemHeight;
583 Self.FFont.Assign(Font);
584 Self.FFrame.Assign(Frame);
585 Self.FGridHorizontal.Assign(GridHorizontal);
586 Self.FGridVertical.Assign(GridVertical);
587 Self.FGroupFont.Assign(GroupFont);
588 Self.FGroupTitles.Assign(GroupTitles);
589 Self.FMarginX := MarginX;
590 Self.FMarginY := MarginY;
591 Self.FSpacing := Spacing;
592 Self.FSymbolFrame.Assign(SymbolFrame);
593 Self.FSymbolWidth := SymbolWidth;
594 Self.FTextFormat := TextFormat;
595 Self.FUseSidebar := UseSidebar;
596 end;
597
598 inherited Assign(Source);
599 end;
600
601 constructor TChartLegend.Create(AOwner: TCustomChart);
602 begin
603 inherited Create(AOwner);
604 FAlignment := laTopRight;
605 FColumnCount := 1;
606 FGridHorizontal := TChartLegendGridPen.Create;
607 FGridHorizontal.OnChange := @StyleChanged;
608 FGridVertical := TChartLegendGridPen.Create;
609 FGridVertical.OnChange := @StyleChanged;
610 FGroupTitles := TStringList.Create;
611 FMarginX := DEF_LEGEND_MARGIN;
612 FMarginY := DEF_LEGEND_MARGIN;
613 FSpacing := DEF_LEGEND_SPACING;
614 FSymbolWidth := DEF_LEGEND_SYMBOL_WIDTH;
615 FUseSidebar := true;
616 Visible := false;
617
618 InitHelper(FBackgroundBrush, TChartLegendBrush);
619 InitHelper(FFont, TFont);
620 InitHelper(FFrame, TChartPen);
621 InitHelper(FGroupFont, TFont);
622 InitHelper(FSymbolFrame, TChartPen);
623 end;
624
625 destructor TChartLegend.Destroy;
626 begin
627 FreeAndNil(FBackgroundBrush);
628 FreeAndNil(FFont);
629 FreeAndNil(FFrame);
630 FreeAndNil(FGridHorizontal);
631 FreeAndNil(FGridVertical);
632 FreeAndNil(FGroupFont);
633 FreeAndNil(FGroupTitles);
634 FreeAndNil(FSymbolFrame);
635
636 inherited;
637 end;
638
639 procedure TChartLegend.Draw(var AData: TChartLegendDrawingData);
640 var
641 drawer: IChartDrawer;
642
643 procedure DrawItems;
644 var
645 i, x, y: Integer;
646 prevFont: TFont = nil;
647 r: TRect;
648 isRTL: Boolean;
649 space, symwid: Integer;
650 begin
651 isRTL := drawer.GetRightToLeft;
652 with AData do begin
653 space := FDrawer.Scale(Spacing);
654 symwid := FDrawer.Scale(SymbolWidth);
655 for i := 0 to FItems.Count - 1 do begin
656 FItems[i].TextFormat := FTextFormat;
657 FItems[i].UpdateFont(drawer, prevFont);
658 drawer.Brush := BackgroundBrush;
659 if SymbolFrame.Visible then
660 drawer.Pen := SymbolFrame
661 else
662 drawer.SetPenParams(psClear, clTAColor);
663 x := 0;
664 y := 0;
665 case ItemFillOrder of
666 lfoColRow: DivMod(i, FRowCount, x, y);
667 lfoRowCol: DivMod(i, FColCount, y, x);
668 end;
669 if isRTL then
670 r := Bounds(
671 FBounds.Right - space - x * (FItemSize.X + space) - symwid,
672 FBounds.Top + space + y * (FItemSize.Y + space),
673 symwid,
674 FItemSize.Y)
675 else
676 r := Bounds(
677 FBounds.Left + space + x * (FItemSize.X + space),
678 FBounds.Top + space + y * (FItemSize.Y + space),
679 symwid,
680 FItemSize.Y);
681 FItems[i].Draw(drawer, r);
682 OffsetRect(r, 0, FItemSize.Y + space);
683 end;
684 if GridHorizontal.EffVisible then begin
685 drawer.Pen := GridHorizontal;
686 drawer.SetBrushParams(bsClear, clTAColor);
687 for i := 1 to FRowCount - 1 do begin
688 y := FBounds.Top + space div 2 + i * (FItemSize.Y + space);
689 drawer.Line(FBounds.Left, y, FBounds.Right, y);
690 end;
691 end;
692 if GridVertical.EffVisible then begin
693 drawer.Pen := GridVertical;
694 drawer.SetBrushParams(bsClear, clTAColor);
695 for i := 1 to FColCount - 1 do begin
696 x := FBounds.Left + space div 2 + i * (FItemSize.X + space);
697 drawer.Line(x, FBounds.Top, x, FBounds.Bottom);
698 end;
699 end;
700 end;
701 end;
702
703 var
704 r: TRect;
705 begin
706 drawer := AData.FDrawer;
707 drawer.SetTransparency(Transparency);
708 try
709 drawer.Brush := BackgroundBrush;
710 if BackgroundBrush.Color = clDefault then
711 drawer.SetBrushColor(ColorToRGB(FOwner.GetDefaultColor(dctBrush)));
712 if Frame.Visible then begin
713 drawer.Pen := Frame;
714 if Frame.Color = clDefault then
715 drawer.SetPenColor(ColorToRGB(FOwner.GetDefaultColor(dctFont)));
716 end else
717 drawer.SetPenParams(psClear, clTAColor);
718 r := AData.FBounds;
719 drawer.Rectangle(r);
720 if AData.FItems.Count = 0 then exit;
721
722 r.Right -= 1;
723 drawer.ClippingStart(r);
724 try
725 DrawItems;
726 finally
727 drawer.ClippingStop;
728 end;
729 finally
730 drawer.SetTransparency(0);
731 end;
732 end;
733
MeasureItemnull734 function TChartLegend.MeasureItem(
735 ADrawer: IChartDrawer; AItems: TChartLegendItems): TPoint;
736 var
737 p: TPoint;
738 prevFont: TFont = nil;
739 li: TLegendItem;
740 begin
741 Result := Point(0, 0);
742 if (FixedItemWidth <= 0) or (FixedItemHeight <= 0) then
743 for li in AItems do begin
744 li.UpdateFont(ADrawer, prevFont);
745 if li.Text = '' then
746 p := Point(0, ADrawer.TextExtent('I', FTextFormat).Y)
747 else
748 p := ADrawer.TextExtent(li.Text, FTextFormat);
749 if li.HasSymbol then
750 p.X += ADrawer.Scale(SYMBOL_TEXT_SPACING + SymbolWidth);
751 Result := MaxPoint(p, Result);
752 end;
753 if FixedItemWidth > 0 then
754 Result.X := ADrawer.Scale(FixedItemWidth);
755 if FixedItemHeight > 0 then
756 Result.Y := ADrawer.Scale(FixedItemHeight);
757 end;
758
TChartLegend.IsPointInBoundsnull759 function TChartLegend.IsPointInBounds(APoint: TPoint): Boolean;
760 begin
761 Result := IsPointInRect(APoint, FLegendRect);
762 end;
763
764 procedure TChartLegend.Prepare(
765 var AData: TChartLegendDrawingData; var AClipRect: TRect);
766 var
767 x, y: Integer;
768 sidebar, legendSize: TPoint;
769 margX, margY, space: Integer;
770 begin
771 with AData do begin
772 margX := FDrawer.Scale(MarginX);
773 margY := FDrawer.Scale(MarginY);
774 space := FDrawer.Scale(Spacing);
775 FColCount := Max(Min(ColumnCount, FItems.Count), 1);
776 FRowCount := (FItems.Count - 1) div FColCount + 1;
777 FItemSize := MeasureItem(FDrawer, FItems);
778 legendSize.X := (FItemSize.X + space) * FColCount + space;
779 legendSize.Y := (FItemSize.Y + space) * FRowCount + space;
780 end;
781
782 sidebar.X := 2 * margX;
783 with AClipRect do
784 legendSize.X := EnsureRange(legendSize.X, 0, Right - Left - sidebar.X);
785 sidebar.X += legendSize.X;
786
787 sidebar.Y := 2 * margX;
788 with AClipRect do
789 legendSize.Y := EnsureRange(legendSize.Y, 0, Bottom - Top - sidebar.Y);
790 sidebar.Y += legendSize.Y;
791
792 // Determine position according to the alignment.
793 case Alignment of
794 laTopLeft, laCenterLeft, laBottomLeft:
795 x := AClipRect.Left + margX;
796 laTopRight, laCenterRight, laBottomRight:
797 x := AClipRect.Right - legendSize.X - margX;
798 laTopCenter, laBottomCenter:
799 x := (AClipRect.Right + AClipRect.Left - legendSize.X) div 2;
800 end;
801 case Alignment of
802 laTopLeft, laTopCenter, laTopRight:
803 y := AClipRect.Top + margY;
804 laBottomLeft, laBottomCenter, laBottomRight:
805 y := AClipRect.Bottom - margY - legendSize.Y;
806 laCenterLeft, laCenterRight:
807 y := (AClipRect.Top + AClipRect.Bottom - legendSize.Y) div 2;
808 end;
809 if UseSidebar then
810 case Alignment of
811 laTopLeft, laCenterLeft, laBottomLeft:
812 AClipRect.Left += sidebar.X;
813 laTopRight, laCenterRight, laBottomRight:
814 AClipRect.Right -= sidebar.X;
815 laTopCenter:
816 AClipRect.Top += legendSize.Y + 2 * margY;
817 laBottomCenter:
818 AClipRect.Bottom -= legendSize.Y + 2 * margY;
819 end;
820 AData.FBounds := Bounds(x, y, legendSize.X, legendSize.Y);
821 FLegendRect := Rect(x, y, x + legendSize.X, y + legendSize.Y);
822 end;
823
824 procedure TChartLegend.SetAlignment(AValue: TLegendAlignment);
825 begin
826 if FAlignment = AValue then exit;
827 FAlignment := AValue;
828 StyleChanged(Self);
829 end;
830
831 procedure TChartLegend.SetBackgroundBrush(AValue: TChartLegendBrush);
832 begin
833 FBackgroundBrush.Assign(AValue);
834 StyleChanged(Self);
835 end;
836
837 procedure TChartLegend.SetColumnCount(AValue: TLegendColumnCount);
838 begin
839 if FColumnCount = AValue then exit;
840 FColumnCount := AValue;
841 StyleChanged(Self);
842 end;
843
844 procedure TChartLegend.SetFixedItemWidth(AValue: Cardinal);
845 begin
846 if FFixedItemWidth = AValue then exit;
847 FFixedItemWidth := AValue;
848 StyleChanged(Self);
849 end;
850
851 procedure TChartLegend.SetFixedItemHeight(AValue: Cardinal);
852 begin
853 if FFixedItemHeight = AValue then exit;
854 FFixedItemHeight := AValue;
855 StyleChanged(Self);
856 end;
857
858 procedure TChartLegend.SetFont(AValue: TFont);
859 begin
860 FFont.Assign(AValue);
861 StyleChanged(Self);
862 end;
863
864 procedure TChartLegend.SetFrame(AValue: TChartPen);
865 begin
866 FFrame.Assign(AValue);
867 StyleChanged(Self);
868 end;
869
870 procedure TChartLegend.SetGridHorizontal(AValue: TChartLegendGridPen);
871 begin
872 if FGridHorizontal = AValue then exit;
873 FGridHorizontal.Assign(AValue);
874 StyleChanged(Self);
875 end;
876
877 procedure TChartLegend.SetGridVertical(AValue: TChartLegendGridPen);
878 begin
879 if FGridVertical = AValue then exit;
880 FGridVertical.Assign(AValue);
881 StyleChanged(Self);
882 end;
883
884 procedure TChartLegend.SetGroupFont(AValue: TFont);
885 begin
886 FGroupFont.Assign(AValue);
887 StyleChanged(Self);
888 end;
889
890 procedure TChartLegend.SetGroupTitles(AValue: TStrings);
891 begin
892 FGroupTitles.Assign(AValue);
893 StyleChanged(Self);
894 end;
895
896 procedure TChartLegend.SetInverted(AValue: Boolean);
897 begin
898 if FInverted = AValue then exit;
899 FInverted := AValue;
900 StyleChanged(Self);
901 end;
902
903 procedure TChartLegend.SetItemFillOrder(AValue: TLegendItemFillOrder);
904 begin
905 if FItemFillOrder = AValue then exit;
906 FItemFillOrder := AValue;
907 StyleChanged(Self);
908 end;
909
910 procedure TChartLegend.SetMargin(AValue: TChartDistance);
911 begin
912 SetMarginX(AValue);
913 SetMarginY(AValue);
914 end;
915
916 procedure TChartLegend.SetMarginX(AValue: TChartDistance);
917 begin
918 if FMarginX = AValue then exit;
919 FMarginX := AValue;
920 StyleChanged(Self);
921 end;
922
923 procedure TChartLegend.SetMarginY(AValue: TChartDistance);
924 begin
925 if FMarginY = AValue then exit;
926 FMarginY := AValue;
927 StyleChanged(Self);
928 end;
929
930 procedure TChartLegend.SetSpacing(AValue: TChartDistance);
931 begin
932 if FSpacing = AValue then exit;
933 FSpacing := AValue;
934 StyleChanged(Self);
935 end;
936
937 procedure TChartLegend.SetSymbolFrame(AValue: TChartPen);
938 begin
939 if FSymbolFrame = AValue then exit;
940 FSymbolFrame := AValue;
941 StyleChanged(Self);
942 end;
943
944 procedure TChartLegend.SetSymbolWidth(AValue: TChartDistance);
945 begin
946 if FSymbolWidth = AValue then exit;
947 FSymbolWidth := AValue;
948 StyleChanged(Self);
949 end;
950
951 procedure TChartLegend.SetTextFormat(AValue: TChartTextFormat);
952 begin
953 if FTextFormat = AValue then exit;
954 FTextFormat := AValue;
955 StyleChanged(self);
956 end;
957
958 procedure TChartLegend.SetTransparency(AValue: TChartTransparency);
959 begin
960 if FTransparency = AValue then exit;
961 FTransparency := AValue;
962 StyleChanged(Self);
963 end;
964
965 procedure TChartLegend.SetUseSidebar(AValue: Boolean);
966 begin
967 if FUseSidebar = AValue then exit;
968 FUseSidebar := AValue;
969 StyleChanged(Self);
970 end;
971
972 procedure TChartLegend.SortItemsByOrder(AItems: TChartLegendItems);
973 var
974 i: Integer;
975 j: Integer = MaxInt;
976 begin
977 for i := AItems.Count - 1 downto 0 do
978 if AItems[i].Order = LEGEND_ITEM_ORDER_AS_ADDED then begin
979 AItems[i].Order := j;
980 j -= 1;
981 end;
982 if FInverted then
983 AItems.Sort(@LegendItemCompare_Inverted)
984 else
985 AItems.Sort(@LegendItemCompare);
986 end;
987
988 procedure TChartLegend.UpdateBidiMode;
989 begin
990 case Alignment of
991 laTopLeft : Alignment := laTopRight;
992 laCenterLeft : Alignment := laCenterRight;
993 laBottomLeft : Alignment := laBottomRight;
994 laTopRight : Alignment := laTopLeft;
995 laCenterRight : Alignment := laCenterLeft;
996 laBottomRight : Alignment := laBottomLeft;
997 else ;
998 end;
999 end;
1000
1001
1002 { TChartSeriesLegend }
1003
1004 procedure TChartSeriesLegend.Assign(Source: TPersistent);
1005 begin
1006 if Source is TChartSeriesLegend then
1007 with TChartSeriesLegend(Source) do begin
1008 Self.FFormat := FFormat;
1009 Self.FGroupIndex := FGroupIndex;
1010 Self.FMultiplicity := FMultiplicity;
1011 Self.FOnDraw := FOnDraw;
1012 Self.FOrder := FOrder;
1013 Self.FTextFormat := FTextFormat;
1014 Self.FUserItemsCount := FUserItemsCount;
1015 Self.FVisible := FVisible;
1016 end;
1017
1018 inherited Assign(Source);
1019 end;
1020
1021 constructor TChartSeriesLegend.Create(AOwner: TCustomChart);
1022 begin
1023 inherited Create(AOwner);
1024 FGroupIndex := LEGEND_ITEM_NO_GROUP;
1025 FOrder := LEGEND_ITEM_ORDER_AS_ADDED;
1026 FVisible := true;
1027 FUserItemsCount := 1;
1028 end;
1029
1030 procedure TChartSeriesLegend.InitItem(
1031 AItem: TLegendItem; AIndex: Integer; ALegend: TChartLegend);
1032 begin
1033 if Assigned(OnCreate) then
1034 OnCreate(AItem, AIndex);
1035 if AItem.Font = nil then
1036 AItem.Font := ALegend.Font;
1037 if AItem.GroupIndex = LEGEND_ITEM_NO_GROUP then
1038 AItem.GroupIndex := GroupIndex;
1039 if AItem.Order = LEGEND_ITEM_ORDER_AS_ADDED then
1040 AItem.Order := Order;
1041 AItem.TextFormat := ALegend.TextFormat;
1042 end;
1043
1044 procedure TChartSeriesLegend.SetFormat(AValue: String);
1045 begin
1046 if FFormat = AValue then exit;
1047 FFormat := AValue;
1048 StyleChanged(Self);
1049 end;
1050
1051 procedure TChartSeriesLegend.SetGroupIndex(AValue: Integer);
1052 begin
1053 if FGroupIndex = AValue then exit;
1054 FGroupIndex := AValue;
1055 StyleChanged(Self);
1056 end;
1057
1058 procedure TChartSeriesLegend.SetMultiplicity(AValue: TLegendMultiplicity);
1059 begin
1060 if FMultiplicity = AValue then exit;
1061 FMultiplicity := AValue;
1062 StyleChanged(Self);
1063 end;
1064
1065 procedure TChartSeriesLegend.SetOnDraw(AValue: TLegendItemDrawEvent);
1066 begin
1067 if TMethod(FOnDraw) = TMethod(AValue) then exit;
1068 FOnDraw := AValue;
1069 StyleChanged(Self);
1070 end;
1071
1072 procedure TChartSeriesLegend.SetOnCreate(AValue: TLegendItemCreateEvent);
1073 begin
1074 if TMethod(FOnCreate) = TMethod(AValue) then exit;
1075 FOnCreate := AValue;
1076 StyleChanged(Self);
1077 end;
1078
1079 procedure TChartSeriesLegend.SetOrder(AValue: Integer);
1080 begin
1081 if FOrder = AValue then exit;
1082 FOrder := AValue;
1083 StyleChanged(Self);
1084 end;
1085
1086 procedure TChartSeriesLegend.SetTextFormat(AValue: TChartTextFormat);
1087 begin
1088 if FTextFormat = AValue then exit;
1089 FTextFormat := AValue;
1090 StyleChanged(Self);
1091 end;
1092
1093 procedure TChartSeriesLegend.SetUserItemsCount(AValue: Integer);
1094 begin
1095 if FUserItemsCount = AValue then exit;
1096 FUserItemsCount := AValue;
1097 StyleChanged(Self);
1098 end;
1099
1100 procedure SkipObsoleteProperties;
1101 const
1102 MARGIN_NOTE = 'Obsolete, use Legend.MarginX instead';
1103 begin
1104 RegisterPropertyToSkip(TChartLegend, 'Margin', MARGIN_NOTE, '');
1105 end;
1106
1107 initialization
1108 SkipObsoleteProperties;
1109
1110 end.
1111
1112