VB程序代码

VB程序代码 1、调用多个应用程序 Option Explicit Dim i As Integer Private Sub Command1_Click() i = Shell("C:\WINDOWS\system32\calc.exe") End Sub Private Sub Command2_Click() i = Shell("C:\WINDOWS\system32\mspaint.exe", 1) End Sub Private Sub Command3_Click() i = Shell("C:\Program Files\Microsoft Office\OFFICE11\WINWORD.EXE", 1) End Sub Private Sub Command4_Click() i = Shell("C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE", 1) End Sub Private Sub Command5_Click() i = Shell("C:\Program Files\Microsoft Office\OFFICE11\POWERPNT.EXE", 1) End Sub 2、圆的计算和字体缩放 Private Sub Command1_Click() Text1 = "" Text2 = "" Text3 = "" End Sub Private Sub Command2_Click() Text2 = 2 * 3.14 * Val(Text1) Text3 = 3.14 * Val(Text1) ^ 2 End Sub Private Sub Command3_Click() Text1.FontSize = Text1.FontSize + 5 Text2.FontSize = Text2.FontSize + 5 Text3.FontSize = Text3.FontSize + 5 End Sub Private Sub Command4_Click() Text1.FontSize = Text1.FontSize - 5 Text2.FontSize = Text2.FontSize - 5 Text3.FontSize = Text3.FontSize - 5 End Sub 3、移动的图片 Private Sub Command1_Click() Timer1.Interval = 1000 End Sub Private Sub Command2_Click() Timer1.Interval = 0 End Sub Private Sub Timer1_Timer() Dim z% z = Int(Rnd * 100 + 1) Image1.Left = Int(Rnd * (Form1.Left - Image1.Left)) Image1.Top = Int(Rnd * (Form1.Top - Image1.Top)) End Sub 4、随机三位数～并求其各个位置上的数字 Private Sub Command1_Click() Dim x%, y% x = Val(Text1): y = Val(Text2) Text3 = Int(Rnd * (y - x + 1) + x) End Sub Private Sub Command2_Click() Dim a%, b%, c%, s% s = Val(Text3) a = s \ 100 b = (s - a * 100) \ 10 c = s - a * 100 - b * 10 Text4 = a: Text5 = b: Text6 = c End Sub Private Sub Command3_Click() Text4 = Left(Text3, 1) Text5 = Mid(Text3, 2, 1) Text6 = Right(Text3, 1) End Sub Private Sub Command4_Click() Text4 = "": Text5 = "": Text6 = "" End Sub Private Sub Command5_Click() End End Sub 5、正向正三角形 Private Sub Command1_Click() Dim i% For i = 1 To 9 Print Tab(20 - i); For j = 1 To 2 * i - 1 Print "*"; Next j Print Next i End Sub 6、倒向正三角形 Private Sub Command2_Click() Dim i% For i = 1 To 9 Print Tab(10 + i); For j = 1 To 2 * (10 - i) - 1 Print "*"; Next j Print Next i End Sub 7、平行四边形 Private Sub Command3_Click() Dim i% For i = 1 To 8 Print Tab(1 + i); For j = 1 To 8 Print "*"; Next j Print Next i End Sub 8、菱形,1, Private Sub Command4_Click() Dim i%, j% For i = 1 To 11 If i <= 6 Then Print Tab(20 - i); For j = 1 To 2 * i - 1 Print "*"; Next j Else Print Tab(8 + i); For j = 1 To 2 * (12 - i) - 1 Print "*"; Next j End If Next i End Sub 9、菱形,方法2, Private Sub Command5_Click() Dim i%, j%, k% For i = 1 To 11 If i <= 6 Then Print Tab(20 - i); k = 2 * i - 1 Else Print Tab(8 + i); k = 2 * (12 - i) - 1 End If For j = 1 To k Print "*"; Next j Next i End Sub 10、漏斗形,方法1, Private Sub Command6_Click() Dim i%, j% For i = 1 To 9 If i <= 5 Then Print Tab(10 + i); For j = 1 To 2 * (6 - i) - 1 Print "*"; Next j Else Print Tab(20 - i); For j = 1 To 2 * (i - 4) - 1 Print "*"; Next j End If Next i End Sub 11、漏斗形,方法2, Private Sub Command7_Click() Dim i%, j%, k% For i = 1 To 9 If i <= 5 Then Print Tab(10 + i); k = 2 * (6 - i) - 1 Else Print Tab(20 - i); k = 2 * (i - 4) - 1 End If For j = 1 To k Print "*"; Next j Next i End Sub 12、数字正向三角形 Private Sub Command1_Click() Dim i%, j% For i = 1 To 10 Print Tab(20 - i); For j = 1 To i Print Trim(i - 1) + " "; Next j Print Next i End Sub 13、混合字符三角形 Private Sub Command2_Click() Dim i%, j% For i = 1 To 8 Print Tab(20 - i); For j = 1 To 2 * i - 1 If i Mod 2 = 0 Then Print "$"; Else Print "*"; End If Next j Print Next i End Sub 14、字母顺序菱形 Private Sub Command3_Click() Dim i%, j%, k% For i = 1 To 7 If i <= 4 Then Print Tab(10 - i); k = 2 * i - 1 Else Print Tab(2 + i); k = 2 * (8 - i) - 1 End If For j = 1 To k Print Chr(64 + j); Next j Print Next i End Sub 15、回文数菱形 Private Sub Command4_Click() Dim i%, j%, k% For i = 1 To 7 If i <= 4 Then Print Tab(10 - i); k = 2 * i - 1 Else Print Tab(2 + i); k = 2 * (8 - i) - 1 End If For j = 1 To k If j <= (k + 1) / 2 Then Print Trim(j); Else Print Trim(k + 1 - j); End If Next j Print Next i End Sub 16、按矩阵形状输出 Private Sub Command1_Click() Dim a(1 To 3, 1 To 2) As Integer, s As Integer s = 1 For i = 1 To 3 For j = 1 To 2 a(i, j) = s s = s + 1 Print a(i, j); Next j Print Next i End Sub 17、求矩阵所有元素之和 Private Sub Command2_Click() Dim a(1 To 3, 1 To 2) As Integer, s As Integer, sum As Integer s = 1 For i = 1 To 3 For j = 1 To 2 a(i, j) = s s = s + 1 Print a(i, j); sum = sum + a(i, j) Next j Print Next i Print "矩阵所有元素之和为:" & sum End Sub 18、求矩阵四周元素之和 Private Sub Command3_Click() Dim a(0 To 3, 0 To 2) As Integer, s As Integer, sum As Integer s = 1 For i = 0 To 3 For j = 0 To 2 a(i, j) = s s = s + 1 Print a(i, j); If i = 0 Or i = 3 Or j = 0 Or j = 2 Then sum = sum + a(i, j) End If Next j Print Next i Print "矩阵四周元素之和为:" & sum End Sub 19、求矩阵非四周元素之和 Private Sub Command4_Click() Dim a(0 To 3, 0 To 2) As Integer, s As Integer, sum As Integer s = 1 For i = 0 To 3 For j = 0 To 2 a(i, j) = s s = s + 1 Print a(i, j); If i <> 0 And i <> 3 And j <> 0 And j <> 2 Then sum = sum + a(i, j) End If Next j Print Next i Print "矩阵非四周元素之和为:" & sum End Sub 20、求方阵主对角线元素之和 Private Sub Command5_Click() Dim a(0 To 4, 0 To 4) As Integer, s As Integer, sum As Integer For i = 0 To 4 For j = 0 To 4 a(i, j) = Int(Rnd * 9) Print a(i, j); Next j Print Next i For i = 0 To 4 For j = 0 To 4 If i = j Then sum = sum + a(i, j) End If Next j Next i Print "方阵主对角线元素之和为:" & sum End Sub 21、求方阵次对角线元素之和 Private Sub Command6_Click() Dim a(0 To 4, 0 To 4) As Integer, s As Integer, sum As Integer For i = 0 To 4 For j = 0 To 4 a(i, j) = Int(Rnd * 9) Print a(i, j); Next j Print Next i For i = 0 To 4 For j = 0 To 4 If i + j = 4 Then sum = sum + a(i, j) End If Next j Next i Print "方阵次对角线元素之和为:" & sum End Sub 22、求π值 Private Sub Command4_Click() Dim i%, t!, π!, s! i = 0: π = 0: t = 1 Do Until Abs(t) < 0.0001 i = i + 1 t = (-1) ^ (i + 1) / (2 * i - 1) s = s + t Loop π = s * 4 Print "π="; π End Sub 23、模拟随机掷骰子 Private Sub Command1_Click() Dim n%, n1%, n2%, n3%, n4%, n5%, n6% Dim r% n = Val(Text13) For i = 1 To n r = Int(Rnd * 6 + 1) If r = 1 Then n1 = n1 + 1 ElseIf r = 2 Then n2 = n2 + 1 ElseIf r = 3 Then n3 = n3 + 1 ElseIf r = 4 Then n4 = n4 + 1 ElseIf r = 5 Then n5 = n5 + 1 Else n6 = n6 + 1 End If Next i Text1 = n1: Text2 = n1 / n * 100 & "%" Text3 = n2: Text4 = n2 / n * 100 & "%" Text5 = n3: Text6 = n3 / n * 100 & "%" Text7 = n4: Text8 = n4 / n * 100 & "%" Text9 = n5: Text10 = n5 / n * 100 & "%" Text11 = n6: Text12 = n6 / n * 100 & "%" End Sub 24、百钱买百鸡 Private Sub Command1_Click() Dim i%, j%, k% Print "鸡翁个数", "鸡母个数", "鸡雏个数" For i = 0 To 20 For j = 0 To 33 For k = 0 To 300 If i * 5 + j * 3 + k / 3 = 100 And i + j + k = 100 Then Print i, j, k End If Next k Next j Next i End Sub 25、阶梯多少阶 方法一 Private Sub Command2_Click() Dim i% Do While i Mod 2 <> 1 Or i Mod 3 <> 2 Or i Mod 5 <> 4 Or i Mod 6 <> 5 Or i Mod 7 <> 0 i = i + 1 Loop Print "阶梯至少有" & i; "阶" 方法二 Private Sub Command2_Click() Dim i% Do Until i Mod 2 = 1 And i Mod 3 = 2 And i Mod 5 = 4 And i Mod 6 = 5 And i Mod 7 = 0 i = i + 1 Loop Print "阶梯至少有" & i; "阶" 26、销售收入翻两番 Private Sub Command3_Click() Dim i%, j! j = 1 Do While j <= 4 j = j * (1 + 0.1) i = i + 1 Loop Print "需要" & i & "年可以翻两番" End Sub 27、多窗体密码对应显示 Private Sub Command1_Click() Form2.Show Form2.Print "用户名:" & Text1.Text Form2.Print "密码:" & Text2.Text Form2.Print "姓名:" & Text3.Text If Option1.Value = True Then Form2.Print "性别:" & Option1.Caption ElseIf Option2.Value = ture Then Form2.Print "性别:" & Option2.Caption End If End Sub 28、单选按钮综合斐波那契数列 Dim fib() As Long, i As Integer, n As Integer For i = 0 To 2 If Option1(i).Value Then n = Val(Option1(i).Caption) End If Next i ReDim fib(n) fib(1) = 1: fib(2) = 1 For i = 3 To n fib(i) = fib(i - 1) + fib(i - 2) Next i Text1 = fib(n)