calculator.frm

非常好用的计算器

Private Sub Command4_Click()
 If Flag1 = 0 And Flag2 = 0 And Flag3 = 0 And Flag4 = 0 And Flag5 = 0 And Flag6 = 0 Then
    Firstnum = Firstnum & "4"
  Text1.Text = Trim(Firstnum)
 Else
  If Flag5 = 1 Or Flag6 = 1 Then
  Text1.Text = ""
  Secondnum = Secondnum & "4"
  Text1.Text = Trim(Flags & Secondnum)
  Else
  Secondnum = Secondnum & "4"
  Text1.Text = Trim(Flags & Secondnum)
  End If
 End If
 Text1.SetFocus
End Sub

Private Sub Command40_Click(Index As Integer)
Dim Dlpara As Double, strTemp As String
If Text1.Text = "" Then
  Nn = MsgBox("没有自变量！", vbOKOnly + vbExclamation, "操作错误警告！")
  Exit Sub
 Else
     If Flag1 = 1 Or Flag2 = 1 Or Flag3 = 1 Or Flag4 = 1 Then
    Dlpara = Val(Fruit(Firstnum, Secondnum))
   Else
    Dlpara = Val(Firstnum)
     End If
  End If
  Select Case Index
  Case 0
  strTemp = Str(ArcSin(Dlpara))
Case 1
  strTemp = Str(ArcCos(Dlpara))
  Case 2
   strTemp = Str(Cot(Dlpara))
  Case 3
  strTemp = Str(ArcCot(Dlpara))
  Case 4
  strTemp = Str(Sh(Dlpara))
  Case 5
  strTemp = Str(ArcSh(Dlpara))
  Case 6
  strTemp = Str(Ch(Dlpara))
  Case 7
  strTemp = Str(ArcCh(Dlpara))
  Case 8
    If Flag1 = 1 Or Flag2 = 1 Or Flag3 = 1 Or Flag4 = 1 Then
   strTemp = Trim(Dlpara ^ (1 / 3))
  Else
   strTemp = Trim(Dlpara ^ (1 / 3))
  End If
  Firstnum = Text1.Text
 Secondnum = ""
 Flag1 = 0
 Flag2 = 0
 Flag3 = 0
 Flag4 = 0
 Text1.SetFocus
  Case 9
  Flag6 = 1
  Exit Sub
  Case 11
  Flag5 = 1
  Exit Sub
  Case 12
  strTemp = Str(Th(Dlpara))
  Case 13
  strTemp = Str(ArcTh(Dlpara))
  Case 14
  strTemp = Str(Cth(Dlpara))
  Case 15
  strTemp = Str(ArcCth(Dlpara))
End Select
Text1.Text = strTemp
 Firstnum = Text1.Text
 Secondnum = ""
 Flag1 = 0
 Flag2 = 0
 Flag3 = 0
 Flag4 = 0
 Flag5 = 0
 Flag6 = 0
 Text1.SetFocus
End Sub

Private Sub Command41_Click()
Dim len0, len1, len2, len3, len4 As Integer
len0 = Len(Text1.Text)
len1 = InStr(Text1.Text, "+")
len2 = InStr(Text1.Text, "-")
len3 = InStr(Text1.Text, "*")
len4 = InStr(Text1.Text, "/")
If len0 = 0 Then
Firstnum = Str(PI)
Text1.Text = Firstnum
ElseIf len0 = len1 Or len0 = len1 Or len0 = len2 Or len0 = len3 Or len0 = len4 Then
Secondnum = Str(PI)
Text1.Text = Text1.Text & Secondnum
Else
Exit Sub
End If
End Sub

Private Sub Command5_Click()
 If Flag1 = 0 And Flag2 = 0 And Flag3 = 0 And Flag4 = 0 And Flag5 = 0 And Flag6 = 0 Then
    Firstnum = Firstnum & "5"
  Text1.Text = Trim(Firstnum)
 Else
  If Flag5 = 1 Or Flag6 = 1 Then
  Text1.Text = ""
  Secondnum = Secondnum & "5"
  Text1.Text = Trim(Flags & Secondnum)
  Else
  Secondnum = Secondnum & "5"
  Text1.Text = Trim(Flags & Secondnum)
  End If
 End If
 Text1.SetFocus
End Sub

Private Sub Command6_Click()
 If Flag1 = 0 And Flag2 = 0 And Flag3 = 0 And Flag4 = 0 And Flag5 = 0 And Flag6 = 0 Then
    Firstnum = Firstnum & "6"
  Text1.Text = Trim(Firstnum)
 Else
  If Flag5 = 1 Or Flag6 = 1 Then
  Text1.Text = ""
  Secondnum = Secondnum & "6"
  Text1.Text = Trim(Flags & Secondnum)
  Else
  Secondnum = Secondnum & "6"
  Text1.Text = Trim(Flags & Secondnum)
  End If
 End If
 Text1.SetFocus
