物件導向的方法在遊戲中的應用的一個例子（下）(轉)[@more@]

　　' 準備開始一盤新遊戲

　　mblnNewGame = True

　　Dim CRLF As String

　　CRLF = Chr$(13) & Chr$(10)

　　' 對話方塊提示"你輸了!"

　　MsgBox "你輸了!", vbExclamation, "掃雷"

　　Case Else:

　　' 如果這個方格的周圍有一個或更多的方格中包含地雷,那麼顯示它周圍包含的地理數

　　mfrmDisplay.PaintPicture mfrmDisplay.imgPressed, mintCol, mintRow

　　mfrmDisplay.CurrentX = mintCol

　　mfrmDisplay.CurrentY = mintRow

　　mfrmDisplay.ForeColor = QBColor(mbytMineStatus(intY, intX))

　　mfrmDisplay.Print mbytMineStatus(intY, intX)

　　' 並且標記這個位置已經被開啟

　　mbytMineStatus(intY, intX) = mbytMineStatus(intY, intX) + BEEN

　　End Select

　　End If

　　End Sub

　　' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' '

　　' 說明: 當這個窗體舊的物件的顯示尺寸被賦予新的屬性值時,過程被呼叫該過程在主顯示窗體被載入時被呼叫

　　'

　　' 輸入引數 : frmDisplay: 舊的主顯示窗體物件 '

　　' '

　　' 輸出引數: 無 '

　　' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

　　Public Property Set frmDisplay(frmDisplay As Form)

　　' Property 表示為一個類的屬性,屬性名為frmDisplay

　　Set mfrmDisplay = frmDisplay

　　mfrmDisplay.FontBold = True

　　' 按遊戲中設定的尺度和雷數,來從新確定主窗體的大小

　　ResizeDisplay

　　End Property

　　' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

　　' '

　　' 說明: 將當前遊戲中設定的遊戲級別的地雷分佈的行數、列數以及地雷數顯示在自定義對話方塊的文字框中

　　'

　　' 輸入引數 : frmDisplay: 舊的主顯示窗體物件 '

　　' '

　　' 輸出引數: 無 '

　　' '

　　' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

　　Public Sub GetMineFieldDimensions(frmDialog As Form)

　　' 得到當前遊戲中設定的遊戲級別的地雷分佈的行數、列數以及地雷數

　　frmDialog.txtRows = mintRows

　　frmDialog.txtColumns = mintCols

　　frmDialog.txtMines = mbytNumMines

　　' 將其高亮顯示在自定義對話方塊的文字框中

　　frmDialog.txtRows.SelLength = Len(frmDialog.txtRows)

　　frmDialog.txtColumns.SelLength = Len(frmDialog.txtColumns)

　　frmDialog.txtMines.SelLength = Len(frmDialog.txtMines)

　　End Sub

　　' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

　　' '

　　' 說明: 按當前遊戲中設定的地雷遊戲的尺寸,動態的分配陣列大小,並且隨機分配地雷分佈的區域

　　' 輸入引數: 無 '

　　' 輸出引數: 無

　　'

　　' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

　　Private Sub InitializeMineField()

　　' 按設定的行列數及雷數,設定二維動態陣列中的大小

　　ReDim mbytMineStatus(mintRows - 1, mintCols - 1)

　　ReDim mbytMarked(mintRows - 1, mintCols - 1)

　　ReDim mbytMineLocations(mbytNumMines - 1, 1)

　　'在地雷分佈區中產生隨機的地雷位置,並將其存放在mbytMineLocations陣列中

　　'並且用包含地雷的位置及其周圍包含的地雷數填充mbytMineStatus陣列

　　Randomize

　　Dim i As Integer '迴圈數

　　Dim r As Integer '迴圈數

　　Dim c As Integer '迴圈數

　　For i = 0 To mbytNumMines - 1

　　Dim intX As Integer

　　Dim intY As Integer

　　intX = Int(Rnd * mintCols)

　　intY = Int(Rnd * mintRows)

　　'如果得到的位置的狀態為有雷,那麼從新分配

　　While mbytMineStatus(intY, intX) = MINE

　　intX = Int(Rnd * mintCols)

　　intY = Int(Rnd * mintRows)

　　Wend

　　'將得到的位置的狀態標記為有地雷

　　mbytMineStatus(intY, intX) = MINE

　　'將這個位置存放在二維陣列中

　　mbytMineLocations(i, 0) = intY

　　mbytMineLocations(i, 1) = intX

