BÀI THỰC HÀNH THÊM Ở NHÀ (Số 4)

Một phần của tài liệu bài thực hành tin học đại cương (Trang 130 - 142)

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 (adsbygoogle = window.adsbygoogle || []).push({});

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 (adsbygoogle = window.adsbygoogle || []).push({});

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 (adsbygoogle = window.adsbygoogle || []).push({});

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

Một phần của tài liệu bài thực hành tin học đại cương (Trang 130 - 142)