End Sub

Private Sub Command7_Click()
 If Flag1 = 0 And Flag2 = 0 And Flag3 = 0 And Flag4 = 0 And Flag5 = 0 And Flag6 = 0 Then
    Firstnum = Firstnum & "7"
  Text1.Text = Trim(Firstnum)
 Else
  If Flag5 = 1 Or Flag6 = 1 Then
  Text1.Text = ""
  Secondnum = Secondnum & "7"
  Text1.Text = Trim(Flags & Secondnum)
  Else
  Secondnum = Secondnum & "7"
  Text1.Text = Trim(Flags & Secondnum)
  End If
 End If
 Text1.SetFocus
End Sub

Private Sub Command8_Click()
 If Flag1 = 0 And Flag2 = 0 And Flag3 = 0 And Flag4 = 0 And Flag5 = 0 And Flag6 = 0 Then
    Firstnum = Firstnum & "8"
  Text1.Text = Trim(Firstnum)
 Else
 If Flag5 = 1 Or Flag6 = 1 Then
  Text1.Text = ""
  Secondnum = Secondnum & "8"
  Text1.Text = Trim(Flags & Secondnum)
  Else
  Secondnum = Secondnum & "8"
  Text1.Text = Trim(Flags & Secondnum)
  End If
 End If
 Text1.SetFocus
End Sub

Private Sub Command9_Click()
 If Flag1 = 0 And Flag2 = 0 And Flag3 = 0 And Flag4 = 0 And Flag5 = 0 And Flag6 = 0 Then
    Firstnum = Firstnum & "9"
  Text1.Text = Trim(Firstnum)
 Else
  If Flag5 = 1 Or Flag6 = 1 Then
  Text1.Text = ""
  Secondnum = Secondnum & "9"
  Text1.Text = Trim(Flags & Secondnum)
  Else
  Secondnum = Secondnum & "9"
  Text1.Text = Trim(Flags & Secondnum)
  End If
 End If
 Text1.SetFocus
End Sub

Private Sub Form_Activate()
Text1.SetFocus
End Sub

