< [ на главную ]

  Игра "Пройди лабиринт" на 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
< [ на главную ]




Hosted by uCoz