EXPRESI OPERASI BILANGAN DALAM 1 TEXBOX di VB6


Dalam pemrogram vb6 kita kadang kesulitan untuk membuat suatu expresi operasional dalam 1 texbox , di bawah ini ada scrib yang kiranya dapat membaatu anda dalam pengembangan program atau bahan risen sikripsi :
Option Explicit

Private Const cnstOrder = "/+-* " 'Konstanta Operasi bilangan

Private Sub Command1_Click()
Label2 = SolveEquation(Text1)
End Sub


Private Function SolveEquation(ByVal pExpr As String) As Double

    SolveEquation = Recur_Solve(pExpr, Left$(cnstOrder, 1))

End Function


Private Function Recur_Solve(ByVal pExp As String, ByVal pOperand As String) As Double

    Dim lArray() As String, NextOperand As String
    Dim lPos As Long, i As Long
    Dim RetVal As Double
    Dim DidEval As Boolean
    
    lPos = InStr(cnstOrder, pOperand)
    If lPos > 0 Then
        lArray = Split(pExp, Mid$(cnstOrder, lPos, 1))
        If lPos < Len(cnstOrder) Then
            NextOperand = Mid$(cnstOrder, lPos + 1, 1)
            For i = 0 To UBound(lArray)
                Recur_Solve = Recur_Solve(lArray(i), NextOperand)
                If i = 0 Then
                    RetVal = Recur_Solve
                Else
                    RetVal = MathItUp(RetVal, Recur_Solve, pOperand)
                End If
            Next i
            Recur_Solve = RetVal
            DidEval = True
        End If
            If Not (DidEval) Then
                Recur_Solve = Val(pExp)
            End If
    End If
End Function

Private Sub Form_Activate()
Text1.SetFocus
Text1_GotFocus
End Sub

Private Sub Text1_GotFocus()
   With Text1
      .SelStart = 0
      .SelLength = Len(.Text)
   End With

End Sub

Private Function MathItUp(ByVal Total As Double, ByVal pVal As String, ByVal pOperand As String) As Double

    Dim lVal As Double
    
    lVal = CDbl(Val(Trim$(pVal)))
    Select Case pOperand
        Case "*": MathItUp = Total * lVal
        Case "/": MathItUp = Total / lVal
        Case "+": MathItUp = Total + lVal
        Case "-": MathItUp = Total - lVal
        Case Else: MathItUp = lVal
    End Select

End Function

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then  ' tekan Enter
    Label2 = SolveEquation(Text1)
    KeyAscii = 0
    Text1_GotFocus
End If

End Sub


SEMOGA BERMANFAAT......