常用算法源程序
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
常用算法源程序
1、常用算法：
（1）求一个数各个位上的数值程序：
Option Explicit
Dim x As Integer
Private Sub Command1_Click() '输入数据
x = InputBox("请输入一个整数：")
Picture1.Print "输入的数据为："; x
End Sub
Private Sub Command2_Click() '用除以10取余数的方法
Dim y%
Picture1.Print "各位中的数是："
Do While x <> 0
y = x Mod 10
x = x \ 10
Picture1.Print y
Loop
End Sub
Private Sub Command3_Click()
Dim i%
Dim y As String
y = Trim(Str(x))
For i = 1 To Len(y)
Picture1.Print Mid(y, Len(y) - i + 1, 1)
Next i
End Sub
（2）进制转换程序：
Function TranDec$(ByVal m%, ByVal r%)
Dim StrDtoR$
Dim iB%, mr%
StrDtoR = ""
Do While m <> 0
mr = m Mod r
m = m \ r
If mr >= 10 Then
StrDtoR = Chr(mr - 10 + 65) & StrDtoR '余数>=10 转换为A～F,最先求出的余数位数最低
Else
StrDtoR = mr & StrDtoR '余数<10 直接连接，最先求出的余数位数最低
End If
Loop
TranDec = StrDtoR
End Function
Private Sub Command1_click()
Dim m0%, r0%, i%
m0 = Val(Text1.Text)
r0 = Val(Text2.Text)
If r0 < 2 Or r0 > 16 Then
i = MsgBox("输入的R进制数超出范围", vbRetryCancel)
If i = vbRetry Then
Text2.Text = ""
Text2.SetFocus
Else
End
End If
End If
Label3.Caption = "转换成" & r0 & "进制数"
Text3.Text = TranDec(m0, r0)
End Sub
（3）n!和1--n累加程序：
Option Explicit
Private Sub Command1_Click()
Dim x%, i%, m%
m = 1
x = Val(InputBox("请输入一个小于等于7的整数"))
For i = 1 To x
m = m * i
Next i
Text1 = Str(m)
End Sub
Private Sub Command2_Click()
Dim x%, i%, sum%
sum = 0
x = Val(InputBox("请输入一个小于等于255的整数"))
For i = 1 To x
sum = sum + i
Next i
Text1 = Str(sum)
End Sub
（4）最大公约数最小公倍数程序：
Option Explicit
Private Sub Command1_Click()
Dim n%, n1%, m%, m1%, r%
n1 = InputBox("输入n")
m1 = InputBox("输入m")
If m1 > n1 Then ' m>n
m = m1: n = n1
Else
m = n1: n = m1
End If
Do
r = m Mod n
If r = 0 Then Exit Do
m = n
n = r
Loop
Print m1; ","; n1; "的最大公约数为"; n
Print "最小公倍数= ", m1 * n1 / n
End Sub
（5）递归算法：求n!和最大公约数程序
Option Explicit
Public Function fac(n As Integer) As Integer
If n = 1 Then
fac = 1
Else
fac = n * fac(n - 1)
End If
End Function
Private Sub Command1_Click() ' 调用递归函数，显示出fac(4)=24 Dim n%
n = Val(InputBox("请输入一个小于等于7的整数："))
Print "fac("; n; ")="; fac(n)
End Sub
Public Function gcd(m As Integer, n As Integer) As Integer
If (m Mod n) = 0 Then
gcd = n
Else
gcd = gcd(n, m Mod n)
End If
End Function
Private Sub Command2_Click()
Dim n%, m%
n = InputBox("输入n")
m = InputBox("输入m")
Print gcd(m, n)
End Sub
（6）水仙花数程序：
Option Explicit
Private Sub Command1_Click()