上面的程序实现了计算阶乘,并将结果直接显示在textbox中,要想保存为文件,只要这样就可以了:
dim filename as string
filename="c:\test.txt"
open filename for binary as #1
put #1,,text1.text
close #1
Function factorial(ByVal n As Long) As String
Dim XYS() As String, xl As Long, yl As Long, i As Long, j As Long, k As Long, TEMP As Long, MULTI As String
If n < 0 Then Exit Function
factorial = "1"
If n > 1 Then
k = 1
Do While k <= n
xl = Len(Trim(factorial))
yl = Len(Trim(k))
ReDim XYS(1 To xl + yl) As String
For i = 1 To xl
For j = 1 To yl
XYS(i + j) = CStr(Val(XYS(i + j)) + Val(Mid(factorial, i, 1)) * Val(Mid(k, j, 1)))
Next
Next
For i = xl + yl To 2 Step -1
TEMP = Val(XYS(i)) \ 10
XYS(i) = Val(XYS(i)) Mod 10
XYS(i - 1) = Val(XYS(i - 1)) + TEMP
Next
If XYS(1) = "0" Then XYS(1) = ""
factorial = Join(XYS, "")
Erase XYS
k = k + 1
Loop
End If
End Function
Private Sub Command1_Click()
x = "1000! = " & Trim(factorial(1000))
Text1 = x
End Sub
Option Explicit
Dim incl As Boolean, starttime As Long
Private Function cacl(num As Long) As String
Dim flag As Long, numlen As Long, last As Long
Dim x As Long, k As Long, i As Long, m As Long, n As Long, j As Long
Dim result() As Long, tmp1() As Long, tmp2() As Long, s() As String
numlen = 1
ReDim result(1 To numlen)
result(1) = 1
x = 0
Do While incl = True And x < num
x = x + 1
flag = x
i = 0
Do
i = i + 1
last = flag Mod 10 '取出被乘数的最后一位
flag = flag \ 10 '去掉乘数的最后一位
tmp1 = result
n = 0
For k = 1 To numlen
m = tmp1(k) * last + n '用每一位数与上次结果数组中的每个数相乘并加上进位的数
tmp1(k) = m Mod 10 '取出最后一位并加入临时结果数组
n = m \ 10 '两个小于10的数相乘最多两位,这里取出进位数
Next
If n > 0 Then '处理最后一个进位数
ReDim Preserve tmp1(1 To numlen + 1)
tmp1(numlen + 1) = n
End If
If i = 1 Then
tmp2 = tmp1 '用第二个临时数组保存每次个位数乘出来的结果
Else
n = 0 '下面把本次乘出来的临时数组与上次乘出来的临时结果错位相加(就象乘法算式一样)。
j = UBound(tmp1) + i - 1
If UBound(tmp2) < j Then ReDim Preserve tmp2(1 To j)
For k = i To j
m = tmp2(k) + tmp1(k - i + 1) + n
tmp2(k) = m Mod 10
n = m \ 10
Next
If n > 0 Then
ReDim Preserve tmp2(1 To j + 1)
tmp2(j + 1) = n
End If
End If
Loop While flag > 0
numlen = UBound(tmp2)
result = tmp2
Label1 = x '下面三句可用Label1与Label2计算进度,并及时更新
Label2 = numlen
Label3 = Timer - starttime
DoEvents
Loop
k = UBound(result)
ReDim s(1 To k)
For i = k To 1 Step -1
s(k - i + 1) = CStr(result(i))
Next
cacl = Join(s, "")
End Function
Private Sub Command1_Click()
Dim i As Long
If incl = False Then
Command1.Caption = "看看结果"
incl = True
starttime = Timer
Text1 = cacl(CLng(Text2))
Else
incl = False
Command1.Caption = "再算一次"
End If
End Sub