　　'找到當前位置的周圍8個位置,並判斷在沒有出地雷分佈區時,這8個位置的狀態,只要每有地雷分佈,就將他們的狀態加1,也就是將它標記為無雷

　　For r = -1 To 1

　　For c = -1 To 1

　　Dim blnDx As Boolean

　　Dim blnDy As Boolean

　　'找它的周圍8個位置,看是否出了有效的地雷分佈區

　　blnDy = intY + r >= 0 And intY + r < mintRows

　　blnDx = intX + c >= 0 And intX + c < mintCols

　　'如果沒有出有效的地雷分佈區

　　If blnDy And blnDx Then

　　'判斷他們的狀態是否有地雷分佈

　　If mbytMineStatus(intY + r, intX + c) <> MINE Then

　　'如果沒有地雷分佈,那麼將它的狀態加1 ( 即設為無雷),並存放在mbytMineStatus中

　　mbytMineStatus(intY + r, intX + c) = mbytMineStatus(intY + r, intX + c) + 1

　　End If

　　End Sub

　　' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

　　' '

　　' 說明: 開始一盤新的遊戲

　　'

　　' 輸入引數: 無 '

　　'

　　' 輸出引數: 無 '

　　' '

　　' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

　　Public Sub NewGame()

　　' 清除再主窗體中的顯示

　　mfrmDisplay.Cls

　　' 從新設定遊戲中的變數和標誌位

　　mbytCorrectHits = 0

　　mbytTotalHits = 0

　　mintRow = -1

　　mintCol = -1

　　mblnNewGame = False

　　mblnHitTestBegun = False

　　Dim i As Integer '迴圈數

　　' 清空錯誤標記地雷的mcolWrongLocations集合

　　For i = 1 To mcolWrongLocations.Count

　　mcolWrongLocations.Remove 1

　　'從新計算新的地雷分佈區域

　　InitializeMineField

　　' 從新設定主窗體中最下面的剩餘地雷數

　　mfrmDisplay.lblMinesLeft = "剩餘地雷數 : " & mbytNumMines

　　End Sub

　　' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

　　' '

　　' 說明：如果這個方格被點選，並且其中不含有地雷，那麼這個過程將開啟所有的它周圍的方格，直到遇到包含地雷的方格為止，這裡使用了一種演算法，有興趣可以研究一下，首先從點選的方格位置開始，一直向左查詢，直到遇到一個不為空的包含地雷的方格為止，此時以前一個掃描的方格位置為中心，順時針查詢它周圍的方格是否含有地雷，從而勾畫出沒有地雷的方格的邊緣，並儲存邊緣地雷的位置的x周座標

　　'

　　' 函式的輸入引數: inX: 記錄滑鼠鍵被點選的位置在X軸上的座標 '

　　' inY: 記錄滑鼠鍵被點選的位置在Y軸上的座標

　　' '

　　' 返回值: 無

　　' '

　　' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

　　Private Sub OpenBlanks(ByVal intX As Single, ByVal intY As Single)

　　' 定義四個布林型變數，用來儲存查詢動作的移動方向

　　Dim blnGoUp As Boolean

　　Dim blnGoRight As Boolean

　　Dim blnGoDown As Boolean

　　Dim blnGoLeft As Boolean

　　' the border starts

　　' 用來儲存查詢動作的移動位置的X ， Y軸座標

　　Dim intXStart As Integer

　　Dim intYStart As Integer

　　' 集合佇列中的位置索引

　　Dim intPos As Integer

　　' 迴圈計數值

　　Dim element As Variant

　　' 迴圈計數值

　　Dim y As Integer

　　Dim x As Integer

　　Dim i As Integer

　　'一個動態的整型陣列集合.其中每一個元素存放掃描行的起始和終止的方格的x軸座標位置。透過這個數值可以得到沒有包含地雷的位置邊緣

　　Dim colX() As New Collection

　　'設定這個陣列的大小和地雷分佈區域的行數相同

　　ReDim colX(mintRows - 1)

　　'一直向左搜尋,直到找到一個空的不包含地雷的位置

　　While mbytMineStatus(intY, intX) = NONE

　　intX = intX - 1

　　If intX < 0 Then

　　intX = 0

　　intXStart = intX

　　intYStart = intY

　　GoTo LFT

　　End If

　　Wend

　　' first direction to go is up

　　' 首先是向上搜尋

　　blnGoUp = True

　　' store this first non-empty mine location as the

物件導向的方法在遊戲中的應用的一個例子（下）(轉)

相關文章