计算器.frm

分科学计算器和简易计算器两种功能

 If Text1.Text = " " Then
  MsgBox ("没有参与运算的数据，请输入要进行运算的数据。")
  Text1.SetFocus
 Else
  num1 = Text1.Text '保存参与运算的第一个数
  Text1.Text = ""  '便于输入参与运算的第二个数
  Text1.SetFocus
  op = Command2(Index).Caption
 End If
If op = "+" Then  '用下面if语句来判断为后面执行那中运算作下标记
 num = 0
 Else
  If op = "-" Then
   num = 1
   Else
   If op = "*" Then
    num = 2
    Else
     If op = "/" Then
      num = 3
     Else
      If op = "\" Then
       num = 5
      Else
       If op = "Mod" Then
        num = 6
       Else
        If op = "&&&" Then
         num = 7
        End If
       End If
      End If
     End If
   End If
  End If
End If
End Sub
Private Sub Command3_Click()
If Text1.Text = " " Then
   MsgBox ("没有参与运算的数据，请输入要进行运算的数据。")
   Text1.SetFocus
Else
  num2 = Text1.Text  '保存参与运算的第二个数
 Select Case num '进行四则运算 加 ，减，乘，除
  Case 0
   Text1.Text = num1 + num2
  Case 1
   Text1.Text = num1 - num2
  Case 2
   Text1.Text = num1 * num2
  Case 3 '除法要判定除数是不是0
   If num2 = 0 Then
    Text1.Text = ""
    MsgBox ("除数不能为0，请核对后从新输入。")
    Text1.SetFocus
   Else
    Text1.Text = num1 / num2
     If (Text1.Text >= 1) Or (Text1.Text <= -1) Then
      Text1.Text = Text1.Text
     Else
      If (Text1.Text < 0) And (Text1.Text > -1) Then
      Text1.Text = "-0" & Abs(Text1.Text) '在计算时如果小于1那小数点前就没0
      Else
       If Text1.Text = 0 Then
        Text1.Text = 0
       Else
         Text1.Text = "0" & Text1.Text
       End If
     End If
    End If
   End If
  Case 4
   Text2.Text = n70 ^ num2
  Case 5  '整除
   If num2 = 0 Then
     Text1.Text = ""
     MsgBox ("除数不能为0，请核对后从新输入。")
     Text1.SetFocus
   Else
     Text2.Text = num1 \ num2
   End If
  Case 6 '求余
   lj = num1 Mod num2
   Text2.Text = lj
  Case 7 '字串连接
   Text2.Text = num1 & num2
 End Select
End If
End Sub
Private Sub Command5_Click()
Text1.SetFocus
Text1.Text = ""  '让文本框得到焦点 并让他为空 从新输入数据
Text2.Text = "" '让其为空 可以进行下次运算  主要是为了好看
Option1(0).Value = False
Option1(1).Value = False
Option1(2).Value = False
Option1(3).Value = False
End Sub

Private Sub Command7_Click(Index As Integer)
 Dim dou As Double
 w = 1 '用于求阶乘 来求和 和置初值
 
If Text1.Text = " " Then
  MsgBox ("没有参与运算的数据，请输入要进行运算的数据。")
  Text1.SetFocus
