主题:VB设计一个复杂计算器,求代码.高手指教!!
Misux
[专家分:0] 发布于 2008-08-31 17:09:00
可以完成加减乘除,乘方,开放,三角函数,进制转换,有数据存储,帮助及错误提示功能的复杂计算机程序
11 楼
一江秋水 [专家分:9680] 发布于 2008-09-02 17:16:00
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