实用计算器，源码，eval-th专栏

图示:

代码:

Option Compare Database
Option Explicit
Public Wz As Long
Public Zs As Long
Private Sub Ctl0_Click()
ShuRu (0)
End Sub
Private Sub Ctl1_Click()
ShuRu (1)
End Sub
Private Sub Ctl2_Click()
ShuRu (2)
End Sub
Private Sub Ctl3_Click()
ShuRu (3)
End Sub
Private Sub Ctl4_Click()
ShuRu (4)
End Sub
Private Sub Ctl5_Click()
ShuRu (5)
End Sub
Private Sub Ctl6_Click()
ShuRu (6)
End Sub
Private Sub Ctl7_Click()
ShuRu (7)
End Sub
Private Sub Ctl8_Click()
ShuRu (8)
End Sub
Private Sub Ctl9_Click()
ShuRu (9)
End Sub
Private Sub dian_Click()
ShuRu (".")
End Sub
Private Sub 左_Click()
ShuRu ("(")
End Sub
Private Sub 右_Click()
ShuRu (")")
End Sub
Private Sub 计算式_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Call 计算_Click
End If
End Sub
Private Sub 计算式_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Me.计算式.SelStart = Me.计算式.SelLength
End If
Wz = Me.计算式.SelStart
Zs = Me.计算式.SelLength
Me.字数 = Zs & "/" & Wz & "/" & Len(Me.计算式.Text)
End Sub
Private Sub 计算式_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Wz = Me.计算式.SelStart
Zs = Me.计算式.SelLength
Me.字数 = Zs & "/" & Wz & "/" & Len(Me.计算式.Text)
End Sub
Private Sub Tui_Click()
On Error Resume Next
Dim Jss
Me.计算式.SetFocus
Jss = Me.计算式.Text
Me.计算式.SelStart = Wz
If Zs = 0 Then
Me.计算式 = Left(Jss, Wz - 1) & Mid(Jss, Wz + 1)
If Wz > 0 Then
Wz = Wz - 1
End If
Else
Me.计算式 = Left(Jss, Wz) & Mid(Jss, Wz + Zs + 1)
Zs = 0
End If
Me.计算结果 = ""
Me.大写结果 = ""

Me.计算式.SelStart = Wz
Me.字数 = Zs & "/" & Wz & "/" & Len(Me.计算式.Text)
End Sub
Private Sub 计算_Click()
On Error GoTo tc
Me.计算式.SetFocus
If Me.计算式.Text = "" Then Exit Sub
Dim Jsjg As Double
Dim Lsjl As String
Jsjg = Eval(Me.计算式.Text)
Me.计算结果 = Jsjg
If Jsjg < 1000000000000# Then
Me.大写结果 = GetDXJE(Jsjg)
Else
Me.大写结果 = "数字超出范围，无法显示！"
End If
If IsNull(Me.历史记录) or Me.历史记录 = "" Then
Lsjl = Me.计算式.Text & "=" & Jsjg
Else
Lsjl = Me.计算式.Text & "=" & Jsjg & Chr(13) & Chr(10) & Me.历史记录
End If
Me.历史记录 = Lsjl
Wz = Me.计算式.SelLength
Me.计算式.SelStart = Wz
Zs = 0
Me.字数 = Zs & "/" & Wz & "/" & Len(Me.计算式.Text)
Exit Sub
tc:
MsgBox Err.Description, vbInformation, "错误提示"
Resume Next
End Sub
Private Sub ShuRufh(Fu As String)
Dim Jss
Jss = Me.计算式
If IsNull(Jss) or Jss = "" Then
Me.字数 = ""
Exit Sub
End If
Me.计算式.SetFocus
Me.计算式.SelStart = Wz
If Wz = 0 Then Exit Sub
If Zs > 0 Then
Me.计算式 = Left(Jss, Wz) & Fu & Mid(Jss, Wz + Zs + 1)
Zs = 0
Wz = Wz + 1
Else
Dim MoWei As String
MoWei = Right(Left(Jss, Wz), 1)
If MoWei = "+" or MoWei = "-" or MoWei = "*" or MoWei = "/" or MoWei = "." Then
Me.计算式 = Left(Jss, Wz - 1) & Fu & Mid(Jss, Wz + 1)
ElseIf IsNumeric(MoWei) or MoWei = ")" Then
Me.计算式 = Left(Jss, Wz) & Fu & Mid(Jss, Wz + 1)
Wz = Wz + 1
End If
End If
Me.计算式.SelStart = Wz
Zs = 0
Me.字数 = Zs & "/" & Wz & "/" & Len(Me.计算式.Text)
End Sub
Private Sub ShuRu(Fu As String)
Me.计算结果 = ""
Me.大写结果 = ""
Me.计算式.SetFocus
Me.计算式.SelStart = Wz
Dim Jss
Jss = Me.计算式
If Zs > 0 Then
Me.计算式 = Left(Jss, Wz) & Fu & Mid(Jss, Wz + Zs + 1)
Zs = 0
Else
If IsNull(Jss) or Jss = "" Then
Me.计算式 = Fu
Me.字数 = "0/1/1"
Else
Me.计算式 = Left(Jss, Wz) & Fu & Mid(Jss, Wz + 1)
End If
End If
Wz = Wz + 1
Me.计算式.SelStart = Wz
Zs = 0
Me.字数 = Zs & "/" & Wz & "/" & Len(Me.计算式.Text)
End Sub
Private Sub 计算式_Change()
Me.计算结果 = ""
Me.大写结果 = ""
Zs = Me.计算式.SelLength
End Sub
Private Sub 加_Click()
ShuRufh ("+")
End Sub
Private Sub 减_Click()
ShuRufh ("-")
End Sub
Private Sub 乘_Click()
ShuRufh ("*")
End Sub
Private Sub 除_Click()
ShuRufh ("/")
End Sub
Private Sub 清除计算式_Click()
Me.计算式 = ""
Me.计算结果 = ""
Me.大写结果 = ""
Me.计算式.SetFocus
Me.字数 = ""
Wz = 0
End Sub