form1.frm

计算器

      TabIndex        =   2
      Top             =   2760
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "算术表达式:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   1455
   End
End
Attribute VB_Name = "compute"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private expr(255) As String
Private nextnum As Integer
Private fore As Integer
Private back As Integer
Private Sub Init()

  expression.Text = ""
  resultnum.Text = ""
  nextnum = 0
  fore = 0
  back = 0

End Sub

Private Sub warning(warnstring As String)

MsgBox warnstring, vbOKOnly, "警告"

End Sub
Private Sub Output_Result(Result As Double)

resultnum.Text = Str(Result)

End Sub
Private Sub compute()

     Dim i As Integer
     Dim OpStack(256 / 2) As String
     Dim NumStack(256 / 2 + 1) As Double
     Dim NumSp As Integer
     Dim OpSp As Integer
     Dim Num As Double
     Dim dot As Integer
     Dim Num1 As Double
     Dim Num2 As Double
     Dim Result As Double

     i = 0: NumSp = 0: OpSp = 0: Num = 0: dot = -1
     Num1 = 0: Num2 = 0: Result = 0
     
     While i < nextnum

     Select Case expr(i)
     Case "("
       OpStack(OpSp) = expr(i)
       OpSp = OpSp + 1
     
     Case ")"
       If expr(i - 1) >= "0" And expr(i - 1) <= "9" Then
          For j = 1 To dot
              Num = Num / 10
          Next j
          NumStack(NumSp) = Num
          NumSp = NumSp + 1: dot = -1:  Num = 0
       End If
       While OpStack(OpSp - 1) <> "("
          NumSp = NumSp - 1
          Num2 = NumStack(NumSp)
          NumSp = NumSp - 1
          Num1 = NumStack(NumSp)
          OpSp = OpSp - 1
          Select Case OpStack(OpSp)
          Case "+"
            Result = Num1 + Num2
          Case "-"
            Result = Num1 - Num2
          Case "*"
            Result = Num1 * Num2
          Case "/"
            If Num2 = 0 Then
               Call warning("运行中产生除数为0的情况！")
               Call Init
               Exit Sub
            End If
            Result = Num1 / Num2
          End Select
          NumStack(NumSp) = Result
          NumSp = NumSp + 1
        Wend
        OpSp = OpSp - 1
    
     Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
        Num = Num * 10 + Asc(expr(i)) - Asc("0")
        If dot >= 0 Then
           dot = dot + 1
        End If
        
     Case "."
        dot = 0
        
        Case "+", "-"
          If expr(i - 1) <> ")" Then
             For j = 1 To dot
                 Num = Num / 10
             Next j
             NumStack(NumSp) = Num
             NumSp = NumSp + 1: dot = -1: Num = 0
          End If
          
          If OpSp = 0 Then
             OpStack(OpSp) = expr(i)
             OpSp = OpSp + 1
          Else
             If expr(i - 1) = "(" Then
                OpStack(OpSp) = expr(i)
                OpSp = OpSp + 1
             Else
               Dim Quit As Boolean
               Quit = False
               While OpSp > 0 And Quit = False
                 If OpStack(OpSp - 1) <> "(" Then
                   NumSp = NumSp - 1
                   Num2 = NumStack(NumSp)
                   NumSp = NumSp - 1
                   Num1 = NumStack(NumSp)
                   OpSp = OpSp - 1
                   Select Case OpStack(OpSp)
                   Case "+"
                     Result = Num1 + Num2
                   Case "-"
                     Result = Num1 - Num2
                   Case "*"
                     Result = Num1 * Num2
                   Case "/"
                    If Num2 = 0 Then
                       Call warning("运行中产生除数为0的情况！")
                       Call Init
                       Exit Sub
                    End If
                     Result = Num1 / Num2
                   End Select
                   NumStack(NumSp) = Result
                   NumSp = NumSp + 1
                 Else
                   Quit = True
                 End If
               Wend
               OpStack(OpSp) = expr(i)
               OpSp = OpSp + 1
             End If
          End If
          
        Case "*", "/"
          If expr(i - 1) <> ")" Then
             For j = 1 To dot
                 Num = Num / 10
             Next j
             NumStack(NumSp) = Num
             NumSp = NumSp + 1:  dot = -1:  Num = 0
          End If
          If OpSp = 0 Then
             OpStack(OpSp) = expr(i)
             OpSp = OpSp + 1
          Else
            If OpStack(OpSp - 1) = "(" Then
               OpStack(OpSp) = expr(i)
               OpSp = OpSp + 1
            Else
               NumSp = NumSp - 1
               Num2 = NumStack(NumSp)
               NumSp = NumSp - 1
               Num1 = NumStack(NumSp)
               OpSp = OpSp - 1
               Select Case OpStack(OpSp)
               Case "+", "-"
                 OpSp = OpSp + 1: NumSp = NumSp + 2
               Case "*"
                 Result = Num1 * Num2
                 NumStack(NumSp) = Result
                 NumSp = NumSp + 1
               Case "/"
                 If Num2 = 0 Then
                    Call warning("运行中产生除数为0的情况！")
                    Call Init
                    Exit Sub
                 End If
                 Result = Num1 / Num2
                 NumStack(NumSp) = Result
                 NumSp = NumSp + 1
               End Select
               OpStack(OpSp) = expr(i)
               OpSp = OpSp + 1
            End If
          End If
          
        End Select

        i = i + 1
     Wend

     If expr(nextnum - 1) <> ")" Then
        For j = 1 To dot
            Num = Num / 10
        Next j
        NumStack(NumSp) = Num
        NumSp = NumSp + 1: dot = -1:  Num = 0
     End If
     
     While OpSp > 0
        NumSp = NumSp - 1
        Num2 = NumStack(NumSp)
        NumSp = NumSp - 1
        Num1 = NumStack(NumSp)
        OpSp = OpSp - 1
        Select Case OpStack(OpSp)
        Case "+"
          Result = Num1 + Num2
        Case "-"
          Result = Num1 - Num2
        Case "*"
          Result = Num1 * Num2
        Case "/"
          If Num2 = 0 Then
             Call warning("运行中产生除数为0的情况！")
             Call Init
             Exit Sub
          End If
          Result = Num1 / Num2
        End Select
        NumStack(NumSp) = Result
        NumSp = NumSp + 1
     Wend
     
     NumSp = NumSp - 1
     Result = NumStack(NumSp)
     
     Call Output_Result(Result)

