powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Пятнашки - двигать на несколько костей
25 сообщений из 45, страница 1 из 2
Пятнашки - двигать на несколько костей
    #37776660
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Здравствуйте, есть проект пятнашки, его прилагаю, как сделать, чтобы после нажатия на любой номер пятнашки мышью в случае если есть возможность вверх вниз вправо влево двигались 2, 3 или 4 кости пятнашки, если нет возможности - сигнал, спасибо
То есть чтобы не по одной двигать
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37776661
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
сорри двигать сразу четыре кости это перебор....
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37776669
Фотография BelowZero
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
катастрофа,

т.е. 4? у тебя даже 2 одновременно двигаться не смогут)
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37776673
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BelowZero,
не понял это Ваш вопрос или утверждение?
мне нужно, чтобы любой номер пятнашки мышью в случае если есть возможность вверх вниз вправо влево двигались 2 или 3 кости пятнашки
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37776675
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
>даже 2 одновременно двигаться не смогут
человек он не только царь зверей... надо чтобы смогли
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37776678
Фотография BelowZero
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
катастрофа,

а... понял, что ты хочешь сделать. если на одной строке или одном столбце - да - можно. не смотрел код, но это будет выглядеть примерно так: проверяешь, что пустой квадратик в той же строке или столбце с нажатым квадратиком. если да, то имитируешь нажатие на квадратик, находящийся между нажатым и пустым. это для двух перемещений сразу. для 3 аналогично
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37776680
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BelowZero, ухты, так и я могу ответить почти на любой вопрос, сможете в коде поправить? буду признателен
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37776718
Фотография BelowZero
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
катастрофа,

код у тя ппц) для такой простой задачи раз в 5 больше, чем должен быть) принцип я написал: ты же определяеш, что нажатая кнопка рядом с картинкой? так же определи, что если они не рядом, нов одном столбце или строке, то нужно симитировать нажатие кнопки, находящейся между нажатой и картинкой. затем имитация кнопки, на которую нажали изнавчально
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37776741
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BelowZero, код не мой, время есть решил глянуть, но ранее запускался проект, сейчас просит smartbutton.ocx, обыскался и в инете, не нашёл, у кого есть?
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37776746
Фотография BelowZero
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
катастрофа,

т.е. код не твой. а значит он тебе наф не сдался. так что ты даже не знал, что у тебя нет нужной dll... и ты решил попросить написать для тебя код для хз какого проекта?) умно... я б так не смог)
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37776753
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BelowZero, всё правда, кроме
>для хз какого проекта
проект известен 15-ки
и писать код не нужно, его надо подправить
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37777203
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ну вот представляю проект без ОСХ, как тут двигать:

Код: vbnet
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.
Const H = 4, W = 4                  ' размер поля - 4х4
Const CH = 50, CW = 50              ' размер клетки - 50x50

Dim stp(1 To W, 1 To H) As Integer  ' правильное расположение
                                    ' фишек
Dim pole(1 To W, 1 To H) As Integer ' игровое поле
Dim ex As Integer, ey As Integer    ' координаты пустой клетки

' новая игра
Sub newGame()

   For i = 1 To W Step 1
      For j = 1 To H Step 1
         ' правильное расположение фишек
         stp(i, j) = (i - 1) * W + j
         pole(i, j) = stp(i, j)
      Next j
   Next i

   stp(W, H) = 0
   
   ' перемешивание фишек и вывод поля
   Call mixer
   Call showPole
End Sub

' вывод игрового поля
Sub showPole()

   Dim i As Integer, j As Integer
   Dim X As Integer, Y As Integer   ' x,y - координаты вывода
                                    ' текста в клетке
   
   ' очистка поля от предыдущего хода
   Form1.Cls
   
   ' сетка: вертикальные линии
   For i = 1 To (W - 1)
      Line (i * CW, 0)-(i * CW, CH * H)
   Next i
    
   ' сетка: горизонтальные линии
   For i = 1 To (H - 1)
      Line (0, i * CH)-(CW * W, i * CH)
   Next i
      
   ' содержимое клеток (цифры фишек)
   For i = 1 To H
      Y = (i - 1) * CH + 18
      For j = 1 To W
            X = (j - 1) * CW + 18
            Select Case pole(i, j)
               Case 0:
               Case 1 To 9:
                  CurrentX = X
                  CurrentY = Y
                  Print " " + Format(pole(i, j))
               Case 10 To 15:
                  CurrentX = X
                  CurrentY = Y
                  Print Format(pole(i, j))
            End Select
      Next j
   Next i

