frmcraps.frm

Visual Basic 6 大学教程的代码

VERSION 5.00
Begin VB.Form frmCraps 
   AutoRedraw      =   -1  'True
   BackColor       =   &H0000FF00&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Fig. 6.22: Craps"
   ClientHeight    =   3705
   ClientLeft      =   2415
   ClientTop       =   1275
   ClientWidth     =   4605
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   Picture         =   "FRMCRAPS.frx":0000
   ScaleHeight     =   3705
   ScaleWidth      =   4605
   Begin VB.Frame fraPoint 
      BackColor       =   &H0000FF00&
      Caption         =   "Point"
      Height          =   1290
      Left            =   135
      TabIndex        =   3
      Top             =   90
      Width           =   2505
      Begin VB.Image imgPointDie2 
         Height          =   735
         Left            =   1425
         Top             =   345
         Width           =   855
      End
      Begin VB.Image imgPointDie1 
         Height          =   735
         Left            =   195
         Top             =   345
         Width           =   885
      End
   End
   Begin VB.CommandButton cmdPlay 
      BackColor       =   &H80000005&
      Caption         =   "Play"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   612
      Left            =   3120
      TabIndex        =   0
      Top             =   225
      Width           =   1332
   End
   Begin VB.CommandButton cmdRoll 
      BackColor       =   &H80000005&
      Caption         =   "Roll"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   612
      Left            =   3120
      TabIndex        =   1
      Top             =   975
      Width           =   1332
   End
   Begin VB.Label lblStatus 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   480
      Left            =   0
      TabIndex        =   2
      Top             =   3240
      Width           =   5265
   End
   Begin VB.Image imgDie2 
      Height          =   1095
      Left            =   2760
      Top             =   2040
      Width           =   1230
   End
   Begin VB.Image imgDie1 
      Height          =   1095
      Left            =   120
      Top             =   1560
      Width           =   1200
   End
End
Attribute VB_Name = "frmCraps"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Fig. 6.22
' Craps program
Option Explicit     ' General declaration

' Declare module variables
Dim mMyPoint As Integer     ' General declaration
Dim mDie1 As Integer        ' General declaration
Dim mDie2 As Integer        ' General declaration

Enum Names
   snakeEyes = 2   ' Explicitly assign 2
   trey            ' Implicitly assign 3
   [yo leven] = 11 ' Explicitly assign 11
   boxCars         ' Implicitly assign 12
End Enum

Private Sub Form_Load()
   Icon = LoadPicture("d:\images\ch06\die.ico")
End Sub

Private Sub cmdPlay_Click()
   Dim sum As Integer
   
   ' initialization
   mMyPoint = 0
   fraPoint.Caption = "Point"
   lblStatus.Caption = ""
   imgPointDie1.Picture = LoadPicture("")
   imgPointDie2.Picture = LoadPicture("")
   Call Randomize
   
   sum = RollDice()     ' Invoke rollDice
                              
   ' Determine outcome of first roll
   Select Case sum
      Case 7, [yo leven]
         cmdRoll.Enabled = False   ' Disable Roll button
         lblStatus.Caption = "You Win!!!"
      Case snakeEyes, trey, boxCars
         cmdRoll.Enabled = False
         lblStatus.Caption = "Sorry. You lose."
      Case Else
         mMyPoint = sum
         fraPoint.Caption = "Point is " & sum
         lblStatus.Caption = "Roll Again."
         Call DisplayDie(imgPointDie1, mDie1)
         Call DisplayDie(imgPointDie2, mDie2)
         cmdPlay.Enabled = False   ' Disable Play button
         cmdRoll.Enabled = True    ' Enable Roll button
   End Select

End Sub

Private Sub cmdRoll_Click()
   Dim sum As Integer
      
   sum = RollDice()          ' Invoke rollDice

   ' Check for a win or loss
   If sum = mMyPoint Then        ' Win
      lblStatus.Caption = "You Win!!!"
      cmdRoll.Enabled = False
      cmdPlay.Enabled = True
   ElseIf sum = 7 Then           ' Loss
      lblStatus.Caption = "Sorry. You lose."
      cmdRoll.Enabled = False
      cmdPlay.Enabled = True
   End If

End Sub

Private Sub DisplayDie(imgDie As Image, face As Integer)
   imgDie.Picture = LoadPicture("d:\images\" & _
                                "common\die" & face & ".gif")
  
End Sub

Private Function RollDice() As Integer
   Dim die1 As Integer, die2 As Integer, dieSum As Integer
   Dim a As Integer, b As Integer

   die1 = 1 + Int(6 * Rnd())      ' Roll die1
   die2 = 1 + Int(6 * Rnd())      ' Roll die2
 
   Call DisplayDie(imgDie1, die1) ' Draw die image
   Call DisplayDie(imgDie2, die2) ' Draw die image
                          
   mDie1 = die1                   ' Store die1 value
   mDie2 = die2                   ' Store die2 value
   dieSum = die1 + die2           ' Sum dice
   RollDice = dieSum              ' Return dieSum to caller
End Function