frmmain.frm

来自「《Visual Basic 6.0趣味程序导学》光盘」· FRM 代码 · 共 668 行 · 第 1/2 页

FRM
668 行
字号
12
VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "速算24"
   ClientHeight    =   6375
   ClientLeft      =   1545
   ClientTop       =   795
   ClientWidth     =   7515
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   12
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   425
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   501
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer tmrGameTime 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   6600
      Top             =   4350
   End
   Begin VB.CommandButton cmdCalculate 
      Caption         =   "计算"
      Enabled         =   0   'False
      Height          =   480
      Left            =   3089
      TabIndex        =   13
      Top             =   3270
      Width           =   1230
   End
   Begin VB.CommandButton cmdNew 
      Caption         =   "新一局"
      Height          =   480
      Left            =   5865
      TabIndex        =   12
      Top             =   2655
      Width           =   1230
   End
   Begin VB.CommandButton cmdRight 
      Caption         =   ")"
      Enabled         =   0   'False
      Height          =   480
      Left            =   1702
      TabIndex        =   11
      Top             =   3270
      Width           =   1230
   End
   Begin VB.CommandButton cmdLeft 
      Caption         =   "("
      Enabled         =   0   'False
      Height          =   480
      Left            =   315
      TabIndex        =   10
      Top             =   3270
      Width           =   1230
   End
   Begin VB.CommandButton cmdDevide 
      Caption         =   "a÷b"
      Enabled         =   0   'False
      Height          =   480
      Left            =   4476
      TabIndex        =   9
      Top             =   2655
      Width           =   1230
   End
   Begin VB.CommandButton cmdMultiply 
      Caption         =   "a×b"
      Enabled         =   0   'False
      Height          =   480
      Left            =   3089
      TabIndex        =   8
      Top             =   2655
      Width           =   1230
   End
   Begin VB.CommandButton cmdMinus 
      Caption         =   "a-b"
      Enabled         =   0   'False
      Height          =   480
      Left            =   1702
      TabIndex        =   7
      Top             =   2655
      Width           =   1230
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "a+b"
      Enabled         =   0   'False
      Height          =   480
      Left            =   315
      TabIndex        =   6
      Top             =   2655
      Width           =   1230
   End
   Begin VB.CommandButton cmdRePlay 
      Caption         =   "重玩"
      Enabled         =   0   'False
      Height          =   480
      Left            =   4476
      TabIndex        =   5
      Top             =   3270
      Width           =   1230
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   480
      Left            =   5865
      TabIndex        =   2
      Top             =   3270
      Width           =   1230
   End
   Begin VB.Label Label3 
      Caption         =   "3.输入完成后按计算按钮，程序会计算你输入的表达式结果，若结果为24，算游戏成功一次，程序会给出你所用的时间。"
      Height          =   585
      Left            =   315
      TabIndex        =   14
      Top             =   5610
      Width           =   6855
      WordWrap        =   -1  'True
   End
   Begin VB.Label lblTime 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "时间"
      Height          =   480
      Left            =   5865
      TabIndex        =   4
      Top             =   3885
      Width           =   1230
   End
   Begin VB.Label lblExpression 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "算术表达式"
      Height          =   450
      Left            =   330
      TabIndex        =   3
      Top             =   3915
      Width           =   5355
   End
   Begin VB.Image imgCard4 
      Enabled         =   0   'False
      Height          =   2250
      Left            =   5685
      MouseIcon       =   "frmMain.frx":0000
      MousePointer    =   99  'Custom
      Picture         =   "frmMain.frx":030A
      Stretch         =   -1  'True
      Tag             =   "0"
      Top             =   210
      Width           =   1500
   End
   Begin VB.Image imgCard3 
      Enabled         =   0   'False
      Height          =   2250
      Left            =   3885
      MouseIcon       =   "frmMain.frx":1633
      MousePointer    =   99  'Custom
      Picture         =   "frmMain.frx":193D
      Stretch         =   -1  'True
      Tag             =   "0"
      Top             =   210
      Width           =   1500
   End
   Begin VB.Image imgCard2 
      Enabled         =   0   'False
      Height          =   2250
      Left            =   1995
      MouseIcon       =   "frmMain.frx":2C66
      MousePointer    =   99  'Custom
      Picture         =   "frmMain.frx":2F70
      Stretch         =   -1  'True
      Tag             =   "0"
      Top             =   195
      Width           =   1500
   End
   Begin VB.Image imgCard1 
      Enabled         =   0   'False
      Height          =   2250
      Left            =   285
      MouseIcon       =   "frmMain.frx":4299
      MousePointer    =   99  'Custom
      Picture         =   "frmMain.frx":45A3
      Stretch         =   -1  'True
      Tag             =   "0"
      Top             =   210
      Width           =   1500
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "2. 要求用户利用扑克牌显示的数字，通过上面的按钮提供的运算符号和括号，计算出24，JQKA算做1。每张扑克牌只能使用一次。"
      Height          =   480
      Left            =   285
      TabIndex        =   1
      Top             =   4950
      Width           =   6900
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label1 
      Caption         =   "1.单击""新一局""按钮，游戏开始，系统将发出4张扑克牌。"
      Height          =   405
      Left            =   315
      TabIndex        =   0
      Top             =   4500
      Width           =   6300
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'运算数字数组，指针
Private ma_dNumber(1 To 20) As Double
Private m_intNumPt As Integer
'操作符数组，指针
Private ma_strOperator(1 To 20) As String
Private m_intOpPt As Integer
'纸牌点数代表的数字
Private m_intCardNum1 As Integer
Private m_intCardNum2 As Integer
Private m_intCardNum3 As Integer
Private m_intCardNum4 As Integer
'保存纸牌点数以便重玩
Private m_intCardNumBak1 As Integer
Private m_intCardNumBak2 As Integer
Private m_intCardNumBak3 As Integer
Private m_intCardNumBak4 As Integer
'游戏时间记录
Private m_lngTime As Long

