Форум программистов, компьютерный форум, киберфорум
Visual Basic .NET
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.80/5: Рейтинг темы: голосов - 5, средняя оценка - 4.80
1 / 1 / 0
Регистрация: 21.04.2010
Сообщений: 10

Исправить ошибки в "Сапере" (при попадании на мину, картинка встает правее чем нужно)

07.06.2012, 15:37. Показов 1112. Ответов 4
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Код "Сапера" взят из методички.Но работает странно как-то.
При раскрытии не выводит поздравления.А при попадании на мину, картинка встает правее чем нужно.Вот основной код.Программа сделана в Visua lStudio 2008
Код в документе.
Вложения
Тип файла: docx Документ Microsoft Office Word.docx (26.3 Кб, 15 просмотров)
0
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
07.06.2012, 15:37
Ответы с готовыми решениями:

Как не попасть на мину при первом нажатии в Сапёре?
Можно ли как-то на c# сделать обработку первого нажатия на кнопку, чтобы нельзя было попасть на мину?

Сапер. Сообщения при попадании на мину
Задали сделать сапера на c# и нужно сделать что бы когда попал на мину 1 раз было сообшение(вроде как зделал) а 2 раза был проиграш....

Исправить проблему с алгоритмом в Сапёре
Недавно решил написать Сапёра по видео https://www.youtube.com/watch?v=hFeIfVCOpNg Но в итоге, у меня не работает алгоритм открывания рядом...

4
Заблокирован
07.06.2012, 16:10
Ошибка разделом !
0
1 / 1 / 0
Регистрация: 21.04.2010
Сообщений: 10
07.06.2012, 17:35  [ТС]
Подробнее можно?

Добавлено через 1 час 18 минут
Помогите пжл, очень надо.
0
 Аватар для Desh
