田草博客

互联网田草博客


网友交流QQ群:11740834 需注明申请加入原因

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件 | ID
-随机-|-分布-
-博客论坛-|-﨣﨤﨧﨨-
-网站导航-|-规范下载-
-BelovedFLash欣赏-

用户登陆
用户:
密码:
 

站点日历
73 2024 - 6 48
      1
2345678
9101112131415
16171819202122
23242526272829
30


站点统计

最新评论



什么是公称直径 空间三点画园
未知 vb 表达试计算   [ 日期:2007-04-06 ]   [ 来自:本站收集整理 ]  HTML
vb 表达试计算



Private   Sub   Command1_Click()   
          Dim   test   As   String   
          test   =   "1.5*(2.5+3.5)-(5.5-1)/3"   
          Set   scr   =   CreateObject("MSScriptControl.ScriptControl")   
          scr.Language   =   "vbscript"   
          MsgBox   test   &   "="   &   scr.Eval(test)   
  End   Sub



另一种方法更简单,用WebBrowser控件   
    
  WebBrowser1.Navigate   "javascript:"   &   "1.5*(2.5+3.5)-(5.5-1)/3"   
    
  msgbox   WebBrowser1.Document.body.innerHTML



Private   Declare   Function   EbExecuteLine   Lib   "vba6.dll"   (ByVal   pStringToExec   As   Long,   ByVal   Unknownn1   As   Long,   ByVal   Unknownn2   As   Long,   ByVal   fCheckOnly   As   Long)   As   Long   '     API   
    
  Private   Function   ExecuteLine(sCode   As   String,   Optional   fCheckOnly   As   Boolean)   As   Boolean   
  ExecuteLine   =   EbExecuteLine(StrPtr(sCode),   0&,   0&,   Abs(fCheckOnly))   =   0   
  End   Function   
  Private   Function   result(ByVal   x   As   String)   As   Single   '计算表达式的结果   
  ExecuteLine   "dim   x   as   single"   
  ExecuteLine   "x=   "   &   x   
  ExecuteLine   "clipboard.settext   x"   '发送到剪切板   
  result   =   Clipboard.GetText   '从剪切板获取   
  Clipboard.Clear   '清空剪切板   
  End   Function   
    
  Private   Sub   Command1_Click()   
          Dim   test   As   String   
          test   =   "1.5*(2.5+3.5)-(5.5-1)/3"   
          MsgBox   test   &   "="   &   result(test)   
  End   Sub



再给你一个已用在商业软件中的代码   
    
  Private   Function   EvaluateExpr(ByVal   expr   As   String)   As   Single   
  '--------------------------------------------------------------------------   
  '功能:   
  '               字符串表达式的计算   
  '参数:   
  '               [expr]...........................字符串表达式   
  '返回值:   
  '               [EvaluateExpr]...................计算后的值   
  '--------------------------------------------------------------------------   
  Const   PREC_NONE   =   11   
  Const   PREC_UNARY   =   10       '   Not   actually   used.   
  Const   PREC_POWER   =   9   
  Const   PREC_TIMES   =   8   
  Const   PREC_DIV   =   7   
  Const   PREC_INT_DIV   =   6   
  Const   PREC_MOD   =   5   
  Const   PREC_PLUS   =   4   
    
  Dim   is_unary   As   Boolean   
  Dim   next_unary   As   Boolean   
  Dim   parens   As   Integer   
  Dim   pos   As   Integer   
  Dim   expr_len   As   Integer   
  Dim   ch   As   String   
  Dim   lexpr   As   String   
  Dim   rexpr   As   String   
  Dim   Value   As   String   
  Dim   status   As   Long   
  Dim   best_pos   As   Integer   
  Dim   best_prec   As   Integer   
    
          '   删除首尾空格及有效性校验   
          expr   =   Trim$(expr)   
          expr_len   =   Len(expr)   
          If   expr_len   =   0   Then   Exit   Function   
            
          '   If   we   find   +   or   -   now,   it   is   a   unary   operator.   
          is_unary   =   True   
            
          '   So   far   we   have   nothing.   
          best_prec   =   PREC_NONE   
            
          '   Find   the   operator   with   the   lowest   precedence.   
          '   Look   for   places   where   there   are   no   open   
          '   parentheses.   
          For   pos   =   1   To   expr_len   
                  '   Examine   the   next   character.(检查下一个字符)   
                  ch   =   Mid$(expr,   pos,   1)   
    
                  '   Assume   we   will   not   find   an   operator.   In   
                  '   that   case   the   next   operator   will   not   
                  '   be   unary.   
                  next_unary   =   False   
                    
                  If   ch   =   "   "   Then   
                          '   Just   skip   spaces.   
                          next_unary   =   is_unary   
                  ElseIf   ch   =   "("   Then   
                          '   Increase   the   open   parentheses   count.   
                          parens   =   parens   +   1   
    
                          '   An   operator   after   "("   is   unary.   
                          next_unary   =   True   
                  ElseIf   ch   =   ")"   Then   
                          '   Decrease   the   open   parentheses   count.   
                          parens   =   parens   -   1   
    
                          '   An   operator   after   ")"   is   not   unary.   
                          next_unary   =   False   
    
                          '   If   parens   <   0,   too   many   ')'s.   
                          If   parens   <   0   Then   
                                  Err.Raise   vbObjectError   +   1001,   _   
                                          "EvaluateExpr",   _   
                                          "Too   many   )s   in   '"   &   _   
                                          expr   &   "'"   
                          End   If   
                  ElseIf   parens   =   0   Then   
                          '   See   if   this   is   an   operator.   
                          If   ch   =   "^"   Or   ch   =   "*"   Or   _   
                                ch   =   "/"   Or   ch   =   "\"   Or   _   
                                ch   =   "%"   Or   ch   =   "+"   Or   _   
                                ch   =   "-"   _   
                          Then   
                                  '   An   operator   after   an   operator   
                                  '   is   unary.   
                                  next_unary   =   True   
                                    
                                  Select   Case   ch   
                                          Case   "^"   
                                                  If   best_prec   >=   PREC_POWER   Then   
                                                          best_prec   =   PREC_POWER   
                                                          best_pos   =   pos   
                                                  End   If   
                                          Case   "*",   "/"   
                                                  If   best_prec   >=   PREC_TIMES   Then   
                                                          best_prec   =   PREC_TIMES   
                                                          best_pos   =   pos   
                                                  End   If   
                                            
                                          Case   "\"   
                                                  If   best_prec   >=   PREC_INT_DIV   Then   
                                                          best_prec   =   PREC_INT_DIV   
                                                          best_pos   =   pos   
                                                  End   If   
                                            
                                          Case   "%"   
                                                  If   best_prec   >=   PREC_MOD   Then   
                                                          best_prec   =   PREC_MOD   
                                                          best_pos   =   pos   
                                                  End   If   
                                            
                                          Case   "+",   "-"   
                                                  '   Ignore   unary   operators   
                                                  '   for   now.   
                                                  If   (Not   is_unary)   And   _   
                                                          best_prec   >=   PREC_PLUS   _   
                                                  Then   
                                                          best_prec   =   PREC_PLUS   
                                                          best_pos   =   pos   
                                                  End   If   
                                  End   Select   
                          End   If   
                  End   If   
                  is_unary   =   next_unary   
          Next   pos   
            
          '   If   the   parentheses   count   is   not   zero,   
          '   there's   a   ')'   missing.   
          If   parens   <>   0   Then   
                  Err.Raise   vbObjectError   +   1002,   _   
                          "EvaluateExpr",   "Missing   )   in   '"   &   _   
                          expr   &   "'"   
          End   If   
            
          '   Hopefully   we   have   the   operator.   
          '   best_prec是最高的运算符   
          Dim   dblTemp1   As   Double,   dblTemp2   As   Double   
          If   best_prec   <   PREC_NONE   Then   
                  lexpr   =   Left$(expr,   best_pos   -   1)   
                  rexpr   =   Right$(expr,   expr_len   -   best_pos)   
                  Select   Case   Mid$(expr,   best_pos,   1)   
                          Case   "^"   
                                  EvaluateExpr   =   EvaluateExpr(lexpr)   ^   EvaluateExpr(rexpr)   
                          Case   "*"   
                                  EvaluateExpr   =   EvaluateExpr(lexpr)   *   EvaluateExpr(rexpr)   
                          Case   "/"   
                                  dblTemp1   =   EvaluateExpr(rexpr)   
                                  dblTemp2   =   EvaluateExpr(lexpr)   
                                  If   dblTemp1   =   0   Then   
                                          EvaluateExpr   =   0   
                                  Else   
                                          EvaluateExpr   =   dblTemp2   /   dblTemp1   
                                  End   If   
                          Case   "\"   
                                  EvaluateExpr   =   EvaluateExpr(lexpr)   \   EvaluateExpr(rexpr)   
                          Case   "%"   
                                  EvaluateExpr   =   EvaluateExpr(lexpr)   Mod   EvaluateExpr(rexpr)   
                          Case   "+"   
                                  EvaluateExpr   =   EvaluateExpr(lexpr)   +   EvaluateExpr(rexpr)   
                          Case   "-"   
                                  EvaluateExpr   =   EvaluateExpr(lexpr)   -   EvaluateExpr(rexpr)   
                  End   Select   
                  Exit   Function   
          End   If   
            
          '   If   we   do   not   yet   have   an   operator,   there   
          '   are   several   possibilities:   
          '   
          '   1.   expr   is   (expr2)   for   some   expr2.   
          '   2.   expr   is   -expr2   or   +expr2   for   some   expr2.   
          '   3.   expr   is   Fun(expr2)   for   a   function   Fun.   
          '   4.   expr   is   a   primitive.   
          '   5.   It's   a   literal   like   "3.14159".   
            
          '   Look   for   (expr2).   
          If   Left$(expr,   1)   =   "("   And   Right$(expr,   1)   =   ")"   Then   
                  '   Remove   the   parentheses.   
                  EvaluateExpr   =   EvaluateExpr(Mid$(expr,   2,   expr_len   -   2))   
                  Exit   Function   
          End   If   
                    
          '   Look   for   -expr2.   
          If   Left$(expr,   1)   =   "-"   Then   
                  EvaluateExpr   =   -EvaluateExpr(   _   
                          Right$(expr,   expr_len   -   1))   
                  Exit   Function   
          End   If   
            
          '   Look   for   +expr2.   
          If   Left$(expr,   1)   =   "+"   Then   
                  EvaluateExpr   =   EvaluateExpr(   _   
                          Right$(expr,   expr_len   -   1))   
                  Exit   Function   
          End   If   
            
          '   Look   for   Fun(expr2).   
          If   expr_len   >   5   And   Right$(expr,   1)   =   ")"   Then   
                  lexpr   =   LCase$(Left$(expr,   4))   
                  rexpr   =   Mid$(expr,   5,   expr_len   -   5)   
                  Select   Case   lexpr   
                          Case   "sin("   
                                  EvaluateExpr   =   Sin(EvaluateExpr(rexpr))   
                                  Exit   Function   
                          Case   "cos("   
                                  EvaluateExpr   =   Cos(EvaluateExpr(rexpr))   
                                  Exit   Function   
                          Case   "tan("   
                                  EvaluateExpr   =   Tan(EvaluateExpr(rexpr))   
                                  Exit   Function   
                          Case   "sqr("   
                                  EvaluateExpr   =   Sqr(EvaluateExpr(rexpr))   
                                  Exit   Function   
                  End   Select   
          End   If   
            
          '   See   if   it's   a   primitive.   
          On   Error   Resume   Next   
          Value   =   Primitives.Item(expr)   
          status   =   Err.Number   
          On   Error   GoTo   0   
          If   status   =   0   Then   
                  EvaluateExpr   =   CSng(Value)   
                  Exit   Function   
          End   If   
            
          '   It   must   be   a   literal   like   "2.71828".   
          On   Error   Resume   Next   
          EvaluateExpr   =   CSng(expr)   
          status   =   Err.Number   
          On   Error   GoTo   0   
          If   status   <>   0   Then   
                  Err.Raise   status,   _   
                          "EvaluateExpr",   _   
                          "Error   evaluating   '"   &   expr   &   _   
                          "'   as   a   constant."   
          End   If   
  End   Function   



