2016-05-12 6 views
0

Ich versuche, Liniendicke in der Legende eines dynamisch erstellten Chart1-Objekts mit dem PostPaint-Ereignis unten aufgeführten zu ändern. Der folgende Code geht jedoch davon aus, dass Chart1 in einem Formular vorhanden ist. Gibt es eine Möglichkeit, herauszufinden, wann das Paint-Ereignis ausgelöst wird, und dann dieses PostPaint-Ereignis zu implementieren?Re-Create bessere Linien in der Legende mit PostPaint Ereignis für Diagramm erstellt dynamisch

Private Sub Chart1_PostPaint(ByVal sender As Object, ByVal e As System.Windows.Forms.DataVisualization.Charting.ChartPaintEventArgs) Handles Chart1.PostPaint 

     If TypeOf e.ChartElement Is Legend Then 

      Dim c As Chart = CType(sender, Chart) 
      Dim g As Graphics = e.ChartGraphics.Graphics 

      'The legend 
      Dim l As Legend = c.Legends(0) 

      'Absolute dimensions of the legend (New legend will be based on this.. won't be exact.) 
      Dim pos As RectangleF = e.ChartGraphics.GetAbsoluteRectangle(l.Position.ToRectangleF) 

      'Absolute dimensions of one legend "cell" 
      Dim itemHeight As Single = pos.Height/c.Series.Count 
      Dim itemWidth As Single = pos.Width/2 

      'Padding between line and text (horizontal) and each item (vertical) 
      Dim horizontalPadding As Single = 10 
      Dim verticalPadding As Single = 1 

      Dim legendFont As New Font("Arial", 10) 

      'Draw a white box on top of the default legend to hide it 
      g.FillRectangle(Brushes.White, pos) 

      For i As Integer = 0 To c.Series.Count - 1 

       Dim s As Series = c.Series(i) 
       Dim p As New Pen(s.Color, CSng(Math.Min(s.BorderWidth, itemHeight))) 'Line no thicker than the item height. 

       'Line 
       Dim posY As Single = CSng(pos.Y + (verticalPadding * i + itemHeight * i + itemHeight/2)) 
       Dim startPoint As PointF = New PointF(pos.X, posY) 
       Dim endPoint As PointF = New PointF(CSng(pos.X + itemWidth), posY) 
       g.DrawLine(p, startPoint, endPoint) 

       'Text 
       posY = CSng(pos.Y + verticalPadding * i + itemHeight * i) 
       startPoint = New PointF(CSng(pos.X + itemWidth), posY) 
       g.DrawString(s.Name, legendFont, Brushes.Black, startPoint.X + horizontalPadding, startPoint.Y) 

      Next 

     End If 

    End Sub 
+0

Versuchte es, aber die Griffe Chart1.PostPaint Ereignis löst eine Ausnahme, weil die Tabelle dynamisch erstellt wird. Es gibt keine einfache Schaltfläche dafür, also müssten Sie kreativ sein, wenn Sie vorschlagen, wie Sie den Code innerhalb dieser Methode in einem dynamisch erstellten Diagramm ausführen. Es muss eine Arbeit geben (?) – wrtsvkrfm

Antwort

0

LÖSUNG für Rechts Andocken von Legend (siehe unten Andocken unten): Es hat funktioniert, dass ich auch eine ChartDashStyle Einstellung für jede Serie Linie hatte, sowie eine Legende Schriftart und -größe festgelegt. Ich habe den obigen Code geändert und ihn mit verschiedenen Pixelanpassungen ein wenig optimiert, um die neue Legende nach oben zu verschieben und den Abstand zwischen den Zeilen basierend auf der Schriftgröße für die Legende hinzuzufügen. Ich habe auch einige logische Anweisungen hinzugefügt, um den ChartDashStyle in den GDI + DashStyle zu konvertieren.

Nachdem Sie dynamisch eine z. Chart1 Objekt und Prozess alle Code, um die Serie zu füllen, usw., alles, was Sie tun müssen, um das PostPaint Ereignis für das Diagramm zu nennen, ist der folgenden Code am Ende aller Chart-Verarbeitungscode hinzufügen:

Dim Chart1 As New Chart 
Chart1.Invalidate() 
Chart1.ChartAreas.Clear() 
Chart1.Legends.Clear() 
Chart1.Series.Clear() 
. 
. 
(fill series datapoints, legend, titles, etc) 
. 
. 
AddHandler Chart1.PostPaint, AddressOf Chart1_PostPaint 

Der Das PostPaint-Ereignis wird nach dem Malen ausgelöst und ruft dann die Methode (Unterroutine unten) auf, um die Legende mit farbigen Linien mit der entsprechenden Stärke und dem Dashstil basierend auf denselben Eigenschaften für jede Serie neu zu erstellen.

(Es muss kein Handles... am Ende des Unterprogramms Definition sein)

Private Sub Chart1_PostPaint(ByVal sender As Object, ByVal e As ChartPaintEventArgs) 

     If TypeOf e.ChartElement Is Legend Then 

      Dim c As Chart = CType(sender, Chart) 
      Dim g As Graphics = e.ChartGraphics.Graphics 

      'The legend 
      Dim l As Legend = c.Legends(0) 

      'Absolute dimensions of the legend (New legend will be based on this.. won't be exact.) 
      Dim pos As RectangleF = e.ChartGraphics.GetAbsoluteRectangle(l.Position.ToRectangleF) 

      'Absolute dimensions of one legend "cell" 
      Dim itemHeight As Single = pos.Height/c.Series.Count + 30 
      Dim itemWidth As Single = pos.Width/2 
      'Padding between line and text (horizontal) and each item (vertical) 
      Dim horizontalPadding As Single = 10 
      Dim verticalPadding As Single = l.Font.Size 

      Dim legendFont As Font = l.Font 

      'Draw a white box on top of the default legend to hide it 
      g.FillRectangle(Brushes.White, pos) 

      For i As Integer = 0 To c.Series.Count - 1 
       Dim s As Series = c.Series(i) 
       Dim p As New Pen(s.Color, CSng(Math.Min(s.BorderWidth, itemHeight))) 'Line no thicker than the item height. 
       Dim ds As ChartDashStyle = s.BorderDashStyle 
       'Line 
       Dim posY As Single = CSng(pos.Y + (verticalPadding * i + itemHeight * i + itemHeight/2)) - (c.Series.Count + 2) * verticalPadding 
       Dim startPoint As PointF = New PointF(pos.X, posY) 
       Dim endPoint As PointF = New PointF(CSng(pos.X + itemWidth), posY) 
       p.DashStyle = ds 
       If ds = ChartDashStyle.Solid Then 
        p.DashStyle = DashStyle.Solid 
       End If 
       If ds = ChartDashStyle.Dash Then 
        p.DashStyle = DashStyle.Dash 
       End If 
       If ds = ChartDashStyle.DashDot Then 
        p.DashStyle = DashStyle.DashDot 
       End If 
       If ds = ChartDashStyle.DashDotDot Then 
        p.DashStyle = DashStyle.DashDotDot 
       End If 
       g.DrawLine(p, startPoint, endPoint) 

       'Text 
       posY = CSng(pos.Y + verticalPadding * i + itemHeight * i) - (c.Series.Count + 2) * verticalPadding 
       startPoint = New PointF(CSng(pos.X + itemWidth), posY) 
       g.DrawString(s.Name, legendFont, Brushes.Black, startPoint.X + horizontalPadding + 5, startPoint.Y - 5) 
      Next 
     End If 
    End Sub 

Hier ist ein Beispiel resultierende Legende: legend

Für Bottom Andocken der Legende hatte der Code vollständig überarbeitet, und die Ergebnisse sind unten zu:

Private Sub Chart1_PostPaint(ByVal sender As Object, ByVal e As ChartPaintEventArgs) 

    If TypeOf e.ChartElement Is Legend Then 
     Dim c As Chart = CType(sender, Chart) 
     Dim g As Graphics = e.ChartGraphics.Graphics 

     'The legend 
     Dim l As Legend = c.Legends(0) 

     'Absolute dimensions of the legend (New legend will be based on this.. won't be exact.) 
     Dim pos As RectangleF = e.ChartGraphics.GetAbsoluteRectangle(l.Position.ToRectangleF) 
     Dim numrows As Single = Math.Max(Math.Floor(pos.Height/l.Font.Height), 1) 
     'Absolute dimensions of one legend "cell" 
     Dim itemHeight As Single = pos.Height/numrows 
     Dim numcols As Integer 
     If c.Series.Count = 1 Then numcols = 1 
     If c.Series.Count = 2 Then numcols = 2 
     If c.Series.Count = 4 Then numcols = 4 
     If c.Series.Count = 3 OrElse c.Series.Count > 4 Then numcols = 3 
     Dim itemWidth As Single = pos.Width 
     If c.Series.Count = 1 Then itemWidth = pos.Width 
     If c.Series.Count = 2 Then itemWidth = pos.Width/2 
     If c.Series.Count = 4 Then itemWidth = pos.Width/4 
     If c.Series.Count = 3 OrElse c.Series.Count > 4 Then itemWidth = pos.Width/3 
     itemWidth *= 0.9 
     'Padding between line and text (horizontal) and each item (vertical) 
     Dim horizontalPadding As Single = 10 
     Dim verticalPadding As Single = 1 

     Dim legendFont As Font = l.Font 
     'Dim legendFont As New Font("Arial", 10) 

     'Draw a white box on top of the default legend to hide it 
     g.FillRectangle(Brushes.White, pos) 

     For i As Integer = 0 To c.Series.Count - 1 

      Dim s As Series = c.Series(i) 
      Dim p As New Pen(s.Color, CSng(Math.Min(s.BorderWidth, itemHeight))) 'Line no thicker than the item height. 
      Dim ds As ChartDashStyle = s.BorderDashStyle 
      If ds = ChartDashStyle.Solid Then 
       p.DashStyle = DashStyle.Solid 
      End If 
      If ds = ChartDashStyle.Dash Then 
       p.DashStyle = DashStyle.Dash 
      End If 
      If ds = ChartDashStyle.DashDot Then 
       p.DashStyle = DashStyle.DashDot 
      End If 
      If ds = ChartDashStyle.DashDotDot Then 
       p.DashStyle = DashStyle.DashDotDot 
      End If 
      Dim row As Integer 
      If c.Series.Count = 4 Then row = Math.Ceiling((i + 1)/4) 
      If c.Series.Count <> 4 Then row = Math.Ceiling((i + 1)/3) 
      Dim col As Integer 
      If c.Series.Count = 1 Then col = 0 
      If c.Series.Count = 2 Then col = i Mod 2 
      If c.Series.Count = 4 Then col = i Mod 4 
      If c.Series.Count = 3 OrElse c.Series.Count > 4 Then col = i Mod 3 
      'Line 
      Dim posx As Single = CSng((pos.X + (horizontalPadding + itemWidth * (col - 1)) + itemWidth/2)) 
      Dim posY As Single = CSng((pos.Y + (verticalPadding + itemHeight * (row - 1)) + itemHeight/2)) 
      Dim startPoint As PointF = New PointF(posx + itemWidth * 0.75, posY) 
      Dim endPoint As PointF = New PointF(CSng(posx + itemWidth), posY) 
      g.DrawLine(p, startPoint, endPoint) 

      'Text 
      posx = posx + itemWidth 
      startPoint = New PointF(posx, posY - l.Font.Height/2) 
      g.DrawString(s.Name, legendFont, Brushes.Black, startPoint.X + horizontalPadding, startPoint.Y) 
     Next 
    End If 

End Sub 

Hier ist ein Beispiel für die Ergebnisse ist, wenn Bottom Docking verwendet:

enter image description here

Verwandte Themen