frmmain.frm

这是一个完成的vb的计算器

      BackColor       =   &H00FF0000&
      Caption         =   "7"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      MaskColor       =   &H8000000F&
      TabIndex        =   2
      Top             =   1200
      Width           =   855
   End
   Begin VB.CommandButton btBackSpace 
      BackColor       =   &H00FF00FF&
      Caption         =   "BackSpace"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1080
      MaskColor       =   &H00FF0000&
      TabIndex        =   1
      Top             =   600
      Width           =   1815
   End
   Begin VB.TextBox tResult 
      Alignment       =   1  'Right Justify
      BackColor       =   &H8000000E&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      Locked          =   -1  'True
      TabIndex        =   0
      Top             =   120
      Width           =   2775
   End
   Begin VB.Menu mFile 
      Caption         =   "文件（&F）"
      Begin VB.Menu mExit 
         Caption         =   "退出（&E）"
      End
   End
   Begin VB.Menu mHelp 
      Caption         =   "帮助（&F）"
      Begin VB.Menu mAbout 
         Caption         =   "关于（&A）..."
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
    Dim sOper As String
    Dim bDot As Boolean
    Dim bEqu As Boolean
    Dim bOper As Boolean
    Dim dblAcc As Double
    Dim dblDes As Double
    Dim dblResult As Double               '定义变量
    
Private Sub subReset()                    '
  sOper = ""
  dblAcc = 0
  dblDes = 0
  dblResult = 0
  bDot = False
  bEqu = False
  bOper = False
  tResult.Text = ""
End Sub

Private Sub btAdd_Click()
dblAcc = Val(tResult.Text)
sOper = "+"
bDot = False
bOper = True
pKey.SetFocus
End Sub

Private Sub btBackSpace_Click()
Dim l As Integer
l = Len(tResult.Text)
If tResult.Text <> "" Then
  If AscB(tResult.Text) = 46 Then
    bDot = False
    End If
  tResult.Text = Left(tResult.Text, l - 1)
End If
pKey.SetFocus
End Sub

Private Sub btC_Click()
subReset
pKey.SetFocus
End Sub

Private Sub btCE_Click()
tResult.Text = ""
pKey.SetFocus
End Sub

Private Sub btDiv_Click()
dblAcc = Val(tResult.Text)
sOper = "/"
bDot = False
bOper = True
pKey.SetFocus
End Sub

Private Sub btDot_Click()
If Not bDot Then
  If tResult.Text = "" Or dblAcc <> 0 Then
    tResult.Text = "0."
  Else
  tResult.Text = tResult.Text & "."
  End If
  bDot = True
End If
pKey.SetFocus
End Sub

Private Sub btEqu_Click()
If Not bEqu Then
  dblDes = Val(tResult.Text)
  End If
  Select Case sOper
  Case "+"
    dblResult = dblAcc + dblDes
  Case "-"
    dblResult = dblAcc - dblDes
  Case "*"
    dblResult = dblAcc * dblDes
  Case "/"
    If dblDes <> 0 Then
    dblResult = dblAcc / dblDes
    Else
    MsgBox "除数不能为0", , "警告！"
    End If
  End Select
  bDot = False
  bEqu = True
  tResult.Text = dblResult
  dblAcc = dblResult
  pKey.SetFocus
End Sub

Private Sub btMul_Click()
dblAcc = Val(tResult.Text)
sOper = "*"
bDot = False
bOper = True
pKey.SetFocus
End Sub

Private Sub btNeg_Click()
Dim l As Integer
l = Len(tResult.Text)
If AscB(tResult.Text) = 45 Then
  tResult.Text = Right(tResult.Text, l - 1)
Else
  tResult.Text = "-" & tResult.Text
End If
pKey.SetFocus
End Sub

Private Sub btNum0_Click()
If bEqu Or bOper Then
  If Not bDot Then
  tResult.Text = ""
  End If
End If
bEqu = False
bOper = False
tResult.Text = tResult.Text & "0"
pKey.SetFocus
End Sub

Private Sub btNum1_Click()
If bEqu Or bOper Then
  If Not bDot Then
  tResult.Text = ""
  End If
End If
bEqu = False
bOper = False
tResult.Text = tResult.Text & "1"
pKey.SetFocus
End Sub