Private Function Calculate(dNum1 As Double, strOP As String, dNum2 As Double) As Double
Select Case strOP
Case "+"
    Calculate = dNum1 + dNum2
Case "-"
    Calculate = dNum1 - dNum2
Case "*"
    Calculate = dNum1 * dNum2
Case "/"
    Calculate = dNum1 / dNum2
End Select

End Function
Private Sub EnableCard(bEnable As Boolean)
    imgCard1.Enabled = bEnable
    imgCard2.Enabled = bEnable
    imgCard3.Enabled = bEnable
    imgCard4.Enabled = bEnable
    '如果纸牌已经使用过则disable
    If (imgCard1.Tag = 1) Then
        imgCard1.Enabled = False
    End If
    If (imgCard2.Tag = 1) Then
        imgCard2.Enabled = False
    End If
    If (imgCard3.Tag = 1) Then
        imgCard3.Enabled = False
    End If
    If (imgCard4.Tag = 1) Then
        imgCard4.Enabled = False
    End If
        
End Sub
Private Sub EnableBotton(bEnable As Boolean)
cmdAdd.Enabled = bEnable
cmdMinus.Enabled = bEnable
cmdMultiply.Enabled = bEnable
cmdDevide.Enabled = bEnable
End Sub


Private Sub cmdAdd_Click()
Dim dNum1 As Double, dNum2 As Double, dResult As Double
Dim strOP As String
'使卡片失效，按钮有效，并且设置计算表达式
EnableBotton False
EnableCard True
On Error GoTo HaveError
lblExpression.Caption = lblExpression.Caption & "+"
'若前面算符为"("或"#"则加号进栈，否则计算,结果进栈
While (ma_strOperator(m_intOpPt - 1) <> "#" And (ma_strOperator(m_intOpPt - 1) <> "("))
    '先将指针减一，得到现在的位置
    m_intNumPt = m_intNumPt - 1
    dNum2 = ma_dNumber(m_intNumPt)
    m_intNumPt = m_intNumPt - 1
    dNum1 = ma_dNumber(m_intNumPt)
    m_intOpPt = m_intOpPt - 1
    strOP = ma_strOperator(m_intOpPt)
    dResult = Calculate(dNum1, strOP, dNum2)
    ma_dNumber(m_intNumPt) = dResult
    m_intNumPt = m_intNumPt + 1
Wend
ma_strOperator(m_intOpPt) = "+"
m_intOpPt = m_intOpPt + 1
Exit Sub
HaveError:
    MsgBox "输入错误！！", vbOKOnly + vbInformation, "输入有误！"
End Sub

Private Sub cmdCalculate_Click()
Dim dNum1 As Double, dNum2 As Double, dResult As Double
Dim strOP As String
'取操作符计算,结果进栈，直到操作符为"#"
On Error GoTo CalError
While (ma_strOperator(m_intOpPt - 1) <> "#")
    '先将指针减一，得到现在的位置
    m_intNumPt = m_intNumPt - 1
    dNum2 = ma_dNumber(m_intNumPt)
    m_intNumPt = m_intNumPt - 1
    dNum1 = ma_dNumber(m_intNumPt)
    m_intOpPt = m_intOpPt - 1
    strOP = ma_strOperator(m_intOpPt)
    
    dResult = Calculate(dNum1, strOP, dNum2)
    ma_dNumber(m_intNumPt) = dResult
    m_intNumPt = m_intNumPt + 1
Wend
m_intNumPt = m_intNumPt - 1
Dim dFinal As Double
dFinal = ma_dNumber(m_intNumPt)
'避免小误差的影响
If (Abs(dFinal - 24) < 0.0001) Then
    dFinal = 24
    MsgBox "你真行，我服了你！", vbOKOnly + vbInformation, "对了"
Else
12

frmmain.frm - 源码说明

本页面展示了「《Visual Basic 6.0趣味程序导学》光盘」中的 frmmain.frm 源码文件，采用 FRM 编程语言编写，共 668 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与Visual相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?