https://www.doczj.com/doc/4c11364466.html,/view/ee1eb60a79563c1ec5da71a0.html
（1） 密码判断
Private Sub Form_Load()
i = 3
End Sub
Private Sub Command1_Click()
If (Text2 <> "wwz314") Or (Text1 <> "wwz314") Then
i = i - 1
If i = 0 Then
a = MsgBox("不要再做无谓的尝试！再见!", , "提示")
End
Else
a = MsgBox("密码错误，你还有" & i & "次机会", , "提示")
End If
Else
Unload Form1
Form2.Show
End If
End Sub
（2）添加信息
https://www.doczj.com/doc/4c11364466.html,mandType = adCmdUnknown 定义命令类型
Form2.Adodc1.RecordSource = "select * from filename where 学号='" & Text0 & "' and 课程号='" & Text3 & "'" 从学号和课程号中查找
Form2.Adodc1.Refresh
If Not Form2.Adodc1.Recordset.EOF Then
MsgBox "已存在"
Exit Sub
End If
Form2.Adodc1.Recordset.AddNew 新增一条空白记录
Form2.Adodc1.Recordset.Fields("学号") = Text0
Form2.Adodc1.Recordset.Fields("姓名") = Text1
Form2.Adodc1.Recordset.Fields("性别") = Text2
Form2.Adodc1.Recordset.Fields("课程号") = Text3
Form2.Adodc1.Recordset.Fields("课程名") = Text4
Form2.Adodc1.Recordset.Fields("成绩") = Text5
Form2.Adodc1.Recordset.Update
Form2.Adodc1.Recordset.MoveFirst
MsgBox "记录已成功添加。"
（3）删除信息
Private Sub Combo1_Click()
Form2.Adodc1.Recordset.MoveFirst
sty = Combo1.Text
Form2.Adodc1.Recordset.find "学号='" & sty & "'"
If Form2.Adodc1.Recordset.EOF Then 如果记录到达末尾则未查找到
Combo1.ListIndex = 0
Else
Text1 = Form2.Adodc1.Recordset.Fields("姓名") 显示姓名
Text2 = Form2.Adodc1.Recordset.Fields("学号") 显示学号
End If
End Sub
Private Sub Command1_Click()
j = Combo1.ListIndex
Combo1.RemoveItem j
j = j + 1
Form2.Adodc1.Recordset.Delete 删除记录
Form2.Adodc1.Recordset.MoveNext
If Form2.Adodc1.Recordset.EOF Then Form2.Adodc1.Recordset.MoveLast
If j > Combo1.ListCount - 1 Then j = Combo1.ListCount - 1
Combo1.ListIndex = j
Text1 = Form2.Adodc1.Recordset.Fields("姓名") 显示姓名
Text2 = Form2.Adodc1.Recordset.Fields("学号") 显示学号
End Sub
Private Sub Command2_Click()
i = MsgBox("继续?" & vocal & "—点击确定返回删除界面" & vocal & "—点击取消直接返回主界面", vbOKCancel, "思考中……")
If i = 2 Then Unload Me 关闭删除窗体
End Sub
Private Sub Command3_Click()
Unload Me 关闭删除窗体
End Sub
Private Sub Form_Load()
https://www.doczj.com/doc/4c11364466.html,mandType = adCmdTable 指定命令类型为adCmdTable
Form2.Adodc1.RecordSource = "filename" 数据源为全部数据（filename）
Form2.Adodc1.Refresh
Form2.Adodc1.Recordset.
MoveFirst 移动到第一条记录
Do While Not (Form2.Adodc1.Recordset.EOF)
Combo1.AddItem Form2.Adodc1.Recordset.Fields("学号") 列表框中添加全部学号
Form2.Adodc1.Recordset.MoveNext 记录下移一条
Loop
Form2.Adodc1.Recordset.MoveFirst
Combo1.ListIndex = 0
End Sub
（4）修改信息
Private Sub Command1_Click()
s = MsgBox("确定修改此学生信息？", vbOKCancel)
If s = vbOK Then
Form2.Adodc1.Recordset.Fields("姓名") = Text1 修改姓名
Form2.Adodc1.Recordset.Fields("性别") = Text3 修改性别
Form2.Adodc1.Recordset.Fields("课程号") = Text4 修改课程号
Form2.Adodc1.Recordset.Fields("课程名") = Text5 修改课程名
Form2.Adodc1.Recordset.Fields("成绩") = Text6 修改成绩
MsgBox "修改成功！"
Else
Form2.Adodc1.Recordset.CancelUpdate 更新记录
End If
End Sub
绘图
Public a As Single, b As Single, c As Single, d As Single, e As Single, num As Single
（5）绘制直方图
Sub Creat()
Form6.Scale (-12, -8)-(8, 8) 'Form6.Scale (-6, 8)-(12, -2)
Form6.Line (-5, 4)-(8, 4), vbBlue
Form6.Line (-5, 4)-(-5, -5), vbRed
Form6.CurrentX = 2: Form6.CurrentY = -2
a1 = 12 * a / num
b1 = 12 * b / num
c1 = 12 * c / num
d1 = 12 * d / num
e1 = 12 * e / num
Form6.Line (-4.5, 4)-(-3, -a1 + 4), vbRed, BF
Form6.Line (-2.5, 4)-(-1, -b1 + 4), vbGreen, BF
Form6.Line (-0.5, 4)-(1, -c1 + 4), vbBlue, BF
Form6.Line (1.5, 4)-(3, -d1 + 4), RGB(210, 0, 200), BF
Form6.Line (3.5, 4)-(5, -e1 + 4), RGB(170, 180, 0), BF
End Sub
Sub litizf()
Creat ‘调用create函数
Dim i%, x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single
Form6.Line (-11, -7)-(-9, -6.5), vbRed, BF 绘制红色矩形
Form6.CurrentX = -8.9: Form6.CurrentY = -7: Form6.Print "90-100分"
Form6.Line (-11, -6.5)-(-9, -6), vbGreen, BF 绘制绿色矩形
Form6.CurrentX = -8.9: Form6.CurrentY = -6.5: Form6.Print "80-89 分"
Form6.Line (-11, -6)-(-9, -5.5), vbBlue, BF 绘制蓝色矩形
Form6.CurrentX = -8.9: Form6.CurrentY = -6: Form6.Print "70-79 分"
Form6.Line (-11, -5.5)-(-9, -5), RGB(210, 0, 200), BF 绘制紫红色矩形
Form6.CurrentX = -8.9: Form6.CurrentY = -5.5: Form6.Print "60-69 分"
Form6.Line (-11, -5)-(-9, -4.5), RGB(170, 180, 0), BF 绘制草绿色矩形
Form6.CurrentX = -8.9: Form6.CurrentY = -5: Form6.Print "00-59 分"
End Sub
(6)绘制饼图
Sub bingtu()
Form6.Scale (-12, -8)-(8, 8)
Dim Xs As Single
Const Pi = 3.141593
Form6.Show
Form6.FillStyle = 0
Xs = 2 * Pi / num
If a > 0 Then
Form6.FillColor = vbRed
Form6.Circle (0, 0), 6, 0, -2 * Pi, -a * Xs
End If 绘制红色扇形
If b > 0 Then
Form6.FillColor = vbGreen
F
orm6.Circle (0, 0), 6, vbGreen, -a * Xs, -(a + b) * Xs
End If 绘制绿色扇形
If c > 0 Then
Form6.FillColor = vbBlue
Form6.Circle (0, 0), 6, 0, -(a + b) * Xs, -(a + c + b) * Xs
End If 绘制蓝色扇形
If d > 0 Then
Form6.FillColor = RGB(210, 0, 200)
Form6.Circle (0, 0), 6, 0, -(a + b + c) * Xs, -(a + c + b + d) * Xs
End If 绘制紫红色扇形
If e > 0 Then
Form6.FillColor = RGB(170, 180, 0)
Form6.Circle (0, 0), 6, 0, -(a + b + c + d) * Xs, -(a + c + b + d + e) * Xs
End If 绘制草绿色扇形
Form6.Line (-11, -7)-(-9, -6.5), vbRed, BF 绘制红色矩形
Form6.CurrentX = -8.9: Form6.CurrentY = -7: Form6.Print "90-100分"
Form6.Line (-11, -6.5)-(-9, -6), vbGreen, BF绘制绿色矩形
Form6.CurrentX = -8.9: Form6.CurrentY = -6.5: Form6.Print "80-89 分"
Form6.Line (-11, -6)-(-9, -5.5), vbBlue, BF绘制蓝色矩形
Form6.CurrentX = -8.9: Form6.CurrentY = -6: Form6.Print "70-79 分"
Form6.Line (-11, -5.5)-(-9, -5), RGB(210, 0, 200), BF绘制紫红色矩形
Form6.CurrentX = -8.9: Form6.CurrentY = -5.5: Form6.Print "60-69 分"
Form6.Line (-11, -5)-(-9, -4.5), RGB(170, 180, 0), BF绘制草绿色矩形
Form6.CurrentX = -8.9: Form6.CurrentY = -5: Form6.Print "00-59 分"
End Sub
(7)保存文件
Sub baocun()
On Error GoTo abc
Dim stud As xinxi
fn = App.Path 当前文件所在路径
CommonDialog1.InitDir = fn 指定默认路径
CommonDialog1.FileName = ""
CommonDialog1.Filter = "*.txt|*.txt|*.*|*.*" 打开文本文件和所有文件
CommonDialog1.ShowSave 显示保存对话框
Open CommonDialog1.FileName For Random As #1 随机打开文件
Adodc1.Recordset.MoveFirst 记录位于首记录
With stud
Do While Not Adodc1.Recordset.EOF 判断是否到达末尾
.xuehao = Adodc1.Recordset.Fields("学号"): .xingming = Adodc1.Recor
dset.Fields("姓名").xingbie = Adodc1.Recordset.Fields("性别"): .kch = Adodc1.Recordset.Fields("课程号") 将信息存入变量中
.kcm = Adodc1.Recordset.Fields("课程名"): .cj = Adodc1. Recordset. Fields("成绩")
Put #1, , stud 写入文件保存变量stud
Adodc1.Recordset.MoveNext
Loop
End With
Close #1
Adodc1.Recordset.MoveFirst
a = MsgBox("文件写入成功!", , "提示")
abc:
End Sub
(8)按学号查询：
Private Sub anxh_Click()
Dim num$
num = InputBox("请输入要查询的学号", "学号查询")
If num <> "" Then
https://www.doczj.com/doc/4c11364466.html,mandType = adCmdUnknown
Adodc1.RecordSource = "Select * From filename Where 学号 ='" & num & "'"
Adodc1.Refresh
If Adodc1.Recordset.EOF Then
a = MsgBox("未找到！请确认输入的学号是否正确。", , "提示")
https://www.doczj.com/doc/4c11364466.html,mandType = adCmdTable
Adodc1.RecordSource = "filename" 显示全部数据记录
Adodc1.Refresh 刷新
End If
End If
End Sub
按姓名查询（同按学号）：
Adodc1.RecordSource = "Select * From filename Where 姓名 ='" + name1 + "'"
按高于某分查询（同按学号）：
Adodc1.RecordSource = "Select * From filename Where 成绩 >=" & en & ""
按低于某分值查询（同按学号）：：
Adodc1.RecordSource = "Select * From filename Where 成绩<=" & zcji & ""
(9)打开帮助文件
dbname = App.Path
If Right$(dbname, 1) <> "\" Then dbname = dbname & "\" 找到文件路径
Shell "hh.exe " + dbname + "z08050743.chm", 1 调用shell函数打开chm文件
(10)工具条按钮代码
Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1: Form3.Show
Case 2: baocun
Case 3: Form4.Show
Case 4: Form7.Show
Case 5: Form8.Show
Case 6: PopupMenu tongji
Case 7: CommonDialog1.ShowPrinter
Case 8: PopupMenu help
Case 9: End
End Select
End Sub
（11）工具条下拉菜单代码：
Private Sub Toolbar2_ButtonMenuClick(ByVal ButtonMenu as SComctlLib.ButtonMe)
Select Case ButtonMenu.Index
Case 1: anxm_Click
Case 2: anxh_Click
Case 3: zcji_Click
End Select