Private Sub btNum2_Click()
If bEqu Or bOper Then
  If Not bDot Then
  tResult.Text = ""
  End If
End If
bEqu = False
bOper = False
tResult.Text = tResult.Text & "2"
pKey.SetFocus
End Sub

Private Sub btNum3_Click()
If bEqu Or bOper Then
  If Not bDot Then
  tResult.Text = ""
  End If
End If
bEqu = False
bOper = False
tResult.Text = tResult.Text & "3"
pKey.SetFocus
End Sub

Private Sub btNum4_Click()
If bEqu Or bOper Then
  If Not bDot Then
  tResult.Text = ""
  End If
End If
bEqu = False
bOper = False
tResult.Text = tResult.Text & "4"
pKey.SetFocus
End Sub

Private Sub btNum5_Click()
If bEqu Or bOper Then
  If Not bDot Then
  tResult.Text = ""
  End If
End If
bEqu = False
bOper = False
tResult.Text = tResult.Text & "5"
pKey.SetFocus
End Sub

Private Sub btNum6_Click()
If bEqu Or bOper Then
  If Not bDot Then
  tResult.Text = ""
  End If
End If
bEqu = False
bOper = False
tResult.Text = tResult.Text & "6"
pKey.SetFocus
End Sub

Private Sub btNum7_Click()
If bEqu Or bOper Then
  If Not bDot Then
  tResult.Text = ""
  End If
End If
bEqu = False
bOper = False
tResult.Text = tResult.Text & "7"
pKey.SetFocus
End Sub

Private Sub btNum8_Click()
If bEqu Or bOper Then
  If Not bDot Then
  tResult.Text = ""
  End If
End If
bEqu = False
bOper = False
tResult.Text = tResult.Text & "8"
pKey.SetFocus
End Sub

Private Sub btNum9_Click()
If bEqu Or bOper Then
  If Not bDot Then
  tResult.Text = ""
  End If
End If
bEqu = False
bOper = False
tResult.Text = tResult.Text & "9"
pKey.SetFocus
End Sub

Private Sub btSub_Click()
dblAcc = Val(tResult.Text)
sOper = "-"
bDot = False
bOper = True
pKey.SetFocus
End Sub

Private Sub Form_Activate()
pKey.SetFocus
End Sub

Private Sub Form_Load()
subReset
End Sub

Private Sub mAbout_Click()
frmAbout.Show
End Sub

Private Sub mExit_Click()
End
End Sub


Private Sub pKey_KeyPress(KeyAscii As Integer)
Dim key As Integer
key = KeyAscii
Select Case key
  Case 48, 49, 50, 51, 52, 53, 54, 55, 56, 57
If bEqu Or bOper Then
  If Not bDot Then
  tResult.Text = ""
  End If
  bFlag = True
End If
bOper = False
bEqu = False
tResult.Text = tResult.Text & Chr(key)
  Case 46
  If Not bDot Then
  If tResult.Text = "" Or dblAcc <> 0 Then
    tResult.Text = "0."
  Else
  tResult.Text = tResult.Text & "."
  End If
  bDot = True
End If
  Case 42, 43, 45, 47
    dblAcc = Val(tResult.Text)
    sOper = Chr(key)
    bDot = False
    bOper = True
  Case 61
    If Not bEqu Then
      dblDes = Val(tResult.Text)
      End If
    Select Case sOper
      Case "+"
        dblResult = dblAcc + dblDes
      Case "-"
        dblResult = dblAcc - dblDes
      Case "*"
        dblResult = dblAcc * dblDes
      Case "/"
        If dblDes <> 0 Then
          dblResult = dblAcc / dblDes
          Else
          MsgBox "除数不能为0", , "警告！"
      End If
    End Select
    bDot = False
    bEqu = True
    tResult.Text = dblResult
    dblAcc = dblResult
  Case 8
    Dim l As Integer
    l = Len(tResult.Text)
    If tResult.Text <> "" Then
      If AscB(tResult.Text) = 46 Then
        bDot = False
        End If
      tResult.Text = Left(tResult.Text, l - 1)
    End If
End Select
End Sub

Private Sub Timer1_Timer()
    Text1.FontSize = 18
    Text1.FontName = "宋体"
    Text1.Text = Time
End Sub