winmine.frm

visual basic课程设计案例精编

VERSION 5.00
Begin VB.Form frmWinMine 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "WinMine"
   ClientHeight    =   6165
   ClientLeft      =   1890
   ClientTop       =   2670
   ClientWidth     =   8670
   BeginProperty Font 
      Name            =   "System"
      Size            =   9.75
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "winmine.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   Picture         =   "winmine.frx":030A
   ScaleHeight     =   6165
   ScaleWidth      =   8670
   Begin VB.ListBox lstSortedX 
      Height          =   1020
      ItemData        =   "winmine.frx":3674C
      Left            =   9240
      List            =   "winmine.frx":3674E
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   120
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Label lblMinesLeft 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Mines Left : 0"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   345
      Left            =   0
      TabIndex        =   1
      Top             =   5790
      Width           =   8655
   End
   Begin VB.Image imgOpenBlocks 
      Height          =   240
      Left            =   2520
      Picture         =   "winmine.frx":36750
      Top             =   6000
      Width           =   8640
   End
   Begin VB.Image imgWrongMine 
      Height          =   240
      Left            =   10200
      Picture         =   "winmine.frx":38F92
      Top             =   3480
      Width           =   240
   End
   Begin VB.Image imgQsPressed 
      Height          =   240
      Left            =   10200
      Picture         =   "winmine.frx":394D4
      Top             =   3240
      Width           =   240
   End
   Begin VB.Image imgQuestion 
      Height          =   240
      Left            =   9960
      Picture         =   "winmine.frx":39A16
      Top             =   3240
      Width           =   240
   End
   Begin VB.Image imgPressed 
      Height          =   240
      Left            =   10200
      Picture         =   "winmine.frx":39F58
      Top             =   2760
      Width           =   240
   End
   Begin VB.Image imgFlag 
      Height          =   240
      Left            =   9960
      Picture         =   "winmine.frx":3A49A
      Top             =   3480
      Width           =   240
   End
   Begin VB.Image imgBlown 
      Height          =   240
      Left            =   9960
      Picture         =   "winmine.frx":3A9DC
      Top             =   3000
      Width           =   240
   End
   Begin VB.Image imgMine 
      Height          =   240
      Left            =   10200
      Picture         =   "winmine.frx":3AF1E
      Top             =   3000
      Width           =   240
   End
   Begin VB.Image imgButton 
      Height          =   240
      Left            =   9960
      Picture         =   "winmine.frx":3B460
      Top             =   2760
      Width           =   240
   End
   Begin VB.Menu mnuGame 
      Caption         =   "&Game"
      Begin VB.Menu mnuNew 
         Caption         =   "&New"
         Shortcut        =   {F2}
      End
      Begin VB.Menu mnuSeparator1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuBeginner 
         Caption         =   "&Beginner"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuIntermediate 
         Caption         =   "&Intermediate"
      End
      Begin VB.Menu mnuExpert 
         Caption         =   "&Expert"
      End
      Begin VB.Menu mnuCustom 
         Caption         =   "&Custom ..."
      End
      Begin VB.Menu mnuSeparator2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "&Help"
      Begin VB.Menu mnuPlayingInstructions 
         Caption         =   "&Playing Instructions ..."
         Shortcut        =   {F1}
      End
   End
End
Attribute VB_Name = "frmWinMine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 游戏初始化
Private objMine As New clsWinMine
Private Sub Form_Load()
    ' 提供主要的游戏界面
    Set objMine.frmDisplay = Me
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    ' 决定被鼠标左键或者右键点击的方格，并相应的执行操作
    objMine.BeginHitTest Button, x, y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    ' 通过鼠标左键点击的坐标确定方格的坐标，并相应的执行操作
    objMine.TrackHitTest Button, x, y
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    ' 确定鼠标左键最终点击的方格，并相应的执行操作
    objMine.EndHitTest Button, x, y
End Sub



Private Sub mnuBeginner_Click()
    
    mnuBeginner.Checked = True
    mnuIntermediate.Checked = False
    mnuExpert.Checked = False
    mnuCustom.Checked = False

    ' 设定“初学者”级别的游戏界面，并开始新游戏
    objMine.SetMineFieldDimension 8, 8, 10, False
    objMine.mblnNewGame = True
    
End Sub
Private Sub mnuCustom_Click()

    mnuBeginner.Checked = False
    mnuIntermediate.Checked = False
    mnuExpert.Checked = False
    mnuCustom.Checked = True

    ' 显示不同级别默认的地雷总数
    objMine.GetMineFieldDimensions frmCustomDlg
    frmCustomDlg.Show 1
    
    ' 如果“ESC”执行，则取消
    If frmCustomDlg.mblnEscape Then Exit Sub
    
    ' 自己设定游戏的界面
    objMine.SetMineFieldDimension Val(frmCustomDlg.txtRows), Val(frmCustomDlg.txtColumns), Val(frmCustomDlg.txtMines), True
    
    ' 打开隐藏的对话框，可以修改所有的变量
    Unload frmCustomDlg
    
    ' 准备开始新的游戏
    objMine.mblnNewGame = True

End Sub
Private Sub mnuExit_Click()
    ' 触发游戏结束事件
    Set objMine = Nothing
    
    ' 退出程序
    End
End Sub
Private Sub mnuExpert_Click()

    mnuBeginner.Checked = False
    mnuIntermediate.Checked = False
    mnuExpert.Checked = True
    mnuCustom.Checked = False

    ' 设置“高手”级别的界面，并开始新游戏
    objMine.SetMineFieldDimension 16, 30, 100, False
    objMine.mblnNewGame = True

End Sub
Private Sub mnuIntermediate_Click()

    mnuBeginner.Checked = False
    mnuIntermediate.Checked = True
    mnuExpert.Checked = False
    mnuCustom.Checked = False

    ' 设置“中级选手”级别的游戏界面，并开始新游戏
    objMine.SetMineFieldDimension 16, 16, 40, False
    objMine.mblnNewGame = True

End Sub
Private Sub mnuNew_Click()
    ' 准备开始新游戏
    objMine.NewGame
End Sub
Private Sub mnuPlayingInstructions_Click()
    ' 显示游戏说明
    frmInstructBox.Show 1
End Sub