回 帖 发 新 帖 刷新版面

主题:VB设计一个复杂计算器,求代码.高手指教!!

可以完成加减乘除,乘方,开放,三角函数,进制转换,有数据存储,帮助及错误提示功能的复杂计算机程序

回复列表 (共12个回复)

11 楼

Function 数学计算(Dat2 As String) As String
On Error GoTo 100
Dim d1 As Double, d2 As Double, z As String, z1 As String, z2 As String
Dim k As Integer, Ty As Integer, i As Integer
For i = 2 To Len(Dat2) - 1
  z = Mid$(Dat2, i, 1): Ty = InStr("+-*/^", z): If Ty > 0 Then Exit For
Next i
If Ty = 0 Then Exit Function
k = InStr(2, Dat2, z): z1 = Left$(Dat2, k - 1): z2 = Mid$(Dat2, k + 1)
z = Left$(z1, 1): If InStr("H,O,B", z) Then z1 = 进制转换(z1)
z = Left$(z2, 1): If InStr("H,O,B", z) Then z2 = 进制转换(z2)
d1 = Val(z1): d2 = Val(z2)
If d1 > 4294967295# Or d2 > 4294967295# Then Exit Function
If Ty = 4 And d2 = 0 Then Exit Function
Select Case Ty
  Case 1: 数学计算 = Format(d1 + d2)
  Case 2: 数学计算 = Format(d1 - d2)
  Case 3: 数学计算 = Format(d1 * d2)
  Case 4: 数学计算 = Format(Round(d1 / d2, 4))
  Case 5
    If InStr(z2, "/") = 2 Then d2 = Val(Left$(z2, 1)) / Val(Right$(z2, 1))
    数学计算 = Format(Round(d1 ^ d2, 4))
End Select
100
End Function

Function 进制转换(Dat3 As String) As String
Dim Ty1 As Integer '转换前的进制标识
Dim Ty2 As Integer '转换后的进制标识
Dim k As Integer   '逗号位置
Dim z As String, i As Integer

z = Left(Dat3, 1)         '提取转换前的进制标识
If InStr("H,O,B", z) Then '如果是 2/8/16 进制
  Dat3 = Mid$(Dat3, 2)
  Ty1 = Abs(16 * (z = "H") + 8 * (z = "O") + 2 * (z = "B"))
Else: Ty1 = 10            '否则均视为 10 进制
End If

k = InStr(Dat3, ","): If k = 0 Then k = InStr(Dat3, ",") '测试是否有中英文逗号
If k Then                            '如果有逗号
  z = Dat3: Dat3 = Left(Dat3, k - 1) '截取逗号前的数据
  If Len(Mid$(z, k)) = 1 Then        '如果逗号后无进制标识
    Ty2 = IIf(Ty1 = 10, 16, 10): If Ty1 = 10 Then k = 0   '10 进制默认转换为 16 进制,其它进制默认转换为 10 进制
  Else                               '如果逗号后有进制标识
    z = Mid$(z, k + 1)               '获取逗号后的进制标识
    Ty2 = Val(z)
    If Ty2 = 0 Then Ty2 = Abs(16 * (z = "H") + 8 * (z = "O") + 2 * (z = "B"))
    If Ty2 = 0 Then Ty2 = 10         '如果不是 2/8/16 进制标识,均视为 10 进制
    If Ty1 = Ty2 Or Ty2 < 2 And Ty2 > 16 Then Exit Function '如果两个进制标识相同或标识2超出范围
    If Ty2 = 10 Or Ty1 = 10 Then k = 0
  End If
Else: Ty2 = IIf(Ty1 = 10, 16, 10)    '如果没有逗号,10 进制默认转换为 16 进制,其它进制默认转换为 10 进制
End If

For i = 1 To Len(Dat3)               '检查数字的合法性
  z = Mid(Dat3, i, 1)
  Select Case Ty1
    Case 2: If InStr("01", z) = 0 Then Exit Function
    Case 8: If InStr("01234567", z) = 0 Then Exit Function
    Case 10: If InStr("0123456789", z) = 0 Then Exit Function
    Case 16: If InStr("0123456789ABCDEF", z) = 0 Then Exit Function
  End Select
Next

Select Case Ty1
  Case 16: If Len(Dat3) < 9 Then z = AnyToDec(Dat3, 16) Else Exit Function   '16 进制转为 10 进制
  Case 2: If Len(Dat3) < 33 Then z = AnyToDec(Dat3, 2) Else Exit Function    '2 进制转为 10 进制
  Case 8: If Len(Dat3) < 12 Then z = AnyToDec(Dat3, 8) Else Exit Function    '8 进制转为 10 进制
  Case 10: If Len(Dat3) < 11 Then z = DecToAny(Dat3, Ty2) Else Exit Function '10 进制转为任意进制
End Select

进制转换 = IIf(k, DecToAny(z, Ty2), z) '如果是任意进制之间互相转换,则再从10进制转为所需进制
End Function

Function DecToAny(ByVal Dat4 As String, Num As Integer) As String '10进制转为任意进制
On Error GoTo Err1
Dim DAT As Double, A As Double, B As Double, z As String, j As Integer
DAT = Val(Dat4)
Do
  A = Int(DAT / Num): B = DAT - A * Num: DAT = A
  If B > 9 Then z = Chr(B + 55) + z Else z = LTrim(Str(B)) + z
  j = j + 1: If j = 4 And DAT > 0 Then j = 0: z = "," & z
Loop While DAT > 0
DecToAny = z
Err1:
End Function

Function AnyToDec(Dat4 As String, Num As Integer) As String '任意进制转为10进制
On Error GoTo Err2
Dim A As Integer, L As Integer, k As Integer, B As Double
L = Len(Dat4)
For k = 0 To L - 1
  A = Asc(Mid$(Dat4, L - k, 1)) - 48
  If A < 0 Or A > 9 And A < 17 Or A > 22 Then A = 0
  If A > 9 Then A = A - 7
  If A > 0 Then B = B + A * Num ^ k
Next
AnyToDec = Format(B)
Err2:
End Function

12 楼

数据存储,帮助及错误提示功能就要你自己去完成了。
好累。

我来回复

您尚未登录,请登录后再回复。点此登录或注册