‘设计一程序，用三维饼图表达考试成绩分别在 优秀、良好、中等、及格和不及格 5个区间的学生人数比例关系（程序运行界面已上传至相册VB6）
Option Base 1
Private Sub Command1_Click()
Dim map(5) As Single, total!, i%, j%
For i = 1 To 5
map(i) = Val(Text1(i - 1)) ' 将各文本框中的数据存入数组map中
If map(i) = 0 Then j = j + 1
total = total + map(i)
Next
If total = 0 Or j > 1 Then
MsgBox "至少要输入2个区间段的人数！！"
Exit Sub
End If
For i = 1 To 5
map(i) = map(i) / total
Next
Call drawcake(map) ' 调用画图过程，实参为数组
End Sub
Private Sub Command2_Click()
Unload Me ’强制退出程序 或者用 end
End Sub
Private Sub Form_Activate()
Text1(0).SetFocus
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) And KeyAscii <> 8 Then
KeyAscii = 0 '如果按非数字键或退格键，取消按键
End If
End Sub
Public Sub drawcake(map() As Single)
Const pi! = 3.1415926
Dim i%, rate!, mx!, my!, mr!
mx = 2500: my = 1200 ' 圆心坐标
mr = 2000 ' 圆的半径
rate = 0.4 ' 椭圆的短轴与长轴之比
Picture1.Cls
Picture1.FillStyle = 0 ' 完全填充
For i = 1 To 200 '用循环语句画200个圆 从而实现从二维图到三维图的转化
If map(1) > 0 Then
Picture1.FillColor = RGB(208, 128, 128) '设定所画区域填充红色
Picture1.Circle (mx, my - i), mr, vbRed, -2 * pi, -2 * pi * map(1), rate '画出所占比例部分扇形
End If
If map(2) > 0 Then
Picture1.FillColor = RGB(240, 240, 128) '设定所画区域填充黄色
Picture1.Circle (mx, my - i), mr, vbYellow, -2 * pi * map(1), -2 * pi * (map(2) + map(1)), rate '画出所占比例部分扇形
End If
If map(3) > 0 Then
Picture1.FillColor = RGB(128, 128, 240) '设定所画区域填充蓝色
Picture1.Circle (mx, my - i), mr, vbBlue, -2 * pi * (map(1) + map(2)), -2 * pi * (map(3) + map(2) + map(1)), rate
End If
If map(4) > 0 Then
Picture1.FillColor = RGB(240, 0, 208) '设定所画区域填充紫红色
Picture1.Circle (mx, my - i), mr, vbMagenta, -2 * pi * (map(1) + map(2) + map(3)), -2 * pi * (map(4) + map(3) + map(2) + map(1)), rate
End If
If map(5) > 0 Then
Picture1.FillColor = RGB(128, 240, 128) '设定所画区域填充绿色
Picture1.Circle (mx, my - i), mr, vbGreen, -2 * pi * (map(1) + map(2) + map(3) + map(4)), -2 * pi * (map(5) + map(4) + map(3) + map(2) + map(1)), rate
End If
Next
For i = 1 To 5 ' 设定各区间人数所占百分比的数据据式
map(i) = Val(Format(map(i) * 100, "0.0"))
Next
Picture1.FillColor = RGB(208, 128, 128) ' 设定同色的方块填充色----------- 红色
Picture1.Line (1600, 2700)-(1900, 2400), , B ' 画小方块
Picture1.Print Space(3); "优秀："; map(1) & "%", "(" & Text1(0) & "人)" '输出标注信息
Picture1.FillColor = RGB(240, 240, 128) ' 设定同色的方块填充色----------- 黄色
Picture1.Line (1600, 3200)-(1900, 2900), , B ' 画小方块
Picture1.Print Space(3); "良好："; map(2) & "%", "(" & Text1(1) & "人)" '输出标注信息
Picture1.FillColor = RGB(128, 128, 240) ' 设定同色的方块填充色----------- 蓝色
Picture1.Line (1600, 3700)-(1900, 3400), , B ' 画小方块
Picture1.Print Space(3); "中等："; map(3) & "%", "(" & Text1(2) & "人)" '输出标注信息
Picture1.FillColor = RGB(240, 0, 208) ' 设定同色的方块填充色----------- 紫红色
Picture1.Line (1600, 4200)-(1900, 3900), , B ' 画小方块
Picture1.Print Space(3); "及格："; map(4) & "%", "(" & Text1(3) & "人)" '输出标注信息
Picture1.FillColor = RGB(128, 240, 128) ' 设定同色的方块填充色----------- 绿色
Picture1.Line (1600, 4700)-(1900, 4400), , B ' 画小方块
Picture1.Print Space(3); "不及格："; map(5) & "%", "(" & Text1(4) & "人)" '输出标注信息
End Sub