回 帖 发 新 帖 刷新版面

主题:[原创]休闲小程序_动态百分圆饼图

这是一个实用程序,只要稍加修改就是一个专门用来显示三元调查项目的百分圆饼图,并且是动态的。

第一步
建一个窗体,名字任意,静态属性如下:
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

第六步
执行程序。

回复列表 (共1个回复)

沙发

我来回复

您尚未登录,请登录后再回复。点此登录或注册