Как ввести + - * / в текстовое поле или входящие в VB6, чтобы сделать мою формулу? - PullRequest
Новая
       29

Как ввести + - * / в текстовое поле или входящие в VB6, чтобы сделать мою формулу?

0 голосов
/ 03 декабря 2018

Как использовать текстовое поле или входящие в VB6, чтобы набрать + - / для подсчета формулы?Как A + BC D / (E) или только A-B + C

1 Ответ

0 голосов
/ 03 декабря 2018

Загляните в эту ветку форума .Вот класс cMathExpr оттуда: 

'--- cMathExpr.cls by Olaf Schmidt
Option Explicit

Private Enum eTokens
  TOK_FINAL = 0
  TOK_RPAREN = 1
  TOK_ADD = 2
  TOK_MOD = 3
  TOK_IDIV = 4
  TOK_MUL = 5
  TOK_UNARY = 6
  TOK_POWER = 7
  TOK_LPAREN = 8
  TOK_NUM = 9
  TOK_WHITE = 10
End Enum

Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any)

Private WC%(), saWC&(0 To 5), TokLUT(0 To 255) As eTokens, ValStack#(0 To 999), OpStack&(0 To 999)

Private Sub Class_Initialize()
  saWC(0) = 1: saWC(1) = 2: saWC(2) = 1 'init the safearry-struct for cDims and cbElements
  GetMem4 VarPtr(saWC(0)), ByVal ArrPtr(WC) 'bind the struct to the 16Bit-Int-array WC

  Dim iC As Long
  For iC = 0 To UBound(TokLUT) 'init the Token-Lookup-Table
    Select Case iC
      Case 40:           TokLUT(iC) = TOK_LPAREN ' "("
      Case 41:           TokLUT(iC) = TOK_RPAREN ' ")"
      Case 43, 45:       TokLUT(iC) = TOK_ADD    ' "+", "-"
      Case 42, 47:       TokLUT(iC) = TOK_MUL    ' "*", "/"
      Case 94:           TokLUT(iC) = TOK_POWER  ' "^"
      Case 92:           TokLUT(iC) = TOK_IDIV   ' "\"
      Case 37:           TokLUT(iC) = TOK_MOD    ' "%"
      Case 48 To 57, 46: TokLUT(iC) = TOK_NUM    ' "0" To "9", "."
      Case Else:         TokLUT(iC) = TOK_WHITE
    End Select
  Next
End Sub

Private Sub Class_Terminate()
  GetMem4 0&, ByVal ArrPtr(WC) 'release the Binding of WC%()
End Sub

Public Function Evaluate(sText As String) As Double
    Dim Tok As eTokens, PrevTok As eTokens
    Dim iC As Long, iV As Long, iO As Long, UB As Long

    saWC(3) = StrPtr(sText) ' pvData
    saWC(4) = Len(sText)    ' cElements
    UB = saWC(4) - 1        ' buffer the UBound (we pass this around into FastVal)

    For iC = 0 To UB
        Tok = TokLUT(WC(iC))
        If Tok = TOK_NUM Then
           iV = iV + 1
           ValStack(iV) = FastVal(iC, UB) 'FastVal will increment iC correctly
        ElseIf Tok = TOK_ADD Then
            If PrevTok >= TOK_ADD And PrevTok < TOK_NUM Then
               Tok = TOK_UNARY
            End If
        End If
        If Tok >= TOK_ADD And Tok < TOK_NUM Then
            If Tok <> TOK_UNARY Then '--- right assoc
               EvalOpStack Tok, iO, iV
            End If
            iO = iO + 1
            OpStack(iO) = Tok * &H10000 + WC(iC)
        End If
        If Tok <> TOK_WHITE Then PrevTok = Tok
    Next

    EvalOpStack TOK_FINAL, iO, iV
    Evaluate = ValStack(iV)
    ValStack(iV) = 0 'clear the bottom of the Value-Stack
End Function

Private Sub EvalOpStack(ByVal Tok As eTokens, iO As Long, iV As Long)
    For iO = iO To 1 Step -1
      If OpStack(iO) < Tok * &H10000 Then Exit For

      iV = iV - 1
      Select Case OpStack(iO) And &HFFFF&
        Case 43         ' "+"
          If OpStack(iO) > TOK_UNARY * &H10000 Then
             iV = iV + 1
          Else
             ValStack(iV) = ValStack(iV) + ValStack(iV + 1)
          End If
        Case 45         ' "-"
          If OpStack(iO) > TOK_UNARY * &H10000 Then
             iV = iV + 1
             ValStack(iV) = -ValStack(iV)
          Else
             ValStack(iV) = ValStack(iV) - ValStack(iV + 1)
          End If
        Case 42         ' "*"
          ValStack(iV) = ValStack(iV) * ValStack(iV + 1)
        Case 47         ' "/"
          ValStack(iV) = ValStack(iV) / ValStack(iV + 1)
        Case 94         ' "^"
          ValStack(iV) = ValStack(iV) ^ ValStack(iV + 1)
        Case 92         ' "\"
          ValStack(iV) = ValStack(iV) \ ValStack(iV + 1)
        Case 37         ' "%"
          ValStack(iV) = ValStack(iV) Mod ValStack(iV + 1)
        Case 40         ' "("
          iV = iV + 1
          If Tok > TOK_RPAREN Then Exit For
          If Tok = TOK_RPAREN Then iO = iO - 1: Exit For
      End Select
    Next
End Sub

Private Function FastVal(iC As Long, ByVal UB As Long) As Double
Dim NewVal&, IntPart#, FracPart#, FracDivisor#, eSgn&, eInt&

    For iC = iC To UB
      Select Case WC(iC)
        Case 48 To 57 'numeric
          If NewVal = 0 Then NewVal = 1
          If eSgn Then
            eInt = eInt * 10 + WC(iC) - 48
          ElseIf FracDivisor = 0 Then
            IntPart = IntPart * 10 + WC(iC) - 48
          ElseIf FracDivisor < 10000000000000# Then
            FracPart = FracPart * 10 + WC(iC) - 48
            FracDivisor = FracDivisor * 10
          End If
        Case 46 'decimal-point
          FracDivisor = 1: If NewVal = 0 Then NewVal = 1
        Case 45 'a leading "-" (only possible after the eSign in this scenario)
          If eSgn > 0 Then eSgn = -1 Else Exit For
        Case 69, 101 'e, E
          eInt = 0: If NewVal Then eSgn = 1
        Case Else: Exit For 'everything else exits the loop
      End Select
    Next
    iC = iC - 1
    If NewVal Then
      If FracDivisor Then
        FastVal = NewVal * (IntPart + FracPart / FracDivisor)
      Else
        FastVal = NewVal * IntPart
      End If
      If eSgn Then FastVal = FastVal * (10 ^ (eSgn * eInt))
    End If
End Function

Вы можете использовать его следующим образом: 

Option Explicit

Private Sub Form_Load()
    With New cMathExpr
        Debug.Print .Evaluate("1+2/3")
    End With
End Sub
...