'在工程中添加“Microsoft   Script   Control1.0”控件,然后试试下面的代码   
    
  Private   Sub   Command1_Click()   
          MsgBox   Me.ScriptControl1.Eval("1.5*(2.5+3.5)-(5.5-1)/3")   
  End   Sub  


在工程中添加“Microsoft   Script   Control1.0”控件,然后试试下面的代码   
    
  Private   Sub   Command1_Click()   
          With   Me.ScriptControl1   
                  .AddCode   "dim   a,b"   
                  .AddCode   "b=1"   
                  .AddCode   "a=b+10"   
                  .AddCode   "Msgbox   a"   
          End   With   
  End   Sub   



Option   Explicit   
  Private   Declare   Function   EbExecuteLine   Lib   "vba6.dll"   (ByVal   pStringToExec   As   Long,   ByVal   Unknownn1   As   Long,   ByVal   Unknownn2   As   Long,   ByVal   fCheckOnly   As   Long)   As   Long   
    
  Public   Function   ExecuteLine(sCode   As   String,   Optional   fCheckOnly   As   Boolean)   As   Boolean   
          ExecuteLine   =   EbExecuteLine(StrPtr(sCode),   0&,   0&,   Abs(fCheckOnly))   =   0   
  End   Function   
    
  Private   Sub   Command1_Click()   
          ExecuteLine   "Dim   X   As   Long,   Y   As   Long"   
          ExecuteLine   "x   =   2"   
          ExecuteLine   "y   =   3"   
          ExecuteLine   "msgbox   "   &   Text1.Text   
  End   Sub   
    
  Private   Sub   Form_Load()   
          Text1.Text   =   "x+y"   
  End   Sub


实例:(转自雪源在线 www.play78.com).

点击下载此文件

[本日志由 田草 于 2007-04-17 09:14 PM 编辑]


暂时没有评论
发表评论 - 不要忘了输入验证码哦!
作者: 用户:  密码:   注册? 验证:  防止恶意留言请输入问题答案:1*2=?  
评论:

禁止表情
禁止UBB
禁止图片
识别链接
识别关键字

字体样式 文字大小 文字颜色
插入粗体文本 插入斜体文本 插入下划线
左对齐 居中对齐 右对齐
插入超级链接 插入邮件地址 插入图像
插入 Flash 插入代码 插入引用
插入列表 插入音频文件 插入视频文件
插入缩进符合
点击下载按钮 下标 上标
水平线 简介分割标记
表  情
 
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©