21. Tạo các thủ tục xử lý biến cố cho 2 option Start và Setup rồi viết code cho chúng như sau: Option Explicit
BÀI THỰC HÀNH THÊM Ở NHÀ (Số 4)
(Số 4)
Mục tiêu sinh viên cần đạt được:
Thiết kế trực quan được các phần tử giao diện của chương trình dạng SDI. Tạo được các thủ tục xử lý biến cố và viết code cho các thủ tục này. Dùng được các hàm vẽ ảnh, thay đổi kích thước đối tượng giao diện. Dùng được các thủ tục xử lý sự kiện cơ bản như MouseDown, ... Chương trình thực hành : trò chơi dò mìn có dạng sau :
Chi tiết các menu như sau :
Qui trình thực hiện :
1-20. Thực hiện các bước từ 1-20 giống y như bài Caro với 1 vài khác biệt : Các image được dùng trong trò chơi dò mìn là :
: BlancInit.jpg : MineInactive.jpg : MineActive.jpg : BlancFin.jpg : One.jpg : Two.jpg
: Three.jpg : Four.jpg : Five.jpg : Six.jpg : Seven.jpg : eight.jpg
Như vậy cửa sổ tạo ImageList như sau :
Cửa sổ thiết lập các thông số có 3 textbox nhận 3 giá trị : số hàng, số cột của bãi mìn và số mìn trong bãi mìn.
21. Tạo các thủ tục xử lý biến cố cho 2 option Start và Setup... rồi viết code cho chúng như sau :Option Explicit Option Explicit
' Lưu ý các image trong ImageList phải có đúng chỉ số được qui định ở đây
Private Const BLANCINIT_IMG = 1 Private Const MINEINACTIVE_IMG = 2 Private Const MINEACTIVE_IMG = 3 Private Const BLANCFIN_IMG = 4 'Private Const ONE_IMG = 5
'Private Const TWO_IMG = 6 'Private Const THREE_IMG = 7 'Private Const FOUR_IMG = 8 'Private Const FIVE_IMG = 9 'Private Const SIX_IMG = 10 'Private Const SEVEN_IMG = 11 'Private Const EIGHT_IMG = 12
Private intRowsBoard As Integer ' số hàng của bãi mìn Private intColsBoard As Integer ' số cột của bãi mìn Private intMineCount As Integer ' số mìn trong bãi mìn
Private intPicXWidth As Integer, intPicXHeight As Integer ' kích thước từng ô Private intBaseX As Integer, intBaseY As Integer ' tọa độ trên trái của bãi mìn Private intOdado As Integer ' số ô đã đạp được
Private DataBoard() As Integer ' ma trận dữ liệu mìn
Private StatusBoard() As Boolean ' ma trận trạng thái đạp mìn '---
' Các thủ tục xử lý sự kiện của form MyMine
'--- Private Sub Form_Load()
' Thiết lập các thông số ban đầu của trò chơi intRowsBoard = 8 intColsBoard = 8 intMineCount = 10 intPicXWidth = 17 intPicXHeight = 17 intBaseX = 4 intBaseY = 4 Call InitBoard End Sub
' Thủ tục xử lý sự kiện ấn chuột form
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Dim row As Integer, col As Integer
If Not blnDangchoi Then Exit Sub
' Kiểm tra vị trí ấn chuột nằm trong bàn cờ không ?
If intBaseX > x Or x > intBaseX + intColsBoard * intPicXWidth Or _
intBaseY > y Or y > intBaseY + intRowsBoard * intPicXHeight Then Exit Sub ' Tính vị trí ô cờ được ấn
col = (x - intBaseX) \ intPicXWidth row = (y - intBaseY) \ intPicXHeight ' Đạp mìn ở vị trí (row,col)
Call Domin(row, col) End Sub
' Thủ tục xử lý sự kiện vẽ lại form Private Sub Form_Paint()
Dim row As Integer, col As Integer Dim cnt As Integer
For row = 0 To intRowsBoard - 1 For col = 0 To intColsBoard - 1 If Not StatusBoard(row, col) Then
Call DisplayElem(row, col, BLANCINIT_IMG) ElseIf DataBoard(row, col) = 1 Then
Call DisplayElem(row, col, MINEINACTIVE_IMG) Else
cnt = MineCount(row, col)
Call DisplayElem(row, col, cnt + 4) End If
End Sub
' Thủ tục xử lý sự kiện chọn menu Help.About MyMine Private Sub mnuHelpAbout_Click()
frmAbout.Show vbModal, Me End Sub
' Thủ tục xử lý sự kiện chọn menu Options.Exit Private Sub mnuOptionsExit_Click()
'unload the form Unload Me End Sub
' Thủ tục xử lý sự kiện chọn menu Options.Setup... Private Sub mnuOptionsSetup_Click()
MyMineSetup.txtRowsBoard = CStr(intRowsBoard) MyMineSetup.txtColsBoard = CStr(intColsBoard) MyMineSetup.txtMineCount = CStr(intMineCount) MyMineSetup.Show vbModal intRowsBoard = Val(MyMineSetup.txtRowsBoard) intColsBoard = Val(MyMineSetup.txtColsBoard) intMineCount = Val(MyMineSetup.txtMineCount) If intRowsBoard < 8 Then intRowsBoard = 8 If intColsBoard < 8 Then intColsBoard = 8
If intMineCount < 1 Or intMineCount >= intRowsBoard * intColsBoard Then intMineCount = 10
End Sub
' Thủ tục xử lý sự kiện chọn menu Options.Start Private Sub mnuOptionsStart_Click()
Call InitBoard Call Form_Paint End Sub
'---' Các thủ tục dịch vụ cấp 1 : được gọi khi bạn ấn chuột vào form ' Các thủ tục dịch vụ cấp 1 : được gọi khi bạn ấn chuột vào form ' Ta dùng tầm vực Public để phân biệt với các thủ tục dịch vụ cấp 2 '---
'Thủ tục khởi động các thông số ban đầu của trò chơi Public Sub InitBoard()
Dim row As Integer, col As Integer Dim i As Integer
ReDim DataBoard(intRowsBoard - 1, intColsBoard - 1) ReDim StatusBoard(intRowsBoard - 1, intColsBoard - 1) 'blnInit = False
blnDangchoi = True intOdado = 0
For row = 0 To intRowsBoard - 1 For col = 0 To intColsBoard - 1 DataBoard(row, col) = 0 StatusBoard(row, col) = False Next col, row
Me.ScaleMode = vbPixels
' Chỉnh lại kích thước form để hiển thị vừa đủ bãi mìn
Me.Width = Me.ScaleX(intColsBoard * intPicXWidth + intBaseX * 4, vbPixels, vbTwips) Me.Height = Me.ScaleY(intRowsBoard * intPicXHeight + intBaseY * 2 + 64, vbPixels, vbTwips)
' Xếp ngẫu nhiên intMineCount trái mìn vào bãi mìn i = 0
Call Randomize
While i < intMineCount
row = (intRowsBoard - 1) * Rnd col = (intColsBoard - 1) * Rnd If DataBoard(row, col) = 0 Then DataBoard(row, col) = 1 i = i + 1 End If Wend End Sub ' Đạp mìn ở vị trí (h,c)
Public Sub Domin(ByVal h As Integer, ByVal c As Integer) Dim cnt As Integer
Dim row As Integer, col As Integer If StatusBoard(h, c) Then Exit Sub
If DataBoard(h, c) = 1 Then 'Dap trung min ' hien thi cac vi tri min
For row = 0 To intRowsBoard - 1 For col = 0 To intColsBoard - 1
If DataBoard(row, col) = 1 Then Call DisplayElem(row, col, MINEINACTIVE_IMG) Next col, row
Call DisplayElem(h, c, MINEACTIVE_IMG) MsgBox ("Ban da thua vi dap trung min roi!") blnDangchoi = False
Else 'do trung cho khong co min cnt = MineCount(h, c)
StatusBoard(h, c) = True If cnt = 0 Then
Call DisplayElem(h, c, BLANCFIN_IMG) Call Doquanh(h, c) Else Call DisplayElem(h, c, cnt + 4) End If intOdado = intOdado + 1 End If
If intOdado = intRowsBoard * intColsBoard - intMineCount Then MsgBox ("Hoan ho, Ban da thang!")
blnDangchoi = False End If
End Sub
'---' Các thủ tục dịch vụ cấp 2 : chỉ được gọi bởi các thủ tục dịch vụ cấp 1 ' Các thủ tục dịch vụ cấp 2 : chỉ được gọi bởi các thủ tục dịch vụ cấp 1
' Ta dùng tầm vực Private để phân biệt với các thủ tục dịch vụ cấp 1
'Hiển thị ô mìn ở vị trí (row,col) có mã ảnh imgCode
Private Sub DisplayElem(ByVal row As Integer, ByVal col As Integer, ByVal imgCode As Integer)
Dim x As Integer, y As Integer Dim curPic As Object
ScaleMode = vbPixels
x = intBaseX + col * intPicXWidth y = intBaseY + row * intPicXHeight
PaintPicture ImageList1.ListImages.Item(imgCode).Picture, x, y, intPicXWidth, intPicXHeight, 0, 0, , , vbSrcCopy
End Sub
' Tính số mìn xung quanh vị trí (h,c)
Private Function MineCount(ByVal h As Integer, ByVal c As Integer) As Integer Dim cnt As Integer If h - 1 >= 0 And c - 1 >= 0 Then If DataBoard(h - 1, c - 1) = 1 Then cnt = cnt + 1 End If If h - 1 >= 0 Then If DataBoard(h - 1, c) = 1 Then cnt = cnt + 1 End If
If h - 1 >= 0 And c + 1 < intColsBoard Then If DataBoard(h - 1, c + 1) Then cnt = cnt + 1 End If
If c - 1 >= 0 Then
If DataBoard(h, c - 1) Then cnt = cnt + 1 End If
If c + 1 < intColsBoard Then
If DataBoard(h, c + 1) Then cnt = cnt + 1 End If
If h + 1 < intRowsBoard And c - 1 >= 0 Then If DataBoard(h + 1, c - 1) Then cnt = cnt + 1 End If
If h + 1 < intRowsBoard Then
If DataBoard(h + 1, c) Then cnt = cnt + 1 End If
If h + 1 < intRowsBoard And c + 1 < intColsBoard Then If DataBoard(h + 1, c + 1) Then cnt = cnt + 1
End If
MineCount = cnt End Function
' Đạp tự động các ô bao quanh ô trống (h,c)
Private Sub Doquanh(ByVal h As Integer, ByVal c As Integer) If h - 1 >= 0 And c - 1 >= 0 Then
If Not StatusBoard(h - 1, c - 1) Then Call Domin(h - 1, c - 1) End If
If h - 1 >= 0 Then
If Not StatusBoard(h - 1, c) Then Call Domin(h - 1, c) End If
If h - 1 >= 0 And c + 1 < intColsBoard Then
If Not StatusBoard(h - 1, c + 1) Then Call Domin(h - 1, c + 1) End If
If c - 1 >= 0 Then
If Not StatusBoard(h, c - 1) Then Call Domin(h, c - 1) End If
If c + 1 < intColsBoard Then
If Not StatusBoard(h, c + 1) Then Call Domin(h, c + 1) End If
If h + 1 < intRowsBoard And c - 1 >= 0 Then
If Not StatusBoard(h + 1, c - 1) Then Call Domin(h + 1, c - 1) End If
If h + 1 < intRowsBoard Then
If Not StatusBoard(h + 1, c) Then Call Domin(h + 1, c) End If
If h + 1 < intRowsBoard And c + 1 < intColsBoard Then
If Not StatusBoard(h + 1, c + 1) Then Call Domin(h + 1, c + 1) End If