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