Место panel2 по форме Расположение 9,75 Размер 659577 скопировать и вставить код
Импорт Microsoft.VisualBasic.PowerPacks
Public Class Form1
область "Данные"
Public Colors() As Color
Public Data(), Degree(359) As Double
Public EArc(), CArc(), Parts(), PieSize(), Radius, SArc() As Integer
Public Labels(0, 3) As Label
Public Center, ECenter() As Point
Public sc As New ShapeContainer
Private GLine(360) As LineShape
Public LabelNamess(), TitleName As String
Private Sub Form1_Load(sender As Object, e As System.EventArgs) Handles Me.Load
Radius = 246
Center.X = 300
Center.Y = 300
Dim count As Integer = -1
For x = 270 To 359
count = count + 1
Degree(count) = 0.01745 * (x)
Next
For x = 0 To 269
count = count + 1
Degree(count) = 0.01745 * (x)
Next
Dim c(12) As Color
c(0) = Color.Black
c(1) = Color.Red
c(2) = Color.DarkSlateBlue
c(3) = Color.Yellow
c(4) = Color.Green
c(5) = Color.Blue
c(6) = Color.Purple
c(7) = Color.Navy
c(8) = Color.Brown
c(9) = Color.Cyan
c(10) = Color.DarkGreen
c(11) = Color.DarkRed
c(12) = Color.HotPink
Colors = c
Dim p(12) As Double
p(0) = 5696
p(1) = 5495.99
p(2) = 6016.99
p(3) = 5168.99
p(4) = 5421.99
p(5) = 6030.99
p(6) = 4810.99
p(7) = 5199.99
p(8) = 4716.0
p(9) = 4095.95
p(10) = 3299.99
p(11) = 4562.19
p(12) = 5267.38
Data = p
Dim s(12) As String
s(0) = "January 2014"
s(1) = "Febuary 2014"
s(2) = "March 2014"
s(3) = "April 2014"
s(4) = "May 2014"
s(5) = "June 2014"
s(6) = "July 2014"
s(7) = "August 2014"
s(8) = "September 2014"
s(9) = "October 2014"
s(10) = "November 2014"
s(11) = "December 2014"
s(12) = "January 2015"
LabelNamess = s
TitleName = "Monthly Graph for 2014"
CreatePieGraph()
End Sub
Конец Регион
Регион "Pie Graph"
Public Sub CreatePieGraph()
Title.Text = TitleName
Title.Left = 639 - Int(Title.Width/2)
DrawGraph()
PieLabels()
End Sub
Public Sub PieLabels()
ReDim Labels(Data.Length - 1, 3)
Dim per As Double
For x = 0 To LabelNamess.GetLength(0) - 1
Dim l As New Label
l.Left = 20
l.Top = 50 + (40 * x)
l.Width = 240
l.Height = 24
l.Font = New System.Drawing.Font("Microsoft Sans Serif", 14.0!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
l.Text = LabelNamess(x)
l.Name = "L0" & x
Labels(x, 0) = l
Panel2.Controls.Add(l)
Dim l1 As New Label
l1.Left = 275
l1.Top = 50 + (40 * x)
l1.Width = 20
l1.Height = 24
l1.BackColor = Colors(x)
l1.Font = New System.Drawing.Font("Microsoft Sans Serif", 14.0!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
l1.Text = ""
l1.Name = "L1" & x
Labels(x, 1) = l1
Panel2.Controls.Add(l1)
Dim l2 As New Label
l2.Left = 315
l2.Top = 50 + (40 * x)
l2.Width = 90
l2.Height = 24
l2.Font = New System.Drawing.Font("Microsoft Sans Serif", 14.0!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
per = (PieSize(x)/360) * 100
l2.Text = Format(per, "###.###") & "%"
l2.Name = "L2" & x
Labels(x, 2) = l2
Panel2.Controls.Add(l2)
Dim l3 As New Label
l3.Left = 425
l3.Top = 50 + (40 * x)
l3.Width = 140
l3.Height = 24
l3.Font = New System.Drawing.Font("Microsoft Sans Serif", 14.0!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
per = (PieSize(x)/252) * 100
l3.Text = Format(Data(x), "$#,###,###,###.00")
l3.Name = "L3" & x
Labels(x, 3) = l3
Panel2.Controls.Add(l3)
Next
End Sub
Private Function PiceSize(RawData() As Double) As Array
Dim Dsum As Double
Dim ps As Integer = RawData.Length - 1
Dim count, z, size0(ps), size1(ps), size2(ps), size3(ps), max As Integer
Dim sizes(2) As Array
For x = 0 To RawData.GetLength(0) - 1
Dsum = Dsum + RawData(x)
Next
For x = 0 To ps
size0(x) = Int((RawData(x)/Dsum) * 360)
If ((RawData(x)/Dsum) * 360) - size0(x) > 0.49999 Then size0(x) = size0(x) + 1
count = count + size0(x)
Next
z = -1
If count < 360 Then
For x = count + 1 To 360
z = z + 1
If z > sizes.GetLength(0) Then z = 0
size0(z) = size0(z) + 1
count = count + 1
Next
End If
If count > 360 Then
For x = count - 1 To 360 Step -1
z = z + 1
If z > sizes.GetLength(0) Then z = 0
size0(z) = size0(z) - 1
count = count - 1
Next
End If
count = 0
For x = 0 To ps
If x = 0 Then size1(x) = 0
If x = 0 Then size2(x) = size0(x)
If x = 0 Then size3(x) = Int(size0(x)/2)
If x <> 0 Then size1(x) = count
If x <> 0 Then size2(x) = count + size0(x)
If x <> 0 Then size3(x) = size1(x) + Int(size0(x)/2)
If x = ps Then size2(x) = size2(x)
count = count + size0(x)
Next
SArc = size1
EArc = size2
CArc = size3
PiceSize = size0
End Function
Private Sub DrawGraph()
Dim x1, y1, z, p As Integer
Dim sizes(Data.GetLength(0) - 1) As Integer
Dim ps As Integer = Data.GetLength(0) - 1
Dim Ecenter1(ps) As Point
PieSize = PiceSize(Data)
z = 1
sc.Height = 600
sc.Width = 600
sc.Top = 74
sc.Left = 608
For num As Double = 0 To 359
x1 = Convert.ToInt32(Radius * Math.Cos(Degree(num)) + Center.X)
y1 = Convert.ToInt32(Radius * Math.Sin(Degree(num)) + Center.Y)
If num = CArc(p) Then
Ecenter1(p).X = Convert.ToInt32(50 * Math.Cos(Degree(num)) + Center.X)
Ecenter1(p).Y = Convert.ToInt32(50 * Math.Sin(Degree(num)) + Center.Y)
End If
Dim Line As New LineShape
Line.X1 = Center.X
Line.Y1 = Center.Y
Line.X2 = x1
Line.Y2 = y1
Line.BorderColor = Colors(p)
Line.BorderWidth = 5
Line.Visible = True
Line.Name = "line" & Chr(p + 65) & z
If z = PieSize(p) Then
p = p + 1
z = 0
End If
z = z + 1
GLine(num) = Line
AddHandler Line.MouseHover, AddressOf CicrleHover
AddHandler Line.MouseLeave, AddressOf CicrleLeave
AddHandler Line.Click, AddressOf ExplodePice
AddHandler Line.DoubleClick, AddressOf ChangeColor
sc.Shapes.Add(Line)
Next
ECenter = Ecenter1
Panel1.Controls.Add(sc)
End Sub
Конец Регион
регион "События"
Protected Sub CicrleHover(sender As Object, e As System.EventArgs)
Dim o As LineShape = sender
Dim n As String = o.Name
Dim s As Integer = Asc(Mid(n, 5, 1)) - 65
For x = 0 To 3
If x <> 1 Then
Labels(s, x).BackColor = Color.Black
Labels(s, x).ForeColor = Color.White
End If
Next
End Sub
Protected Sub CicrleLeave(sender As Object, e As System.EventArgs)
Dim o As LineShape = sender
Dim n As String = o.Name
Dim s As Integer = Asc(Mid(n, 5, 1)) - 65
For x = 0 To 3
If x <> 1 Then
Labels(s, x).BackColor = Color.White
Labels(s, x).ForeColor = Color.Black
End If
Next
End Sub
Protected Sub ExplodePice(Sender As Object, e As System.EventArgs)
Dim o As LineShape = Sender
Dim n As String = o.Name
Dim s As Integer = Asc(Mid(n, 5, 1)) - 65
Dim x1, y1 As Integer
Dim cpoint As Point
If o.X1 = Center.X Then cpoint = ECenter(s) Else cpoint = Center
For x = SArc(s) To EArc(s) - 1
x1 = Convert.ToInt32(Radius * Math.Cos(Degree(x)) + cpoint.X)
y1 = Convert.ToInt32(Radius * Math.Sin(Degree(x)) + cpoint.Y)
GLine(x).X2 = x1
GLine(x).Y2 = y1
GLine(x).X1 = cpoint.X
GLine(x).Y1 = cpoint.Y
Next
End Sub
Protected Sub ChangeColor(Sender As Object, e As System.EventArgs)
Dim o As LineShape = Sender
Dim n As String = o.Name
Dim s As Integer = Asc(Mid(n, 5, 1)) - 65
ColorDialog1.ShowDialog()
For x = SArc(s) To EArc(s) - 1
GLine(x).BorderColor = ColorDialog1.Color
Next
Labels(s, 1).BackColor = ColorDialog1.Color
End Sub
Конец Регион
End Class
Если это реальный код, который вы должны, по крайней мере, отказаться от последней строки. Элемент под названием «Series1» уже добавлен в коллекцию серии. –
Я удалил последнюю строку кода, но я все еще получаю пустой элемент управления диаграммой. – Riples