Else
 x = Text1.Text
 Select Case Index
 Case 0
  n70 = x
  Text1.Text = ""
  Text1.SetFocus
  num = 4
 Case 1
   n71 = x ^ 2
   Text2.Text = n71
 Case 2
   n72 = x ^ 3
   Text2.Text = n72
 Case 3 '求倒数
   If x = 0 Then
    Text1.Text = ""
    MsgBox ("0没有倒数，请核对后从新输入。")
    Text1.SetFocus
   End If
   If x > 0 Then
     dou = 1 / x
     st1 = Left$(dou, 1) '保存首个字符
     If Asc(Left$(dou, 1)) = 46 Then '看首个字符是不是小数点
      Text2.Text = "0" & dou
     Else
      Text2.Text = dou
     End If
   End If
   If x < 0 Then
     dou = 1 / x
     st1 = Left$(dou, 2) '保存前两个字符
     If (Asc(Right$(st1, 1)) = 46) And (Asc(Left$(dou, 1)) <> 0) Then '判断前面加0不
       Text2.Text = "-0" & Abs(dou)
     Else
       Text2.Text = dou
     End If
   End If
   'Text2.Text = dou ’原来想用来测试dou的长度来看小数点前加不加0，没成功
   'st1 = Chr$(dou)
   '  num11 = Len(dou)
   '  Print num11
   '  If num11 < 18 Then
   '   Text2.Text = "0" & Text2.Text
   '  Else
   '   If num11 >= 18 Then
   '    Text2.Text = dou
   '   End If
   ' End If ’这想用比较大小看小数点前加不加0，也没成功
   'If dou < 0 Then '如果用text2.text那么将导致数据类型不匹配
   ' Text2.Text = "-0." & Abs(Text2.Text)
   ' Else
   ' If 0 < dou And dou < 1 Then
   '  Text2.Text = "0" & Text2.Text
   ' End If
   ' End If
  
Case 4 '求阶乘
  If x < 0 Then
    Text1.Text = ""
    MsgBox ("负数没有阶乘,请核对后从新输入。")
    Text1.SetFocus
  Else
   If x = 0 Then
    w = 1
   Else
    If x > 0 Then
     For l = 1 To x Step 1
     w = w * l
     Next l
    End If
   End If
    Text2.Text = w
  End If
 Case 5 '开平方
   If x < 0 Then
     Text1.Text = ""
     Text2.Text = ""
     Text1.SetFocus
     MsgBox ("负数不能开平方,请核对后从新输入。")
   Else
     Text2.Text = Sqr(x)
   End If
Case 6
 Text2.Text = x * (-1)
 End Select
End If
End Sub

Private Sub Command8_Click()
End
End Sub

Private Sub Command9_Click(Index As Integer)
If Text1.Text = " " Then
   MsgBox ("没有参与运算的数据，请输入要进行运算的数据。")
   Text1.SetFocus
Else
 num7 = Val(Text1.Text)
 Select Case Index
  Case 0
   Text2.Text = Int(num7)
  Case 1
   Text2.Text = Fix(num7) '去浮点数的小数
  Case 2
   Text2.Text = CInt(num7) '四舍五入保整
  Case 3 '要判断 因为输出要符合逻辑
   If (Sin(num7)) < 0 Then
    Text2.Text = "-0" & Abs(Sin(num7))
   Else
    Text2.Text = "0" & Sin(num7)
   End If
  Case 4 '要判断 因为输出要符合逻辑
   If Cos(num7) < 0 Then
    Text2.Text = "-0" & Abs(Cos(num7))
   Else
    Text2.Text = "0" & Cos(num7)
   End If
  Case 5
   If (Asc(Right$(Left$(Tan(num7), 2), 1))) = 46 Then
     Text2.Text = "-0" & Abs(Tan(num7))
    Else
     Text2.Text = Tan(num7)
    End If
  Case 6
   Text2.Text = Atn(num7)
  Case 7
   Text2.Text = Sgn(num7) '判断正负 正 反1 负 反-1 0反0
  Case 8
   Text2.Text = Abs(num7) '绝对值
  Case 9
   Text2.Text = Sqr(num7) '开方
  Case 10
   Text2.Text = Exp(num7) '求以e为底的对数
 End Select
End If
End Sub

Private Sub div_Click()
Dim dou2 As Double '用来测试输出，看是否满足精度的要求
n1 = InputBox("请输入被除数")
n2 = InputBox("请在输入除数,除数不能为0。")
Text1.Text = n1 / n2
dou2 = Text1.Text
If (dou2 >= 1) Or (dou2 <= -1) Then
     Text1.Text = Text1.Text
    Else
     If (dou2 < 0) And (dou2 > -1) Then
     Text1.Text = "-0" & Abs(Text1.Text) '在计算时如果小于1那小数点前就没0
     Else
      If Text1.Text = 0 Then
       Text1.Text = 0
      Else
        Text1.Text = "0" & Text1.Text
      End If
     End If
 End If
End Sub