End Sub

Private Sub Command1_Click(Index As Integer)

Call expression_KeyPress(Asc(Command1(Index).Caption))

End Sub

Private Sub Command2_Click(Index As Integer)

Call expression_KeyPress(Asc(Command2(Index).Caption))

End Sub

Private Sub Command3_Click()

Call Init

End Sub

Private Sub expression_KeyPress(KeyAscii As Integer)

  Dim ch As String
  Dim Quit As Boolean
  
  ch = Chr(KeyAscii)

    If (KeyAscii = vbKeyReturn Or KeyAscii = Asc("=")) And nextnum <> 0 Then
          
       Select Case expr(nextnum - 1)
       Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ")"
         If fore = back Then
            Quit = True
         Else
            Call warning("( ) 不匹配！")
         End If
       Case Else
          Call warning("表达式输入不完整！")
       End Select
                 
       If Quit = True Then
          Call compute
       End If
          
       Exit Sub
          
    Else
      If KeyAscii = vbKeyBack Then
         If nextnum > 0 Then
            nextnum = nextnum - 1
            If expr(nextnum) = ")" Then
               back = back - 1
            End If
            If expr(nextnum) = "(" Then
               fore = fore - 1
            End If
          End If
          
      Else
           If nextnum = 256 Then
              Call warning("表达式超出最大长度！")
              Exit Sub
           Else
             Select Case ch
             
             Case "."
               If nextnum = 0 Then
                  Call warning("当前不能输入该字符！")
               Else
                 If expr(nextnum - 1) < "0" Or expr(nextnum - 1) > "9" Then
                    Call warning("当前不能输入该字符！")
                 Else
                    expr(nextnum) = ch
                    nextnum = nextnum + 1
                 End If
               End If
               
             Case "("
               If nextnum = 0 Then
                  fore = fore + 1
                  expr(nextnum) = ch
                  nextnum = nextnum + 1
               Else
                 Select Case expr(nextnum - 1)
                 Case "+", "-", "*", "/", "("
                   fore = fore + 1
                   expr(nextnum) = ch
                   nextnum = nextnum + 1
                 Case Else
                   Call warning("当前不能输入该字符！")
                 End Select
               End If
               
             Case ")"
               If back > fore - 1 Then
                  Call warning("( ) 不匹配！")
               Else
                  Select Case expr(nextnum - 1)
                  Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ")"
                    back = back + 1
                    expr(nextnum) = ch
                    nextnum = nextnum + 1
                  Case Else
                    Call warning("当前不能输入该字符！")
                  End Select
                End If
                
             Case "+", "-", "*", "/"
               If nextnum = 0 Then
                  Call warning("当前不能输入该字符！")
               Else
                 Select Case expr(nextnum - 1)
                 Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ")"
                   expr(nextnum) = ch
                   nextnum = nextnum + 1
                 Case Else
                   Call warning("当前不能输入该字符！")
                 End Select
               End If
             
             Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
               If nextnum <> 0 Then
                  If expr(nextnum - 1) = ")" Then
                     Call warning("当前不能输入该字符！")
                  Else
                     expr(nextnum) = ch
                     nextnum = nextnum + 1
                  End If
               Else
                  expr(nextnum) = ch
                  nextnum = nextnum + 1
               End If
                
             Case Else
               Call warning("不能输入该字符！")
               
             End Select
          End If
        End If
      End If

      expression.Text = ""
      For i = 0 To nextnum - 1
        expression.Text = expression.Text & expr(i)
      Next i
      expression.SelStart = Len(expression.Text)

End Sub

Private Sub Form_Load()

Call Init

End Sub