End Sub

' функция проверяет, расположены ли фишки в нужном порядке
Function Finish() As Boolean
   Dim row As Integer, col As Integer
   ' координаты фишки
   
   row = 1
   col = 1
   Finish = True    ' пусть фишки расположены в нужном порядке

   For i = 1 To (W * H - 1)
      If pole(row, col) <> i Then
         Finish = False
         Exit Function
      End If

      ' к следующей клетке
      If col < W Then
         col = col + 1
      Else
         col = 1
         row = row + 1
      End If
   Next i
   
End Function

' процедура '"перемешивает" фишки
Sub mixer()
   Dim x1 As Integer, y1 As Integer ' координаты пустой фишки
   Dim x2 As Integer, y2 As Integer ' координаты фишки,
                                    ' перемещаемой на место
                                    ' пустой
   Dim d As Integer                 ' направление перемещения,
                                    ' относительно пустой
                                    ' фишки
   x1 = W
   y1 = H
   
   For i = 1 To W * H * 10 Step 1
      Do
         x2 = x1
         y2 = y1
         d = Int((Rnd * W) + 1)     ' предполагается, что поле
                                    ' квадратное
         Select Case d
            Case 1: x2 = x2 + 1
            Case 2: x2 = x2 - 1
            Case 3: y2 = y2 + 1
            Case 4: y2 = y2 - 1
         End Select

      Loop Until (x2 >= 1) And (x2 <= W) And _
                 (y2 >= 1) And (y2 <= H)
    
      pole(y1, x1) = pole(y2, x2)
      pole(y2, x2) = 0

      x1 = x2
      y1 = y2
   Next i
   
   ' запоминание координаты пустой клетки
   ex = x1
   ey = y1
End Sub

' процедура "перемещает" фишку в соседнюю пустую клетку, если
' она есть, конечно
Sub fMove(cx As Integer, cy As Integer)
   ' cx, cy - клетка, в которой игрок сделал щелчок

   ' проверка возможности обмена
   If Not ((Abs(cx - ex) = 1) And (cy - ey = 0) Or _
           (Abs(cy - ey) = 1) And (cx - ex = 0)) Then Exit Sub

   ' обмен: перемещение фишки из (x, y) в (ex, ey)
   pole(ey, ex) = pole(cy, cx)
   pole(cy, cx) = 0
   ex = cx
   ey = cy
    
   ' вывод поля
   Call showPole
   
   If Finish = True Then
      y_n = MsgBox("Цель достигнута!" + Chr(13) + _
                   "Еше раз?", vbYesNo, "Игра 15")
      If y_n = vbYes Then Call newGame      ' новая игра
      If y_n = vbNo Then Unload Form1       ' завершение
                                            ' работы программы
   End If

End Sub

' инициализация формы
Private Sub Form_Initialize()
   Form1.Width = (Form1.Width - Form1.ScaleWidth) + _
                 (CW * W) * Screen.TwipsPerPixelX
   Form1.Height = (Form1.Height - Form1.ScaleHeight) + _
                  (CH * H) * Screen.TwipsPerPixelY
   Form1.Font.Size = 10
   Form1.ScaleMode = 3
   
   Randomize
   Call newGame
End Sub

' щелчок мышки на форме
Private Sub Form_MouseDown(Button As Integer, _
   Shift As Integer, X As Single, Y As Single)
   ' X, Y - координаты щелчка

   Dim cx As Integer, cy As Integer     ' координаты клетки

   ' преобразуем щелчок в координаты клетки
   cx = Int(X / CW) + 1
   cy = Int(Y / CH) + 1

   Call fMove(cx, cy)
End Sub

' обработка события Paint
Private Sub Form_Paint()
   Call showPole
End Sub

...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37777208
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
сам проект
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37777308
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
это
Код: vbnet
1.
2.
3.
'проверка возможности обмена
If Not ((Abs(cx - ex) = 1) And (cy - ey = 0) Or _
           (Abs(cy - ey) = 1) And (cx - ex = 0)) Then Exit Sub


