就是一个简单的计算器。该论坛有一个现成的,支持较为全面,Search it。

解决方案 »

  1.   

    模块代码:
    '计算用户输入的表达式
    '如 "3+2*2" 结果为 "7"Public Function 计算(GS As String) As String
        Dim i, n As Integer
        Dim TempGs, Temp As String
        Dim Vl() As String '操作数
        Dim Vls As Integer '操作数的数目
        Dim Si As Integer '上一操作符的位置
        Dim Ads, Sus, Mus, Bys, Lks, Rks As Integer     '操作符的数目
        Dim Adp(), Mup(), Byp(), Lkp(), Rkp() As Integer '操作符的位置
        Dim Adn(), Mun(), Byn() As Integer '操作符的排列次序
        Dim Sig() As Integer '每一个操作符的位置
        
    On Error GoTo Err
    Do While True
        ReDim Adp(Len(GS)), Mup(Len(GS)), Byp(Len(GS)) _
            , Lkp(Len(GS)), Rkp(Len(GS)) As Integer
        ReDim Adn(Len(GS)), Mun(Len(GS)), Byn(Len(GS)) _
            , Lkn(Len(GS)), Rkn(Len(GS)), Sig(Len(GS)) As Integer
        
        ReDim Vl(Len(GS))
        
        If Len(GS) = 0 Then GoTo Err
        If Mid(GS, Len(GS), 1) <> "#" Then
        
            TempGs = GS
            For i = 1 To Len(GS) '将减化加
                
                If Mid(GS, i, 1) = "-" And i <> 1 Then
                    If Mid(GS, i - 1, 1) <> "+" And Mid(GS, i - 1, 1) <> "-" _
                        And Mid(GS, i - 1, 1) <> "*" And Mid(GS, i - 1, 1) <> "/" Then
                        TempGs = Mid(TempGs, 1, i - 1 + n) + "+" + Mid(GS, i)
                        n = n + 1
                    End If
                    
                End If
            Next i
            GS = TempGs
            
            n = 0
            For i = 1 To Len(GS) '处理负负得正
                If Mid(GS, i, 1) = "-" Then
                    If Mid(GS, i + 1, 1) = "-" Then
                        TempGs = Mid(TempGs, 1, i - 1 - n) + Mid(GS, i + 2)
                        n = n + 2
                    End If
                End If
            Next i
            GS = TempGs
            GS = GS + "#"
        End If
        
        Vls = 1
        Ads = 0: Sus = 0: Mus = 0: Bys = 0: Lks = 0: Rks = 0
        
        For i = 1 To Len(GS)
            
            Select Case Mid(GS, i, 1)
                Case "+"
                    Ads = Ads + 1
                    Adp(Ads) = i
                    Adn(Ads) = Vls
                Case "*"
                    Mus = Mus + 1
                    Mup(Mus) = i
                    Mun(Mus) = Vls
                Case "/"
                    Bys = Bys + 1
                    Byp(Bys) = i
                    Byn(Bys) = Vls
                Case "("
                    Lks = Lks + 1
                    Lkp(Lks) = i
                   
                Case ")"
                    Rks = Rks + 1
                    Rkp(Rks) = i
                    
            End Select
            
            If Mid(GS, i, 1) = "+" Or Mid(GS, i, 1) = "*" Or _
                Mid(GS, i, 1) = "/" Or Mid(GS, i, 1) = "#" Then
                
                If Si + 1 = i And Mid(GS, i + 1, 1) <> "#" _
                     Then '操作符非法连续或以操作符开头
                    GoTo Err
                Else
                    Si = i
                End If
                
                If Not IsNumeric(Vl(Vls)) And Mid(GS, i + 1, 1) <> "#" _
                     Then '操作数不是数字
                    GoTo Err
                End If
                Sig(Vls) = i
                Vls = Vls + 1
                
            Else
                If Mid(GS, i, 1) <> "(" And Mid(GS, i, 1) <> ")" Then
                    Vl(Vls) = Vl(Vls) + Mid(GS, i, 1) '制作操作数
                Else
                  If i <> 1 Then
                    If ((Mid(GS, i - 1, 1) = "(" And Mid(GS, i, 1) = ")") Or _
                       (Mid(GS, i - 1, 1) = ")" And Mid(GS, i, 1) = "(")) _
                          Then '判定括号前后符号的合法性
                        GoTo Err
                    End If
                  End If
                End If
            End If
            
        Next i
        
        If Lks <> Rks Then
            GoTo Err '左右括号数是否匹配
        End If
        
        For i = 1 To Lks
            If Lkp(i) > Rkp(i) Then GoTo Err '左右括号出现顺序错误
        Next i
        
        If Lks <> 0 Then '括号处理
          Do While True
            For i = Lks To 1 Step -1
                For n = Rks To 1 Step -1
                    Temp = 计算(Mid(GS, Lkp(i) + 1, Rkp(n) - Lkp(i) - 1))
                    If Temp <> "公式有错误" Then
                        GS = Mid(GS, 1, Lkp(i) - 1) + Temp + Mid(GS, Rkp(n) + 1)
                        Exit Do
                    End If
                Next n
            Next i
            If Temp = "公式有错误" Then GoTo Err
                '括号中有错误退出
          Loop
        Else
            If Mus <> 0 Then '乘法处理
                GS = Mid(GS, 1, Sig(Mun(1) - 1)) + Trim(Str(Val(Vl(Mun(1))) _
                    * Val(Vl(Mun(1) + 1)))) + Mid(GS, Val(Mup(1)) + Len(Vl(Mun(1) _
                    + 1)) + 1)
            Else
                If Bys <> 0 Then '除法处理
                    GS = Mid(GS, 1, Sig(Byn(1) - 1)) + Trim(Str(Val(Vl(Byn(1))) _
                        / Val(Vl(Byn(1) + 1)))) + Mid(GS, Val(Byp(1)) + Len(Vl(Byn(1) _
                        + 1)) + 1)
                Else
                    If Ads <> 0 Then '加法处理
                        GS = Trim(Str(Val(Vl(1)) + Val(Vl(2)))) + Mid(GS, Val(Adp(1)) _
                            + Len(Vl(2)) + 1)
                    Else
                        计算 = Mid(GS, 1, Len(GS) - 1)
                        Exit Function
                    End If
                End If
            End If
        End If
    Loop
        
        
    Err:
        计算 = "公式有错误"
        
    End Function
      

  2.   

    以前有人问过
    acptvb(微软全球技术中心 VB技术支持)的回答:回复人: acptvb(微软全球技术中心 VB技术支持) (  ) 信誉:99  2002-6-26 16:53:41  得分:0  
     
     
      感谢您使用微软产品。您可以利用Microsoft Script Control来实现这个功能。首先,你需要在工程里引用一下Microsoft Script Control。然后加入一下代码:Private Sub Form_Load()Dim scr As New ScriptControl
    Dim mycode As Stringscr.Language = "vbscript"
    mycode = "public function Test()" + vbCrLf
    mycode = mycode + "MsgBox ""Hello VB""" + vbCrLf
    mycode = mycode + "End function"scr.AddCode (mycode)
    scr.Eval ("Test()")End Sub这样,在字符串mycode里定义的函数Test()就会被调用了。参考:HOWTO: Use Script Control Modules and Procedures Collections 
    http://support.microsoft.com/default.aspx?scid=KB;EN-US;Q184745
    -  微软全球技术中心 VB技术支持本贴子以“现状”提供且没有任何担保,同时也没有授予任何权利。具体事项可参见使用条款
    (http://support.microsoft.com/directory/worldwide/zh-cn/community/terms_chs.asp)。
    为了为您创建更好的讨论环境,请参加我们的用户满意度调查
    (http://support.microsoft.com/directory/worldwide/zh-cn/community/survey.asp?key=(S,49854782))。