Private Sub Form_Load()
Call Move((Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2)
Calculator.Caption = "标准型计算器"
 Me.Height = 4100
 Frame4.Visible = False
 Frame5.Visible = False
 Option1.Visible = False
 Option2.Visible = False
 Frame1.Top = 550
 Frame2.Top = 550
 Frame3.Top = 550
 Text1.Text = ""
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
PopupMenu mnuedit
If Text1.SelLength = 0 Then
mnueditcopy.Enabled = False
ElseIf Text1.SelLength <> 0 Then
mnueditcopy.Enabled = True
End If
End If
End Sub

Private Sub menu1_1_Click()
 Me.Height = 4100
 Frame4.Visible = False
 Frame5.Visible = False
 Option2.Visible = False
 Option1.Visible = False
 Frame1.Top = 550
 Frame2.Top = 550
 Frame3.Top = 550
 Calculator.Caption = "标准型计算器"
 Text1.SetFocus
 Call Move((Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2)
End Sub

Private Sub menu1_2_Click()
 Me.Height = 6650
 Frame1.Top = 3120
 Frame2.Top = 3120
 Frame3.Top = 3120
 Frame4.Visible = True
 Frame5.Visible = True
 Option2.Visible = True
 Option1.Visible = True
Calculator.Caption = "科学型计算器"
Call Move((Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2)
 Text1.SetFocus
End Sub

Private Sub menu2_1_Click()
About.Show
End Sub

Private Sub menu2_2_Click()
Help.Show
End Sub

Private Sub menu2_3_Click()
End
End Sub

Private Sub mnuedit_Click()
If Text1.SelLength = 0 Then
mnueditcopy.Enabled = False
ElseIf Text1.SelLength <> 0 Then
mnueditcopy.Enabled = True
End If
End Sub

Private Sub mnuEditCopy_Click()
Clipboard.Clear
    Clipboard.SetText Text1.SelText
End Sub

Private Sub mnueditselall_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_Change()
Text1.SelStart = Len(Text1.Text)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim Keynum As Integer
Keynum = KeyAscii
Select Case Keynum
Case 49
Command1.Value = True
Case 50
Command2.Value = True
Case 51
Command3.Value = True
Case 52
Command4.Value = True
Case 53
Command5.Value = True
Case 54
Command6.Value = True
Case 55
Command7.Value = True
Case 56
Command8.Value = True
Case 57
Command9.Value = True
Case 48
Command10.Value = True
Case 46
Command11.Value = True
Case 43
Command13.Value = True
Case 45
Command14.Value = True
Case 42
Command15.Value = True
Case 47
Command16.Value = True
Case 61
Command17.Value = True
Case 13
Command17.Value = True
Case vbKeyBack
Command39.Value = True
Case Else
Exit Sub
End Select
End Sub
Private Function ArcSin(x As Double) As Double
Dim Nn As Integer, Temp As Double
If Abs(x) > 1 Then
  Nn = MsgBox("自变量越界！", vbOKOnly + vbExclamation, "操作错误警告！")
  Text1.Text = ""
  Exit Function
Else
  If x = 1 Then
  Temp = PI / 2
  ElseIf x = -1 Then
  Temp = -PI / 2
  Else
  Temp = Atn(x / Sqr(1 - x * x))
  End If
End If
ArcSin = Temp
End Function
Private Function ArcCos(x As Double) As Double
Dim Nn As Integer, Temp As Double
If Abs(x) > 1 Then
  Nn = MsgBox("自变量越界！", vbOKOnly + vbExclamation, "操作错误警告！")
  Text1.Text = ""
  Exit Function
Else
  If x = 0 Then
  Temp = PI / 2
   Else
  Temp = Atn(Sqr(1 - x * x) / x)
  End If
End If
ArcCos = Temp
End Function
Private Function ArcCot(x As Double) As Double
Dim Temp As Double
  If x = 0 Then
  Temp = PI / 2
   Else
  Temp = Atn(1 / x)
  End If
ArcCot = Temp
End Function

Private Function Cot(x As Double) As Double
Dim Nn As Integer, Temp As Double
  If x = 0 Then
  Nn = MsgBox("函数无意义！", vbOKOnly + vbExclamation, "操作错误警告！")
  Text1.Text = ""
  Exit Function
   Else
  Temp = 1 / Atn(x)
  End If
Cot = Temp
End Function

Private Function Sec(x As Double) As Double
Dim Nn As Integer, Temp As Double
  If Cos(x) = 0 Then
  Nn = MsgBox("函数无意义！", vbOKOnly + vbExclamation, "操作错误警告！")
  Text1.Text = ""
  Exit Function
   Else
  Temp = 1 / Cos(x)
  End If
Sec = Temp
End Function

Private Function Csc(x As Double) As Double
Dim Nn As Integer, Temp As Double
  If Sin(x) = 0 Then
  Nn = MsgBox("函数无意义！", vbOKOnly + vbExclamation, "操作错误警告！")
  Text1.Text = ""
  Exit Function
   Else
  Temp = 1 / Sin(x)
  End If
Csc = Temp
End Function

Private Function ArcCsc(x As Double) As Double
Dim Nn As Integer, Temp As Double
  If Abs(x) < 1 Then
  Nn = MsgBox("自变量越界！", vbOKOnly + vbExclamation, "操作错误警告！")
  Text1.Text = ""
  Exit Function
   Else
  Temp = Atn(x / Sqr(x ^ 2 - 1)) + (Sgn(x) - 1) * 2 * Atn(1)
  End If
ArcCsc = Temp
End Function
Private Function Sh(x As Double) As Double
Dim Temp As Double
   Temp = (Exp(x) - Exp(-x)) / 2
   Sh = Temp
End Function
Private Function Ch(x As Double) As Double
Dim Temp As Double
   Temp = (Exp(x) + Exp(-x)) / 2
   Ch = Temp
End Function

Private Function Th(x As Double) As Double
Dim Temp As Double
   Temp = Sh(x) / Ch(x)
   Th = Temp
End Function
Private Function Cth(x As Double) As Double
Dim Temp As Double
   Temp = Ch(x) / Sh(x)
   Cth = Temp
End Function

Private Function ArcSh(x As Double) As Double
Dim Temp As Double

   Temp = Log(x + Sqr(x ^ 2 + 1))
   ArcSh = Temp
End Function

Private Function ArcCh(x As Double) As Double
Dim Temp As Double, Nn As Integer
If x ^ 2 - 1 < 0 Or x + Sqr(x ^ 2 - 1) <= 0 Then
 Nn = MsgBox("自变量越界！", vbOKOnly + vbExclamation, "操作错误警告！")
  Text1.Text = ""
  Exit Function
  End If
   Temp = Log(x + Sqr(x ^ 2 - 1))
   ArcCh = Temp
End Function

Private Fu