{ ***************************************************************************** See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** Authors: Alexander Klenin } unit TALegend; {$MODE ObjFPC}{$H+} interface uses Classes, Contnrs, FPCanvas, Graphics, SysUtils, TAChartUtils, TADrawUtils, TATypes; const DEF_LEGEND_SPACING = 4; DEF_LEGEND_MARGIN = 4; DEF_LEGEND_SYMBOL_WIDTH = 20; LEGEND_ITEM_ORDER_AS_ADDED = -1; LEGEND_ITEM_NO_GROUP = -1; type { TLegendItem } TLegendItem = class strict private FColor: TColor; FFont: TFont; FGroupIndex: Integer; FOrder: Integer; FOwner: TIndexedComponent; FText: String; FTextFormat: TChartTextFormat; public constructor Create(const AText: String; AColor: TColor = clTAColor); procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); virtual; function HasSymbol: Boolean; virtual; procedure UpdateFont(ADrawer: IChartDrawer; var APrevFont: TFont); public property Color: TColor read FColor write FColor; property Font: TFont read FFont write FFont; property GroupIndex: Integer read FGroupIndex write FGroupIndex; property Order: Integer read FOrder write FOrder; property Owner: TIndexedComponent read FOwner write FOwner; property Text: String read FText write FText; property TextFormat: TChartTextFormat read FTextFormat write FTextFormat; end; { TLegendItemGroupTitle } TLegendItemGroupTitle = class(TLegendItem) public procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override; function HasSymbol: Boolean; override; end; TLegendItemDrawEvent = procedure ( ACanvas: TCanvas; const ARect: TRect; AIndex: Integer; AItem: TLegendItem ) of object; { TLegendItemUserDrawn } TLegendItemUserDrawn = class(TLegendItem) strict private FIndex: Integer; FOnDraw: TLegendItemDrawEvent; public constructor Create( AIndex: Integer; AOnDraw: TLegendItemDrawEvent; const AText: String); procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override; property OnDraw: TLegendItemDrawEvent read FOnDraw; end; { TLegendItemLine } TLegendItemLine = class(TLegendItem) strict protected FPen: TFPCustomPen; public constructor Create(APen: TFPCustomPen; const AText: String); procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override; end; { TLegendItemLinePointer } TLegendItemLinePointer = class(TLegendItemLine) strict protected FPointer: TSeriesPointer; FBrush: TBrush; FPresetBrush: Boolean; public constructor Create( APen: TPen; APointer: TSeriesPointer; const AText: String); constructor CreateWithBrush( APen: TPen; ABrush: TBrush; APointer: TSeriesPointer; const AText: String); procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override; end; { TLegendItemLinePointerBrush } { Draws a line with APen, a pointer on the line, and the area below the line is filled with ABrush } TLegendItemLinePointerBrush = class(TLegendItemLinePointer) strict protected FAreaBrush: TBrush; public constructor Create(APen: TPen; ABrush: TBrush; APointer: TSeriesPointer; const AText: String; AreaBrush: TBrush = nil); procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override; end; { TLegendItemBrushRect } TLegendItemBrushRect = class(TLegendItem) strict private FBrush: TFPCustomBrush; public constructor Create(ABrush: TFPCustomBrush; const AText: String); procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override; end; { TLegendItemBrushPenRect } TLegendItemBrushPenRect = class(TLegendItemBrushRect) strict private FPen: TFPCustomPen; public constructor Create(ABrush: TFPCustomBrush; APen: TFPCustomPen; const AText: String); procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override; end; TLegendItemsEnumerator = class(TListEnumerator) public function GetCurrent: TLegendItem; property Current: TLegendItem read GetCurrent; end; { TChartLegendItems } TChartLegendItems = class(TObjectList) strict private function GetItem(AIndex: Integer): TLegendItem; procedure SetItem(AIndex: Integer; AValue: TLegendItem); public function GetEnumerator: TLegendItemsEnumerator; property Items[AIndex: Integer]: TLegendItem read GetItem write SetItem; default; end; TChartLegendBrush = class(TBrush) published constructor Create; override; property Color default clDefault; end; TLegendAlignment = ( laTopLeft, laCenterLeft, laBottomLeft, laTopCenter, laBottomCenter, // laCenterCenter makes no sense. laTopRight, laCenterRight, laBottomRight); TChartLegendDrawingData = record FBounds: TRect; FColCount: Integer; FDrawer: IChartDrawer; FItems: TChartLegendItems; FItemSize: TPoint; FRowCount: Integer; end; TLegendColumnCount = 0..MaxInt; TLegendItemFillOrder = (lfoColRow, lfoRowCol); TChartLegendGridPen = class(TChartPen) published property Visible default false; end; { TChartLegend } TChartLegend = class(TChartElement) strict private FAlignment: TLegendAlignment; FBackgroundBrush: TChartLegendBrush; FColCount: Integer; FColumnCount: TLegendColumnCount; FFixedItemWidth: Cardinal; FFixedItemHeight: Cardinal; FFont: TFont; FFrame: TChartPen; FGridHorizontal: TChartLegendGridPen; FGridVertical: TChartLegendGridPen; FGroupFont: TFont; FGroupTitles: TStrings; FInverted: Boolean; FItemFillOrder: TLegendItemFillOrder; FItemSize: TPoint; FLegendRect: TRect; FMarginX: TChartDistance; FMarginY: TChartDistance; FRowCount: Integer; FSpacing: TChartDistance; FSymbolFrame: TChartPen; FSymbolWidth: TChartDistance; FTextFormat: TChartTextFormat; FTransparency: TChartTransparency; FUseSidebar: Boolean; // Not includes the margins around item. function MeasureItem( ADrawer: IChartDrawer; AItems: TChartLegendItems): TPoint; procedure SetAlignment(AValue: TLegendAlignment); procedure SetBackgroundBrush(AValue: TChartLegendBrush); procedure SetColumnCount(AValue: TLegendColumnCount); procedure SetFixedItemWidth(AValue: Cardinal); procedure SetFixedItemHeight(AValue: Cardinal); procedure SetFont(AValue: TFont); procedure SetFrame(AValue: TChartPen); procedure SetGridHorizontal(AValue: TChartLegendGridPen); procedure SetGridVertical(AValue: TChartLegendGridPen); procedure SetGroupFont(AValue: TFont); procedure SetGroupTitles(AValue: TStrings); procedure SetInverted(AValue: Boolean); procedure SetItemFillOrder(AValue: TLegendItemFillOrder); procedure SetMargin(AValue: TChartDistance); procedure SetMarginX(AValue: TChartDistance); procedure SetMarginY(AValue: TChartDistance); procedure SetSpacing(AValue: TChartDistance); procedure SetSymbolFrame(AValue: TChartPen); procedure SetSymbolWidth(AValue: TChartDistance); procedure SetTextFormat(AValue: TChartTextFormat); procedure SetTransparency(AValue: TChartTransparency); procedure SetUseSidebar(AValue: Boolean); public constructor Create(AOwner: TCustomChart); destructor Destroy; override; public procedure AddGroups(AItems: TChartLegendItems); procedure Assign(Source: TPersistent); override; procedure Draw(var AData: TChartLegendDrawingData); function IsPointInBounds(APoint: TPoint): Boolean; function ItemClicked(ADrawer: IChartDrawer; APoint: TPoint; AItems: TChartLegendItems): Integer; procedure Prepare(var AData: TChartLegendDrawingData; var AClipRect: TRect); procedure SortItemsByOrder(AItems: TChartLegendItems); procedure UpdateBidiMode; published property Alignment: TLegendAlignment read FAlignment write SetAlignment default laTopRight; property BackgroundBrush: TChartLegendBrush read FBackgroundBrush write SetBackgroundBrush; property ColumnCount: TLegendColumnCount read FColumnCount write SetColumnCount default 1; property FixedItemWidth: Cardinal read FFixedItemWidth write SetFixedItemWidth default 0; property FixedItemHeight: Cardinal read FFixedItemHeight write SetFixedItemHeight default 0; property Font: TFont read FFont write SetFont; property Frame: TChartPen read FFrame write SetFrame; property GridHorizontal: TChartLegendGridPen read FGridHorizontal write SetGridHorizontal; property GridVertical: TChartLegendGridPen read FGridVertical write SetGridVertical; property GroupFont: TFont read FGroupFont write SetGroupFont; property GroupTitles: TStrings read FGroupTitles write SetGroupTitles; property Inverted: Boolean read FInverted write SetInverted default false; property ItemFillOrder: TLegendItemFillOrder read FItemFillOrder write SetItemFillOrder default lfoColRow; property MarginX: TChartDistance read FMarginX write SetMarginX default DEF_LEGEND_MARGIN; property MarginY: TChartDistance read FMarginY write SetMarginY default DEF_LEGEND_MARGIN; property Spacing: TChartDistance read FSpacing write SetSpacing default DEF_LEGEND_SPACING; property SymbolFrame: TChartPen read FSymbolFrame write SetSymbolFrame; property SymbolWidth: TChartDistance read FSymbolWidth write SetSymbolWidth default DEF_LEGEND_SYMBOL_WIDTH; property TextFormat: TChartTextFormat read FTextFormat write SetTextFormat default tfNormal; property Transparency: TChartTransparency read FTransparency write SetTransparency default 0; property UseSidebar: Boolean read FUseSidebar write SetUseSidebar default true; property Visible default false; end; TLegendMultiplicity = (lmSingle, lmPoint, lmStyle); TLegendItemCreateEvent = procedure ( AItem: TLegendItem; AIndex: Integer) of object; { TChartSeriesLegend } TChartSeriesLegend = class(TChartElement) strict private FFormat: String; FGroupIndex: Integer; FMultiplicity: TLegendMultiplicity; FOnCreate: TLegendItemCreateEvent; FOnDraw: TLegendItemDrawEvent; FOrder: Integer; FTextFormat: TChartTextFormat; FUserItemsCount: Integer; procedure SetFormat(AValue: String); procedure SetGroupIndex(AValue: Integer); procedure SetMultiplicity(AValue: TLegendMultiplicity); procedure SetOnCreate(AValue: TLegendItemCreateEvent); procedure SetOnDraw(AValue: TLegendItemDrawEvent); procedure SetOrder(AValue: Integer); procedure SetTextFormat(AValue: TChartTextFormat); procedure SetUserItemsCount(AValue: Integer); public constructor Create(AOwner: TCustomChart); public procedure Assign(Source: TPersistent); override; procedure InitItem( AItem: TLegendItem; AIndex: Integer; ALegend: TChartLegend); published property Format: String read FFormat write SetFormat; property GroupIndex: Integer read FGroupIndex write SetGroupIndex default LEGEND_ITEM_NO_GROUP; property Multiplicity: TLegendMultiplicity read FMultiplicity write SetMultiplicity default lmSingle; property Order: Integer read FOrder write SetOrder default LEGEND_ITEM_ORDER_AS_ADDED; property TextFormat: TChartTextFormat read FTextFormat write SetTextFormat default tfNormal; property UserItemsCount: Integer read FUserItemsCount write SetUserItemsCount default 1; property Visible default true; published property OnCreate: TLegendItemCreateEvent read FOnCreate write SetOnCreate; property OnDraw: TLegendItemDrawEvent read FOnDraw write SetOnDraw; end; implementation uses Math, PropEdits, Types, LResources, TADrawerCanvas, TAGeometry; const SYMBOL_TEXT_SPACING = 4; function LegendItemCompare(AItem1, AItem2: Pointer): Integer; var li1: TLegendItem absolute AItem1; li2: TLegendItem absolute AItem2; begin Result := Sign(li1.GroupIndex - li2.GroupIndex); if Result = 0 then Result := Sign(li1.Order - li2.Order); end; function LegendItemCompare_Inverted(AItem1, AItem2: Pointer): Integer; var li1: TLegendItem absolute AItem1; li2: TLegendItem absolute AItem2; begin Result := Sign(li1.GroupIndex - li2.GroupIndex); if Result = 0 then Result := Sign(li2.Order - li1.Order); end; { TLegendItemsEnumerator } function TLegendItemsEnumerator.GetCurrent: TLegendItem; begin Result := TLegendItem(inherited GetCurrent); end; { TChartLegendItems } function TChartLegendItems.GetEnumerator: TLegendItemsEnumerator; begin Result := TLegendItemsEnumerator.Create(Self); end; function TChartLegendItems.GetItem(AIndex: Integer): TLegendItem; begin Result := TLegendItem(inherited GetItem(AIndex)); end; procedure TChartLegendItems.SetItem(AIndex: Integer; AValue: TLegendItem); begin inherited SetItem(AIndex, AValue); end; { TChartLegendBrush } constructor TChartLegendBrush.Create; begin inherited; Color := clDefault; end; { TLegendItem } constructor TLegendItem.Create(const AText: String; AColor: TColor); begin FColor := AColor; FGroupIndex := LEGEND_ITEM_NO_GROUP; FOrder := LEGEND_ITEM_ORDER_AS_ADDED; FText := AText; end; procedure TLegendItem.Draw(ADrawer: IChartDrawer; const ARect: TRect); var symTextSpc: Integer; P: TPoint; begin symTextSpc := ADrawer.Scale(SYMBOL_TEXT_SPACING); P := ADrawer.TextExtent(FText, FTextFormat); if ADrawer.GetRightToLeft then ADrawer.TextOut. TextFormat(FTextFormat). Pos(ARect.Left - symTextSpc - P.X, (ARect.Top + ARect.Bottom - P.Y) div 2). Text(FText).Done else ADrawer.TextOut. TextFormat(FTextFormat). Pos(ARect.Right + symTextSpc, (ARect.Top + ARect.Bottom - P.Y) div 2). Text(FText).Done; end; function TLegendItem.HasSymbol: Boolean; begin Result := true; end; procedure TLegendItem.UpdateFont(ADrawer: IChartDrawer; var APrevFont: TFont); begin if APrevFont = Font then exit; ADrawer.Font := Font; APrevFont := Font; end; { TLegendItemGroupTitle } procedure TLegendItemGroupTitle.Draw(ADrawer: IChartDrawer; const ARect: TRect); begin if ADrawer.GetRightToLeft then ADrawer.TextOut. TextFormat(TextFormat). Pos(ARect.Right - ADrawer.TextExtent(Text, TextFormat).X, ARect.Top). Text(Text).Done else ADrawer.TextOut. TextFormat(TextFormat). Pos(ARect.Left, ARect.Top). Text(Text).Done; end; function TLegendItemGroupTitle.HasSymbol: Boolean; begin Result := false; end; { TLegendItemUserDrawn } constructor TLegendItemUserDrawn.Create( AIndex: Integer; AOnDraw: TLegendItemDrawEvent; const AText: String); begin inherited Create(AText); FIndex := AIndex; FOnDraw := AOnDraw; end; procedure TLegendItemUserDrawn.Draw(ADrawer: IChartDrawer; const ARect: TRect); var ic: IChartTCanvasDrawer; begin if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(FOnDraw) then FOnDraw(ic.Canvas, ARect, FIndex, Self); inherited Draw(ADrawer, ARect); end; { TLegendItemLine } constructor TLegendItemLine.Create(APen: TFPCustomPen; const AText: String); begin inherited Create(AText); FPen := APen; end; procedure TLegendItemLine.Draw(ADrawer: IChartDrawer; const ARect: TRect); var y: Integer; begin inherited Draw(ADrawer, ARect); if FPen = nil then exit; ADrawer.Pen := FPen; y := (ARect.Top + ARect.Bottom) div 2; ADrawer.Line(ARect.Left, y, ARect.Right, y); end; { TLegendItemLinePointer } { Draws a line segment and a pointer, in addition to the legend text. } constructor TLegendItemLinePointer.Create( APen: TPen; APointer: TSeriesPointer; const AText: String); begin inherited Create(APen, AText); FPointer := APointer; end; constructor TLegendItemLinePointer.CreateWithBrush( APen: TPen; ABrush: TBrush; APointer: TSeriesPointer; const AText: String); begin Create(APen, APointer, AText); FBrush := ABrush; FPresetBrush := true; end; procedure TLegendItemLinePointer.Draw( ADrawer: IChartDrawer; const ARect: TRect); var c, sz: TPoint; begin inherited Draw(ADrawer, ARect); if FPointer = nil then exit; c := CenterPoint(ARect); // Max width slightly narrower then ARect to leave place for the line. sz.X := Min(ADrawer.Scale(FPointer.HorizSize), (ARect.Right - ARect.Left) div 3); sz.Y := Min(ADrawer.Scale(FPointer.VertSize), (ARect.Bottom - ARect.Top) div 2); if FPresetBrush then ADrawer.SetBrush(FBrush); FPointer.DrawSize(ADrawer, c, sz, Color, 0.0, FPresetBrush); end; { TLegendItemLinePointerBrush } constructor TLegendItemLinePointerBrush.Create(APen: TPen; ABrush: TBrush; APointer: TSeriesPointer; const AText: String; AreaBrush: TBrush = nil); begin CreateWithBrush(APen, ABrush, APointer, AText); FAreaBrush := AreaBrush; end; procedure TLegendItemLinePointerBrush.Draw( ADrawer: IChartDrawer; const ARect: TRect); begin if Assigned(FAreaBrush) then begin ADrawer.SetBrush(FAreaBrush); ADrawer.FillRect(ARect.Left, (ARect.Top + ARect.Bottom) div 2, ARect.Right, ARect.Bottom); end; inherited; end; { TLegendItemBrushRect } constructor TLegendItemBrushRect.Create( ABrush: TFPCustomBrush; const AText: String); begin inherited Create(AText); FBrush := ABrush; end; procedure TLegendItemBrushRect.Draw(ADrawer: IChartDrawer; const ARect: TRect); begin inherited Draw(ADrawer, ARect); if FBrush = nil then ADrawer.SetBrushParams(bsSolid, ColorDef(Color, clRed)) else begin ADrawer.Brush := FBrush; if Color <> clTAColor then ADrawer.SetBrushParams(FBrush.Style, Color); end; ADrawer.Rectangle(ARect); end; { TLegendItemBrushPenRect } constructor TLegendItemBrushPenRect.Create( ABrush: TFPCustomBrush; APen: TFPCustomPen; const AText: String); begin inherited Create(ABrush, AText); FPen := APen; end; procedure TLegendItemBrushPenRect.Draw(ADrawer: IChartDrawer; const ARect: TRect); begin ADrawer.Pen := FPen; inherited Draw(ADrawer, ARect); end; { TChartLegend } procedure TChartLegend.AddGroups(AItems: TChartLegendItems); var i, gi: Integer; g: TLegendItemGroupTitle; begin for i := AItems.Count - 1 downto 0 do begin gi := AItems[i].GroupIndex; if InRange(gi, 0, GroupTitles.Count - 1) and ((i = 0) or (AItems[i - 1].GroupIndex <> gi)) then begin g := TLegendItemGroupTitle.Create(GroupTitles[gi]); g.GroupIndex := gi; g.Font := GroupFont; g.TextFormat := FTextFormat; AItems.Insert(i, g); end; end; end; procedure TChartLegend.Assign(Source: TPersistent); begin if Source is TChartLegend then with TChartLegend(Source) do begin Self.FAlignment := Alignment; Self.FBackgroundBrush.Assign(BackgroundBrush); Self.FColumnCount := ColumnCount; Self.FFixedItemWidth := FixedItemWidth; Self.FFixedItemHeight := FixedItemHeight; Self.FFont.Assign(Font); Self.FFrame.Assign(Frame); Self.FGridHorizontal.Assign(GridHorizontal); Self.FGridVertical.Assign(GridVertical); Self.FGroupFont.Assign(GroupFont); Self.FGroupTitles.Assign(GroupTitles); Self.FMarginX := MarginX; Self.FMarginY := MarginY; Self.FSpacing := Spacing; Self.FSymbolFrame.Assign(SymbolFrame); Self.FSymbolWidth := SymbolWidth; Self.FTextFormat := TextFormat; Self.FUseSidebar := UseSidebar; end; inherited Assign(Source); end; constructor TChartLegend.Create(AOwner: TCustomChart); begin inherited Create(AOwner); FAlignment := laTopRight; FColumnCount := 1; FGridHorizontal := TChartLegendGridPen.Create; FGridHorizontal.OnChange := @StyleChanged; FGridVertical := TChartLegendGridPen.Create; FGridVertical.OnChange := @StyleChanged; FGroupTitles := TStringList.Create; FMarginX := DEF_LEGEND_MARGIN; FMarginY := DEF_LEGEND_MARGIN; FSpacing := DEF_LEGEND_SPACING; FSymbolWidth := DEF_LEGEND_SYMBOL_WIDTH; FUseSidebar := true; Visible := false; InitHelper(FBackgroundBrush, TChartLegendBrush); InitHelper(FFont, TFont); InitHelper(FFrame, TChartPen); InitHelper(FGroupFont, TFont); InitHelper(FSymbolFrame, TChartPen); end; destructor TChartLegend.Destroy; begin FreeAndNil(FBackgroundBrush); FreeAndNil(FFont); FreeAndNil(FFrame); FreeAndNil(FGridHorizontal); FreeAndNil(FGridVertical); FreeAndNil(FGroupFont); FreeAndNil(FGroupTitles); FreeAndNil(FSymbolFrame); inherited; end; procedure TChartLegend.Draw(var AData: TChartLegendDrawingData); var drawer: IChartDrawer; procedure DrawItems; var i, x, y: Integer; prevFont: TFont = nil; r: TRect; isRTL: Boolean; space, symwid: Integer; begin isRTL := drawer.GetRightToLeft; with AData do begin space := FDrawer.Scale(Spacing); symwid := FDrawer.Scale(SymbolWidth); for i := 0 to FItems.Count - 1 do begin FItems[i].TextFormat := FTextFormat; FItems[i].UpdateFont(drawer, prevFont); drawer.Brush := BackgroundBrush; if SymbolFrame.Visible then drawer.Pen := SymbolFrame else drawer.SetPenParams(psClear, clTAColor); x := 0; y := 0; if FColumnCount = 0 then case Alignment of laBottomCenter, laTopCenter: DivMod(i, FColCount, y, x); else DivMod(i, FRowCount, x, y); end else case ItemFillOrder of lfoColRow: DivMod(i, FRowCount, x, y); lfoRowCol: DivMod(i, FColCount, y, x); end; if isRTL then r := Bounds( FBounds.Right - space - x * (FItemSize.X + space) - symwid, FBounds.Top + space + y * (FItemSize.Y + space), symwid, FItemSize.Y) else r := Bounds( FBounds.Left + space + x * (FItemSize.X + space), FBounds.Top + space + y * (FItemSize.Y + space), symwid, FItemSize.Y); FItems[i].Draw(drawer, r); OffsetRect(r, 0, FItemSize.Y + space); end; if GridHorizontal.EffVisible then begin drawer.Pen := GridHorizontal; drawer.SetBrushParams(bsClear, clTAColor); for i := 1 to FRowCount - 1 do begin y := FBounds.Top + space div 2 + i * (FItemSize.Y + space); drawer.Line(FBounds.Left, y, FBounds.Right, y); end; end; if GridVertical.EffVisible then begin drawer.Pen := GridVertical; drawer.SetBrushParams(bsClear, clTAColor); for i := 1 to FColCount - 1 do begin x := FBounds.Left + space div 2 + i * (FItemSize.X + space); drawer.Line(x, FBounds.Top, x, FBounds.Bottom); end; end; end; end; var r: TRect; begin drawer := AData.FDrawer; drawer.SetTransparency(Transparency); try drawer.Brush := BackgroundBrush; if BackgroundBrush.Color = clDefault then drawer.SetBrushColor(FOwner.GetDefaultColor(dctBrush)) else drawer.SetBrushColor(BackgroundBrush.Color); if Frame.Visible then begin drawer.Pen := Frame; if Frame.Color = clDefault then drawer.SetPenColor(FOwner.GetDefaultColor(dctFont)) else drawer.SetPenColor(Frame.Color); end else drawer.SetPenParams(psClear, clTAColor); r := AData.FBounds; drawer.Rectangle(r); if AData.FItems.Count = 0 then exit; r.Right -= 1; drawer.ClippingStart(r); try DrawItems; finally drawer.ClippingStop; end; finally drawer.SetTransparency(0); end; end; function TChartLegend.IsPointInBounds(APoint: TPoint): Boolean; begin Result := IsPointInRect(APoint, FLegendRect); end; function TChartLegend.ItemClicked(ADrawer: IChartDrawer; APoint: TPoint; AItems: TChartLegendItems): Integer; var i, x, y, w: Integer; prevFont: TFont = nil; r: TRect; isRTL: Boolean; space, symwid: Integer; data: TChartLegendDrawingData; begin with data do begin FDrawer := ADrawer; FBounds := Self.FLegendRect; FColCount := Self.FColCount; FItems := AItems; FItemSize := Self.FItemSize; FRowCount := Self.FRowCount; isRTL := FDrawer.GetRightToLeft; space := FDrawer.Scale(Spacing); symwid := FDrawer.Scale(SymbolWidth); for i := 0 to FItems.Count - 1 do begin FItems[i].UpdateFont(FDrawer, prevFont); x := 0; y := 0; if (FColumnCount = 0) then case Alignment of laBottomCenter, laTopCenter: DivMod(i, FColCount, y, x); else DivMod(i, FRowCount, x, y); end else case ItemFillOrder of lfoColRow: DivMod(i, FRowCount, x, y); lfoRowCol: DivMod(i, FColCount, y, x); end; w := FDrawer.TextExtent(FItems[i].Text, FItems[i].TextFormat).X; if isRTL then r := Bounds( FBounds.Right - space - x * (FItemSize.X + space) - (symwid + space + w), FBounds.Top + space + y * (FItemSize.Y + space), symwid + space + w, FItemSize.Y) else r := Bounds( FBounds.Left + space + x * (FItemSize.X + space), FBounds.Top + space + y * (FItemSize.Y + space), symwid + space + w, FItemSize.Y); if PtInRect(r, APoint) then begin Result := i; exit; end; end; end; Result := -1; end; function TChartLegend.MeasureItem( ADrawer: IChartDrawer; AItems: TChartLegendItems): TPoint; var p: TPoint; prevFont: TFont = nil; li: TLegendItem; begin Result := Point(0, 0); if (FixedItemWidth <= 0) or (FixedItemHeight <= 0) then for li in AItems do begin li.UpdateFont(ADrawer, prevFont); if li.Text = '' then p := Point(0, ADrawer.TextExtent('I', FTextFormat).Y) else p := ADrawer.TextExtent(li.Text, FTextFormat); if li.HasSymbol then p.X += ADrawer.Scale(SYMBOL_TEXT_SPACING + SymbolWidth); Result := MaxPoint(p, Result); end; if FixedItemWidth > 0 then Result.X := ADrawer.Scale(FixedItemWidth); if FixedItemHeight > 0 then Result.Y := ADrawer.Scale(FixedItemHeight); end; procedure TChartLegend.Prepare( var AData: TChartLegendDrawingData; var AClipRect: TRect); procedure CalcColRowCount(AItemSize: TPoint; ASpace, AMarginX, AMarginY: Integer; var AColCount, ARowCount: Integer); var w, h, dw, dh: Integer; begin if FColumnCount <= 0 then begin case Alignment of laTopCenter, laBottomCenter: begin w := AClipRect.Right - AClipRect.Left - 2*AMarginX - ASpace; dw := AItemSize.X + ASpace; AColCount := Max(Min(w div dw, AData.FItems.Count), 1); ARowCount := (AData.FItems.Count - 1) div AColCount + 1; end; else begin h := AClipRect.Bottom - AClipRect.Top - 2*MarginY - ASpace; dh := AItemSize.Y + ASpace; ARowCount := Max(Min(h div dh, AData.FItems.Count), 1); AColCount := (AData.FItems.Count - 1) div ARowCount + 1; end; end; end else begin AColCount := Max(Min(ColumnCount, AData.FItems.Count), 1); ARowCount := (AData.FItems.Count - 1) div AColCount + 1; end; end; var x, y: Integer; sidebar, legendSize: TPoint; margX, margY, space: Integer; begin with AData do begin margX := FDrawer.Scale(MarginX); margY := FDrawer.Scale(MarginY); space := FDrawer.Scale(Spacing); FItemSize := MeasureItem(FDrawer, FItems); CalcColRowCount(FItemSize, space, margX, margY, FColCount, FRowCount); Self.FItemSize := FItemSize; Self.FColCount := FColCount; Self.FRowCount := FRowCount; legendSize.X := (FItemSize.X + space) * FColCount + space; legendSize.Y := (FItemSize.Y + space) * FRowCount + space; end; sidebar.X := 2 * margX; with AClipRect do legendSize.X := EnsureRange(legendSize.X, 0, Right - Left - sidebar.X); sidebar.X += legendSize.X; sidebar.Y := 2 * margX; with AClipRect do legendSize.Y := EnsureRange(legendSize.Y, 0, Bottom - Top - sidebar.Y); sidebar.Y += legendSize.Y; // Determine position according to the alignment. case Alignment of laTopLeft, laCenterLeft, laBottomLeft: x := AClipRect.Left + margX; laTopRight, laCenterRight, laBottomRight: x := AClipRect.Right - legendSize.X - margX; laTopCenter, laBottomCenter: x := (AClipRect.Right + AClipRect.Left - legendSize.X) div 2; end; case Alignment of laTopLeft, laTopCenter, laTopRight: y := AClipRect.Top + margY; laBottomLeft, laBottomCenter, laBottomRight: y := AClipRect.Bottom - margY - legendSize.Y; laCenterLeft, laCenterRight: y := (AClipRect.Top + AClipRect.Bottom - legendSize.Y) div 2; end; if UseSidebar then case Alignment of laTopLeft, laCenterLeft, laBottomLeft: AClipRect.Left += sidebar.X; laTopRight, laCenterRight, laBottomRight: AClipRect.Right -= sidebar.X; laTopCenter: AClipRect.Top += legendSize.Y + 2 * margY; laBottomCenter: AClipRect.Bottom -= legendSize.Y + 2 * margY; end; AData.FBounds := Bounds(x, y, legendSize.X, legendSize.Y); FLegendRect := Rect(x, y, x + legendSize.X, y + legendSize.Y); end; procedure TChartLegend.SetAlignment(AValue: TLegendAlignment); begin if FAlignment = AValue then exit; FAlignment := AValue; StyleChanged(Self); end; procedure TChartLegend.SetBackgroundBrush(AValue: TChartLegendBrush); begin FBackgroundBrush.Assign(AValue); StyleChanged(Self); end; procedure TChartLegend.SetColumnCount(AValue: TLegendColumnCount); begin if FColumnCount = AValue then exit; FColumnCount := AValue; StyleChanged(Self); end; procedure TChartLegend.SetFixedItemWidth(AValue: Cardinal); begin if FFixedItemWidth = AValue then exit; FFixedItemWidth := AValue; StyleChanged(Self); end; procedure TChartLegend.SetFixedItemHeight(AValue: Cardinal); begin if FFixedItemHeight = AValue then exit; FFixedItemHeight := AValue; StyleChanged(Self); end; procedure TChartLegend.SetFont(AValue: TFont); begin FFont.Assign(AValue); StyleChanged(Self); end; procedure TChartLegend.SetFrame(AValue: TChartPen); begin FFrame.Assign(AValue); StyleChanged(Self); end; procedure TChartLegend.SetGridHorizontal(AValue: TChartLegendGridPen); begin if FGridHorizontal = AValue then exit; FGridHorizontal.Assign(AValue); StyleChanged(Self); end; procedure TChartLegend.SetGridVertical(AValue: TChartLegendGridPen); begin if FGridVertical = AValue then exit; FGridVertical.Assign(AValue); StyleChanged(Self); end; procedure TChartLegend.SetGroupFont(AValue: TFont); begin FGroupFont.Assign(AValue); StyleChanged(Self); end; procedure TChartLegend.SetGroupTitles(AValue: TStrings); begin FGroupTitles.Assign(AValue); StyleChanged(Self); end; procedure TChartLegend.SetInverted(AValue: Boolean); begin if FInverted = AValue then exit; FInverted := AValue; StyleChanged(Self); end; procedure TChartLegend.SetItemFillOrder(AValue: TLegendItemFillOrder); begin if FItemFillOrder = AValue then exit; FItemFillOrder := AValue; StyleChanged(Self); end; procedure TChartLegend.SetMargin(AValue: TChartDistance); begin SetMarginX(AValue); SetMarginY(AValue); end; procedure TChartLegend.SetMarginX(AValue: TChartDistance); begin if FMarginX = AValue then exit; FMarginX := AValue; StyleChanged(Self); end; procedure TChartLegend.SetMarginY(AValue: TChartDistance); begin if FMarginY = AValue then exit; FMarginY := AValue; StyleChanged(Self); end; procedure TChartLegend.SetSpacing(AValue: TChartDistance); begin if FSpacing = AValue then exit; FSpacing := AValue; StyleChanged(Self); end; procedure TChartLegend.SetSymbolFrame(AValue: TChartPen); begin if FSymbolFrame = AValue then exit; FSymbolFrame := AValue; StyleChanged(Self); end; procedure TChartLegend.SetSymbolWidth(AValue: TChartDistance); begin if FSymbolWidth = AValue then exit; FSymbolWidth := AValue; StyleChanged(Self); end; procedure TChartLegend.SetTextFormat(AValue: TChartTextFormat); begin if FTextFormat = AValue then exit; FTextFormat := AValue; StyleChanged(self); end; procedure TChartLegend.SetTransparency(AValue: TChartTransparency); begin if FTransparency = AValue then exit; FTransparency := AValue; StyleChanged(Self); end; procedure TChartLegend.SetUseSidebar(AValue: Boolean); begin if FUseSidebar = AValue then exit; FUseSidebar := AValue; StyleChanged(Self); end; procedure TChartLegend.SortItemsByOrder(AItems: TChartLegendItems); var i: Integer; j: Integer = MaxInt; begin for i := AItems.Count - 1 downto 0 do if AItems[i].Order = LEGEND_ITEM_ORDER_AS_ADDED then begin AItems[i].Order := j; j -= 1; end; if FInverted then AItems.Sort(@LegendItemCompare_Inverted) else AItems.Sort(@LegendItemCompare); end; procedure TChartLegend.UpdateBidiMode; begin case Alignment of laTopLeft : Alignment := laTopRight; laCenterLeft : Alignment := laCenterRight; laBottomLeft : Alignment := laBottomRight; laTopRight : Alignment := laTopLeft; laCenterRight : Alignment := laCenterLeft; laBottomRight : Alignment := laBottomLeft; else ; end; end; { TChartSeriesLegend } procedure TChartSeriesLegend.Assign(Source: TPersistent); begin if Source is TChartSeriesLegend then with TChartSeriesLegend(Source) do begin Self.FFormat := FFormat; Self.FGroupIndex := FGroupIndex; Self.FMultiplicity := FMultiplicity; Self.FOnDraw := FOnDraw; Self.FOrder := FOrder; Self.FTextFormat := FTextFormat; Self.FUserItemsCount := FUserItemsCount; Self.FVisible := FVisible; end; inherited Assign(Source); end; constructor TChartSeriesLegend.Create(AOwner: TCustomChart); begin inherited Create(AOwner); FGroupIndex := LEGEND_ITEM_NO_GROUP; FOrder := LEGEND_ITEM_ORDER_AS_ADDED; FVisible := true; FUserItemsCount := 1; end; procedure TChartSeriesLegend.InitItem( AItem: TLegendItem; AIndex: Integer; ALegend: TChartLegend); begin if Assigned(OnCreate) then OnCreate(AItem, AIndex); if AItem.Font = nil then AItem.Font := ALegend.Font; if AItem.GroupIndex = LEGEND_ITEM_NO_GROUP then AItem.GroupIndex := GroupIndex; if AItem.Order = LEGEND_ITEM_ORDER_AS_ADDED then AItem.Order := Order; AItem.TextFormat := ALegend.TextFormat; end; procedure TChartSeriesLegend.SetFormat(AValue: String); begin if FFormat = AValue then exit; FFormat := AValue; StyleChanged(Self); end; procedure TChartSeriesLegend.SetGroupIndex(AValue: Integer); begin if FGroupIndex = AValue then exit; FGroupIndex := AValue; StyleChanged(Self); end; procedure TChartSeriesLegend.SetMultiplicity(AValue: TLegendMultiplicity); begin if FMultiplicity = AValue then exit; FMultiplicity := AValue; StyleChanged(Self); end; procedure TChartSeriesLegend.SetOnDraw(AValue: TLegendItemDrawEvent); begin if TMethod(FOnDraw) = TMethod(AValue) then exit; FOnDraw := AValue; StyleChanged(Self); end; procedure TChartSeriesLegend.SetOnCreate(AValue: TLegendItemCreateEvent); begin if TMethod(FOnCreate) = TMethod(AValue) then exit; FOnCreate := AValue; StyleChanged(Self); end; procedure TChartSeriesLegend.SetOrder(AValue: Integer); begin if FOrder = AValue then exit; FOrder := AValue; StyleChanged(Self); end; procedure TChartSeriesLegend.SetTextFormat(AValue: TChartTextFormat); begin if FTextFormat = AValue then exit; FTextFormat := AValue; StyleChanged(Self); end; procedure TChartSeriesLegend.SetUserItemsCount(AValue: Integer); begin if FUserItemsCount = AValue then exit; FUserItemsCount := AValue; StyleChanged(Self); end; procedure SkipObsoleteProperties; const MARGIN_NOTE = 'Obsolete, use Legend.MarginX instead'; begin RegisterPropertyToSkip(TChartLegend, 'Margin', MARGIN_NOTE, ''); end; initialization SkipObsoleteProperties; end.