计算器2.rar (3.84 KB)

程序代码：

Option Explicit
Const 精度 = 15

Dim 清显示 As Boolean
Dim 第1数 As Double         '第一个数
Dim 运算符 As Long            '运算符，0,未 1+,2-,3*,4/,99,计算了,未使用


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Call NUMC_KeyDown(19, KeyCode, Shift)
    '如果按钮失去焦点,就一般是窗体的焦点,如果在窗体上按下钮,就当作在等于上面按下键
End Sub

Private Sub Form_Load()
Label1.Caption = "0"                '直接显示一个零

End Sub

Private Sub NUMC_Click(Index As Integer)

If NUMC(Index).Value = 1 Then       '只有是按下按钮时，才起当作输入了数字
    Timer1.Enabled = True       '激活定时器，100毫秒后弹起按钮
   
    Select Case Index
    Case 0 To 9         '数字
        Call 添加数字(Index)
    Case 10             '小数点
        Call 小数点
    Case 11             '正负
        Call 正负
    Case 12 To 15       '符号
        Call 符号(Index - 11)       '参数为index-11
    Case 16             '退格
        Call 退格
    Case 17             '清除
        Call 清除
    Case 18             'C
        Call 修正
    Case 19             '等号
        Call 等号
       
    End Select
        'NUMC(19).SetFocus
End If
End Sub

Private Sub NUMC_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case 48 To 55, 57           '大键盘区的数字,0-7,9
        NUMC(KeyCode - 48).Value = 1
    Case 56                  '大键盘区数字8
        If Shift = 1 Then
            NUMC(14).Value = 1  '乘 Shift+8,输入星号
        Else
            NUMC(8).Value = 1   '8
        End If
    Case 96 To 105           '小键盘区的数字
        NUMC(KeyCode - 96).Value = 1
    Case 13                 '回车
        NUMC(19).Value = 1
    Case 110, 190           '小键盘区小数点,大键盘区小数点
        NUMC(10).Value = 1
    Case 8                  '退格
        NUMC(16).Value = 1
    Case 107, 187           '加,大键盘区+
        NUMC(12).Value = 1
    Case 109, 189           '减,大键盘区-
        NUMC(13).Value = 1
    Case 106                '乘
        NUMC(14).Value = 1
    Case 111, 191           '除,大键盘区/
        NUMC(15).Value = 1
    Case 27                 '清除,ESC
        NUMC(17).Value = 1

    'Case Else
    '    MsgBox KeyCode
    End Select
End Sub


Private Sub 等号()
If IsNumeric(Label1.Caption) Then
    Select Case 运算符
    Case 1 To 4         '有效符号
        Label1.Caption = 计算(第1数, Label1.Caption, 运算符)
    Case 0              '未输入运算符
        Label1.Caption = 第1数
    Case 99             '运算过了，取消
   
    End Select
Else
        Label1.Caption = "请输入数字"       '提示

End If
    清显示 = True
    运算符 = 0

End Sub

Private Sub 符号(cs As Integer)
If IsNumeric(Label1.Caption) Then
   
   
    If 运算符 > 0 And 运算符 < 99 Then          '如果前面有符号，则进行计算

       Label1.Caption = 计算(第1数, Label1.Caption, 运算符)

    End If
    If IsNumeric(Label1.Caption) Then
        第1数 = CDbl(Label1.Caption)        '保存第1数
        运算符 = cs
        清显示 = True
    Else
        'Label1.Caption = "请输入数字"       '提示
        清显示 = True
        运算符 = 0

    End If
    'Label1.Caption = 0
End If

End Sub

Private Function 计算(cs1 As Double, cs2 As Double, cs3 As Long) As String
Dim j As Double
Select Case cs3
    Case 1      '加
        j = cs1 + cs2
    Case 2      '减
        j = cs1 - cs2
    Case 3      '乘
        j = cs1 * cs2
    Case 4      '除
        If cs2 = 0 Then
            计算 = "除数为零"
            Exit Function
        Else
            j = cs1 / cs2
        End If
End Select

    If j < 0.0000000000001 Then
        计算 = "数值太小"
    End If
       
    If j < 1 Then
        If j = 0 Then
            计算 = CStr(j)
        Else
            计算 = "0" & j
        End If
    Else
        计算 = CStr(j)
    End If
    运算符 = 99
    If IsNumeric(计算) Then
        第1数 = CDbl(计算)
    End If
End Function

Private Sub 清除()
    第1数 = 0
    运算符 = 0
    Label1.Caption = 0
End Sub

Private Sub 修正()
    Label1.Caption = 0
End Sub

Private Sub 正负()
    Dim j As Double
    If IsNumeric(Label1.Caption) Then       '如果为数字，则加正负号
        j = CDbl(Label1.Caption)
        j = -j
        Label1.Caption = j
    Else
        Label1.Caption = "请输入数字"       '提示
        清显示 = True
        运算符 = 0
    End If
End Sub


Private Sub 退格()
Dim j As String
If IsNumeric(Label1.Caption) Then          '是否为数字
    j = Label1.Caption
    If Len(j) > 1 Then
        If Right(j, 1) = "." Then          '最后为小数点
            j = Left(j, Len(j) - 1)         '先减掉小数点
            Label1.Caption = j
            Call 退格                       '再退一次
        Else
            j = Left(j, Len(j) - 1)         '直接减掉最右边的数字
            Label1.Caption = j
        End If
    Else
        Label1.Caption = "0"                '直接为零
    End If
Else
    Label1.Caption = "0"                    '直接为零
End If
End Sub

Private Sub 小数点()
If 清显示 Then              '清显示时，输入小数点为 0.
    Label1.Caption = "0."
Else
    If InStr(1, Label1.Caption, ".") = 0 Then       '不存在小数点时，则添加
        Label1.Caption = Label1.Caption & "."
    End If
End If
End Sub


Private Sub 添加数字(cs As Integer)
Dim j As String, i As Long

If 清显示 Then                  '按下符号，或者计算后，置清显示为真
    j = 0
    Label1.Caption = 0          '先置显示为零，再判断
    清显示 = False
Else
    j = Label1.Caption
End If

If j = "0" Then                 '显示零时，需要处理
    If cs = 0 Then              '原零，再输入零，就丢弃
        Exit Sub
    Else
        Label1.Caption = cs         '去掉零，直接等于该值
    End If
Else
    If 数字长度(Label1.Caption) < 精度 Then            '控制数字精度
        Label1.Caption = Label1.Caption & cs
    End If
End If

End Sub


Public Function 数字长度(cs As String) As Long
Dim i As Long
Dim j As Long
For i = 1 To Len(cs)
    If IsNumeric(Mid(cs, i, i)) Then    '取一位，如果是数字则计数
        j = j + 1
    End If
Next i
数字长度 = j
End Function



Private Sub Timer1_Timer()
Dim i As Long
    For i = 0 To NUMC.Count - 1
        NUMC(i).Value = 0           '弹起来
    Next i
    Timer1.Enabled = False
End Sub