📄 modcalculate.bas
字号:
ExtractToken
'Get logarithm base
Text = frmCalcSolver.txtLogBase.Text
'If the box is empty, set it with the default 10
If Text = "" Then
frmCalcSolver.txtLogBase.Text = "10"
Base = 10
'Check for errors in the logarithm base
Else
NumDecimals = 0
For i = 1 To Len(Text)
Char = Mid(Text, i, 1)
If Char = "." Then
NumDecimals = NumDecimals + 1
End If
If NumDecimals > 1 Then
Char = "e"
End If
If Not (Char >= "0" And Char <= "9") And Char <> "." Then
ErrorMessage = "Error: Invalid Logarithm Base"
InError = True
OutputString = "TError"
Exit Function
End If
Next i
'Set the logarithm base
Base = CDbl(Text)
frmCalcSolver.txtLogBase.Text = CStr(Base)
End If
'Get number
Value = GetBody
GetF = Log(Value) / Log(Base)
ExtractToken
'Natural logarithm
Case "ln"
GetBody
If InError Then
Exit Function
Else
GetF = Log(Value)
End If
ExtractToken
'Pi
Case "pi"
GetF = Pi
ExtractToken
Exit Function
'Square Root
Case "sr"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
GetF = Sqr(Value)
End If
'Cosine
Case "cos"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = Cos(Value)
End If
'Cotangent
Case "cot"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = 1 / Tan(Value)
End If
'Cosecant
Case "csc"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = 1 / Sin(Value)
End If
'Hyperbolic cosecant
Case "hcc"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = 2 / (Exp(Value) - Exp(-Value))
End If
Exit Function
'Hyperbolic cosine
Case "hcs"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = (Exp(Value) + Exp(-Value)) / 2
End If
'Hyperbolic cotangent
Case "hct"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = (Exp(Value) + Exp(-Value)) / (Exp(Value) - Exp(-Value))
End If
'Hyperbolic secant
Case "hsc"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = 2 / (Exp(Value) + Exp(-Value))
End If
'Hyperbolic sine
Case "hsn"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = (Exp(Value) - Exp(-Value)) / 2
End If
'Hyperbolic tangent
Case "htn"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = (Exp(Value) - Exp(-Value)) / (Exp(Value) + Exp(-Value))
End If
'Inverse hyperbolic cosine
Case "ihc"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Log(Value + Sqr(Value * Value - 1))
ConvertToDegrees
GetF = Value
End If
'Inverse hyperbolic cosecant
Case "ihcc"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Log((Sgn(Value) * Sqr(Value * Value + 1) + 1) / Value)
ConvertToDegrees
GetF = Value
End If
'Inverse hyperbolic cotangent
Case "ihct"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Log((Value + 1) / (Value - 1)) / 2
ConvertToDegrees
GetF = Value
End If
'Inverse hyperbolic sine
Case "ihs"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Log(Value + Sqr(Value * Value + 1))
ConvertToDegrees
GetF = Value
End If
'Inverse hyperbolic secant
Case "ihsc"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Log((Sqr(-Value * Value + 1) + 1) / Value)
ConvertToDegrees
GetF = Value
End If
'Inverse hyperbolic tangent
Case "iht"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Log((1 + Value) / (1 - Value)) / 2
ConvertToDegrees
GetF = Value
End If
'Inverse cosecant
Case "icc"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Atn(Value / Sqr(Value * Value - 1)) + (Sgn(Value) - 1) * (2 * Atn(1))
ConvertToDegrees
GetF = Value
End If
'Inverse cosine
Case "ics"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Atn(-Value / Sqr(-Value * Value + 1)) + 2 * Atn(1)
ConvertToDegrees
GetF = Value
End If
'Inverse cotangent
Case "ict"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Atn(Value) + 2 * Atn(1)
ConvertToDegrees
GetF = Value
End If
'Inverse secant
Case "isc"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Atn(Value / Sqr(Value * Value - 1)) + Sgn((Value) - 1) * (2 * Atn(1))
ConvertToDegrees
GetF = Value
End If
'Inverse sine
Case "isn"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Atn(Value / Sqr(-Value * Value + 1))
ConvertToDegrees
GetF = Value
End If
'Inverse tangent
Case "itn"
ExtractToken
Value = GetBody
If InError Then
Exit Function
Else
Value = Atn(Value)
ConvertToDegrees
GetF = Value
End If
'Secant
Case "sec"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = 1 / Cos(Value)
End If
'Sine
Case "sin"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = Sin(Value)
End If
'Tangent
Case "tan"
ExtractToken
Value = GetBody
ConvertToRadians
If InError Then
Exit Function
Else
GetF = Tan(Value)
End If
'Anything else is an error
Case Else
TrapErrors 0
End Select
Exit Function
ErrorHandler:
'Trap errors
TrapErrors Err.Number
End Function
Private Function GetBody()
On Error GoTo ErrorHandler
Select Case OutputString
Case "Number"
GetBody = OutputValue
ExtractToken
Case "("
ExtractToken
GetBody = GetE
If OutputString <> ")" And OutputString <> "EOS" Then
TrapErrors 0
Exit Function
End If
ExtractToken
End Select
Exit Function
ErrorHandler:
'Trap errors
TrapErrors Err.Number
End Function
Private Sub TrapErrors(ErrNumber As Long)
'Set trapped error message
If ErrNumber = 6 Then
'Overflow
ErrorMessage = "Error: Overflow"
ElseIf ErrNumber = 11 Then
'Division By Zero
ErrorMessage = "Error: Division By Zero"
Else
'Unknown error
ErrorMessage = "Calculation Error"
End If
'Set return values
InError = True
OutputString = "TError"
End Sub
Private Sub ConvertToDegrees()
'Convert to degrees
If frmCalcSolver.optAngMode(0).Value = True Then
Value = Value * (180 / Pi)
End If
End Sub
Private Sub ConvertToRadians()
'Convert to radians
If frmCalcSolver.optAngMode(0).Value = True Then
Value = Value * (Pi / 180)
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -