Option Explicit
Private Sub Form_Load()
Call init
Text1(0).Text = "1234567812345678"
Text1(1).Text = "1234567812345678"
End Sub
Private Sub Command1_Click(Index As Integer)
'Open "d:\1.txt" For Output As #1
Dim D1$, D2$, i&, tt
For i = 0 To 2
Text1(i).Text = Trim(Text1(i).Text)
Text1(i).Text = Replace(Text1(i).Text, vbCrLf, "")
Next
D1 = Text1(0).Text
D2 = Text1(1).Text
Call big32(D1, Big1) '字符串转数组【4位一个分组，数组首位的长度，减少运算是数组长度判断】
Call big32(D2, Big2)
Label1.Caption = Format(Now(), "hh:mm:ss")
tt = Timer
Select Case Index
Case 0: Call BigAdd(Big1, Big2, p1p2): Text1(2).Text = B2D(p1p2) '【加法】
Case 1: Call BigSub(Big1, Big2, p1p2): Text1(2).Text = B2D(p1p2) '【减法】
Case 2: Call BigMult(Big1, Big2, p1p2): Text1(2).Text = B2D(p1p2) '【乘法】
Case 3: Call BIgDiv(Big1, Big2, p1p2): Text1(2).Text = B2D(p1p2) '【除法】
End Select
tt = Timer - tt
Label2.Caption = Format(tt, "0.0000")
' Close #1
End Sub
Private Sub init()
Dim i&
For i = 0 To 2: Text1(i).Width = Screen.Width - 100: Next
ReDim C2D(3, 48 To 57) As Double '字符映射引用，减少字符转数字时间
For i = 0 To 9: C2D(0, i + 48) = i: Next
For i = 0 To 9: C2D(1, i + 48) = i * 10: Next
For i = 0 To 9: C2D(2, i + 48) = i * 100: Next
For i = 0 To 9: C2D(3, i + 48) = i * 1000: Next
End Sub
Option Explicit
'//////////////////////////////////////////////////////////////////////////////
'//
'// 公有声明
'//
'//////////////////////////////////////////////////////////////////////////////
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As Long)
'------------------------------------------------------------------------------
' 公有变量
'------------------------------------------------------------------------------
Public C2D, Big1() As Double, Big2() As Double, p1p2() As Double
'=========================================================================
'求(a,b)最大值
'=========================================================================
Public Function max(a, b) As Variant
max = IIf(a >= b, a, b)
End Function
'=========================================================================
'=======================================================================================
'【大数加法】【4字节】-模拟竖式加法【输入:数组、输出:长度+数组】【调用函数：Nzero】
'========================================================================================
Public Function BigAdd(D1() As Double, D2() As Double, sum() As Double)
Dim i&, j&
i = max(D1(0), D2(0)) '数组最大长度
j = Abs(D1(0) - D2(0)) '数组长度差
ReDim sum(i + 1)
sum(0) = i + 1
If i >= D1(0) Then '【A>=B】利用一次判断，减少不同位数的加法运算
For i = 1 To j: sum(i + 1) = D1(i): Next '【差异部分】【直接赋值】
For i = 1 To D2(0)
sum(i + j + 1) = D1(i + j) + D2(i) '【相同部分】【求和】
If sum(i + j + 1) > 10000 Then '【进位处理】
sum(i + j) = sum(i + j) + 1
sum(i + j + 1) = sum(i + j + 1) - 10000
End If
Next
Else '【A<B】
For i = 1 To j: sum(i + 1) = D2(i): Next '大数末位对齐
For i = 1 To D1(0)
sum(i + j + 1) = D2(i + j) + D1(i)
If sum(i + j + 1) > 10000 Then '进位处理
sum(i + j) = sum(i + j) + 1
sum(i + j + 1) = sum(i + j + 1) - 10000
End If
Next
End If
If sum(1) = 0 Then Call NZero(sum) '【去前缀0】
End Function
'=======================================================================================
'【大数加法】【4字节】-模拟竖式加法【输入:数组、输出:长度+数组】【调用函数：nzero】
'========================================================================================
Public Function BigSub(D1() As Double, D2() As Double, sum() As Double)
Dim i&, j&
i = max(D1(0), D2(0)) '数组最大长度
j = Abs(D1(0) - D2(0)) '数组长度差
ReDim sum(i)
sum(0) = i
If i >= D1(0) Then
For i = 1 To j: sum(i) = D1(i): Next '【差异部分】【直接赋值】
For i = 1 To D2(0)
sum(i + j) = D1(i + j) - D2(i) '【相同部分】【求差】
If sum(i + j) < 0 Then '进位处理
sum(i + j - 1) = sum(i + j - 1) - 1
sum(i + j) = sum(i + j) + 10000
End If
Next
Else
MsgBox "被减数溢出": End
End If
If sum(1) = 0 Then Call NZero(sum)
End Function
'======================================================================================
'【大数乘法】【4字节】-模拟竖式加法【输入:数组、输出:长度+数组】【调用函数：nzero】
'======================================================================================
Public Function BigMult(D1() As Double, D2() As Double, p1p2() As Double)
Dim d3#, i&, j&, maxc&
maxc = D1(0) + D2(0)
ReDim p1p2(maxc + 1) '保存积
p1p2(0) = maxc
For i = 1 To D1(0) '不考虑进位的竖式乘法运算
For j = 1 To D2(0) 'p1p2位D1的i位与D2的j位相乘结果
p1p2(i + j) = p1p2(i + j) + D1(i) * D2(j)
Next
Next
For i = maxc To 2 Step -1 '单独处理进位，减少每次加法的进位词素
If p1p2(i) >= 10000 Then
d3 = Int(p1p2(i) / 10000)
p1p2(i - 1) = p1p2(i - 1) + d3
p1p2(i) = p1p2(i) - d3 * 10000
End If
Next
If p1p2(1) = 0 Then Call NZero(p1p2)
End Function
'======================================================================================================
'【大数除法】【4字节数组】-补位、试商除法【输入:数组、输出:数组】【调用函数：bigmult、bigsub、bigcomp】
'======================================================================================================
Public Function BIgDiv(D1() As Double, D2() As Double, p1p2() As Double)
Dim i&, k&, j&, r0, top(1) As Double, temp() As Double, len1&, num1() As Double
ReDim r0(D1(0) - D2(0) + 1) '除法的商（临时）
ReDim p1p2(D1(0) - D2(0) + 1) '除法的商（结果）
p1p2(0) = D1(0) - D2(0) + 1
top(0) = 1 '保留商
len1 = 0 '缩位控制
If D1(0) > D2(0) Then '【同位减法】位数不等，D2补位，首位小少补1位
len1 = IIf(D1(1) < D2(1), D1(0) - D2(0) - 1, D1(0) - D2(0))
ReDim Preserve D2(D2(0) + len1) '补位，扩大10^len1倍，d1>=d2
D2(0) = D2(0) + len1 '数组首位：数组数据长度
End If
st1:
k = BigComp(D1, D2) '比较数组大小
If D1(1) < 0 Then End
If k = 0 Then r0(len1) = r0(len1) + 1: GoTo st2 '【N倍整除】-【返回】
If k >= 1 Then '【够除】【k=1：位数不等】【k=2：位数相等】
If k = 1 Then top(1) = Int((D1(1) * 10000 + D1(2)) / (D2(1) + 1)) '试商结果0-9999
If k = 2 Then top(1) = Int(D1(1) / (D2(1) + 1)) ''试商结果0-9999
If top(1) > 1 Then '【试商后结果：2-9999】【先乘，后减】
Call BigMult(D2, top, temp)
Call BigSub(D1, temp, num1)
r0(len1) = r0(len1) + top(1)
Else '【试商后结果：0-1】【直接减】
Call BigSub(D1, D2, num1)
r0(len1) = r0(len1) + 1
End If
ReDim D1(UBound(num1))
D1 = num1 '剩余数据
GoTo st1
Else '【不够减】【len1<>0,缩位】【len1=0，结束】
If len1 >= 1 Then '若扩位，则缩位
len1 = len1 - 1: D2(0) = D2(0) - 1: ReDim Preserve D2(D2(0)): GoTo st1 '缩少1字节扩位
End If
st2:
For j = UBound(r0) To 0 Step -1 '倒序商数
If r0(j) <> 0 Then Exit For
Next
p1p2(0) = j + 1
For i = 0 To j: p1p2(i + 1) = r0(j - i): Next
End If
End Function
'===============================================================================
'【10进制串->数组】【输入:字符串】【输出：长度+4字节数组】【高位在前)】
'调用函数：C2D数组映射、copymemory 内存数据复制
'===============================================================================
Public Function big32(msg As String, arr() As Double)
Dim i&, top_len&, dest_len&, src_len&, bz&, Count&, temp() As Integer
src_len = Len(msg) '输入字符串长度
dest_len = Int((Len(msg) - 1) / 4) + 1 '目的分组长度【4位上取整】
top_len = Len(msg) Mod 4 '头部分组长度(1-3字节)
ReDim arr(dest_len) '目的数组数据
arr(0) = dest_len '目的数组长度
ReDim temp(src_len - 1) '字符串缓冲数组
i = StrPtr(msg) '字符串指针地址
CopyMemory ByVal VarPtr(temp(0)), ByVal i, src_len * 2 '读取字符串内容到内存
Count = 0
For i = 1 To top_len '【非4位整数的头字节】1-3字节
If i = 1 Then Count = Count + 1 '只加一次
arr(Count) = arr(Count) + C2D(top_len - i, temp(i - 1))
Next
For i = top_len + 1 To src_len '【4位字节整数】
bz = (i - top_len - 1) Mod 4
If bz = 0 Then Count = Count + 1
arr(Count) = arr(Count) + C2D(3 - bz, temp(i - 1))
Next
End Function
'=======================================================================
'【数组比较】【输入:数组、输出:1:长度大 2:长度相等大于 0:等于 -1:小于】
'=======================================================================
Public Function BigComp(num1() As Double, num2() As Double) As Long
Dim i&
If num1(0) > num2(0) Then BigComp = 1: Exit Function '长度大，大数
If num1(0) < num2(0) Then BigComp = -1: Exit Function '长度小，小数
For i = 1 To num1(0) '逐位比较
If num1(i) > num2(i) Then BigComp = 2: Exit Function '长度相等，大数
If num1(i) < num2(i) Then BigComp = -1: Exit Function '长度相等，小数
Next
If i > num1(0) Then BigComp = 0 '数组相等
End Function
'=======================================================================
'【清数组前置0】【输入:数组、输出:去前缀0数组】
'=======================================================================
Public Sub NZero(Soure() As Double) '去除数组前置0
Dim i&, j&
For i = 1 To Soure(0)
If Soure(i) <> 0 Then Exit For
Next
If i > Soure(0) Then Soure(0) = 1: Soure(1) = 0: Exit Sub
If i > 1 Then
For j = i To Soure(0): Soure(j - i + 1) = Soure(j): Next
Soure(0) = Soure(0) - i + 1
End If
End Sub
'=========================================================================
'【数组->10进制串】【输入:byte数组、输出:字符串】
'=========================================================================
Public Function B2D(byte1) As String
Dim i&
B2D = Trim(Str(byte1(1)))
For i = 2 To byte1(0)
B2D = B2D & Format(byte1(i), "0000")
Next
End Function
'这个代码无法运行，启动后点击+-*或者/按钮，都是提示变量Big1没有定义，不知道咋回事，咋弄呢？
2021-05-10 21:22
