主题:[原创]休闲小程序_动态百分圆饼图
这是一个实用程序,只要稍加修改就是一个专门用来显示三元调查项目的百分圆饼图,并且是动态的。
第一步
建一个窗体,名字任意,静态属性如下:
AutoRedraw = True
ScaleMode = 3
ScaleWidth = 300
ScaleHeight = 200
第二步
在窗体上添加一个竖直滚动条,一个文本框,一个标题框。
三个控件分别命名为 VScroll,Text 和 Label。
三个控件的 Index 的属性在静态时都设置为 0,其它属性和控件大小都不用理会。在程序运行时,以上三个控件都是数组成员,其它数组成员的添加及属性的设置都由程序代码来完成的,避免大家在静态时添加过多的控件而出现差错。
第三步
在窗体的声明段中粘贴如下代码:
Option Explicit
Const sX As Integer = 180 '圆饼图中心坐标
Const sY As Integer = 75 '圆饼图中心坐标
Const sR As Integer = 50 '圆饼图半径
Const Pi As Single = 3.1416
Private Yes As Integer '赞成数
Private No As Integer '反对数
Private Abandon As Integer '弃权数
Private Entirety As Integer '总数
Private ColorYes As Long '赞成区颜色值
Private ColorNo As Long '反对区颜色值
Private ColorAbandon As Long '弃权区颜色值
Private Start As Boolean
Private Sub DrawPercent()
Dim ArcYes As Single, ArcNo As Single, ArcAbandon As Single
Dim ArcStart As Single, ArcEnd As Single
Cls
If Entirety = 0 Then Exit Sub
ArcYes = 2 * Pi * Yes / Entirety
ArcNo = 2 * Pi * No / Entirety
ArcAbandon = 2 * Pi * Abandon / Entirety
ArcStart = -0.001: ArcEnd = ArcStart
If ArcYes <> 0 Then
FillColor = ColorYes
If ArcNo + ArcAbandon = 0 Then
Circle (sX, sY), sR, ColorYes: GoTo ComMark
End If
ArcEnd = -ArcYes
If ArcEnd < -6.28 Then ArcEnd = -6.28
Circle (sX, sY), sR, ColorYes, ArcStart, ArcEnd
End If
ArcStart = ArcEnd
If ArcNo <> 0 Then
FillColor = ColorNo
If ArcYes + ArcAbandon = 0 Then
Circle (sX, sY), sR, ColorNo: GoTo ComMark
End If
ArcEnd = ArcStart - ArcNo
If ArcEnd < -6.28 Then ArcEnd = -6.28
Circle (sX, sY), sR, ColorNo, ArcStart, ArcEnd
End If
ArcStart = ArcEnd
If ArcAbandon <> 0 Then
FillColor = ColorAbandon
If ArcYes + ArcNo = 0 Then
Circle (sX, sY), sR, ColorAbandon: GoTo ComMark
End If
ArcEnd = ArcStart - ArcAbandon
If ArcEnd < -6.28 Then ArcEnd = -6.28
Circle (sX, sY), sR, ColorAbandon, ArcStart, ArcEnd
End If
ComMark:
ForeColor = vbWhite
CurrentX = 10: CurrentY = 20
Print "总 数: "; Entirety
CurrentX = 10: CurrentY = 50
Print "赞 成: "; Format(Yes / Entirety * 100, "0.00") & "%"
CurrentX = 10: CurrentY = 70
Print "反 对: "; Format(No / Entirety * 100, "0.00") & "%"
CurrentX = 10: CurrentY = 90
Print "弃 权: "; Format(Abandon / Entirety * 100, "0.00") & "%"
End Sub
第四步
在窗体的 Load 过程中粘贴如下代码:
Private Sub Form_Load()
Dim n As Integer
ColorYes = RGB(0, 240, 128)
ColorNo = RGB(255, 32, 16)
ColorAbandon = RGB(160, 160, 192)
VScroll(0).Width = 15: VScroll(0).Height = 20
VScroll(0).Left = 60: VScroll(0).Top = 170
VScroll(0) = 40
Text(0).Width = 45: Text(0).Height = 20
Text(0).Left = 12: Text(0).Top = 170
Text(0).Alignment = 2: Text(0) = "40"
Label(0).Width = 60: Label(0).Height = 15
Label(0).Left = 12: Label(0).Top = 150
Label(0).ForeColor = ColorYes: Label(0).BackColor = vbBlack
Label(0).Alignment = 2: Label(0).Caption = "赞 成"
For n = 1 To 2
Load VScroll(n): Load Text(n): Load Label(n)
VScroll(n).Left = VScroll(0).Left + n * 100
VScroll(n).Visible = True
Text(n).Left = Text(0).Left + n * 100
Text(n).Visible = True
Label(n).Left = Label(0).Left + n * 100
Label(n).Visible = True
Next
VScroll(1) = 40: VScroll(2) = 20
Text(1) = "40": Text(2) = "20"
Label(1).ForeColor = ColorNo
Label(2).ForeColor = ColorAbandon
Label(1).Caption = "反 对": Label(2).Caption = "弃 权"
DrawStyle = 0: DrawWidth = 1: FillStyle = 0
BackColor = vbBlack: Caption = " 百分圆饼图"
Yes = 40: No = 40: Abandon = 20: Entirety = 100
Start = True
Call DrawPercent
End Sub
第五步
在 VScroll_Change 过程中粘贴如下代码:
Private Sub VScroll_Change(Index As Integer)
If Start = False Then Exit Sub
Select Case Index
Case 0
Yes = VScroll(0)
Case 1
No = VScroll(1)
Case 2
Abandon = VScroll(2)
End Select
Text(Index) = Format(VScroll(Index), "00")
Entirety = Yes + No + Abandon
Call DrawPercent
Me.SetFocus
End Sub
第六步
执行程序。
第一步
建一个窗体,名字任意,静态属性如下:
AutoRedraw = True
ScaleMode = 3
ScaleWidth = 300
ScaleHeight = 200
第二步
在窗体上添加一个竖直滚动条,一个文本框,一个标题框。
三个控件分别命名为 VScroll,Text 和 Label。
三个控件的 Index 的属性在静态时都设置为 0,其它属性和控件大小都不用理会。在程序运行时,以上三个控件都是数组成员,其它数组成员的添加及属性的设置都由程序代码来完成的,避免大家在静态时添加过多的控件而出现差错。
第三步
在窗体的声明段中粘贴如下代码:
Option Explicit
Const sX As Integer = 180 '圆饼图中心坐标
Const sY As Integer = 75 '圆饼图中心坐标
Const sR As Integer = 50 '圆饼图半径
Const Pi As Single = 3.1416
Private Yes As Integer '赞成数
Private No As Integer '反对数
Private Abandon As Integer '弃权数
Private Entirety As Integer '总数
Private ColorYes As Long '赞成区颜色值
Private ColorNo As Long '反对区颜色值
Private ColorAbandon As Long '弃权区颜色值
Private Start As Boolean
Private Sub DrawPercent()
Dim ArcYes As Single, ArcNo As Single, ArcAbandon As Single
Dim ArcStart As Single, ArcEnd As Single
Cls
If Entirety = 0 Then Exit Sub
ArcYes = 2 * Pi * Yes / Entirety
ArcNo = 2 * Pi * No / Entirety
ArcAbandon = 2 * Pi * Abandon / Entirety
ArcStart = -0.001: ArcEnd = ArcStart
If ArcYes <> 0 Then
FillColor = ColorYes
If ArcNo + ArcAbandon = 0 Then
Circle (sX, sY), sR, ColorYes: GoTo ComMark
End If
ArcEnd = -ArcYes
If ArcEnd < -6.28 Then ArcEnd = -6.28
Circle (sX, sY), sR, ColorYes, ArcStart, ArcEnd
End If
ArcStart = ArcEnd
If ArcNo <> 0 Then
FillColor = ColorNo
If ArcYes + ArcAbandon = 0 Then
Circle (sX, sY), sR, ColorNo: GoTo ComMark
End If
ArcEnd = ArcStart - ArcNo
If ArcEnd < -6.28 Then ArcEnd = -6.28
Circle (sX, sY), sR, ColorNo, ArcStart, ArcEnd
End If
ArcStart = ArcEnd
If ArcAbandon <> 0 Then
FillColor = ColorAbandon
If ArcYes + ArcNo = 0 Then
Circle (sX, sY), sR, ColorAbandon: GoTo ComMark
End If
ArcEnd = ArcStart - ArcAbandon
If ArcEnd < -6.28 Then ArcEnd = -6.28
Circle (sX, sY), sR, ColorAbandon, ArcStart, ArcEnd
End If
ComMark:
ForeColor = vbWhite
CurrentX = 10: CurrentY = 20
Print "总 数: "; Entirety
CurrentX = 10: CurrentY = 50
Print "赞 成: "; Format(Yes / Entirety * 100, "0.00") & "%"
CurrentX = 10: CurrentY = 70
Print "反 对: "; Format(No / Entirety * 100, "0.00") & "%"
CurrentX = 10: CurrentY = 90
Print "弃 权: "; Format(Abandon / Entirety * 100, "0.00") & "%"
End Sub
第四步
在窗体的 Load 过程中粘贴如下代码:
Private Sub Form_Load()
Dim n As Integer
ColorYes = RGB(0, 240, 128)
ColorNo = RGB(255, 32, 16)
ColorAbandon = RGB(160, 160, 192)
VScroll(0).Width = 15: VScroll(0).Height = 20
VScroll(0).Left = 60: VScroll(0).Top = 170
VScroll(0) = 40
Text(0).Width = 45: Text(0).Height = 20
Text(0).Left = 12: Text(0).Top = 170
Text(0).Alignment = 2: Text(0) = "40"
Label(0).Width = 60: Label(0).Height = 15
Label(0).Left = 12: Label(0).Top = 150
Label(0).ForeColor = ColorYes: Label(0).BackColor = vbBlack
Label(0).Alignment = 2: Label(0).Caption = "赞 成"
For n = 1 To 2
Load VScroll(n): Load Text(n): Load Label(n)
VScroll(n).Left = VScroll(0).Left + n * 100
VScroll(n).Visible = True
Text(n).Left = Text(0).Left + n * 100
Text(n).Visible = True
Label(n).Left = Label(0).Left + n * 100
Label(n).Visible = True
Next
VScroll(1) = 40: VScroll(2) = 20
Text(1) = "40": Text(2) = "20"
Label(1).ForeColor = ColorNo
Label(2).ForeColor = ColorAbandon
Label(1).Caption = "反 对": Label(2).Caption = "弃 权"
DrawStyle = 0: DrawWidth = 1: FillStyle = 0
BackColor = vbBlack: Caption = " 百分圆饼图"
Yes = 40: No = 40: Abandon = 20: Entirety = 100
Start = True
Call DrawPercent
End Sub
第五步
在 VScroll_Change 过程中粘贴如下代码:
Private Sub VScroll_Change(Index As Integer)
If Start = False Then Exit Sub
Select Case Index
Case 0
Yes = VScroll(0)
Case 1
No = VScroll(1)
Case 2
Abandon = VScroll(2)
End Select
Text(Index) = Format(VScroll(Index), "00")
Entirety = Yes + No + Abandon
Call DrawPercent
Me.SetFocus
End Sub
第六步
执行程序。