VB常用算法代码.doc

Feb数列前18项Option Base 1Private Sub Form_Click()Dim Feb(18) As Integer, I As IntegerFeb(1) = 1Feb(2) = 1For I = 3 To 18 Feb(I) = Feb(I - 1) + Feb(I - 2)NextFor I = 1 To 18 Print Feb(I), If I Mod 5 = 0 Then PrintNextEnd Sub鞍点Option ExplicitOption Base 1Private Sub Form_Click()ClsDim A(4, 5) As Integer, I As Integer, J As Integer, K As IntegerDim Max As Integer, Min As IntegerDim Row As Integer, Col As Integer, Flag As BooleanRandomizeFor I = 1 To 4 For J = 1 To 5 A(I, J) = Rnd * 90 + 10 Print A(I, J); Next PrintNextI = 1Flag = FalseDo While I = 4Max = A(I, 1)Row = ICol = 1 For J = 2 To 5 If Max A(I, J) Then Max = A(I, J) Row = I Col = J End If Next Min = Max For K = 1 To 4 If Min A(K, Col) Then I = I + 1 Flag = False Exit For End If Next If K = 5 Then Flag = True Exit Do End IfLoopIf Not Flag Then Print 鞍点不存在！ Else Print 鞍点的位置： CStr(Row) 行 CStr(Col) 列End Sub插入排序Option Base 1Private Sub Command1_Click()Dim A(10) As Integer, I As Integer, J As Integer, X As IntegerClsPrint 排序前：;For I = 1 To 10 A(I) = Int(100 * Rnd) Print A(I);NextPrintFor J = 2 To 10 X = A(J) I = J - 1 Do While X A(I) A(I + 1) = A(I) I = I - 1 If I 1 Then Exit Do Loop A(I + 1) = XNextPrint 排序后：;For I = 1 To 10 Print A(I);NextEnd Sub二分插入排序Option Base 1Private Sub Command1_Click()二分插入排序Dim A(10) As Integer, I As Integer, J As Integer, X As IntegerClsPrint 排序前：;For I = 1 To 10 A(I) = Int(100 * Rnd) Print A(I);NextPrintDim First As Integer, Last As Integer, Middle As IntegerDim K As IntegerFor J = 2 To 10 X = A(J) First = 1 Last = J - 1 Do While First = Last Middle = (First + Last) / 2 If X A(Middle) Then Last = Middle - 1 Else First = Middle + 1 End If Loop For K = J - 1 To Middle Step -1 A(K + 1) = A(K) Next A(Middle) = XNextPrint 排序后：;For I = 1 To 10 Print A(I);NextEnd Sub插入一个数到有序数列Dim A(10) As Integer, I As Integer, J As IntegerPrivate Sub Command1_Click()Dim X As IntegerX = Text1.TextI = 9Do While X A(I) A(I + 1) = A(I) I = I - 1LoopA(I + 1) = XPrint 插入数后：;For I = 0 To 10 Print A(I);NextPrintEnd SubPrivate Sub Command2_Click()Dim temp As IntegerClsFor I = 0 To 9 A(I) = Int(100 * Rnd)NextFor I = 0 To 8 For J = I + 1 To 9 If A(I) A(J) Then temp = A(I) A(I) = A(J) A(J) = temp End If NextNextPrint 有序序列：;For I = 0 To 9 Print A(I);NextPrintText1.SetFocusEnd SubPrivate Sub Form_Activate()Print 将一个数插入到一个有序的序列中！End Sub查找子串位置Option Base 1Private Sub Command1_Click()Dim S1 As String, S2 As StringS1 = Text1.TextS2 = Text2.TextText3.Text = Index(S1, S2)End SubPublic Function Index(S As String, T As String) As IntegerDim I As Integer, J As IntegerDim LenS As Integer, LenT As IntegerLenS = LenB(S)LenT = LenB(T)I = 1: J = 1Do While I = LenS And J = LenT If MidB(S, I, 1) = MidB(T, J, 1) Then I = I + 1 J = J + 1 Else I = I - J + 2 J = 1 End IfLoopIf J LenT Then Index = I - LenT Else Index = 0End Function自动出题Option ExplicitPublic A As Integer, B As Integer, Opt As StringPublic Correct As Integer, Wrong As IntegerPrivate Sub Command1_Click()RandomizeDim C As IntegerText1.Text = A = Int(10 * Rnd) + 1B = Int(10 * Rnd) + 1C = Int(4 * Rnd)Select Case C Case 0: Opt = + Case 1: Opt = - Case 2: Opt = * Case 3: Opt = /End SelectLabel1.Caption = ALabel2.Caption = OptLabel3.Caption = BLabel4.Visible = TrueText1.Visible = TrueText1.SetFocusEnd SubPrivate Sub Command2_Click()Dim Result As IntegerSelect Case Opt Case +: Result = A + B Case -: Result = A - B Case *: Result = A * B Case /: Result = A / BEnd SelectIf Result = Val(Text1.Text) Then MsgBox 很好，你做对了! Picture1.Print A Opt B = Text1.Text V Correct = Correct + 1Else MsgBox 好可惜，你错了！ Picture1.Print A Opt B = Text1.Text X Wrong = Wrong + 1End IfEnd SubPrivate Sub Command3_Click()MsgBox (你做对了 + CStr(Correct) + 题，做错了 + CStr(Wrong) + 题)End SubPrivate Sub Form_Activate()Command1.SetFocusLabel4.Visible = FalseText1.Visible = FalseEnd Sub打印ASIIC码Private Sub Form_Click()Dim I As Integer, N As IntegerN = 1For I = 32 To 126 Print I; :; Chr(I), If N = 5 Then N = 1 Print Else N = N + 1 End IfNext End Sub递归法Feb数列前10项Private Sub Form_Click()Dim I As IntegerFor I = 1 To 10 Print Feb(I)NextEnd SubPrivate Function Feb(ByVal N As Integer) As IntegerIf N = 1 Then Feb = 0ElseIf N = 2 Then Feb = 1Else Feb = Feb(N - 1) + Feb(N - 2)End IfEnd Function递归法逆转输出字符串Private Sub Form_Click()Dim S As StringS = InputBox(Input a string)Invert SEnd SubPublic Sub Invert(ByVal S As String)Dim N As IntegerN = Len(S)If N = 0 Then Exit SubElse Print Mid(S, N, 1); S = Mid(S, 1, N - 1) Invert SEnd IfEnd Sub递归法求最大公约数Private Sub Form_Click()Dim M As Integer, N As IntegerM = InputBox(M)N = InputBox(N)Print M; N; 的最大公约数为：; Gcd(M, N)End SubPublic Function Gcd(ByVal M As Integer, ByVal N As Integer) As IntegerDim R As IntegerR = M Mod NIf R = 0 Then Gcd = NElse M = N N = R Gcd = Gcd(M, N)End IfEnd Function计算两个矩阵的积Option Base 1Private Sub Form_Click()Dim A(3, 4) As Integer, B(4, 3) As Integer, C(3, 3) As IntegerDim I As Integer, J As Integer, K As IntegerPrint 矩阵A为：For I = 1 To 3 For J = 1 To 4 A(I, J) = 5 * Rnd Print A(I, J), Next PrintNextPrint 矩阵B为：For I = 1 To 4 For J = 1 To 3 B(I, J) = 5 * Rnd Print B(I, J), Next PrintNextPrint 矩阵C为：For I = 1 To 3 For J = 1 To 3 C(I, J) = 0 For K = 1 To 4 C(I, J) = C(I, J) + A(I, K) * B(K, J) Next Print C(I, J), Next PrintNextEnd Sub冒泡法排序Option Base 1Private Sub Form_Click()Dim A(10) As Integer, I As Integer, J As Integer, Temp As IntegerFor I = 1 To 10 A(I) = Int(90 * Rnd) + 10 Print A(I);NextPrintFor I = 9 To 1 Step -1 For J = 1 To I If A(J) A(J + 1) Then Temp = A(J) A(J) = A(J + 1) A(J + 1) = Temp End If NextNextFor I = 1 To 10 Print A(I);NextEnd Sub逆序输出字符串Private Sub Form_Click()Dim C As String, I As IntegerC = InputBox(请输入一个字符串)Print CFor I = 1 To Len(C) Print Mid(C, Len(C) - I + 1, 1);NextPrintEnd Sub牛顿迭代法Private Sub Command1_Click()Dim x As Single, x1 As Single, Eps As Singlex = InputBox(输入X的初始值, 牛顿迭代法)Eps = InputBox(输入允许的误差, 牛顿迭代法)Do x1 = x x = x1 - (x1 * Exp(x1) - 1) / (Exp(x1) * (x1 + 1)Loop Until Abs(x - x1) = EpsText1.Text = Str(x)End Sub求定积分Private Sub Form_Click()Dim A As Single, B As Single, N As LongDim S As Double, H As Double, I As LongN = InputBox(Input N)A = 0B = 1H = (B - A) / NS = 0For I = 0 To N S = S + (A + I * H) * HNextPrint SEnd Sub求组合数Private Sub Form_Click()Dim M As Integer, N As IntegerM = InputBox(M)N = InputBox(N)Print Fact(M) / (Fact(N) * Fact(M - N)End SubPublic Function Fact(N As Integer) As Long Dim I As Integer Fact = 1 For I = 1 To N Fact = Fact * I NextEnd Function人口增长Private Sub Command1_Click()Dim X As Single, n As LongX = Val(Text1.Text)n = 0Do Until X = 20 X = X * (1 + 0.01) n = n + 1LoopText2.Text = nEnd Sub筛选法排序Option Base 1Private Sub Form_Click()Dim A(10) As Integer, I As Integer, J As Integer, Temp As IntegerPrint 排序前：;For I = 1 To 10 A(I) = Int(90 * Rnd) + 10 Print A(I);NextPrintFor I = 1 To 9 For J = I + 1 To 10 If A(I) A(J) Then Temp = A(I) A(I) = A(J) A(J) = Temp End If Next JNext IPrint 排序后：;For I = 1 To 10 Print A(I);NextPrintEnd Sub删除数列中重复的数Option Base 1Private Sub Form_Click()Dim A() As Integer, I As Integer, N As IntegerDim J As Integer, K As Integer, Ub As IntegerRandomizeReDim A(10)ClsFor I = 1 To 10 A(I) = Rnd * 90 + 10 Print A(I);NextPrintUb = UBound(A)I = 1Do While I = Ub - 1 J = I + 1 Do While J = Ub If A(I) = A(J) Then For K = J To Ub - 1 A(K) = A(K + 1) Next Ub = Ub - 1 ReDim Preserve A(Ub) Else J = J + 1 End If Loop I = I + 1LoopFor I = 1 To UBound(A) Print A(I);NextPrintEnd Sub统计文件中字母出现的次数Option ExplicitOption Base 1Private Sub Command1_Click()Dim Ch As String, A(26) As Integer, I As IntegerDim Fname As StringClscmDlg.ShowOpenFname = cmDlg.FileNameIf Fname Then Open Fname For Input As #1 以Input方式打开文件，文件号为1 For I = 1 To 26 A(I) = 0 Next Do While Not EOF(1) Ch = Input$(1, 1) 从文件中读取一个字符赋给变量Ch For I = 65 To 90 判断这个字符是什么 If UCase(Ch) = Chr(I) Then A(I - 64) = A(I - 64) + 1 Exit For End If Next Loop For I = 1 To 26 Print Chr(I + 64), A(I) Next Close #1 关闭所打开的文件Else Print 你没有打开文件！End IfEnd SubPrivate Sub Command2_Click()EndEnd Sub数据库操作Private Sub cmdAdd_Click()If cmdAdd.Caption = 添加 Then Data1.Recordset.AddNew cmdAdd.Caption = 确定 txtXh.Text = txtXm.Text = txtXb.Text = txtNl.Text = txtYx.Text = RTF1.Text = txtXh.SetFocusElse Data1.Recordset.Fields(xh) = txtXh.Text Data1.Recordset.Fields(xm) = txtXm.Text Data1.Recordset.Fields(xb) = txtXb.Text Data1.Recordset.Fields(nl) = txtNl.Text Data1.Recordset.Fields(yx) = txtYx.Text Data1.Recordset.Fields(jl) = RTF1.Text Data1.Recordset.Update cmdAdd.Caption = 添加End IfEnd SubPrivate Sub cmdDelete_Click()Data1.Recordset.DeleteData1.Recordset.MoveFirstEnd SubPrivate Sub cmdExit_Click()EndEnd SubPrivate Sub Command1_Click()Data1.Recordset.MoveFirstEnd SubPrivate Sub Command2_Click()Data1.Recordset.MovePreviousIf Data1.Recordset.BOF = True Then Data1.Recordset.MoveFirstEnd SubPrivate Sub Command3_Click()Data1.Recordset.MoveNextIf Data1.Recordset.EOF = True Then Data1.Recordset.MoveLastEnd SubPrivate Sub Command4_Click()Data1.Recordset.MoveLastEnd Sub水仙花数Private Sub Form_Click()Dim I As IntegerDim A As Integer, B As Integer, C As IntegerFor I = 1 To 999 A = I Mod 10 个位 C = I 100 百位 B = (I - C * 100) 10 十位 If I = A 3 + B 3 + C 3 Then Print INextEnd Sub素数Private Sub Form_Click()Dim X As Integer, I As IntegerDim Flag As BooleanX = InputBox(请输入一个自然数：)Flag = FalseIf X = 2 Then Print X; 是素数！Else For I = 2 To X - 1 If X Mod I 0 Then Flag = True Else Flag = False Exit For End If NextIf Flag Then Print X; 是素数！ Else Print X; 不是素数！End IfEnd Sub质数Private Sub Form_Click()Dim J As IntegerFor J = 2 To 100 If Prime(J) Then Print JNextEnd SubPublic Function Prime(n As Integer) As BooleanDim I As IntegerPrime = TrueFor I = 2 To Int(n / 2) If n 2 And n Mod I = 0 Then Prime = False Exit For End IfNextEnd FunctionPublic Function Prime1(n As Integer) As BooleanDim I As IntegerFor I = 2 To Int(n / 2) If n 2 And n Mod I = 0 Then Exit For End IfNextIf I Int(n / 2) Then Prime1 = True Else Prime1 = FalseEnd Function随机文件学生信息Option ExplicitDim Student As RecordTypeDim StuInfo As RecordTypeDim RecLen As Long 记录长度Dim RecNum As Long 记录号Private Sub Command1_Click() 添加一条记录Student.XH = txtXH.TextStudent.XM = txtXM.TextStudent.XB = cboXB.TextStudent.BJ = cboBJ.TextRecLen = Len(Student)Open D:student.txt For Random As #1 Len = RecLenRecNum = LOF(1) RecLen + 1Put #1, RecNum, StudenttxtXH = txtXM = cboXB = cboBJ = txtXH.SetFocusRecNum = LOF(1) RecLentxtRecNo.ToolTipText = 输入记录号。范围为：1 CStr(RecNum)ResetEnd SubPrivate Sub Command2_Click() 打印所有记录Dim I As LongPicture1.Cls 清空图像框RecLen = Len(Student)Open D:student.txt For Random As #1 Len = RecLenRecNum = LOF(1) RecLen + 1For I = 1 To RecNum Get #1, I, StuInfo Picture1.Print StuInfo.XH; StuInfo.XM; StuInfo.XB; StuInfo.BJNextResetEnd SubPrivate Sub Command3_Click() 修改指定记录号的记录Dim I As LongI = Int(Val(txtRecNo.Text)If I = 0 Then MsgBox 请输入正确的记录号！, vbOKOnly, ErrorElse RecLen = Len(Student) Open D:student.txt For Random As #1 Len = RecLen If Command3.Caption = 修改 Then Command1.Enabled = False Command2.Enabled = False Command4.Enabled = False Command3.Caption = 确定 txtRecNo.Visible = False Seek #1, I Get #1, I, StuInfo txtXH.Text = StuInfo.XH txtXM.Text = StuInfo.XM cboXB.Text = StuInfo.XB cboBJ.Text = StuInfo.BJ Else Command1.Enabled = True Command2.Enabled = True Command4.Enabled = True Command3.Caption = 修改 txtRecNo.Visible = True Student.XH = txtXH.Text Student.XM = txtXM.Text Student.XB = cboXB.Text Student.BJ = cboBJ.Text Put #1, I, Student txtXH = txtXM = cboXB = cboBJ = txtXH.SetFocus End IfEnd IfResetEnd SubPrivate Sub Command4_Click() 删除指定记录号的记录Dim I As Long, J As Long, K As LongI = Val(txtRecNo.Text)If I = 0 Then MsgBox 请输入记录号！, vbOKOnly, ErrorElse RecLen = Len(Student) Open D:student.txt For Random As #1 Len = RecLen Open D:tempfile.txt For Random As #2 Len = RecLen Do While Not EOF(1) J = J + 1 Get #1, J, Student If J I Then K = K + 1 Put #2, K, Student End If Loop RecNum = LOF(2) RecLen txtRecNo.ToolTipText = 输入记录号。范围为：1 CStr(RecNum) Reset Kill D:student.txt Name d:tempfile.txt As d:student.txtEnd IfEnd SubPrivate Sub Form_Load()RecLen = Len(Student)Open D:student.txt For Random As #1 Len = RecLenRecNum = LOF(1) RecLentxtRecNo.ToolTipText = 输入记录号。范围为：1 CStr(RecNum)ResetEnd Sub同构数Private Sub Form_Click()Dim I As LongFor I = 1 To 999 Select Case I Case Is = 9 And (I * I - I) Mod 10 = 0: Print I, I 2 Case Is = 99 And (I * I - I) Mod 100 = 0: Print I, I 2 Case Is = 999 And (I * I - I) Mod 1000 = 0: Print I, I 2 End SelectNextEnd Sub统计文本中字母出现的次数Option Base 1Private Sub Command1_Click()Dim Ch(26) As Integer, I As Integer, S As String, J As IntegerS = Text1.TextFor I = 1 To Len(S) If Asc(UCase(Mid(S, I, 1) = 65 And Asc(UCase(Mid(S, I, 1) = 90 Then Ch(Asc(UCase(Mid(S, I, 1) - 64) = Ch(Asc(UCase(Mid(S, I, 1) - 64) + 1 End IfNextFor I = 1 To 26 If Ch(I) 0 Then Print Chr(I + 64); Ch(I), J = J + 1 If J Mod 4 = 0 Then Print End IfNextEnd SubPrivate Sub Text1_Click()Dim N As Integer, I As IntegerRandomizeN = InputBox(请输入随机生成的字符数, 统计字母个数)For I = 1 To N Text1.Text = Text1.Text Chr(Rnd * 95 + 32)NextEnd Sub统计文本中字母个数Private Sub Form_Click()Dim S As String, Ch As StringDim Count(65 To 90) As IntegerDim I As IntegerS = Text1.TextFor I = 1 To Len(S) Ch = UCase(Mid(S, I, 1) If Ch = Z And Ch = A Then Count(Asc(Ch) = Count(Asc(Ch) + 1 End IfNextFor I = 65 To 90 If Count(I) 0 Then Print Chr(I), Count(I)NextEnd Sub完全数Private Sub Form_Click()Dim N As Integer, I As Integer, S As IntegerN = InputBox(请输入一个整数, 完全数)S = 0For I = 1 To N - 1 If N Mod I = 0 Then S = S + I End IfNextIf S = N Then Print N; 是完全数Else Print N; 不是完全数End IfEnd Sub原码Private Sub Form_Click()Dim X As Integer, S As String, Y As Integer, I As IntegerX = InputBox(Input a integer:)Y = XS = Do If X Mod 2 = 0 Then S