Разработка логической игры "Сапер" средствами VBA

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

ПРИЛОЖЕНИЕ 1

Листинг логической игры «Сапер»

 

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim i As Integer, j As Integer, i1 As Integer, j1 As Integer

If Button = 1 Then

OldX = x: OldY = y: OldFace = Face.Face

If FaceCoord(x, y) Then FaceBtn 0 Else If Not GameOver Then FaceBtn 3

If Not GameOver Then

If DoskaCoord(x, y) Then

XY2IJ x, y, i, j

If Doska1(i, j) = 0 Then

DoskaCell i, j, 15

OldI = i: OldJ = j

Else

OldI = 0: OldJ = 0

End If

End If

End If

Else

If Not GameOver Then

If DoskaCoord(x, y) Then

XY2IJ x, y, i, j

Select Case Doska1(i, j)

Case 0            'Устанавливаем флажок

If ind(0).value >= 1 Then

Doska1(i, j) = 1

DoskaCell i, j, 1

Indikator 0, ind(0).value - 1

End If

Case 1            'Устанавливаем метку (?)

Doska1(i, j) = 2

DoskaCell i, j, 2

Indikator 0, ind(0).value + 1

Case 2            'Снимаем метку (?)

Doska1(i, j) = 0

DoskaCell i, j, 0

End Select

End If

End If

End If

End Sub

 

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim i As Integer, j As Integer, i1 As Integer, j1 As Integer

If Button = 1 Then

If FaceCoord(OldX, OldY) Then

If FaceCoord(x, y) Then FaceBtn 0 Else FaceBtn OldFace

End If

If Not GameOver Then

If OldI > 0 Then DoskaCell OldI, OldJ, 0

If DoskaCoord(x, y) Then

XY2IJ x, y, i, j

If Doska1(i, j) = 0 Then

DoskaCell i, j, 15

OldI = i: OldJ = j

End If

End If

End If

End If

End Sub

 

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim i As Integer, j As Integer, i1 As Integer, j1 As Integer, empt As Integer

If Button = 1 Then

OldI = 0: OldJ = 0

If FaceCoord(OldX, OldY) And FaceCoord(x, y) Then InitGame Else FaceBtn

OldFace

If Not GameOver Then

If DoskaCoord(x, y) Then

If Not Timer1.Enabled Then Timer1.Enabled = True: Timer1_Timer

XY2IJ x, y, i, j

If Doska1(i, j) = 0 Then

Select Case Doska(i, j)

Case -1              'Мина!!!

Loss i, j

 Case 0 To 8          'Пронесло

Doska1(i, j) = 3

DoskaCell i, j, (8 - Doska(i, j)) + 7

CloseCell = CloseCell - 1

If CloseCell = KolMines Then Win

If Doska(i, j) = 0 Then

empt = 1

Do While empt > 0

empt = 0

For i = 1 To SizeY

For j = 1 To SizeX

If Doska(i, j) = 0 And Doska1(i, j) = 3 Then

  For i1 = i - 1 To i + 1

For j1 = j - 1 To j + 1

If i1 >= 1 And i1 <= SizeY And j1 >= 1 And j1 <= SizeX Then

If Doska1(i1, j1) = 0 Then

empt = empt + 1

Doska1(i1, j1) = 3

DoskaCell i1, j1, (8 - Doska(i1, j1)) + 7

CloseCell = CloseCell - 1

If CloseCell = KolMines Then Win

End If

End If

Next

Next

End If

Next

Next

Loop

End If

 

Private Sub mnuGameRang_Click(Index As Integer)

Dim i As Integer

For i = 0 To 3

mnuGameRang(i).Checked = False

Next

Rang = Index

mnuGameRang(Index).Checked = True 'Выбор нужного уровня сложности

Select Case Index

Case 0                 'Новичок

SizeY = 8

SizeX = 8

KolMines = 40

Case 1                 'Средний

SizeY = 16

SizeX = 16

KolMines = 50

Case 2                 'Профи

SizeY = 16

SizeX = 30

KolMines = 69

dlgRazmer.Show vbModal

End Select

 

Private Sub XY2IJ(x As Single, y As Single, i As Integer, j As Integer)

x = x - Dsk.x

y = y - Dsk.y

i = y \ conCellHeight

j = x \ conCellWidth

If y Mod conCellHeight > 0 Then i = i + 1

If x Mod conCellWidth > 0 Then j = j + 1

End Sub

 

'Функция проверяет находится  ли точка (X,Y) в пределах доски

Private Function DoskaCoord(x As Single, y As Single) As Boolean

If x >= Dsk.x + 15 And x <= Dsk.x + Dsk.width - 15 And y >= Dsk.y + 15 And _

y <= Dsk.y + Dsk.height - 15 Then DoskaCoord = True

End Function

 

'Функция проверяет находится  ли точка (X,Y) в пределах кнопки с рожицей

Private Function FaceCoord(x As Single, y As Single) As Boolean

If x >= Face.x And x <= Face.x + conFaceWidth And y >= Face.y And _

y <= Face.y + conFaceWidth Then FaceCoord = True

End Function 'Победа!!!

 

Private Sub Win()

Dim i As Integer, j As Integer

 'Выводим на месте неоткрытых клеток флажки

For i = 1 To SizeY

For j = 1 To SizeX

If Doska1(i, j) < 3 Then

Doska1(i, j) = 1

DoskaCell i, j, 1

Indikator 0, 0

End If

Next

Next

End If

End If

End Sub 'Поражение!?

 

 

 

 

 

 

 

 

ПРИЛОЖЕНИЕ 2

 

Приложением служит разработанная логическая игра «Сапер», которая записана на цифровом (CD-RW) носителе.