我们来看一个计算逻辑:
dim out as double=(1360 / (480 * 3)) * (30 / 22) + 227 / 480 + 5 * 30
这个写起来很简单,运算也能执行
但写成字符串,让代码就无法执行了:
dim outstr as string="(1360 / (480 * 3)) * (30 / 22) + 227 / 480 + 5 * 30"
有没有办法让这串字符串也能计算出结果呢,例如这样:
dim outstr as string="(1360 / (480 * 3)) * (30 / 22) + 227 / 480 + 5 * 30"
dim cal as new CalString
dim out as double=cal.Cal_Start(outstr)
Imports System.Data
Public Class CalString
Dim CF1() As String = {"^", "*", "/", "\", "+", "-", "m", "s", "c", "t"}
'sin=s,cos=c,tan=t
Public Cal_Log As New List(Of String)
Public Class CalDT
Implements IDisposable
Public _DT_THis As New DataTable
Public Sub New()
_DT_THis.Columns.Add("字符")
_DT_THis.Columns.Add("数值", Type.GetType("System.Double"))
_DT_THis.Columns.Add("符号", Type.GetType("System.Boolean"))
End Sub
Public Function GetMyString() As String
Dim MS As String = ""
For i As Integer = 0 To _DT_THis.Rows.Count - 1
If _DT_THis.Rows(i)("符号") = True Then
MS = MS & _DT_THis.Rows(i)("字符")
Else
MS = MS & _DT_THis.Rows(i)("数值")
End If
Next
Return MS
End Function
#Region "IDisposable Support"
Private disposedValue As Boolean ' 要检测冗余调用
' IDisposable
Protected Overridable Sub Dispose(disposing As Boolean)
If Not disposedValue Then
If disposing Then
' TODO: 释放托管状态(托管对象)。
End If
If IsNothing(_DT_THis) = False Then
_DT_THis.Dispose()
_DT_THis = Nothing
End If
' TODO: 释放未托管资源(未托管对象)并在以下内容中替代 Finalize()。
' TODO: 将大型字段设置为 null。
End If
disposedValue = True
End Sub
' TODO: 仅当以上 Dispose(disposing As Boolean)拥有用于释放未托管资源的代码时才替代 Finalize()。
'Protected Overrides Sub Finalize()
' ' 请勿更改此代码。将清理代码放入以上 Dispose(disposing As Boolean)中。
' Dispose(False)
' MyBase.Finalize()
'End Sub
' Visual Basic 添加此代码以正确实现可释放模式。
Public Sub Dispose() Implements IDisposable.Dispose
' 请勿更改此代码。将清理代码放入以上 Dispose(disposing As Boolean)中。
Dispose(True)
' TODO: 如果在以上内容中替代了 Finalize(),则取消注释以下行。
' GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
'mod转化为m
Private Sub CalAllTeshu(_calDT As CalDT)
Cal_TeShu("s", _calDT, "sin")
CreateCalLog("sin", _calDT.GetMyString)
Cal_TeShu("c", _calDT, "cos")
CreateCalLog("cos", _calDT.GetMyString)
Cal_TeShu("t", _calDT, "tan")
CreateCalLog("tan", _calDT.GetMyString)
End Sub
Private Function ReplaceTeShu(_S As String)
Dim TS As String = _S
TS = TS.Replace("sin", "s")
TS = TS.Replace("cos", "c")
TS = TS.Replace("tan", "t")
Return TS
End Function
Public Function Cal_teshuall(ByVal Nowc As String, s1 As Double) As Double
Select Case Nowc
Case "s"
Return Math.Sin(s1)
Case "c"
Return Math.Cos(s1)
Case "t"
Return Math.Tan(s1)
Case Else
Throw New Exception("出现无法识别的运算符:" & Nowc)
End Select
End Function
Private Function ModToM(ByVal _S As String) As String
Dim TS As String = _S
TS = TS.Replace("mode", "m")
TS = TS.Replace("mod", "m")
Return TS
End Function
Public Function IsHave符号(ByVal _S As String, _CalDT As CalDT) As Boolean
Dim dt_this = _CalDT._DT_THis
For i As Integer = dt_this.Rows.Count - 1 To 0 Step -1
If dt_this.Rows(i)("符号") = True Then
If dt_this.Rows(i)("字符") = _S Then
Return True
End If
End If
Next
Return False
End Function
Public Sub Cal_TeShu(Nowc As String, _CalDT As CalDT, NowName As String)
Dim dt_this = _CalDT._DT_THis
Try
Do While IsHave符号(Nowc, _CalDT) = True
For i As Integer = 0 To dt_this.Rows.Count - 1
If dt_this.Rows(i)("符号") = True Then
If dt_this.Rows(i)("字符") = Nowc Then
Dim c1 As Double = dt_this.Rows(i + 1)("数值")
Dim GCV As Double = Cal_teshuall(Nowc, c1)
dt_this.Rows(i + 1)("数值") = GCV
dt_this.Rows.RemoveAt(i)
Exit For
End If
End If
Next
Loop
Catch ex As Exception
Throw New Exception(NowName & "附近有错误发生,详细错误如下:" & vbCrLf & ex.Message)
End Try
End Sub
Public Sub Cal_Value(NowC As String, _CalDT As CalDT)
Dim dt_this = _CalDT._DT_THis
Try
Do While IsHave符号(NowC, _CalDT) = True
For i As Integer = 0 To dt_this.Rows.Count - 1
If dt_this.Rows(i)("符号") = True Then
If dt_this.Rows(i)("字符") = NowC Then
Dim c1 As Double = dt_this.Rows(i - 1)("数值")
Dim c2 As Double = dt_this.Rows(i + 1)("数值")
Dim GCV As Double = Cal_all(NowC, c1, c2)
dt_this.Rows(i - 1)("数值") = GCV
dt_this.Rows.RemoveAt(i + 1)
dt_this.Rows.RemoveAt(i)
Exit For
End If
End If
Next
Loop
Catch ex As Exception
Throw New Exception(NowC & "附近有错误发生,详细错误如下:" & vbCrLf & ex.Message)
End Try
End Sub
Public Sub Cal_Value_Together(NowC1 As String, Nowc2 As String, _CalDT As CalDT)
Dim dt_this = _CalDT._DT_THis
Try
Do While (IsHave符号(NowC1, _CalDT) = True Or IsHave符号(Nowc2, _CalDT))
For i As Integer = 0 To dt_this.Rows.Count - 1
If dt_this.Rows(i)("符号") = True Then
If dt_this.Rows(i)("字符") = NowC1 Then
Dim c1 As Double = dt_this.Rows(i - 1)("数值")
Dim c2 As Double = dt_this.Rows(i + 1)("数值")
Dim GCV As Double = Cal_all(NowC1, c1, c2)
dt_this.Rows(i - 1)("数值") = GCV
dt_this.Rows.RemoveAt(i + 1)
dt_this.Rows.RemoveAt(i)
Exit For
End If
If dt_this.Rows(i)("字符") = Nowc2 Then
Dim c1 As Double = dt_this.Rows(i - 1)("数值")
Dim c2 As Double = dt_this.Rows(i + 1)("数值")
Dim GCV As Double = Cal_all(Nowc2, c1, c2)
dt_this.Rows(i - 1)("数值") = GCV
dt_this.Rows.RemoveAt(i + 1)
dt_this.Rows.RemoveAt(i)
Exit For
End If
End If
Next
Loop
Catch ex As Exception
Throw New Exception(NowC1 & Nowc2 & "附近有错误发生,详细错误如下:" & vbCrLf & ex.Message)
End Try
End Sub
Public Function Cal_Start(SText As String) As Double
Dim RD As Double = 0
Try
Cal_Log.Clear()
Dim _s As String = SText.Replace(" ", "").ToLower '去掉所有空格,小写化
_s = ModToM(_s) 'mod转换为m
'括号转换
_s = _s.Replace("(", "(")
_s = _s.Replace(")", "(")
_s = ReplaceTeShu(_s)
RD = Cal_Del括号(_s)
CreateCalLog("结果", RD, True)
Return RD
Catch ex As Exception
CreateCalLog("结果", "错误:" & ex.Message, True)
Return RD
Finally
End Try
End Function
Public Function Cal_Del括号(_S As String) As Double
Dim I_Start As Integer = 0
Dim I_end As Integer = 0
Dim GetS As String = ""
For i As Integer = 0 To _S.Length - 1
If _S(i) = "(" Then I_Start = i + 1
If _S(i) = ")" Then I_end = i + 1
If I_Start <> 0 And I_end > I_Start Then Exit For
Next
CreateCalLog("括号运算", _S)
If I_Start = 0 And I_Start = 0 Then
Return Cal_四则运算(_S)
End If
If I_end - I_Start > 1 Then
Dim S1 As String = Mid(_S, 1, I_Start - 1)
Dim SC As String = Cal_四则运算(Mid(_S, I_Start + 1, I_end - I_Start - 1))
Dim S2 As String = Mid(_S, I_end + 1)
_S = S1 & SC & S2
Dim In1 As Integer = InStr(_S, "(")
Dim In2 As Integer = InStr(_S, ")")
If In1 > 0 And In2 > 0 Then
Return Cal_Del括号(_S)
ElseIf In1 = 0 And In2 = 0 Then
Return Cal_四则运算(_S)
Else
Throw New Exception("括号附近出现错误!")
End If
Else
Throw New Exception("括号附近出现错误!")
End If
Throw New Exception("判断括号出现异常,请联程序开发员处理!")
End Function
Private Function Cal_四则运算(S1_S As String) As Double
Dim S1_C As New CalDT
Dim I_Start As Integer = 1
If S1_S.Length = 1 Then Return Val(S1_S)
For i As Integer = 0 To S1_S.Length - 1
Dim NowS1S As String = S1_S(i)
Dim NowS1S_Next As String = ""
Dim NowS1S_Per As String = ""
If i <> 0 Then
NowS1S_Per = S1_S(i - 1)
End If
If S1_S.Length - 1 <> i Then
NowS1S_Next = S1_S(i + 1)
End If
If NowS1S_Next = "" Then
Dim NewC = S1_C._DT_THis.NewRow
NewC("字符") = Mid(S1_S, I_Start)
NewC("符号") = False
ChangeStrTOValue(NewC)
S1_C._DT_THis.Rows.Add(NewC)
Else
If CheckCF1(NowS1S_Per, NowS1S, NowS1S_Next) = True Then
If NowS1S_Per <> "" Then
If Is符号(NowS1S_Per) = False Then
Dim NewC = S1_C._DT_THis.NewRow
NewC("字符") = Mid(S1_S, I_Start, i - I_Start + 1)
NewC("符号") = False
ChangeStrTOValue(NewC)
S1_C._DT_THis.Rows.Add(NewC)
End If
End If
Dim NewC1 = S1_C._DT_THis.NewRow
NewC1("字符") = NowS1S
NewC1("符号") = True
S1_C._DT_THis.Rows.Add(NewC1)
I_Start = i + 2
End If
End If
Next
CreateCalLog("分支运行", S1_C.GetMyString)
CalAllTeshu(S1_C)
Cal_Value("^", S1_C)
CreateCalLog("^", S1_C.GetMyString)
Cal_Value_Together("*", "/", S1_C)
CreateCalLog("*,/", S1_C.GetMyString)
Cal_Value("\", S1_C)
CreateCalLog("\", S1_C.GetMyString)
Cal_Value("m", S1_C)
CreateCalLog("Mod", S1_C.GetMyString)
Cal_Value_Together("+", "-", S1_C)
CreateCalLog("+,-", S1_C.GetMyString)
Return Val(S1_C.GetMyString)
End Function
Public Function Cal_all(ByVal Nowc As String, s1 As Double, s2 As Double) As Double
Select Case Nowc
Case "^"
Return s1 ^ s2
Case "*"
Return s1 * s2
Case "/"
If s2 = 0 Then
Throw New Exception("除数不能为0!")
End If
Return s1 / s2
Case "\"
If s2 = 0 Then
Throw New Exception("除数不能为0!")
End If
Return s1 \ s2
Case "m"
If s2 = 0 Then
Throw New Exception("除数不能为0!")
End If
Return s1 Mod s2
Case "+"
Return s1 + s2
Case "-"
Return s1 - s2
Case Else
Throw New Exception("找不到符号'" & Nowc & "'")
End Select
End Function
Private Sub ChangeStrTOValue(ByRef _ES As DataRow)
Try
If _ES("符号") = False Then
Dim I_E As Integer = InStr(_ES("字符"), "e")
Dim i_加 As Integer = InStr(_ES("字符"), "+")
Dim i1 As Integer = 0
Dim i2 As Integer = 0
If I_E > i_加 Then
i2 = I_E
If i_加 <> 0 Then
i1 = i_加
Else
i1 = I_E
End If
Else
i2 = i_加
If i_加 <> 0 Then
i1 = I_E
Else
i1 = i_加
End If
End If
If i1 > 0 And i2 > 0 Then
_ES("数值") = Val(Mid(_ES("字符"), 1, i1)) * 10 ^ Val(Mid(_ES("字符"), i2 + 1))
Else
_ES("数值") = Val(_ES("字符"))
End If
End If
Catch ex As Exception
Throw New Exception("e附近有错误发生!")
End Try
End Sub
Private Function CheckCF1(ByVal _S_per As String, ByVal _S As String, ByVal _S_Next As String) As Boolean
If _S = "+" And _S_Next = "e" Then Return False
If _S = "e" And _S_Next = "+" Then Return False
If _S = "+" And _S_per = "e" Then Return False
If _S = "e" And _S_per = "+" Then Return False
If (_S_per = "" Or _S_per = "e") And _S = "-" Then Return False
If Is符号(_S_per) = True Then
If _S = "-" Then
Return False
End If
'If Is符号(_S) = True Then
' Throw New Exception(_S_per & _S & "附近发生错误!")
'End If
End If
For i As Integer = 0 To CF1.Length - 1
If CF1(i) = _S Then Return True
Next
Return False
End Function
Private Function Is符号(ByVal _S) As Boolean
For i As Integer = 0 To CF1.Length - 1
If CF1(i) = _S Then Return True
Next
Return False
End Function
Dim LastValString As String = ""
Private Sub CreateCalLog(ByVal SS_Per As String, ByVal SS_Value As String, Optional MustAdd As Boolean = False)
If LastValString <> SS_Value Or MustAdd = True Then
Dim s1 As String = "计算元素(" & SS_Per & "):"
Cal_Log.Add(s1 & SS_Value)
LastValString = SS_Value
End If
End Sub
End Class