我做了一个双行显示的计算器,支持+、—、*、/、^和括号。 你就是直接打"3^(45/(3+6))都可以!!! txt、txtResult是textbox cmdOK是commandbutton ------------------------------------ Private Function KEMP(lki) On Error GoTo Errorhandle Dim Lengh As Integer, Total As Integer Dim Point As Integer Dim Value() As Double Dim Aura() As String Dim Start As Integer, Tail As Integer ReDim Value(0 To 0) ReDim Aura(0 To 0) Lengh = Len(lki) Start = 1 For i = 1 To Lengh kq = Mid(lki, i, 1) Select Case kq Case "+" Tail = i - 1 ReDim Preserve Value(UBound(Value) + 1) ReDim Preserve Aura(UBound(Value) + 1) Point = Point + 1 Aura(Point) = "+" Value(Point - 1) = Val(Mid(lki, Start, Tail - Start + 1)) Start = i + 1 Case "-" Tail = i - 1 ReDim Preserve Value(UBound(Value) + 1) ReDim Preserve Aura(UBound(Value) + 1) Point = Point + 1 Aura(Point) = "-" Value(Point - 1) = Val(Mid(lki, Start, Tail - Start + 1)) Start = i + 1 Case "*" Tail = i - 1 ReDim Preserve Value(UBound(Value) + 1) ReDim Preserve Aura(UBound(Value) + 1) Point = Point + 1 Aura(Point) = "*" Value(Point - 1) = Val(Mid(lki, Start, Tail - Start + 1)) Start = i + 1 Case "/" Tail = i - 1 ReDim Preserve Value(UBound(Value) + 1) ReDim Preserve Aura(UBound(Value) + 1) Point = Point + 1 Aura(Point) = "/" Value(Point - 1) = Val(Mid(lki, Start, Tail - Start + 1)) Start = i + 1 Case "^" Tail = i - 1 ReDim Preserve Value(UBound(Value) + 1) ReDim Preserve Aura(UBound(Value) + 1) Point = Point + 1 Aura(Point) = "^" Value(Point - 1) = Val(Mid(lki, Start, Tail - Start + 1)) Start = i + 1 End Select Next i Total = Point Value(Point) = Val(Mid(lki, Start, Lengh - Start + 1)) For t = 1 To Total If Aura(t) = "^" Then Aura(t) = "*" Value(t) = Value(t - 1) ^ Value(t) Value(t - 1) = 1 End If Next t For v = 1 To Total Select Case Aura(v) Case "+" Case "-" Value(v) = Value(v) * -1 Case "*" Value(v) = Value(v) * Value(v - 1) Value(v - 1) = 0 Case "/" Value(v) = Value(v - 1) / Value(v) Value(v - 1) = 0 End Select Next v For r = 0 To Total KEMP = KEMP + Value(r) Next r Errorhandle: End Function ------------------------------------ Function slot(UTS) On Error GoTo Errorhandle Dim t As Integer Dim q As Integer, a As Integer slot = UTS t = 0 Lengh = Len(UTS) For i = 1 To Lengh If Mid(UTS, i, 1) = "(" And t = 0 Then a = i + 1 For o = a To Lengh If Mid(UTS, o, 1) = ")" And t = 0 Then q = o Exit For ElseIf Mid(UTS, o, 1) = ")" And t > 0 Then t = t - 1 ElseIf Mid(UTS, o, 1) = "(" Then t = t + 1 End If Next o Exit For End If Next i If q <> 0 And a <> 0 Then slot = Mid(UTS, a, q - a) Errorhandle: End Function ------------------------------------ Private Sub cmdOk_Click() On Error GoTo Errorhandle Dim UjTa As String Dim naRar As String, kaSar As String UjTa = txt.Text a2: naRar = txt.Text a1: kaSar = slot(naRar) If kaSar = naRar Then kr = KEMP(kaSar) txt.Text = Replace(txt.Text, "(" & kaSar & ")", Str(kr)) Else naRar = kaSar GoTo a1 End If If slot(txt.Text) <> txt.Text Then GoTo a2 kr = KEMP(txt.Text) txt.Text = UjTa txtResult.Text = "=" & kr Errorhandle: End Sub
--------------------------------------- 整个算式输入,敲回车,就完毕了。
[此贴子已经被作者于2005-8-5 17:25:33编辑过]
爱编程,也爱吃红萝卜.