| 网站首页 | 业界新闻 | 群组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 编程论坛
共有 1263 人关注过本帖
标题:无括号的四则混合运算
只看楼主 加入收藏
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:735
专家分:3478
注 册:2013-1-26
结帖率:100%
  问题点数:0  回复次数:3   
无括号的四则混合运算
因为前段时间有一个在文本框输入公式,自动计算结果的问题。
https://bbs.bccn.net/viewthread.php?tid=444134&page=1#pid2483797
写了一段代码来进行无括号的“+-*/”运算。想到哪儿写哪儿,实现功能,没有容错。
四个文本框,一个按钮。文本框1输入公式,文本框4输出结果,文本框2、3需要设置为多行及纵向滑标来显示中间过程。
程序代码:
Option Explicit
Dim DatumStr() As String   'Array of datum in string style,use for splitting
Dim Datum() As Single   'Array of Datum in single style
Dim Operator() As String   'Array of operators


Private Sub Command1_Click()
  Text2.Text = ""
  Text3.Text = ""
  Cal (Text1.Text)
End Sub

Private Sub Form_Load()
  Text1.Text = "32+81*9/55-60*3"
End Sub

Sub Cal(Formula As String)
  Dim temp As String
  Dim i As Integer, S As Integer, j As Integer 'i,j for temprary using,S for the operator with the high priority
  Dim M As Single 'For the operation's outcome of two data
  Dim DTemp() As Single 'Array for after delete used data
  Dim OTemp() As String 'Array for after delete used operator
  Dim SetOK As Boolean 'Sign for assigning M to Dtemp()
  Dim OutTemp As String 'String for temporary formula
  Dim FirstNegative As Boolean 'Sign for the first data is negative

  FirstNegative = False
  temp = Formula
  If Mid(Formula, 1, 1) = "-" Then
    FirstNegative = True
    Formula = Replace(Formula, "-", "", 1, 1)
    temp = Formula
  End If
  temp = Replace(temp, "+", " ") 'Get formula's datum and operators
  temp = Replace(temp, "-", " ")
  temp = Replace(temp, "*", " ")
  temp = Replace(temp, "/", " ")
  DatumStr = Split(temp, " ")
  ReDim Datum(UBound(DatumStr))
  For i = 0 To UBound(DatumStr)
    If FirstNegative = True And i = 0 Then
      Datum(i) = Val("-" & DatumStr(i))
    Else
      Datum(i) = Val(DatumStr(i))
    End If
  Next
  temp = ""
  For i = 1 To Len(Formula)
    If Mid(Formula, i, 1) = "+" Or Mid(Formula, i, 1) = "-" Or Mid(Formula, i, 1) = "*" Or Mid(Formula, i, 1) = "/" Then temp = temp & Mid(Formula, i, 1)
  Next
  ReDim Operator(Len(temp) - 1)
  For i = 0 To UBound(Operator)
    Operator(i) = Mid(temp, i + 1, 1)
    Text2.Text = Text2.Text & Operator(i) & " "
  Next
  Text2.Text = Text2.Text & vbCrLf
 
  S = 0 'Get the operator with the high priority
  For i = 0 To UBound(Operator)
    If Operator(i) = "*" Or Operator(i) = "/" Then
      S = i
      Exit For
    End If
  Next

  Select Case Operator(S) 'calculate
    Case Is = "+"
      M = Datum(S) + Datum(S + 1)
    Case Is = "-"
      M = Datum(S) - Datum(S + 1)
    Case Is = "*"
      M = Datum(S) * Datum(S + 1)
    Case Is = "/"
      M = Datum(S) / Datum(S + 1)
  End Select
 
  If UBound(Datum) = 1 Then 'judge if exit cal function.Datum() only has two datum.
    Text4.Text = M
    Exit Sub
  End If
 
  ReDim DTemp(UBound(Datum) - 1) 'Recompose the rest datum and operators ,get a new formula and call cal function once more.
  ReDim OTemp(UBound(Operator) - 1)
  For i = 0 To UBound(Datum)
    If i = S Or i = S + 1 Then
      If SetOK = False Then DTemp(j) = M: SetOK = True: j = j + 1
    Else
      DTemp(j) = Datum(i)
      j = j + 1
    End If
  Next
  j = 0
  For i = 0 To UBound(Operator)
    If i <> S Then
      OTemp(j) = Operator(i)
      j = j + 1
    End If
  Next
  For i = 0 To UBound(OTemp)
    OutTemp = OutTemp & DTemp(i) & OTemp(i)
  Next
  OutTemp = OutTemp & DTemp(i)
  Text3.Text = Text3.Text & OutTemp & vbCrLf
  Cal (OutTemp)
   
End Sub

搜索更多相关主题的帖子: 文本框  color  
2015-05-22 11:50
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:230
帖 子:4333
专家分:26449
注 册:2008-10-15
  得分:0 
我以前也写过,写的有BUG,后来就没去动了。
以后发贴,最少给1分,才不会影响结贴率,我到最近才知道。
1分,系统不会小气,会还给你的。

授人于鱼,不如授人于渔
早已停用QQ了
2015-05-22 16:58
wmf2014
Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18
等 级:贵宾
威 望:156
帖 子:1717
专家分:9556
注 册:2014-12-6
  得分:0 
多用递归写。

能编个毛线衣吗?
2015-05-22 17:03
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:735
专家分:3478
注 册:2013-1-26
  得分:0 
回复 2楼 风吹过b
要是至少能区分问答贴和交流贴就不会有结贴的麻烦了

大开眼界
2015-05-25 09:24







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.040671 second(s), 8 queries.
Copyright©2004-2018, BCCN.NET, All Rights Reserved