Игра "Пройди лабиринт" на Gambas-е !
|
Эта достаточно простая игра написана
на языке Gambas и может рассматриваться как дополнение ко встроенным в
сам язык примерам. Лабиринт для этой игры создан в конструкторе
лабиринтов (смотри статью в этом разделе). После успешного прохождения
лабиринта программа проинформирует сколько времени
(минуты/секунды) вы убили на это безобразие. Исходники, как всегда прилагаются : LabirintGame2D01.tar.gz Распаковываем и запускаем в Gambas-е, видим нечто подобное (в зависимости от настройки шрифтов Qt3): Как видите на форме нет всяких
"кнопочек", это связанно с тем ,что в программе используются курсорные
клавиши для перемещения по игровому полю (при наличии кнопок стрелки
курсора к ним намертво прилипают).
Основной процедурой программы является Form_KeyPress() ,которая в зависимости от нажатых клавиш вызывает соответствующие им процедуры. На самом деле все достаточно просто, половина процедур взята из конструктора лабиринтов ,поэтому объяснять ничего не буду если есть вопросы, спрашивайте в гостевой или пишите на mail kostyalamer@yandex.ru . Для тех, кому интересно код программы:
' Gambas class file
PUBLIC i AS Integer PUBLIC j AS Integer PUBLIC xcur AS Integer PUBLIC ycur AS Integer lab[40, 34] AS Integer PUBLIC FileSize AS Integer ' Bytes PUBLIC rejim AS Integer = 0 'Режим работы редактора PUBLIC vhx AS Integer = 0 'координаты входа PUBLIC vhy AS Integer = 33 PUBLIC vihx AS Integer = 39 'координаты выхода PUBLIC vihy AS Integer = 0 PUBLIC bufvhod AS Integer = 0 PUBLIC bufvihod AS Integer = 0 PUBLIC help AS Integer = 1 PUBLIC xs AS Integer PUBLIC ys AS Integer PUBLIC xsold AS Integer PUBLIC ysold AS Integer PUBLIC t1 AS Integer PUBLIC t2 AS Integer PUBLIC tt AS Integer PUBLIC ts AS Integer PUBLIC tm AS Integer PUBLIC SUB _new() Zero END PUBLIC SUB Form_Open() FMain.Height = 760 FMain.Width = 819 Lab1.x = 8 Lab2.x = 0 Lab1.y = 693 DrA1.Height = 681 DrA1.Width = 801 Lab1.Width = DrA1.Width lab2.Width = DrA1.Width Lab2.Visible = FALSE Load Setka Scaner Setcurs DrA1.SetFocus() t1 = Time PRINT Time tt = 1 Timer1.Enabled = TRUE 'Kontrol 'PRINT Key.Control END PUBLIC SUB Form_KeyPress() IF Key.Code = Key.Escape THEN ME.Close SELECT CASE Key.Code CASE Key.Space Form_Open CASE Key.Left IF xs > 0 THEN xs = xs - 1 CASE Key.Right IF xs < 39 THEN xs = xs + 1 CASE Key.Up IF ys > 0 THEN ys = ys - 1 CASE Key.Down IF ys < 33 THEN ys = ys + 1 CASE Key.Tab Load_Lab() END SELECT IF lab[xs, ys] <> 1 THEN SetPole Setcurs ELSE xs = xsold ys = ysold ENDIF IF lab[xs, ys] = 3 THEN Victory END PUBLIC SUB Victory() Timer1.Stop tm = tt \ 60 ts = tt MOD 60 Lab2.Text = "Вы прошли лабиринт за " & tm & "м. " & ts & " c." Lab2.Visible = TRUE END PUBLIC SUB Setka() 'создает новое игровое поле DIM x1, x2, y1, y2, i, j AS Integer DrA1.Clear() DrA1.Visible = TRUE Draw.Begin(DrA1) FOR i = 0 TO 800 STEP 20 Draw.Line(i, 0, i, 680) NEXT FOR j = 0 TO 800 STEP 20 Draw.Line(0, j, 800, j) NEXT Draw.End END PUBLIC SUB Zero() 'обнуление массива лабиринта DIM i AS Integer DIM j AS Integer FOR i = 0 TO 39 FOR j = 0 TO 33 lab[i, j] = 0 NEXT NEXT END PUBLIC SUB Load() DIM q AS Integer DIM i AS Integer DIM j AS Integer DIM hFile AS File IF help = 0 THEN RETURN 'IF Dialog.OpenFile() THEN RETURN hFile = OPEN "labirint01" FOR READ FileSize = Stat("labirint01").Size IF FileSize <> 5440 THEN RETURN 'неправильная длина файла SEEK #hFile, 0 FOR i = 0 TO 39 FOR j = 0 TO 33 READ #hFile, lab[i, j] IF lab[i, j] = 2 THEN xs = i ys = j xsold = i ysold = j ELSE ENDIF NEXT NEXT CLOSE #hFile END PUBLIC SUB Setcurs() Draw.Begin(DrA1) Draw.FillColor = Color.DarkMagenta Draw.ForeColor = Color.DarkMagenta Draw.FillStyle = Fill.Solid Draw.Rect(((xs * 20) + 2), ((ys * 20) + 2), 17, 17) Draw.End xsold = xs ysold = ys END PUBLIC SUB SetPole() Draw.Begin(DrA1) Draw.FillColor = Color.White Draw.ForeColor = Color.White Draw.FillStyle = Fill.Solid Draw.Rect(((xsold * 20) + 2), ((ysold * 20) + 2), 17, 17) Draw.End END PUBLIC SUB Load_Lab() DIM q AS Integer DIM i AS Integer DIM j AS Integer DIM hFile AS File IF help = 0 THEN RETURN IF Dialog.OpenFile() THEN RETURN hFile = OPEN Dialog.Path FOR READ FileSize = Stat(Dialog.Path).Size IF FileSize <> 5440 THEN RETURN 'неправильная длина файла SEEK #hFile, 0 FOR i = 0 TO 39 FOR j = 0 TO 33 READ #hFile, lab[i, j] IF lab[i, j] = 2 THEN xs = i ys = j xsold = i ysold = j ELSE ENDIF NEXT NEXT CLOSE #hFile Setka Scaner END PUBLIC SUB Scaner() 'рисует лабиринт из массива DIM i AS Integer DIM j AS Integer Draw.Begin(DrA1) Draw.FillStyle = Fill.Solid FOR i = 0 TO 39 FOR j = 0 TO 33 SELECT CASE lab[i, j] CASE 1 Draw.FillColor = Color.DarkGray Draw.ForeColor = Color.DarkGray CASE 0 Draw.FillColor = Color.TextBackground Draw.ForeColor = Color.TextBackground CASE 2 Draw.FillColor = Color.DarkGreen Draw.ForeColor = Color.DarkGreen vhx = i vhy = j CASE 3 Draw.FillColor = Color.DarkRed Draw.ForeColor = Color.DarkRed vihx = i vihy = j END SELECT Draw.Rect(((i * 20) + 2), ((j * 20) + 2), 17, 17) NEXT NEXT Draw.End END PUBLIC SUB New_Game() IF help = 0 THEN RETURN Zero Form_Open END PUBLIC SUB Timer1_Timer() tt = tt + 1 END |
kostyalamer 09.06.2009 < [ на главную ] |