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

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

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

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

т.е. код не твой. а значит он тебе наф не сдался. так что ты даже не знал, что у тебя нет нужной dll... и ты решил попросить написать для тебя код для хз какого проекта?) умно... я б так не смог)
...
Рейтинг: 0 / 0
29.04.2012, 14:54
    #37776753
катастрофа
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пятнашки - двигать на несколько костей
BelowZero, всё правда, кроме
>для хз какого проекта
проект известен 15-ки
и писать код не нужно, его надо подправить
...
Рейтинг: 0 / 0
30.04.2012, 08:38
    #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
30.04.2012, 08:41
    #37777208
катастрофа
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пятнашки - двигать на несколько костей
сам проект
...
Рейтинг: 0 / 0
30.04.2012, 11:54
    #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
30.04.2012, 20:08
    #37777668
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пятнашки - двигать на несколько костей
катастрофано почему после вывода сообщения "Готово" поле отображается без костей?потому что странный автор этой программы не поставил свойство Form1.AutoRedraw=True. Вместо этого он использует ненужную конструкцию
Код: vbnet
1.
2.
3.
Private Sub Form_Paint()
   Call showPole
End Sub


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

Модератор: а простыни кода не забывай убирать под спойлер, в следующий раз выгоню из класса
...
Рейтинг: 0 / 0
30.04.2012, 20:19
    #37777675
катастрофа
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пятнашки - двигать на несколько костей
Shocker.Pro, ОК, поставил Form1.AutoRedraw=True
удалил всю процедуру и любые упоминания о showPole - и нету цифирок
??
...
Рейтинг: 0 / 0
30.04.2012, 20:32
    #37777686
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пятнашки - двигать на несколько костей
катастрофаи любые упоминания о showPoleзаставь дурака богу молиться...
...
Рейтинг: 0 / 0
03.05.2012, 20:59
    #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
03.05.2012, 23:06
    #37781298
AndreTM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пятнашки - двигать на несколько костей
А подключить верхнюю часть организма - тяжко?
Какой элсэиф? - получается в результате - кэйс...
Что и с чем вы меняете? Где пустое поле, а где фишки?
...
Рейтинг: 0 / 0
04.05.2012, 04:55
    #37781407
катастрофа
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пятнашки - двигать на несколько костей
AndreTM, в том то и загвоздка, когда нужно передвинуть две или три кости, это уже прямоугольник получится и не до конца понимаю предназначение строк при замене одной фишки
Код: vbnet
1.
2.
3.
4.
pole(ey, ex) = pole(cy, cx)
        pole(cy, cx) = 0
        ex = cx
        ey = cy


почему их так много?
...
Рейтинг: 0 / 0
04.05.2012, 06:34
    #37781430
катастрофа
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пятнашки - двигать на несколько костей
я про то, что если нужно передвинуть три или две ячейки как их подвинуть по одной я предствляю, а можно? и как передвинуть сразу две или кости
Код: vbnet
1.
2.
'ex, ey - координаты пустой клетки
'cx, cy - координаты клетки куда пользователь щёлкнул
...
Рейтинг: 0 / 0
04.05.2012, 06:50
    #37781434
катастрофа
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пятнашки - двигать на несколько костей
а можно? и как? передвинуть сразу две или ири кости
...
Рейтинг: 0 / 0
04.05.2012, 15:36
    #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
04.05.2012, 15:36
    #37782263
vasatka
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пятнашки - двигать на несколько костей
ЦЭ , ну вот сделал, чтобы двигались по 2-3 фишки, но в это же невозможно играть!
Сам попробуй.
...
Рейтинг: 0 / 0
04.05.2012, 16:01
    #37782334
BelowZero
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пятнашки - двигать на несколько костей
vasatka,

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


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