Private Sub imul_Click()
n1 = InputBox("请输入被乘数")
n2 = InputBox("请在输入乘数")
Text1.Text = n1 * n2
End Sub

Private Sub jianyi_Click()
计算器.Height = 5835
计算器.ScaleHeight = 5415
计算器.ScaleWidth = 346.2599
计算器.Top = 105
计算器.Width = 3585 '是简易计算器要的宽度
End Sub
Private Sub kexue_Click()
计算器.Height = 5835
计算器.ScaleHeight = 5415
计算器.ScaleWidth = 706.0105
计算器.Top = 105
计算器.Width = 7185 '科学计算器要的宽度
End Sub

Private Sub Label1_Click()

End Sub

Private Sub nyr_Click()
Dim m9 As String
Text3.ForeColor = &HC0&
Text3.FontSize = 15
m1 = Year(Now)
m2 = Month(Now)
m3 = Day(Now)
m9 = ":"  '输出 年 月 日 时间 用作分隔符
Text3.Text = m1 & m9 & m2 & m9 & m3
End Sub

Private Sub ON_Click()
Text1.SetFocus
Text1.Text = "" '让文本框得到焦点 并让他为空 从新输入数据
Text2.Text = ""
Option1(0).Value = False
Option1(1).Value = False
Option1(2).Value = False
Option1(3).Value = False
End Sub
Private Sub Option1_Click(Index As Integer)
If Text1.Text = " " Then
  MsgBox ("没有参与运算的数据，请输入要进行运算的数据。")
  Text1.SetFocus
 Else
Select Case Index
Case 0
 Text2.Text = num4
Case 1 '转换成八进制
 num4 = num3 \ 8
 num8 = num3 Mod 8
 If num4 = 0 Then
   Text2.Text = "&O" & num8
 Else
  Text2.Text = "&O" & num4 & num8 '当然可以用函数
 End If
Case 2
  Text2.Text = num3
Case 3
 num4 = num3 \ 16
 num8 = num3 Mod 16
  If num8 < 10 Then
    Text2.Text = "&H" & num4 & num8
  Else
   If num8 = 10 Then
    num9 = "A"
   Else
    If num8 = 11 Then
     num9 = "B"
    Else
     If num8 = 12 Then
      num9 = "C"
     Else
      If num8 = 13 Then
       num9 = "D"
      Else
       If num8 = 14 Then
        num9 = "E"
       Else
        If num8 = 15 Then
         num9 = "F"
        End If
       End If
      End If
     End If
    End If
   End If
  Text2.Text = "&H" & num4 & num9 '当然可以用函数
 End If
 If (num4 = 0) And (num8 < 10) Then '输出要符合逻辑前面是0要省去
  Text2.Text = "&H" & num8
 ElseIf (num4 = 0) And (num8 > 9) Then
 Text2.Text = "&H" & num9
 End If
 End Select
End If
End Sub
'Static Sub delayloop(delaytime) '用delayloop来指定延迟时间
'  Const secondsinday = 24& * 60& * 60&
'  loopfinish = Timer + delaytime
'  If loopfinish > secondsinday Then
'   loopfinish = loopfinish - secondsinday '查看所给时间是不是大于一天的时间
'   Do While Timer > loopfinish
'   Loop
'  End If
'  Do While Timer < loopfinish
'  Loop
'End Sub

Private Sub quit_Click()
End
End Sub

Private Sub sub_Click()
n1 = InputBox("请输入被减数数")
n2 = InputBox("请在输入减数数")
Text1.Text = Val(n1) - Val(n2)
End Sub

Private Sub Time1_Click()
Text3.ForeColor = &HC0&
Text3.FontSize = 15
m4 = Hour(Now)
m5 = Minute(Now)
m6 = Second(Now) '时间可以用这个语句 text3.text=time!
m9 = ":"  '输出 年 月 日 时间 用作分隔符
Text3.Text = m4 & m9 & m5 & m9 & m6
End Sub

Private Sub Weekday_Click()
m10 = "今天是星期"
'm1 = Weekday(Now) - 1
Text3.Text = m10 '& m7
End Sub