VB程序代码

VB程序代码 2-4 Private Sub Command1_Click() Text1.Font = "黑体" Text2.Font = "隶" End Sub Private Sub Command2_Click() Text1.ForeColor = vbRed Text2.BackColor = vbBlue End Sub Private Sub Command3_Click() End End Sub 2-5 Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) form1.BackColor = vbGreen End Sub Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) form1.BackColor = vbRed End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Text1.Text = "在窗体上抬起了鼠标" End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Text1.Text = "在窗体上anxia了鼠标" End Sub 2-6 Private Sub Command1_Click() Form1.Print "hhggg" End Sub Private Sub Command2_Click() Form1.Cls End Sub 2-8 Private Sub Command1_Click() Text1.Text = "" Text2.Text = "" Text3.Text = "" Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Command2_Click() End End Sub Private Sub Text1_Change() Text2.Text = Text1.Text Text3.Text = Text1.Text End Sub 2-10 Dim x As Single Private Sub Command1_Click() x = x + 5 Text1.FontSize = x End Sub Private Sub Command2_Click() If x < 10 Then Text1.FontSize = 5 ElseIf x >= 10 Then x = x - 5 Text1.FontSize = x End If End Sub Private Sub Command3_Click() Text1.FontUnderline = True End Sub Private Sub Command4_Click() Text1.FontStrikethru = True End Sub Private Sub Command5_Click() Text1.FontBold = True End Sub Private Sub Command6_Click() Text1.FontItalic = True End Sub 3-1 代码如下 Const pi = 3.14 Dim r As Single, h As Single Private Sub Command1_Click() r = Val(Text1.Text) h = Val(Text2.Text) Text3.Text = Val(pi * r ^ 2) Text4.Text = Val(2 * pi * r * h) Text5.Text = Val(pi * r ^ 2 * h) End Sub Private Sub Command1_Click() 3-2 代码如下 Private Sub Command1_Click() randomize Text1.Text = Int(100 * Rnd + 1) Text2.Text = Int(100 * Rnd + 1) End Sub Private Sub Command2_Click() Text3.Text=val(Text1.Text)+val(Text2.Text) 3-3 Private Sub Form_Load() Label2.Caption = DatePart("yyyy", Now) Label4.Caption = DatePart("m", Now) Label6.Caption = DatePart("d", Now) Label9.Caption = Int(DatePart("w", Now)) - 1 Label11.Caption = Time End Sub Private Sub Form_Load() Label2.Caption = Year(Now) Label4.Caption = Month(Now) Label6.Caption = Day(Now) Label9.Caption = Weekday(Now) Label11.Caption = Time End Sub 3-4 代码如下 Dim a As String Dim b As Integer Dim d As String Private Sub Text1_Change() a = UCase(Trim(Text1.Text)) d = "THE QUICK BROWN FOX JUMPS OVER A LAZY DOG" b = InStr(d, a) Text2.Text = a & " first occurs in position " & b End Sub P61 Option Explicit Dim a As Single, b As Single, c As Single Private Sub Command1_Click() a = Val(Text1.Text) b = Val(Text2.Text) c = Val(Text3.Text) Text4.Text = (a + b + c) / 3 End Sub Private Sub Command2_Click() Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Text1.SetFocus End Sub Private Sub Command3_Click() End End Sub Private Sub Text1_gotfocus() Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Text2_gotfocus() Text2.SelStart = 0 Text2.SelLength = Len(Text2.Text) End Sub Private Sub Text3_gotfocus() Text3.SelStart = 0 Text3.SelLength = Len(Text3.Text) End Sub Private Sub Text1_change() Text4.Text = "" End Sub Private Sub Text2_change() Text4.Text = "" End Sub Private Sub Text3_change() Text4.Text = "" End Sub P63 Option Explicit Private Sub Command1_Click() Dim char As String * 1 char = Text1.Text Text2.Text = Text2.Text & Space(5) & char & Space(5) & Str(Asc(char)) & vbCrLf Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub P64 Private Sub Command1_Click() Dim a As Single, b As Single, c As Single, p As Single, s As Single a = Val(Text1.Text) b = Val(Text2.Text) c = Val(Text3.Text) p = (a + b + c) / 2 s = Sqr(p * (p - a) * (p - b) * (p - c)) Label2.Caption = Format(s, "0.00") Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Form_Load() End Sub Private Sub Text1_Change() Label2.Caption = "" End Sub Private Sub Text2_Change() Label2.Caption = "" End Sub Private Sub Text3_Change() Label2.Caption = "" End Sub P65 Option Explicit Private Sub Command1_Click() MsgBox "吧vvghjjk" End Sub Private Sub Command2_Click() MsgBox "踢死信息" & vbCrLf & "huanhangtisi" End Sub Private Sub Command3_Click() MsgBox "踢死信息", , "mmjk" End Sub Private Sub Command4_Click() MsgBox "踢死信息", 1, "kll" End Sub Private Sub Command5_Click() MsgBox "踢死信息", 1 + 16, "klh" End Sub Private Sub Command6_Click() MsgBox "踢死信息", 1 + 16 + 256, "klh" End Sub P68 Option Explicit Dim x As Integer, y As Integer, z As Integer Private Sub Form_Activate() x = 5: y = 8 Print "ngfgh" Print x + y Print z = x + y ?关系达式 Print "2+4"; 2 + 4 ?表达式用分号作为分隔符时，则按紧凑输出数据 Print "2-4", 2 – 4 ‘表达式用逗号作为分隔符时，则按分区格式显示数据项 Print "2+4"; 2 + 4, 没执行一次print方法时，自动换行，如要在同一行输出，则可以在末 尾加分号或逗号 CurrentX = 1000 决定下一次打印的水平或垂直坐标 CurrentX = 500 Print "2+4"; Print 2 - 4 Print 省略表达式，则输出一个空行或取消前面print的逗号或分号的作用 Print "2+4"; 2 + 4, Print Form1.Show 若在form-load事件中，必须首先使用show 或把窗体对象.图片框的 autoredraw属性设置为true，否则print不起作用 Print "ghjgfg" Print "2+4"; 2 + 4, Print "2+4"; Print 2 + 4 End Sub Private Sub Form_Load() Form1.Print "jggfhj" End Sub P69 Private Sub Form_Activate() Print "ghfdggf" Print "gffd"; Tab(10); "fgd" '第二个输出项在10列输出 Print "gfgdd"; Tab; "fghjk" 'tab函数无参数，第二项在第二个打印去输出 Print "ddffg"; Tab(4); "fghh" 'n小雨当前打印位置，第二项在下一行输出 Print Tab(-5); "ghfl" 'n小于1，在第一列输出 Print "lkkj"; Spc(3); "gfdds" '跳过3个空格 End Sub P70 Private Sub Command1_Click() Dim h As Integer, f As Integer, x As Integer, y As Integer h = Val(Text1.Text) f = Val(Text2.Text) x = (4 * h - f) / 2 y = (f - 2 * h) / 2 Label3.Caption = Label3.Caption & Str(x) & "只" Label4.Caption = Label4.Caption & Str(y) & "只" End Sub Private Sub Text1_gotfocus() Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Text2_gotfocus() Text2.SelStart = 0 Text2.SelLength = Len(Text2.Text) End Sub P71 Private Sub Command1_Click() Dim A As Integer, B As Integer Randomize A = Val(Text1.Text) B = Val(Text2.Text) Label5.Caption = Str(Int(Rnd * (B - A + 1) + A)) '产生[A，B]区间的随机整数 Label6.Caption = Str(Int(Rnd * (B - A + 1) + A)) Label7.Caption = Str(Int(Rnd * (B - A + 1) + A)) End Sub Private Sub Text1_GotFocus() Text1.SelStart = 0 '在TEXT获得焦点时，选中其中的文本 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Text2_GotFocus() Text2.SelStart = 0 Text2.SelLength = Len(Text2.Text) End Sub P72 Private Sub Form_Load() Dim M As Long, TEMP As String Show M = 2 ^ 30 TEMP = Str(M) '将M转换成字符串 Label1.Caption = "2^30" Label3.Caption = Label3.Caption & TEMP CurrentX = 2000 '定义窗体当前打印位置的X，Y坐标 CurrentY = 2000 Print "总共有"; Len(Trim(TEMP)); "位" '使用TRIM去除空格 End Sub P72 Private Sub Command1_Click() Dim PhoneNO As String, n As Integer Dim tmp As String, num As Long PhoneNO = Trim(Text1.Text) n = Len(PhoneNO) tmp = Right(PhoneNO, 7) num = Val(tmp) + 61000000 PhoneNO = Left(PhoneNO, n - 7) + "-" + Trim(Str(num)) Text2.Text = PhoneNO End Sub 4-1 Option Explicit Dim a As Single, b As Single Private Sub Command1_Click() a = Val(Text1.Text) b = Val(Text2.Text) Text3.Text = a * b End Sub Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 13 ?当焦点在该位置时,点ENTER相当于点击鼠标 End Sub Private Sub Command2_Click() End End Sub Private Sub Command2_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 13 End Sub Private Sub Text1_GotFocus() Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Text2_GotFocus() Text2.SelStart = 0 Text2.SelLength = Len(Text1.Text) End Sub 4-2 Dim A As Single, B As Single, C As Single '定义A.B.C变量 Private Sub Command1_Click() A = Val(T1.Text) '给变量赋值 B = Val(T2.Text) C = Val(T3.Text) TRESULT.Text = A * B * (1 - C) '计算应付款 T3.SetFocus End Sub Private Sub Command2_Click() TRESULT.Text = "" '清除应付款 T3.SetFocus '将焦点定位在“折扣”一栏，选中“折扣”中的 T3.SelStart = 0 T3.SelLength = Len(TRESULT.Text) End Sub Private Sub Command3_Click() End End Sub 4-3 Dim A As Single, B As Single, C As Single Const PI = 3.141 '定义变量 Private Sub Command1_Click() A = Val(Text1.Text) / 180 * PI B = Abs(Sin(A)) '分别计算sin,cos C = Abs(Cos(A)) Text2.Text =Text2.Text & Space(5) & Format(A, "0.000") & Space(25) & Format(B, "0.000") & Space(30) & Format(C, "0.000") & vbCrLf '每次计算结果赋在上次计 算结果之后，显示于带垂直滚动条的文本框中，所有结果保留3位小数 Text1.SetFocus '每次计算完，选中输入的文本，一边继续输入 Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub 4-4 Dim a As Single, b As Single, c As Single Private Sub Form_Click() a = InputBox("请输入小时") b = InputBox("请输入分") c = InputBox("请输入秒") Print a & "小时" & b & "分" & c & "秒 =" & a * 3600 + b * 60 + c & "秒" End Sub 4-6 Option Explicit Dim a As Single, b As Single, c As Single, d As Single, e As Single, f As Single Private Sub Command1_Click() a = Val(Text1.Text) b = Val(Text2.Text) c = Val(Text3.Text) d = Val(Text4.Text) e = Val(Text5.Text) f = Val(Text6.Text) Label5.Caption = "X=" & (c * e - b * f) / (a * e - b * d) Label6.Caption = "Y=" & (a * f - d * c) / (a * e - b * d) End Sub Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 13 设置ENTER键 End Sub Private Sub Command2_Click() Text1.Text = "" Text2.Text = "" Text3.Text = "" 清除 Text4.Text = "" Text5.Text = "" Text6.Text = "" Label5.Caption = "" Label6.Caption = "" End Sub Private Sub Text1_GotFocus() Text1.SelStart = 0 ?获得焦点是,选中文本 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Text2_GotFocus() Text2.SelStart = 0 Text2.SelLength = Len(Text2.Text) End Sub Private Sub Text3_GotFocus() Text3.SelStart = 0 Text3.SelLength = Len(Text3.Text) End Sub Private Sub Text4_GotFocus() Text4.SelStart = 0 Text4.SelLength = Len(Text4.Text) End Sub Private Sub Text5_GotFocus() Text5.SelStart = 0 Text5.SelLength = Len(Text5.Text) End Sub Private Sub Text6_GotFocus() Text6.SelStart = 0 Text6.SelLength = Len(Text6.Text) End Sub 4-6-1 Private Sub Text1_GotFocus() Text1.SelStart = 0 '将焦点设置在text1,雪中所有内容 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Text2_GotFocus() Text2.SelStart = 0 Text2.SelLength = Len(Text2.Text) End Sub P76 Dim x As Single, y As Single Private Sub Command1_Click() x = Val(Text1.Text) If x <= 0 Then y = Abs(x) Else y = Log(x) Label3.Caption = y Text1.SetFocus Text1.SelStart = 0 '将焦点设置在text1,雪中所有内容 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 13 End Sub P76 Dim x As Single, y As Single Private Sub Command1_Click() x = Val(Text1.Text) y = Val(Text2.Text) If x = 0 Or y = 0 Then Print "ngj": Exit Sub If x > 0 Then If y > 0 Then Print "在第一象限" Else Print "在第四象限" Else If y > 0 Then Print "在第二象限" Else Print "在第三象限" End Sub Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 13 End Sub Private Sub Text1_GotFocus() Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Text2_GotFocus() Text2.SelStart = 0 Text2.SelLength = Len(Text2.Text) End Sub Dim x As Single, y As Single Private Sub Command1_Click() x = Val(Text1.Text) y = Val(Text2.Text) If x = 0 Or y = 0 Then Print "该点不在任何象限内" ElseIf x > 0 And y > 0 Then Print "在第一象限" ElseIf x > 0 And y < 0 Then Print "在第四象限" ElseIf x < 0 And y < 0 Then Print "在第三象限" Else Print "在第二象限" End If End Sub Private Sub Text1_GotFocus() Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Text2_GotFocus() Text2.SelStart = 0 Text2.SelLength = Len(Text2.Text) End Sub P79 Option Explicit Dim c As Single Private Sub Command1_Click() c = 5 / 9 * (Val(Text1.Text) - 32) Text2.Text = Format(c, "0.00") If c > 40 Then Label2.Caption = "hot" ElseIf c > 30 And c <= 40 Then Label2.Caption = "warm" ElseIf c > 20 And c <= 30 Then Label2.Caption = "room temperature" ElseIf c > 10 And c <= 20 Then Label2.Caption = "cool" ElseIf c > 0 And c <= 10 Then Label2.Caption = "cold" Else Label2.Caption = "freezing" End If End Sub Private Sub Text1_GotFocus() Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub Dim c As Single Private Sub Command1_Click() c = 5 / 9 * (Val(Text1.Text) - 32) Text2.Text = Format(c, "0.00") If c > 40 Then Label2.Caption = "hot" ElseIf c > 30 Then Label2.Caption = "warm" ElseIf c > 20 Then Label2.Caption = "room temperature" ElseIf c > 10 Then Label2.Caption = "cool" ElseIf c > 0 Then Label2.Caption = "cold" Else Label2.Caption = "freezing" End If End Sub Private Sub Text1_GotFocus() Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub P82 Option Explicit Dim x As Single, y As Single Private Sub Command1_Click() x = Val(Text1.Text) Select Case x Case Is < 0 y = Exp(x) + Exp(-x) Case 0 y = 1.25 Case Is > 0 y = Log(x) / Log(10) End Select Text2.Text = Format(y, "0.000000") End Sub Private Sub Text1_GotFocus() Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub P83 Option Explicit Dim x As Double, y As Double, z As Double, a As Double Private Sub Command1_Click() x = Val(Text1.Text) y = Val(Text2.Text) z = Val(Text3.Text) Select Case z Case Is < 250 a = 0 Case Is < 500 a = 0.02 Case Is < 1000 a = 0.05 Case Is < 2000 a = 0.08 Case Is < 3000 a = 0.1 Case Else a = 0.15 End Select Text4.Text = x * y * z * (1 - a) End Sub P84 Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer) Static i As Integer If KeyCode = 13 Then If UCase(Text1.Text) = "kkll" Then Label2.Caption = "恭喜～您进入了本系统" ElseIf i = 0 Or i = 1 Then i = i + 1 Label2.Caption = "口令错!请重新输入" Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) Else MsgBox "对不起，你不能进入本系统" End If End If End Sub P86 Option Explicit Dim a As Double, b As Double, c As Double, x As Double, y As Double, d As Double Private Sub Command1_Click() a = Val(Text1.Text) b = Val(Text2.Text) c = Val(Text3.Text) Cls CurrentX = 600 CurrentY = 1100 If a = 0 Then If b = 0 Then MsgBox "系数为零，请重新输入" Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) Else x = -c / b Print "x="; Format(x, "0.000") End If Exit Sub End If d = b ^ 2 - 4 * a * c Select Case d Case 0 Print "x1=x2"; Format(-b / (2 * a), "0.000") Case Is > 0 Print "x1="; Format((-b + Sqr(d)) / (2 * a), "0.000") CurrentX = 600 CurrentY = 1300 Print "x2="; Format((-b - Sqr(d)) / (2 * a), "0.000") Case Is < 0 Print "x1="; Format(-b / (2 * a), "0.000"); "+"; Format(Sqr(Abs(d)) / (2 * a), "0.000"); "i" CurrentX = 600 CurrentY = 1300 Print "x2="; Format(-b / (2 * a), "0.000"); "+"; Format(Sqr(Abs(d)) / (2 * a), "0.000"); "i" End Select End Sub Private Sub Text1_GotFocus() Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Sub Private Sub Text2_GotFocus() Text2.SelStart = 0 Text2.SelLength = Len(Text2.Text) End Sub Private Sub Text3_GotFocus() Text3.SelStart = 0 Text3.SelLength = Len(Text3.Text) End Sub P86 Dim a As String Private Sub Text1_Change() Label2.Caption = Trim(Text1.Text) End Sub Private Sub Command1_Click() Randomize Text2.Text = Int(Rnd * 1001) Text3.Text = Int(Rnd * 1001) Text4.Text = "" End Sub Private Sub Command2_Click() If Label2.Caption = "+" Then Text4.Text = Val(Text2.Text) + Val(Text3.Text) ElseIf Label2.Caption = "-" Then Text4.Text = Val(Text2.Text) - Val(Text3.Text) ElseIf Label2.Caption = "*" Then Text4.Text = Val(Text2.Text) * Val(Text3.Text) ElseIf Label2.Caption = "/" Then Text4.Text = Val(Text2.Text) / Val(Text3.Text) Else a = MsgBox("运算错，请重输", , "警告") Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End If End Sub Private Sub Command3_Click() Select Case Label2.Caption Case "+" If Text4.Text = Val(Text2.Text) + Val(Text3.Text) Then Label4.Caption = "正确" Else Label4.Caption = "错误" End If Case "-" If Text4.Text = Val(Text2.Text) - Val(Text3.Text) Then Label4.Caption = "正确" Else Label4.Caption = "错误" End If Case "*" If Text4.Text = Val(Text2.Text) * Val(Text3.Text) Then Label4.Caption = "正确" Else Label4.Caption = "错误" End If Case "/" If Text4.Text = Val(Text2.Text) / Val(Text3.Text) Then Label4.Caption = "正确" Else Label4.Caption = "错误" End If Case Else a = MsgBox("运算错，请重输", , "警告") Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Select End Sub Private Sub Command4_Click() End End Sub 黎稳 2010110096 5-1 Dim a As Integer, b As Integer, c As Integer ?定义变量 Private Sub Text1_Click() Text1.Text = InputBox("请输入一个整数") ‘用InputBox()函数输给文本框text1 一个整数 End Sub Private Sub Command1_Click() a = Val(Text1.Text) Mod 3 ‘同时除以3.5.7取余数 b = Val(Text1.Text) Mod 5 c = Val(Text1.Text) Mod 7 If a = 0 And b = 0 And c = 0 Then Label1.Caption = "能同时被3.5.7整除" _ Else Label1.Caption = "不能整除" ‘判断text1中的整数能否被3.5.7整除 ?能整除时显示“能同时被3.5.7整除”，否则显示“不能整除” End Sub 5-2 Option Explicit Dim a As Single, b As Single, c As Single, max As Single, min As Single Private Sub Form_Load() Show Text1.Text = InputBox("ii") Text2.Text = InputBox("ii") Text3.Text = InputBox("ii") a = Val(Text1.Text) b = Val(Text2.Text) c = Val(Text3.Text) max = a If b > max Then max = b If c > max Then max = c Print "最大值:"; max min = a If b < min Then min = b If c < min Then min = c Print "最小值:"; min End Sub 5-3 Dim a As Single, b As Single Private Sub Command1_Click() Label1.Caption = "y=" a = Val(Trim(Text1.Text)) b = Val(Trim(Text2.Text)) If a > 0 And b > 0 Then Label2.Caption = Str(Log(a) + Log(b)) ElseIf a > 0 And b <= 0 Then Label2.Caption = Str(Sin(a) + Sin(b)) Else Label2.Caption = Str(Sin(a) + Cos(b)) End If End Sub 5-4 Dim a As Single Private Sub Command1_Click() a = Val(Text1.Text) If a <= 800 Then Text2.Text = "" ElseIf a > 800 And a <= 2000 Then Text2.Text = (a - 800) * 0.1 Else Text2.Text = (a - 800) * 0.2 End If End Sub 5-6 Dim a As Single, b As Integer Private Sub Command1_Click() a = Val(Text1.Text) If a > 100 Or a < 0 Then b = MsgBox("成绩无效", 1 + 48, "学生成绩") Select Case a Case Is >= 90 Label1.Caption = "优" Case Is >= 80 Label1.Caption = "良" Case Is >= 70 Label1.Caption = "中" Case Is >= 60 Label1.Caption = "及格" Case Is >= 0 Label1.Caption = "不及格" End Select End Sub 5-6 Dim a As Integer, b As Integer, c As Integer, d As Single, e As Integer Private Sub Command1_Click() a = Val(Text2.Text) 'text2中输入月份 Select Case a Case 4, 6, 9, 11 '月份为4.6.9.11个月的天数为30 Text3.Text = 30 Case 1, 3, 5, 7, 8, 10, 12 '月份为4.6.9.11个月的天数为30 Text3.Text = 31 Case Else c = Val(Text1.Text) Mod 4 'text1中的年份分别除以4，100，400 d = Val(Text1.Text) Mod 100 e = Val(Text1.Text) Mod 400 If c = 0 And d <> 0 Then '判断年份能否被4整除，但不能被一百整除， '条件满足则2月份天数为29天。或者能否被400整除，条件满足则2月份为29天。否则为28天 Text3.Text = 29 ElseIf e = 0 Then Text3.Text = 29 Else Text3.Text = 28 End If End Select End Sub 小学生算术 Dim insign As Integer, d As String, a As Integer, b As Integer, c As Integer '定义变量 Private Sub Form_Load() Randomize Label1.Caption = Int(Rnd * 101) '在label1，label2中产生随机数 Label3.Caption = Int(Rnd * 101) insign = Int(Rnd * 101) Mod 3 '对变量insign取余数 Select Case insign '当insign分别等于0，1，2时，Label2.Caption分别为+，-，*; 且Label4.Caption 自动生成 "=" Case 0 Label2.Caption = "+": Label4.Caption = "=" Case 1 Label2.Caption = "-": Label4.Caption = "=" Case 2 Label2.Caption = "*": Label4.Caption = "=" End Select End Sub Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then '如果按下回车键 d = Val(Trim(Text1.Text)) '在text1中输入一个整数 Select Case insign Case 0 If d = Val(Label1.Caption) + Val(Label3.Caption) Then 'label2.caption为+时，比较text1中的值与表达式的值 Label5.Caption = "很好" d = MsgBox("要继续练习吗", 1 + 32) '如果text1的值与表达式的值相等，则用MsgBox函数提示信息问―要继续练习吗,‖，由回答结果确定与否决定退出练习或继续练习，继续时再次生成新的表达式，Text1置空 Label1.Caption = Int(Rnd * 101) Label3.Caption = Int(Rnd * 101) Else Label5.Caption = "很遗憾～" '若输入与准确值不相等， Label5中写入―很遗憾～‖，并选中Text1的所有文本，等待学生新的输入。 End If Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) Case 1 If d = Val(Label1.Caption) - Val(Label3.Caption) Then '当 label2.caption为+时，比较text1中的值与表达式的值 Label5.Caption = "很好" d = MsgBox("要继续练习吗", 1 + 32) '如果 text1的值与表达式的值相等，则用MsgBox函数提示信息问―要继续练习吗,‖，由回答结 果确定与否决定退出练习或继续练习，继续时再次生成新的表达式，Text1置空 Label1.Caption = Int(Rnd * 101) Label3.Caption = Int(Rnd * 101) Else Label5.Caption = "很遗憾～" '若输入与准确值 不相等， Label5中写入―很遗憾～‖，并选中Text1的所有文本，等待学生新的输入。 End If Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) Case 2 If d = Val(Label1.Caption) * Val(Label3.Caption) Then ' 当label2.caption为+时，比较text1中的值与表达式的值 Label5.Caption = "很好" d = MsgBox("要继续练习吗", 1 + 32) '如 果text1的值与表达式的值相等，则用MsgBox函数提示信息问―要继续练习吗,‖，由回答 结果确定与否决定退出练习或继续练习，继续时再次生成新的表达式，Text1置空 Label1.Caption = Int(Rnd * 101) Label3.Caption = Int(Rnd * 101) Else Label5.Caption = "很遗憾～" '若输入与准确 值不相等， Label5中写入―很遗憾～‖，并选中Text1的所有文本，等待学生新的输入。 End If Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End Select End If End Sub Dim a As String Private Sub Form_Load() Text1.Text = "" End Sub Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer) Static i As Integer If KeyCode = 13 Then If Text1.Text = "liwen" Then Shell "c:\winnt\system32\form2.exe", vbNormalFocus ElseIf i = 0 Or i = 1 Then i = i + 1 Form1.Caption = "口令错，请重新输入" Else a = MsgBox("对不起，您不能使用本系统", 1 + 48) End End If End If End Sub 5-7 Dim b As Integer Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = 13 End Sub Private Sub Command1_Click() Static a As Integer If Text1.Text = "li187" Then b = MsgBox("欢迎") ElseIf a = 0 Or a = 1 Then a = a + 1 Form1.Caption = "口令错" Else MsgBox "对不起" End If End Sub Option Base 1 Private Sub Command1_Click() Dim c() As Integer, b As Integer, g As String Text1.Text = "" b = Val(InputBox("请输入总人数", "", "")) '输入总人数 ReDim c(b) Call li1(b, c()) '调用过程li1 For i = 1 To b Text1.Text = Text1.Text & Str(c(i)) '成绩显示在Text1中 Next i Call li2(b, c(), g) '调用过程li2，成绩数组元素的最大、最小值并记录最大值、最小值所在的位置 Label1.Caption = g Text2.Text = "" Call li3(b, c()) '调用过程li3，将排序后的成绩显示在Text2 For i = 1 To b Text2.Text = Text2.Text & Str(c(i)) Next i End Sub Sub li1(n As Integer, ByRef score() As Integer) Randomize ReDim score(n) '过程li1随机产生n个成绩 For i = 1 To n score(i) = Val(Int(101 * Rnd)) Next i End Sub Sub li2(n As Integer, c() As Integer, f As String) Dim MAX As Integer, MIN As Integer, d As Integer, e As Integer MAX = c(1): MIN = c(1) For i = 1 To n If MAX < c(i) Then '排序，如果max大于c(i)则将c(i)赋给max MAX = c(i) d = i End If If MIN > c(i) Then '排序，如果MIN大于c(i)则将c(i)赋给MIN MIN = c(i) e = i End If Next f = "最高分为:" & Str(MAX) & "分" & "在第" & Str(d) & "位" & "最低分为:" & Str(MIN) & "分" & "在第" & Str(e) & "位" End Sub Sub li3(b As Integer, c() As Integer) Dim t As Integer, i As Integer, j As Integer For i = 1 To b - 1 For j = i + 1 To b '过程li2排序 If c(i) < c(j) Then t = c(i) c(i) = c(j) c(j) = t End If Next j, i End Sub 实验六、数组应用.. 一.实验目的 ?掌握数组基本概念，数组的多种定义方法(静态、动态;一维、二维) ?掌握数组的输入输出及数组删除释放存储空间; ?使用多种程序设计结构对数组元素进行统计、添加、删除、排序等操作; ?创建控件数组，达到可多样化地输出数组的运行效果。 通过本实验，学生可以掌握数组的基本操作;进一步熟悉各种结构程序设计编程技巧;感受数组结合控件 设计方法的技巧。 二.实验内容和步骤: 实验内容:(两个题目) 本实验的所有数据处理算法、界面风格设计及事件过程均由学生自行设计、实现。 题目7-1: 随机生成 [40，100]上20位学生的两门课程成绩(事件1),完成以下功能: ?分别求出各门课程学生成绩的最高分、最低分和平均分;(事件2) ?求每位学生两门课程的平均分数，按此分数分段统计各分数段的人数并显示;(事件3) 7-1题目窗体界面标题:―学生成绩统计程序,设计者姓名‖。 题目7-2:(用控件数组实现,如多个按钮，多个文本框) 输入N位学生(或运功员)的单门课程(或单目比赛)成绩并显示(事件1)，其中人数N，由读入得到; ?对数组按值从大到小排序后并显示成绩(事件2) ?给出某成绩，删除数组的该成绩记录并显示(若无，显示相应信息); (事件3) ?给出新成绩，添加到成绩数组中并显示 。(事件4) 黎稳 2010110096 7-1 Option Base 1 Dim A() As Integer, B() As Integer, SCORE() As Single Private Sub Command1_Click() Text1.Text = "" '清空 Text5.Text = "" n = 20 ReDim A(n), B(n) For i = 1 To 20 Randomize A(i) = Int(Rnd * 61 + 40) '随机生成40-100之间的20个数，显示在text1中 Text1.Text = Text1.Text & Str(A(i)) B(i) = Int(Rnd * 61 + 40) '随机生成40-100之间的20个数，显示在text5中 Text5.Text = Text5.Text & Str(B(i)) Next i End Sub Private Sub Command2_Click() Dim MAX1 As Integer, MIN1 As Integer, AVER1 As Integer, MAX2 As Integer, MIN2 As Integer, AVER2 As Integer, SUM1 As Integer, SUM2 As Integer MAX1 = A(1): MIN1 = A(1): MAX2 = B(1): MIN2 = B(1): SUM1 = 0: SUM2 = 0 For i = 1 To 20 If MAX1 < A(i) Then '排序，如果max1小于A(i)则将A(i)赋给max1 MAX1 = A(i) End If If MAX2 < B(i) Then '排序，如果max2小于B(i)则将B(i)赋给max2 MAX2 = B(i) End If Text2.Text = Str(MAX1) Text6.Text = Str(MAX2) If MIN1 > A(i) Then '排序，如果MIN1小于A(i)则将A(i)赋给MIN1 MIN1 = A(i) End If If MIN2 > B(i) Then '排序，如果MIN2小于B(i)则将B(i)赋给MIN2 MIN2 = B(i) End If Text3.Text = Str(MIN1) Text7.Text = Str(MIN2) SUM1 = SUM1 + A(i) '累加A(i) SUM2 = SUM2 + B(i) Next Text4.Text = Str(SUM1 / 20) '求课程1的平均成绩 Text8.Text = Str(SUM2 / 20) '求课程2的平均成绩 End Sub Private Sub Command3_Click() Dim NUM1 As Single, NUM2 As Single, NUM3 As Single n = 20 ReDim SCORE(n) For i = 1 To n SCORE(i) = (Val(A(i)) + Val(B(i))) / 2 Text9.Text = Text9.Text & Str(SCORE(i)) If SCORE(i) >= 40 And SCORE(i) < 60 Then '如果分数在40-60则NUM1加1 NUM1 = NUM1 + 1 ElseIf SCORE(i) >= 60 And SCORE(i) < 80 Then '如果分数在60-80则NUM2加1 NUM2 = NUM2 + 1 Else NUM3 = NUM3 + 1 End If Text10.Text = Str(NUM1): Text11.Text = Str(NUM2): Text12.Text = Str(NUM3) '如果分数在80-100则NUM3加1 Next End Sub 7-2 Option Base 1 Dim score() As Integer, n As Integer Private Sub Command1_Click() Dim a As String n = Val(InputBox("请输入总人数", "", "")) ReDim score(n) Text1.Text = "" For I = 1 To n score(I) = Val(InputBox("请输入" & Str(I) & "个学生的成绩", "请输入成绩", "")) Text1.Text = Text1.Text & Str(score(I)) Next I End Sub Private Sub Command2_Click() For I = 1 To n - 1 For j = I + 1 To n If score(I) > score(j) Then t = score(I) score(I) = score(j) score(j) = t End If Next j, I Text2.Text = "" For I = 1 To n Text2.Text = Text2.Text & Str(score(I)) Next I End Sub Private Sub Command3_Click() Dim c As Integer, d As String, k As Integer c = Val(Text3.Text) For I = 1 To n If score(I) = c Then k = I End If Next I If k <= 0 Or k > n Then MsgBox "没找到该分数" Else For I = k To n - 1 score(I) = score(I + 1) Next I Text4.Text = "" For I = 1 To n - 1 Text4.Text = Text4.Text & Str(score(I)) Next I End If End Sub Private Sub Command4_Click() Dim num As Integer, pos As Integer num = Val(Text5.Text) pos = Val(Text6.Text) ReDim Preserve score(n) Select Case pos Case Is <= 1 'Pos <= 1, 将Num插在第1个位置 For I = n To 2 Step -1 score(I) = score(I - 1) '对数组的元素全部向后移动一个位置 Next I score(1) = num ' 插入 Case Is >= n ' Pos, = N ，则将Num插在最后一个位置 score(n) = num ' 插入 Case Else '在数组中插入 For I = n To pos + 1 Step -1 score(I) = score(I - 1) Next I score(pos) = num ' 插入 End Select For I = 1 To n Text7.Text = Text7.Text & Str(score(I)) Next I End Sub 实验七、过程调用 实验题目:编写一个学生(或运动员)成绩管理的应用程序，要求具有以下3个功能,每一个功能由自定义过程或自定义函数过程实现: ? 随机生成 [0，100]上n位学生的单门课程成绩(或[0，10] 上n位运动员的单次比赛成绩); 其中过程形式如:Sub 过程名(N As Integer,Scrore()As Integer) ，虚参Score()为成绩数组，N为数组元素的上界; ?分别求出成绩数组元素的最大、最小值并记录最大值、最小值所在的位置(即对应的哪位同学(或运动员)); ?对数组按成绩值从大到小排序; 其中过程形式为:Sub 过程名(N As Integer,Score()As Integer)。 实验要求: 建立一个窗体，窗体界面标题为:―学生(或运动员)成绩管理程序—设计者姓名‖。 (1)在窗体中调用Sub子过程产生学生(或运动员)的原始成绩，将其显示在文本框1或其他控件中; (2)调用Sub过程或函数过程完成学生(或运动员)成绩的计算(即功能?)操作,并显示计算结果; (3)调用Sub过程实现成绩排序，并将结果显示在文本框2或其他控件中。 注意: 1) 提交实验报告(电子版和书面两种形式，实验报告模板可参考数组应用)。电子版实验报告文件命名:后8位学号-过程调用实验.doc。 2) 提交题目的.exe文件，文件命名:后8位学号_7-1 .exe Option Base 1 Private Sub Command1_Click() Dim c() As Integer, b As Integer, g As String Text1.Text = "" b = Val(InputBox("请输入总人数", "", "")) '输入总人数 ReDim c(b) Call li1(b, c()) '调用过程li1 For i = 1 To b Text1.Text = Text1.Text & Str(c(i)) '成绩显示在Text1中 Next i Call li2(b, c(), g) '调用过程li2，成绩数组元素的最大、最小值并记录最大值、最小值所在的位置 Label1.Caption = g Text2.Text = "" Call li3(b, c()) '调用过程li3，将排序后的成绩显示在Text2 For i = 1 To b Text2.Text = Text2.Text & Str(c(i)) Next i End Sub Sub li1(n As Integer, ByRef score() As Integer) Randomize ReDim score(n) '过程li1随机产生n个成绩 For i = 1 To n score(i) = Val(Int(101 * Rnd)) Next i End Sub Sub li2(n As Integer, c() As Integer, f As String) Dim MAX As Integer, MIN As Integer, d As Integer, e As Integer MAX = c(1): MIN = c(1) For i = 1 To n If MAX < c(i) Then '排序，如果max大于c(i)则将c(i)赋给max MAX = c(i) d = i End If If MIN > c(i) Then '排序，如果MIN大于c(i)则将c(i)赋给MIN MIN = c(i) e = i End If Next f = "最高分为:" & Str(MAX) & "分" & "在第" & Str(d) & "位" & "最低分为:" & Str(MIN) & "分" & "在第" & Str(e) & "位" End Sub Sub li3(b As Integer, c() As Integer) Dim t As Integer, i As Integer, j As Integer For i = 1 To b - 1 For j = i + 1 To b '过程li2排序 If c(i) < c(j) Then t = c(i) c(i) = c(j) c(j) = t End If Next j, i End Sub