корректировать нужно
для меня конечно пошагово в конце функции showPole поставил MsgBox$ "Готово"
чтобы потом нажать любую кнопку и пройти по шагам, но почему после вывода сообщения "Готово" поле отображается без костей?
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37777668
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
катастрофано почему после вывода сообщения "Готово" поле отображается без костей?потому что странный автор этой программы не поставил свойство Form1.AutoRedraw=True. Вместо этого он использует ненужную конструкцию
Код: vbnet
1.
2.
3.
Private Sub Form_Paint()
   Call showPole
End Sub


хотелось бы, чтобы только незнание про AutoRedraw мешало тебе проанализировать эту программу.... эх, мечты... мечты...

Модератор: а простыни кода не забывай убирать под спойлер, в следующий раз выгоню из класса
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37777675
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Shocker.Pro, ОК, поставил Form1.AutoRedraw=True
удалил всю процедуру и любые упоминания о showPole - и нету цифирок
??
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37777686
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
катастрофаи любые упоминания о showPoleзаставь дурака богу молиться...
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37781220
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
здравствуйте, проверку сделал, так и не знаю как менять несколько костей сразу, попробовал тупо как для одной клетки, но есстественно облом, меняет просто местами, как же двигать две или три кости сразу?
Код: vbnet
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.
'перемещение 1 фишки
    If Cheng1 = True Then
        'обмен: перемещение 1 фишки из (x, y) в (ex, ey)
        pole(ey, ex) = pole(cy, cx)
        pole(cy, cx) = 0
        ex = cx
        ey = cy

        'перемещение 2 фишек
    ElseIf Cheng2 = True Then
        pole(ey, ex) = pole(cy, cx)
        pole(cy, cx) = 0
        ex = cx
        ey = cy

        'перемещение 3 фишек
    ElseIf Cheng3 = True Then
        pole(ey, ex) = pole(cy, cx)
        pole(cy, cx) = 0
        ex = cx
        ey = cy

    Else
        'звук сигнала, когда обмен не возможен
        Beep
        Exit Sub
    End If
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37781298
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А подключить верхнюю часть организма - тяжко?
Какой элсэиф? - получается в результате - кэйс...
Что и с чем вы меняете? Где пустое поле, а где фишки?
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37781407
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AndreTM, в том то и загвоздка, когда нужно передвинуть две или три кости, это уже прямоугольник получится и не до конца понимаю предназначение строк при замене одной фишки
Код: vbnet
1.
2.
3.
4.
pole(ey, ex) = pole(cy, cx)
        pole(cy, cx) = 0
        ex = cx
        ey = cy


почему их так много?
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37781430
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
я про то, что если нужно передвинуть три или две ячейки как их подвинуть по одной я предствляю, а можно? и как передвинуть сразу две или кости
Код: vbnet
1.
2.
'ex, ey - координаты пустой клетки
'cx, cy - координаты клетки куда пользователь щёлкнул
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37781434
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
а можно? и как? передвинуть сразу две или ири кости
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37782260
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
катастрофа
Код: vbnet
1.
2.
'ex, ey - координаты пустой клетки
'cx, cy - координаты клетки куда пользователь щёлкнул

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
If ex = cx Or ey = cy And Not(ex = cx And ey = cy) Then
    dx = Sign(cx - ex)
    dy = Sign(cy - ey)
    While Not(ex = cx And ey = cy)
        pole(ey, ex) = pole(ey + dy, ex + dx)
        pole(ey + dy, ex + dx) = 0
        ex = ex + dx
        ey = ey + dy
    Wend
Else
    ' звук сигнала, когда обмен не возможен
    Beep
    Exit Sub
End If
...
Function Sign(a As Integer) As Integer
    Sign = IIf(a > 0, 1, IIf(a < 0, -1, 0))
End Function
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37782263
vasatka
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ЦЭ , ну вот сделал, чтобы двигались по 2-3 фишки, но в это же невозможно играть!
Сам попробуй.
...
Рейтинг: 0 / 0
Пятнашки - двигать на несколько костей
    #37782334
Фотография BelowZero
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
vasatka,

ахахах ему не это было нужно)))
...
Рейтинг: 0 / 0
25 сообщений из 45, страница 1 из 2
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Пятнашки - двигать на несколько костей
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]