147 / 147 / 41
Регистрация: 01.12.2009
Сообщений: 275
07.06.2012, 18:48
Не открываетсо код, выкладывай сюды (в спойлер).
0
1 / 1 / 0
Регистрация: 21.04.2010
Сообщений: 10
07.06.2012, 18:58  [ТС]
VB.NET
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
Public Class Form1
    Const KV = 15 ' количество клеток по вертикали 
    Const KG = 15 ' количество клеток по горизонтали 
    Const KM = 55   ' количество мин 
    Const W = 30   ' ширина клетки поля 
    Const H = 30  ' высота клетки поля
    ' массив минное поле
    Dim Pole(KV + 1, KG + 1) As Integer
    Dim nMin As Integer     ' количество найденных мин
    Dim nFlag As Integer    ' количество выставленных флагов
    Dim status As Integer   ' статус игры: 0 - начало игры, 1 - идет игра, 2 - результат игры
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ' загрузка формы 
        Dim row As Integer, col As Integer
        For row = 0 To KV + 1
            For col = 0 To KG + 1
                Pole(row, col) = -3
            Next col
        Next row
    End Sub
    '  процедура выводит на форму содержимое клетки
    Sub Kletka(ByVal row As Integer, ByVal col As Integer, ByVal status As Integer)
        Dim Gr As Graphics = Me.CreateGraphics
        Dim X As Integer, Y As Integer   ' координаты верхнего левого угла области вывода клетки
        X = (col - 1) * W
        Y = (row - 1) * H
 
        If status = 0 Then 'начало игры 
            'рисуем синие клетки с черными границами и значениями массива Pole (в качестве подсказки)
            Gr.FillRectangle(Brushes.DarkBlue, X + 5, Y + 25, W, H)
            Gr.DrawRectangle(Pens.Black, X + 5, Y + 25, W, H)
            'Gr.DrawString(Pole(row, col), Me.Font, Brushes.Blue, X + 15, Y + 40)
            'MsgBox("строка " & row & vbCrLf & "столбец " & col & vbCrLf & "Pole " & Pole(row, col))
            Exit Sub
        ElseIf status = 2 And Pole(row, col) = 209 Then 'показываем все мины 
            Gr.FillRectangle(Brushes.Gray, X + 5, Y + 25, W, H)
            Gr.DrawRectangle(Pens.DarkGray, X + 5, Y + 25, W, H)
            Call Mina(X, Y)
            Exit Sub
        End If
 
        Select Case Pole(row, col) ' идет игра
            Case Is = 9 'закрываем клетку (убираем "правильный" флаг) 
                Gr.FillRectangle(Brushes.DarkBlue, X + 5, Y + 25, W, H)
                Gr.DrawRectangle(Pens.Black, X + 5, Y + 25, W, H)
                'Gr.DrawString(Pole(row, col), Me.Font, Brushes.Blue, X + 15, Y + 40)
                nFlag = nFlag - 1 : nMin = nMin - 1
                Me.Text = "Сапер. Обнаружено мин: " & nMin & " из " & KM
                Exit Select
            Case Is < 100 'закрываем клетку (убираем флаг) 
                Gr.FillRectangle(Brushes.DarkBlue, X + 5, Y + 25, W, H)
                Gr.DrawRectangle(Pens.Black, X + 5, Y + 25, W, H)
                'Gr.DrawString(Pole(row, col), Me.Font, Brushes.Blue, X + 15, Y + 40)
                nFlag = nFlag - 1
            Case Is = 100 ' клетка открывается, в соседних клетках мин нет 
                Gr.FillRectangle(Brushes.Gray, X + 5, Y + 25, W, H)
                Gr.DrawRectangle(Pens.DarkGray, X + 5, Y + 25, W, H)
                Exit Sub
            Case 101 To 108 ' клетка открывается, в соседних клетках мины есть  
                Gr.FillRectangle(Brushes.Gray, X + 5, Y + 25, W, H)
                Gr.DrawRectangle(Pens.DarkGray, X + 5, Y + 25, W, H)
                ' вывод количества мин в соседних клетках
                Gr.DrawString(Int(Pole(row, col)) - 100, Me.Font, Brushes.Blue, X + 15, Y + 40)
                Exit Sub
            Case Is = 109 ' на этой мине подорвались
                Gr.FillRectangle(Brushes.Red, X + 5, Y + 25, W, H)
                Gr.DrawRectangle(Pens.Black, X + 5, Y + 25, W, H)
                Call Mina(X, Y)
            Case Is = 209 'ставим "правильный" флаг в клетку
                nMin = nMin + 1
                nFlag = nFlag + 1
                Call Flag(X, Y)
                Me.Text = "Сапер. Обнаружено мин: " & nMin & " из " & KM
                Exit Select
            Case 200 To 208 'ставим флаг в клетку
                nFlag = nFlag + 1
                Call Flag(X, Y)
        End Select
    End Sub
    Sub ShowPole(ByVal status As Integer) ' процедура выводит поле
        Dim row As Integer, col As Integer
        For row = 1 To KV
            For col = 1 To KG
                Call Kletka(row, col, status)
            Next col
        Next row
    End Sub
    Sub n_open(ByVal row As Integer, ByVal col As Integer)
        'процедура открывает текущую и все соседние клетки, в которых нет мин 
        If Pole(row, col) = 0 Then
            Pole(row, col) = 100
            Call Kletka(row, col, 1)
            ' примыкающие клетки по вертикали и горизонтали
            Call n_open(row, col - 1)
            Call n_open(row - 1, col)
            Call n_open(row, col + 1)
            Call n_open(row + 1, col)
            ' примыкающие диагонально
            Call n_open(row - 1, col - 1)
            Call n_open(row - 1, col + 1)
            Call n_open(row + 1, col - 1)
            Call n_open(row + 1, col + 1)
        Else
            If (Pole(row, col) < 100) And (Pole(row, col) <> -3) Then
                Pole(row, col) = Pole(row, col) + 100
                Call Kletka(row, col, 1)
            End If
        End If
    End Sub
    Sub newGame() ' процедура генерирует новое игровое поле 
        Dim row, col As Integer  ' координаты клетки
        Dim n As Integer    ' количество поставленных мин
        Dim k As Integer    ' количество мин в соседних клетках
        ' очистка игрового поля 
        For row = 1 To KV
            For col = 1 To KG
                Pole(row, col) = 0
            Next col
        Next (row)
        ' расстановка мин
        Randomize()   '
        n = 0    ' количество мин
        Do
            row = Int((KV * Rnd()) + 1)
            col = Int((KG * Rnd()) + 1)
            If (Pole(row, col) <> 9) Then
                Pole(row, col) = 9
                n = n + 1
            End If
        Loop Until (n = KM)
        ' вычисление количества мин в соседних клетках для каждой клетки 
        For row = 1 To KV
            For col = 1 To KG
                If Pole(row, col) = 9 Then ' т.е., если мина в клетке 
                    k = 9
                Else
                    k = 0
                    If Pole(row - 1, col - 1) = 9 Then k += 1
                    If Pole(row - 1, col) = 9 Then k += 1
                    If Pole(row - 1, col + 1) = 9 Then k += 1
                    If Pole(row, col - 1) = 9 Then k += 1
                    If Pole(row, col + 1) = 9 Then k += 1
                    If Pole(row + 1, col - 1) = 9 Then k += 1
                    If Pole(row + 1, col) = 9 Then k += 1
                    If Pole(row + 1, col + 1) = 9 Then k += 1
                End If
                Pole(row, col) = k
            Next col
        Next row
 
        status = 0  ' начало игры
        nMin = 0    ' нет обнаруженных мин
        nFlag = 0   ' нет поставленных флагов
        Me.Text = "Саперрррр"
    End Sub
    Sub Flag(ByVal X As Integer, ByVal Y As Integer) ' процедура выводит флаг
        Dim Gr As Graphics = Me.CreateGraphics
        Dim Флаг As Image = Image.FromFile("1.jpg")
        Dim pnt As New Point(X + 5, Y + 25)
        Gr.DrawImage(Флаг, pnt)
        'граница клетки
        'Gr.DrawRectangle(Pens.Brown, X + 5, Y + 25, W, H)
    End Sub
    Sub Mina(ByVal X As Integer, ByVal Y As Integer) ' процедура выводит мину 
        Dim Gr As Graphics = Me.CreateGraphics
        Dim Мина As Image = Image.FromFile("2.jpg")
        Dim pnt As New Point(X + 9, Y + 30)
        Gr.DrawImage(Мина, pnt)
        'граница клетки
        'Gr.DrawRectangle(Pens.Brown, X + 5, Y + 25, W, H)
    End Sub
    Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
        Dim row As Integer, col As Integer
        If status = 2 Then Exit Sub ' игра завершена
        If status = 0 Then status = 1 ' первый щелчок
        ' преобразование координат мыши в индексы клетки поля
        row = Int(e.Y / H)
        col = Int(e.X / W) + 1
        ' нажатие левой кнопки мыши
        If e.Button = MouseButtons.Left Then
            If Pole(row, col) = 9 Then
                MessageBox.Show("BOOM!!!!!", "Сапер", _
                                    MessageBoxButtons.OK, MessageBoxIcon.Stop)
                'открываем клетку, в которой есть мина
                Pole(row, col) = 109
                status = 2   ' игра закончена
                Call Kletka(row, col, 2)
            Else
                If Pole(row, col) < 9 Then Call n_open(row, col) ' открытие клеток 
            End If
        End If
 
        ' нажатие правой кнопки мыши 
        If e.Button = MouseButtons.Right Then
            If Pole(row, col) >= 200 Then 'в клетке стоит флаг, пользователь хочет его убрать 
                Pole(row, col) = Pole(row, col) - 200
                Call Kletka(row, col, status) 'убираем флаг
            Else 'в клетке нет флага, а пользователь хочет его поставить
                ' если клетка открыта, то флаг нельзя поставить, если клетка закрыта - можно
                If Pole(row, col) >= 100 Then
                    MessageBox.Show("Нельзя поставить флаг в открытую клетку.", "Ставим флаги", _
                                    MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
                    Exit Sub
                End If
                Pole(row, col) = Pole(row, col) + 200   'установка флага
                Call Kletka(row, col, status)  ' рисуем флаг
                ' если все флаги расставлены на правильных местах
                If (nMin = KM) And (nFlag = KM) Then
                    status = 2  ' игра закончена
                    MessageBox.Show("Поздравления! Поле разминировано!", "Конец", _
                                    MessageBoxButtons.OK, MessageBoxIcon.Information)
                    Call ShowPole(status)   ' вывод поля
                End If
            End If
        End If
    End Sub
    Private Sub НоваяИграToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles НоваяИграToolStripMenuItem.Click
        ' выбор пункта меню "Игра - новая" 
        Call newGame()          ' новая игра
        Call ShowPole(status)   ' вывод игрового поля
    End Sub
    Private Sub ОПрограммеToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ОПрограммеToolStripMenuItem.Click
        MenuStrip1.Show() '"Справка - о программе" 
        Form2.Show()
    End Sub
    Private Sub ВыходToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ВыходToolStripMenuItem.Click
        Me.Close() '"Игра - выход" 
    End Sub
    Private Sub ПомощьToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ПомощьToolStripMenuItem.Click
        MenuStrip1.Show() '"Помощь" 
        Помощь.Show()
 
    End Sub
End Class
Основное все здесь.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
07.06.2012, 18:58
Помогаю со студенческими работами здесь

Картинка не встает в html
Здравствуйте! Помогите пожалуйста! Вот код &lt;head&gt; &lt;html&gt; &lt;title&gt;Training Create Pics &lt;/title&gt; &lt;/head&gt; &lt;body&gt; ...

Картинка-фоном нормально не встаёт
Нужно картинку прижать к нижнему левому краю окна и сделать фиксированной вот только при указании фиксированной позиции она уходит под...

сма EWT 1066 TDW Prod № 913101359, на всех режимах при запуске встаёт на паузу, без обозначения кода ошибки
Уважаемые форумчане, столкнулся со следующей проблемой: Перестала запускаться сма Electrolux EWT 1066 TDW Prod № 913101359, после...

в чем ошибки?как исправить?
в чем ошибки #include &lt;conio.h&gt; #include &lt;iostream&gt; #include &lt;math.h&gt; #include &lt;stdlib.h&gt; #include &lt;locale.h&gt; using namespace...

С чем связаны ошибки, как исправить?
Вроде делал все по методичке, адрес к базе данных задал свой, но выдает ошибки Вот код для кнопки записать _ Private Sub...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
Новые блоги и статьи
SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий
8Observer8 02.03.2026
Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11680&amp;d=1772460536 Одним из. . .
Реалии
Hrethgir 01.03.2026
Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .
Ритм жизни
kumehtar 27.02.2026
Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .
SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten
8Observer8 27.02.2026
Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами
8Observer8 20.02.2026
Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .
Конвертировать закладки radiotray-ng в m3u-плейлист
damix 19.02.2026
Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .
Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI
Eddy_Em 18.02.2026
Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .
Камера Toupcam IUA500KMA
Eddy_Em 12.02.2026
Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru