| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 6096 人关注过本帖, 1 人收藏
标题:急求VB编的计算器代码(只要加减乘除)
只看楼主 加入收藏
Oppenheimer
Rank: 1
等 级:新手上路
帖 子:52
专家分:0
注 册:2005-7-7
收藏
得分:0 

我做了一个双行显示的计算器,支持+、—、*、/、^和括号。 你就是直接打"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

--------------------------------------- 整个算式输入,敲回车,就完毕了。

vYQlzQms.rar (8.77 KB)

[此贴子已经被作者于2005-8-5 17:25:33编辑过]


爱编程,也爱吃红萝卜.
2005-08-05 14:43
slore
Rank: 5Rank: 5
等 级:贵宾
威 望:16
帖 子:1108
专家分:0
注 册:2005-7-1
收藏
得分:0 
楼上的不错.

要改进的地方.....-1/2=?

1/2=?

我敲ENTER没用....BEEP

快上课了……
2005-08-05 16:07
Oppenheimer
Rank: 1
等 级:新手上路
帖 子:52
专家分:0
注 册:2005-7-7
收藏
得分:0 
    冤枉啊,冤枉啊大人!
怎么可能会发出BEEP----BEEP声呢?
    看了这么久辛苦您了!多谢支持!
cmdOK.Default = True

[此贴子已经被作者于2005-8-11 15:21:58编辑过]



爱编程,也爱吃红萝卜.
2005-08-05 16:45
Oppenheimer
Rank: 1
等 级:新手上路
帖 子:52
专家分:0
注 册:2005-7-7
收藏
得分:0 
    我准备编一个能自动解方程的程序,.

爱编程,也爱吃红萝卜.
2005-08-05 21:11
zsm30845
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2005-12-28
收藏
得分:0 
2005-12-28 10:58
moonyyo
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2005-10-28
收藏
得分:0 

我做了一个,有点小问题,你们可以看一下。

Option Explicit
Private x As Double, y As Double, o As Double '第一,第二个数和总合
Private q As Boolean '是否有小数点
Private w As Boolean, r As Boolean '定初值和第二个数出来时隐藏第一个数
Private e As String '定cmd1(index).caption 的值
Private n As Boolean, m As Boolean '定是否有运算符和等于号
Private c As Boolean '上次运算的结果加载到第一个数

'注释:
'1.代码风格不好,一定要让别人容易读你的代码。要适当的空行和空格。注释是非常必要的,你没有注释,
' 跟我刚开始写程序时一样,注释是用来说明这段代码来实现什么功能的,以及对接口的具体描述,我改了一下。你看看.
'2.变量命名一定要尽量取见名知意的名称,如 int_result,尽量不要用一个字母来做变量名.

Private Sub cmd_Click(Index As Integer)
'If q = True And Index = 10 Then Exit Sub '这是你的
If q And Index = 10 Then Exit Sub '已经更改过的,如果Q boolean 类型,请直接用 if Q then or if not Q then

If Index = 10 Then q = True '这一句的判断多余,如果程序能够执行到这里,肯定index=10,因为前面一句已经判断了。

If r = True Then '这里r 是boolean型,照上面的修改
txt.Text = cmd(Index).Caption
r = False
Else
txt.Text = txt.Text & cmd(Index).Caption
End If

n = False
m = False
End Sub

Private Sub cmd1_Click(Index As Integer)
If n = False Then
'If c = False Then x = Val(txt.Text) '这是你的
'If w = True Then Call cmd2_Click '这是你的
If Not c Then x = Val(txt.Text) '已经改过的。
If w Then Call cmd2_Click '已经改过的。

r = True
c = True
e = cmd1(Index).Caption
w = True
End If

n = True
m = True
End Sub

Private Sub cmd2_Click()
If m = False Then
y = Val(txt.Text)

Select Case e
Case "-"
o = x - y
Case "+"
o = x + y
Case "*"
o = x * y
Case "/"
If y <> 0 Then o = x / y
End Select

txt.Text = o
End If

n = True
m = True
x = Val(txt.Text)
End Sub


Private Sub Command1_Click()
txt.Text = 0 - Val(txt.Text)
End Sub

Private Sub Command2_Click()
txt.Text = ""
Exit Sub
End Sub

Private Sub Command3_Click()
txt.SelStart = 0
txt.SelLength = Len(txt.Text) - 1
txt.Text = txt.SelText
End Sub

2005-12-30 00:41
mjf007
Rank: 1
等 级:新手上路
帖 子:43
专家分:0
注 册:2005-12-2
收藏
得分:0 
大家努力呀
2005-12-30 10:30
Goodness
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2006-8-1
收藏
得分:0 
都是高手啊,呵呵~~~

2006-10-17 11:07
waaa123
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2006-10-17
收藏
得分:0 

自己太菜了,竟然看不懂。

2006-10-17 13:34
hope
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2006-10-24
收藏
得分:0 

大哥大姐们,我急需做一个系统自带的计算器,加减乘除还好写,可百分比,倒数,平方跟就觉得不对头了,,
帮忙帮忙啊!!!


纯真守夜人....
2006-10-24 13:14
快速回复:急求VB编的计算器代码(只要加减乘除)
数据加载中...
 
   



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

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