1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
|
Public Class Form1
Private WithEvents gb As GameBoard
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
gb = New GameBoard
gb.NewMap()
Me.Panel1.Controls.Add(gb)
Me.WindowState = FormWindowState.Maximized
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
gb.NewMap()
gb.Refresh()
End Sub
Protected Overrides Function ProcessCmdKey(ByRef msg As System.Windows.Forms.Message, ByVal keyData As System.Windows.Forms.Keys) As Boolean
Select Case keyData
Case Keys.Up
gb.MoveUp()
Case Keys.Down
gb.MoveDown()
Case Keys.Left
gb.MoveLeft()
Case Keys.Right
gb.MoveRight()
End Select
Return MyBase.ProcessCmdKey(msg, keyData)
End Function
Private Sub gb_DestinationReached(ByVal sender As GameBoard) Handles gb.DestinationReached
MessageBox.Show("Good job!", "Destination Reached", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End Sub
Private Class GameBoard
Inherits PictureBox
Public Enum CellType
None
Path
PathB
Wall
End Enum
Public Event DestinationReached(ByVal sender As GameBoard)
Public Sub New()
' ..this gets rid of the flicker when we call Refresh()...
Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
Me.Dock = DockStyle.Fill
Me.NewMap()
End Sub
Public curCol As Integer = 4
Public curRow As Integer = 3
Public destCol As Integer
Public destRow As Integer
Public rowHeight As Integer = 25
Public rowCount As Integer = 25
Public columnWidth As Integer = 25
Public columnCount As Integer = 25
Public LeftMargin As Integer = 20
Public Grid(,) As GameBoard.CellType
Public Sub NewMap()
Dim R As New Random
ReDim Grid(rowCount - 1, columnCount - 1)
' start with ALL walls
For row As Integer = 0 To rowCount - 1
For col As Integer = 0 To columnCount - 1
Grid(row, col) = CellType.Wall
Next
Next
' pick starting and destination cells
curCol = R.Next(0, columnCount)
curRow = R.Next(0, rowCount)
Grid(curRow, curCol) = CellType.Path
Do
destCol = R.Next(0, columnCount)
destRow = R.Next(0, rowCount)
Loop While destCol = curCol AndAlso destRow = curRow
Grid(destRow, destCol) = CellType.PathB
' make sure there is a path from start to finish
' use the "water" method to flow out from both start and finish
' at the same time until they meet
Dim tmpCurCol As Integer = curCol
Dim tmpCurRow As Integer = curRow
Dim tmpDestCol As Integer = destCol
Dim tmpDestRow As Integer = destRow
Dim dir As Integer
Dim connected As Boolean = False
While Not connected
dir = R.Next(0, 4)
Select Case dir
Case 0 ' left
If tmpCurCol > 0 Then
tmpCurCol = tmpCurCol - 1
If Grid(tmpCurRow, tmpCurCol) = CellType.PathB Then
connected = True
Else
Grid(tmpCurRow, tmpCurCol) = CellType.Path
End If
End If
Case 1 ' right
If tmpCurCol < columnCount - 1 Then
tmpCurCol = tmpCurCol + 1
If Grid(tmpCurRow, tmpCurCol) = CellType.PathB Then
connected = True
Else
Grid(tmpCurRow, tmpCurCol) = CellType.Path
End If
End If
Case 2 ' up
If tmpCurRow > 0 Then
tmpCurRow = tmpCurRow - 1
If Grid(tmpCurRow, tmpCurCol) = CellType.PathB Then
connected = True
Else
Grid(tmpCurRow, tmpCurCol) = CellType.Path
End If
End If
Case 3 ' down
If tmpCurRow < rowCount - 1 Then
tmpCurRow = tmpCurRow + 1
If Grid(tmpCurRow, tmpCurCol) = CellType.PathB Then
connected = True
Else
Grid(tmpCurRow, tmpCurCol) = CellType.Path
End If
End If
End Select
If Not connected Then
dir = R.Next(0, 4)
Select Case dir
Case 0 ' left
If tmpDestCol > 0 Then
tmpDestCol = tmpDestCol - 1
If Grid(tmpDestRow, tmpDestCol) = CellType.Path Then
connected = True
Else
Grid(tmpDestRow, tmpDestCol) = CellType.PathB
End If
End If
Case 1 ' right
If tmpDestCol < columnCount - 1 Then
tmpDestCol = tmpDestCol + 1
If Grid(tmpDestRow, tmpDestCol) = CellType.Path Then
connected = True
Else
Grid(tmpDestRow, tmpDestCol) = CellType.PathB
End If
End If
Case 2 ' up
If tmpDestRow > 0 Then
tmpDestRow = tmpDestRow - 1
If Grid(tmpDestRow, tmpDestCol) = CellType.Path Then
connected = True
Else
Grid(tmpDestRow, tmpDestCol) = CellType.PathB
End If
End If
Case 3 ' down
If tmpDestRow < rowCount - 1 Then
tmpDestRow = tmpDestRow + 1
If Grid(tmpDestRow, tmpDestCol) = CellType.Path Then
connected = True
Else
Grid(tmpDestRow, tmpDestCol) = CellType.PathB
End If
End If
End Select
End If
End While
' add random paths
For row As Integer = 0 To rowCount - 1
For col As Integer = 0 To columnCount - 1
If Grid(row, col) = CellType.Wall Then
If R.NextDouble < 0.5 Then
Grid(row, col) = CellType.Path
End If
End If
Next
Next
End Sub
Private Sub GameBoard_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
' draw the blocks
Dim rc As Rectangle
For row As Integer = 0 To rowCount - 1
For col As Integer = 0 To columnCount - 1
rc = New Rectangle(New Point(LeftMargin + (col * columnWidth), row * rowHeight), New Size(columnWidth, rowHeight))
e.Graphics.FillRectangle(IIf(Grid(row, col) = CellType.Wall, Brushes.Blue, Brushes.White), rc)
Next
Next
' draw the destination block
rc = New Rectangle(New Point(LeftMargin + (destCol * columnWidth), destRow * rowHeight), New Size(columnWidth, rowHeight))
e.Graphics.FillRectangle(Brushes.Red, rc)
' draw the highlighted block
rc = New Rectangle(New Point(LeftMargin + (curCol * columnWidth), curRow * rowHeight), New Size(columnWidth, rowHeight))
e.Graphics.FillRectangle(Brushes.Green, rc)
' draw the grid lines
For r As Integer = 0 To rowCount
e.Graphics.DrawLine(Pens.Black, LeftMargin, rowHeight * r, LeftMargin + (columnCount * columnWidth), rowHeight * r)
Next
For c As Integer = 0 To columnCount
e.Graphics.DrawLine(Pens.Black, LeftMargin + (c * columnWidth), 0, LeftMargin + (c * columnWidth), rowCount * rowHeight)
Next
End Sub
Public Function MoveUp() As Boolean
If Me.curRow > 0 Then
If Me.Grid(Me.curRow - 1, Me.curCol) <> GameBoard.CellType.Wall Then
Me.curRow = Me.curRow - 1
Me.Refresh()
If Me.curRow = Me.destRow AndAlso Me.curCol = Me.destCol Then
RaiseEvent DestinationReached(Me)
End If
Return True
End If
End If
Return False
End Function
Public Function MoveDown() As Boolean
If Me.curRow < Me.rowCount - 1 Then
If Me.Grid(Me.curRow + 1, Me.curCol) <> GameBoard.CellType.Wall Then
Me.curRow = Me.curRow + 1
Me.Refresh()
If Me.curRow = Me.destRow AndAlso Me.curCol = Me.destCol Then
RaiseEvent DestinationReached(Me)
End If
Return True
End If
End If
Return False
End Function
Public Function MoveLeft() As Boolean
If Me.curCol > 0 Then
If Me.Grid(Me.curRow, Me.curCol - 1) <> GameBoard.CellType.Wall Then
Me.curCol = Me.curCol - 1
Me.Refresh()
If Me.curRow = Me.destRow AndAlso Me.curCol = Me.destCol Then
RaiseEvent DestinationReached(Me)
End If
Return True
End If
End If
Return False
End Function
Public Function MoveRight() As Boolean
If Me.curCol < Me.columnCount - 1 Then
If Me.Grid(Me.curRow, Me.curCol + 1) <> GameBoard.CellType.Wall Then
Me.curCol = Me.curCol + 1
Me.Refresh()
If Me.curRow = Me.destRow AndAlso Me.curCol = Me.destCol Then
RaiseEvent DestinationReached(Me)
End If
Return True
End If
End If
Return False
End Function
End Class
End Class
|
