Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

vbSokoban: Hajde da napravimo igru!

[es] :: Visual Basic 6 :: vbSokoban: Hajde da napravimo igru!

Strane: 1 2

[ Pregleda: 12519 | Odgovora: 38 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon vbSokoban: Hajde da napravimo igru!02.11.2006. u 22:38 - pre 185 meseci
vbSokoban: Hajde da napravimo igru!

VAŽNO: ovo nije još jedan od pokušaja da se na forumu okupi grupa ljudi koja bi
zajedno učestvovala u izradi nekog projekta! Već je ovo jedan mali tutorijal namenjen
ljudima koji bi želeli da nauče kako se prave igre u Visual Basicu.

[Ovu poruku je menjao krckoorascic dana 03.11.2006. u 00:24 GMT+1]
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 22:39 - pre 185 meseci
Uvod:
Kao što rekoh ovo je tutorijal o pravljenju igara. Zajedno ćemo napraviti jednu verziju
popularne Sokoban igre, ja ću je zvati vbSokoban (ukoliko imate neko originalnije ime,
možete tako nazvati svoju kreaciju). Pošto možda ima nekoga među vama, čitaocima, koji
nikad nisu igrali neku verziju Sokobana (ili su igrali a nisu znali da je to ustvari
samo jedna od kopija ove igre) ukratko ću pojasniti o čemu se radi u ovoj igri:

Vi se nalazite u jednom lavirintu iz koga nema izlaska i vaš zadatak je da kutije koje
se nalaze u tom lavirintu složite na označena mesta. Iako ovo zvuči jednostavno i dosadno
upravo je suprotno: komplikovano i zanimljivo! Pravila su da se kutija može gurati samo u
smeru "od sebe" tj ne možete vući kutiju krećući se u nazad, možete gurati samo kutiju koja
ispred sebe (u smeru u kome je gurate) nema ni zid ni neku drugu kutiju. Upravo su ova
pravila i posebno oblikovani nivoi (izgledi lavirnta i raspored kutija i ciljnih mesta)
ono zbog čega je ova igra zanimljiva i zbog čega postoji ogroman broj klonova i rimejkova
ove igre.

Dakle sada kada znamo šta ćemo da pravimo neko može da postavi pitanje zašto sam baš odabrao
Sokoban za ovaj tutorial. Odgovor je da je Sokoban veoma lak za programiranje i samim tim
pogodan za prve korake ka svetu programiranja igara. Lakše je iskodirati Sokoban nego, recimo
Pong, iz razloga što kod Ponga moramo da vodimo računa i o uglu odbijanja loptice i o ubrzanju
koje loptica dobija kada udari u ivicu reketa i sl. Kod Sokobana nema ni fizike ni matematike
(sem sabiranja i oduzimanja ) već samo obično kretanje (gore, dole, levo, desno), i kod Ponga
bi morali da imamo petlju (tzv "Game Loop") u kojoj bi se odigravala logika igre (proračuni
kretanja lopte i reketa) i iscrtavali frejmovi, kod Sokobana nema takve dinamičnosti već svu
logiku koju treba da primenimo (a to je samo da proverimo mogućnost kretanja u željenom pravcu i
pomeranja kutija) izvršavamo samo kada korisnik pritisne jedan od mogućih tastera, a za to nam
ne treba petlja već KeyDown događaj.

To bi bilo to o tome zašto pravimo Sokoban, a sada da vidimo kako ćemo da ga napravimo.

Pre nego što se počne sa izradom bilo kog programa, prvo mora da postoji algoritam,
odnosno prvo se problem dobro analizira i napravi se neki plan (algoritam) koji će
se posle pretočiti u pisani program. Važno je da shvatite da je svrha programiranja
dobro razumevanje problema i nalaženje pogodnog rešenja, a samo programiranje (tj
pisanje koda) je najlakši deo u celoj toj stvari.

Mi nećemo crtati algoritam (ono "početak->ulaz->obrada->izlaz->kraj") ali ćemo napraviti
analizu "problema" koji je pred nama.
Dakle, znamo šta je Sokoban i šta treba da napravimo, ono što naš Sokoban treba da ima je:

1. "Mehanizam" za učitavanje nivoa iz fajlova
2. Mehanizam za iscrtavanje nivoa (lavirnita, kutija i igrača)
3. Mehanizam za upravljanje igračem (tu spada i pomeranje kutija)

ok, nema mnogo tačaka

sada da se spremimo za rešavanje problema, tačku po tačku.
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 22:43 - pre 185 meseci
Priprema:
Prvo što treba da razmislimo to je kako ćemo da posmatramo nivo, tj lavirint i sve u njemu.
Najjednostavnije (i najlogičnije) je da lavirint posmatramo kao dvodimenzionalnu matricu, ili
tabelu sa redovima i kolonama. Sada se postavlja pitanje na koji način ćemo da čuvamo podatke o
nivou, odgovor sledi iz predhodne rečenice: matrica (matrica je višedimenzionalni niz, u našem
slučaju to je niz sa dve dimenzije), da bi znali šta da čuvamo u toj matrici moramo se prvo
podsetiti koji su sve "objekti" u pitanju:

imamo:
- zid, to je polje na koje igrač ne može da stane niti kutija može da se nalazi na tom polju
- prazno polje, tuda se zapravo igrač kreće i gura kutije
- ciljno mesto, tj tamo gde treba da se stavi kutija, ovo je ustvari isto kao prazno polje samo što ima neku oznaku
- kutiju, to je kutija koja se nalazi na praznom polju
- postavljenu kutiju, to je kutija na ciljnom mestu
- i na kraju imamo igrača, koji se kreće po praznim (i ciljnim) poljima

znači svako polje u našoj matrici će imati jednu od vrednosti koja označava šta se nalazi na tom polju:
- ZID
- POLJE
- CILJ
- KUTIJA
- ZGODITAK (ovo je kutija na ciljnom mestu )

u matrici nećemo čuvati podatak o tome gde se nalazi igrač jer je mnogo lakše da to
čuvamo u posebnoj promenljivoj, iz razloga što bi pre pomeranja igrača morali prvo
da tražimo u matrici njegovu trenutnu poziciju, a u slučaju da to čuvamo u posebnoj
promenljivoj uvek imamo podatke o njegovoj poziciji...

ok pre nego što konačno počnemo sa programiranjem moramo da imamo grafiku sa kojom ćemo da
radimo, sličice koje nam trebaju su:

- zid
- ciljno polje
- kutija
- kutija na ciljnom polju
- igrač

evo šta sam ja nacrtao:


(vbsokslicice.zip)

znam, odvratno je ali ja nisam mogao bolje Ukoliko vi imate malo većeg talenta od mene
možete koristiti vaše sličice, samo pazite da su sve veličine 40x40 pixela.
Prikačeni fajlovi
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 22:47 - pre 185 meseci
Izrada:
Konačno da počnemo sa pravljenjem igre!

Pokrenite VB i izaberite Standard EXE projekat. Form1 preimenujte u frmGame i podesite
joj ScaleMode property na 3 - Pixel.

Dodajte jedan PictureBox i nazovite ga picLevel. Podesite mu sledeća svojstva:
Appearance: 0 - Flat
AutoRedraw: True
BackColor: &H0042734A&
Enabled: False
ScaleMode: 3 - Pixel

u picLevel ćemo da isrtavamo naš nivo, i on bi trebao da bude uvek na sredini forme
(to ćemo sledeće da uradimo).
Napomena: ukoliko koristite vaše sličice, BackColor postavite na hex vrednost boje koja
je vama pozadina. Samo obratite pažnju na to da VB boje zapisuje u BGR obliku a ne u RGB
(kao photoshop recimo) tj ako je vaša boja pozadine u photoshopu FFCCAA u vb-u će to biti
&H00AACCFF& (a ne &H00FFCCAA&)!

Sada da centriramo picLevel na sredinu forme: kliknite dva puta na formu da bi vam se otvorio
Code View, u gornjem desnom comboboxu (gde sada piše Load) izaberite Resize i otkucajte
sledeće:
Code:

Private Sub Form_Resize()

    picLevel.Move (Me.ScaleWidth - picLevel.Width) / 2, _
                  (Me.ScaleHeight - picLevel.Height) / 2

End Sub

Sada pokrenite program (F5) i menjajte veličinu forme, videćete da je naš picLevel uvek na
sredini.

Sada ćemo da dodamo sličice na našu formu. Kopirajte picLevel i pritisnite Ctrl+V, kada vas
VB pita da li želite da napravite control array odgovorite mu sa No. Promenite ime Picture1
u picImage i podesite AutoSize na True, Visible na False, a za Picture postavite cilj.bmp (ili
vašu sličicu), kopirajte picImage i pritisnite Ctrl+V, sada odgovorite vb-u da hoćete da
napravite control array. Za picImage(1) postavite igrac.bmp kao Picture. Opet pritisnite Ctrl+V
(ali predhodno kliknite na formu, tj deselektujte picImage(1)) i sada za Picture postavite kutija.bmp
ponovite postupak za zgoditak.bmp i zid.bmp. Sada bi trebalo da imate 5 picImage objekata.

sada nam još treba tzv bafer (buffer) u koji ćemo da crtamo nivo sličicu-po-sličicu pa tek ceo frejm
kopiramo u picLevel (tako da nema tzv "flicker" efekta) iz bafera. Selektujte picLevel i kopirajte ga,
pritisnite Ctrl+V i odgovorite sa No, preimenujte Picture1 u picBuffer i podesite mu Visible na False.

evo kako meni izgleda forma:




ok, sada nam trebaju metode za crtanje, u ovu svrhu ćemo koristiti BitBlt API funkciju i to će biti
jedina API funkcija koju ćemo koristiti u našem projektu!

ona izgleda ovako:
Code:

Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
                                     ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

BitBlt (BitBlock) funkcija služi za kopiranje dela (ili cele) slike sa jednog mesta na drugo, i nju ćemo koristiti da iz picImage objekata
kopiramo sličice na određena mesta u picBuffer, kada iscrtamo sve (ceo frejm) onda ćemo sliku iz picBuffer-a prekopirati u picLevel.

Dodajte u projekat novi Modul (Project->Add Module) i nazovite ga modDraw, u njega ćemo da stavimo sav kod koji ima veze sa crtanjem.

za početak prepišite sledeći kod u modDraw:
Code:

Option Explicit

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Public Const CILJ       As Byte = 0
Public Const SMAJLI     As Byte = 1
Public Const KUTIJA     As Byte = 2
Public Const ZGODITAK   As Byte = 3
Public Const ZID        As Byte = 4

Public Const POLJE      As Byte = 5

Dakle prvo smo deklarisali BitBlt funkciju, zatim smo naveli neke konstante, ono što je
važno to je da se vrednost konstanti CILJ, SMAJLI, KUTIJA, ZGODITAK i ZID poklapaju sa
indexima picImage objekata tj picImage(0) ima sliku cilja, picImage(1) sliku igraca, itd...

Sada da napišemo funkciju koja će određenu sliku da nacrta na određenom mestu u baferu:
Code:

' ova funkcija crta odredjenu slicicu na odredjeno mesto u bafer
Public Sub DrawImage(ImageId As Byte, X As Long, Y As Long)

    ' crtamo sliku u bafer
    BitBlt frmGame.picBuffer.hDC, X, Y, 40, 40, _
           frmGame.picImage(ImageId).hDC, 0, 0, vbSrcCopy

End Sub

Dakle funkcija drawImage prima tri parametra, to su id sličice (CILJ, SMAJLI, KUTIJA,
ZGODITAK ili ZID), x i y pozicija na koju treba da "nalepimo" sličicu.
Za kopiranje sličice iz picImage-a u picBuffer koristimo BitBlt funkciju, prvi parametar
koji prosleđujemo BitBlt funkciji je hDC (Device Context Handle) onog PictureBox-a na koji
želimo da crtamo, to je picBuffer u našem slučaju. Zatim prosleđujemo informacije o
poziciji i veličini bloka (BitBlock transfer) koji želimo da isrtamo na taj DC, to su
X, Y, 40 i 40 (40 i 40 su W i H bloka koji kopiramo), zatim prosleđujemo hDC objekta sa kojeg
kopiramo, to je određeni picImage (ImageId određuje koji picImage je u pitanju), kada prosledimo
hDC izvora (picImage-a) moramo da odredimo sa koje pozicije će se uzimati blok, u našem slučaju
to je 0, 0 (gornji levi ugao), a pošto je naš picImage 40x40 pixela ceo njegov sadržaj ćemo
prekopirati u bafer, i poslednji (ali ne i najneznačajniji) parametar je tip operacije koji
će se izvršiti nad pixelima u blokovima (blok na koji kopiramo i blok koji kopiramo), pošto
mi treba samo da prekopiramo sadržaj sa jednog mesta na drugo, koristimo vbSrcCopy konstantu koja
samo kopira blok sa izvornog DC-a na odredišni (ne menja pixele). BitBlt ima još dosta korisnih
operacija ali to nije tema ovog tutorijala tako da neću o tome govoriti (ako vas interesuje koje
su to još konstante možete u vb-u pritisnuti F2 i otkucati rasteropconstants)

Ok da bi videli da li radi ova naša drawImage funkcija moramo da napišemo još jednu koja će da
kopira ceo sadržaj bafera na picLevel, tj na ekran.
Analogno predhodnoj funkciji:
Code:

' ova funkcija kopira sadrzaj bafera na ekran
Public Sub Render()

    ' preslikavamo ceo bafer na ekran
    BitBlt frmGame.picLevel.hDC, 0, 0, frmGame.picLevel.ScaleWidth, _
           frmGame.picLevel.ScaleHeight, frmGame.picBuffer.hDC, 0, 0, vbSrcCopy

    frmGame.picBuffer.Cls ' cistimo sadrzaj bafera

     ' osvezavamo nas picturebox da bi se izmene pokazale na ekranu
    frmGame.picLevel.Refresh

End Sub

Dakle opet kopiramo blok sa jednog mesta (picBuffer) na drugo (picLevel) razlika je samo što je taj
blok sada veličine bafera odnosno nivoa (picBuffer i picLevel moraju imati identične dimenzije).
Kada prekopiramo sadržaj bafera na picLevel moramo očistiti sadržaj bafera (picBuffer.Cls) i osvežiti
sadržaj picLevel-a (picLevel.Refresh) da bi se novi frejm prikazao na ekranu (picLevel.Refresh je neophodan
iz razloga što je AutoRedraw property podešen na True).

Ok sada da testiramo kod! Otvorite kod frmGame-a i u desnom comboboxu (obratite pažnju da je u levom
selektovano Form) izaberite KeyDown događaj. Unesite sledeći kod:
Code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    DrawImage SMAJLI, 50, 50
    Render

End Sub

Pokrenite program i pritisnite bilo koji taster, pojaviće se smajli! Woo-hoo! Odlično za početak, zar ne?





Hmm, mislim da do sada nisam pominjao čuvanje fajlova! To je trebalo prvo da uradimo
Elem sad je dobar trenutak da sačuvamo sve što smo do sada uradili (valjalo bi da vam Ctrl+S postane "navika" )
Ovo je sav kod koji do sada imamo:

frmGame:
Code:

Option Explicit
'


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    DrawImage SMAJLI, 50, 50
    Render

End Sub
'

Private Sub Form_Resize()

    picLevel.Move (Me.ScaleWidth - picLevel.Width) / 2, _
                  (Me.ScaleHeight - picLevel.Height) / 2

End Sub
'


modGame:
Code:

Option Explicit

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Public Const CILJ       As Byte = 0
Public Const SMAJLI     As Byte = 1
Public Const KUTIJA     As Byte = 2
Public Const ZGODITAK   As Byte = 3
Public Const ZID        As Byte = 4

Public Const POLJE      As Byte = 5
'

' ova funkcija crta odredjenu slicicu na odredjeno mesto u bafer
Public Sub DrawImage(ImageId As Byte, X As Long, Y As Long)

    ' crtamo sliku u bafer
    BitBlt frmGame.picBuffer.hDC, X, Y, 40, 40, _
           frmGame.picImage(ImageId).hDC, 0, 0, vbSrcCopy

End Sub
'

' ova funkcija kopira sadrzaj bafera na ekran
Public Sub Render()

    ' preslikavamo ceo bafer na ekran
    BitBlt frmGame.picLevel.hDC, 0, 0, frmGame.picLevel.ScaleWidth, _
           frmGame.picLevel.ScaleHeight, frmGame.picBuffer.hDC, 0, 0, vbSrcCopy

    frmGame.picBuffer.Cls ' cistimo sadrzaj bafera

     ' osvezavamo nas picturebox da bi se izmene pokazale na ekranu
    frmGame.picLevel.Refresh

End Sub
'

Fajlove organizujte "po želji", ja volim da imam ovakvu strukturu fajlova:
Code:

[<ime projekta>]
    |
    +--- [src]
          |
          +--- [frm]        <-- ovde čuvam forme (*.frm)
          |
          +--- [bas]        <-- ovde čuvam module (*.bas)
          |
          +--- <ime projekta>.vbp  <-- projekat (*.vbp),  nalazi se u src

ali to je nebitno i stvar je ukusa, čuvajte fajlove kako se vama sviđa.
Prikačeni fajlovi
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 22:51 - pre 185 meseci
Pred nama je učitavanje nivoa iz fajlova i njihovo iscrtavanje!
Pre nego što se pozabavimo problematikom učitavanja fajlova moramo da vidimo kakve
ćemo to fajlove da koristimo, tj kakvog formata:

Pošto već postoji ogroman broj sokoban klonova i rimejkova, na internetu se
ustalio standardan format fajlova za opisivanje nivoa.
To su obični text fajlovi sa promenjenom ekstenzijom (u našem slučaju
ekstenzija će biti .sok). Nivo se opisuje pomoću sledećih karaktera:

Code:

<space> - prazno polje
      $ - kutija
      . - polje na koje treba postaviti kutiju ("tačka")
      * - kutija na jednoj od tačaka
      @ - početna pozicija igrača
      + - početna pozicija igrača na jednoj od tačaka
      # - zid


Primer:
Code:

######
#@   #####
# $ $  ..#
##########


Nivoi (fajlovi) se čitaju liniju po liniju i proces učitavanja se prekida
kada se naiđe na liniju koja sadrži bar jedan nedozvoljeni karakter
(nedozvoljeni karakteri su svi osim onih 7 gore navedenih). Što znači da
nivo mora da počne u prvoj liniji fajla! Isto tako znači da posle nivoa (ispod)
možete da stavite šta god hoćete; komentar, uputstva i td...

Napravite novi fajl i sačuvajte ga kao 01.sok, ubacite ovo u njega:
Code:

###########
#.#       #
#*#   #   #
#         #
#    ##$$##
###### +  #
     ######

Nivo:  01.sok
Autor: krcko

01.sok ubacite u levels folder koji se nalazi u istom folderu kao i vaš projekat (*.vbp)

Ovaj fajl ćemo koristiti za testiranje.

Pre nego što učitamo fajl moramo da vidimo gde ćemo da čuvamo učitane i obrađene podatke,
dodajte još jedan modul u projekat i nazovite ga modGame.
Prekucajte sledeće u njega:
Code:

Option Explicit

Public Type Pozicija

    X       As Long
    Y       As Long

End Type

Public nivo()       As Byte         ' matrica koja sadrzi podatke o nivou
Public igrac        As Pozicija     ' trenutna pozicija igraca
Public ukupnoKutija As Long         ' broj kutija u nivou
Public postavljenih As Long         ' broj kutija koje su postavljene
Public polja        As Long         ' broj ciljnih polja
Public duzina       As Long         ' velicina matrice "po horizontali"
Public sirina       As Long         ' velicina matrice po vertikali

Pored svake promenljive stoji komentar tako da se vidi za šta koja služi.

Ok evo funkcije za učitavanje nivoa:
Code:

' ova funkcija ucitava nivo iz fajla (vraca false ako dodje do greske)
Public Function UcitajNivo(fajl As String) As Boolean

    UcitajNivo = False

    ' brisemo predhodni nivo
    ReDim nivo(0, 0)
    duzina = 0
    sirina = 0

    ' pomeramo igraca van tabele (pomaze nam da ispitamo ispravnost nivoa)
    igrac.X = -1
    igrac.Y = -1

    ' resetujemo broj kutija i polja (i broj postavljenih kutija)
    ukupnoKutija = 0
    polja = 0 ' polja na koja treba staviti kutije
    postavljenih = 0

    Dim sok()   As String
    Dim X       As Long
    Dim Y       As Long

    sok = UcitajFajl(fajl) ' iscitavamo iz fajla sve sto mozemo da prepoznamo

    ' proveravamo da li je ispravan fajl, matrica ce imati 0 elementata ako nije
    If UBound(sok, 1) > 0 And UBound(sok, 2) > 0 Then

        ' ispravan je fajl
        duzina = UBound(sok, 1)
        sirina = UBound(sok, 2)

        ReDim nivo(1 To duzina, 1 To sirina)

        For X = 1 To duzina
            For Y = 1 To sirina

                Select Case sok(X, Y)

                    Case " ", "" ' prazno polje
                        nivo(X, Y) = POLJE

                    Case "#" ' zid
                        nivo(X, Y) = ZID

                    Case "$" ' kutija
                        nivo(X, Y) = KUTIJA

                        ukupnoKutija = ukupnoKutija + 1


                    Case "@" ' igrac
                        nivo(X, Y) = POLJE

                        If igrac.X > -1 Then Exit Function ' dupliran igrac

                        ' pozicioniramo igraca
                        igrac.X = X
                        igrac.Y = Y

                    Case "." ' mesto na koje treba postaviti kutiju ("tacka")
                        nivo(X, Y) = CILJ
                        polja = polja + 1

                    Case "*" ' kutija na jednoj od "tacaka"
                        nivo(X, Y) = ZGODITAK ' :)
                        polja = polja + 1
                        ukupnoKutija = ukupnoKutija + 1
                        postavljenih = postavljenih + 1

                    Case "+" ' igrac na jednoj od "tacaka"
                        nivo(X, Y) = CILJ

                        If igrac.X > -1 Then Exit Function ' dupliran igrac

                        igrac.X = X
                        igrac.Y = Y

                        polja = polja + 1

                End Select

            Next
        Next

        ' proveravamo validnost ucitanih podataka
        If (ukupnoKutija = polja) And igrac.X > -1 Then UcitajNivo = True

    End If

End Function

i potrebna UcitajFajl funkcija:
Code:

' ova funkcija "izvlaci" iz fajla sve sto moze da prepozna kao
' validni "level info", tj cita samo one karaktere koji su predvidjeni za
' opis nivoa (citanje se prekida kada se naidje na liniju koja sadrzi bar
' jedan neodgovarajuci karakter)
Private Function UcitajFajl(fajl As String) As String()

    ' ova funkcija vraca dvodimenzionalni niz (matricu)
    Dim ret()   As String

    Dim fn      As Integer

    Dim X       As Long
    Dim Y       As Long
    Dim W       As Long

    Dim line    As String


    ReDim ret(0 To 0, 0 To 0) ' isto sto i ReDim ret(0, 0) ali lepse :)

    fn = FreeFile
    Open fajl For Input As #fn

        While Not EOF(fn)

            Line Input #fn, line

            line = RTrim(line)

            If Not ispravniPodaci(line) Then

                UcitajFajl = ret
                Exit Function

            End If

             ' ova linija je duza od svih predhodnih
            If Len(line) > W Then W = Len(line)

            ' dodajemo novi red u matricu
            Y = UBound(ret, 2) + 1

            ReDimMatrix ret, W, Y

            ' i popunjavamo ga:
            For X = 1 To Len(line)

                ret(X, Y) = Mid(line, X, 1)

            Next

        Wend

    Close #fn

    UcitajFajl = ret

End Function

i funkcije potrebne za UcitajFajl:
Code:

' ova funkcija vraca true ako se u liniji nalaze samo podrzani karakteri
Private Function ispravniPodaci(linija As String) As Boolean

    Const dozvoljeniKarakteri = "# @.$+*"

    Dim i           As Integer
    Dim karakter    As String

    ispravniPodaci = False

    If Len(linija) = 0 Then Exit Function

    For i = 1 To Len(linija)

        karakter = Mid(linija, i, 1)

        If InStr(dozvoljeniKarakteri, karakter) < 1 Then Exit Function

    Next

    ispravniPodaci = True

End Function
'

' jedan od nacina da se zaobidje vb-ova ogranicenost po pitanju menjanja
' velicine (2D) matrice sa cuvanjem podataka (ReDim Preserve)
Private Sub ReDimMatrix(ByRef source() As String, W As Long, H As Long)

    Dim ret()   As String
    Dim X       As Long
    Dim Y       As Long

    ReDim ret(W, H)

    For X = 1 To UBound(source, 1)
        For Y = 1 To UBound(source, 2)
            ret(X, Y) = source(X, Y)
        Next
    Next

    source = ret

End Sub

Uh, ovde ima mnogo koda! Hajdemo polako od početka:

Funckija UcitajNivo prima jedan parametar a to je putanja do fajla koji treba da se učita,
ukoliko je fajl ispravan funkcija će da vrati True. Prvo što UcitajNivo radi je brisanje
(resetovanje) podataka o predhodnom nivou, zatim poziva UcitajFajl funkciju koja sadržaj
fajla koji može da prepozna kao validan vraća u obliku dvodimenzinalne matrice string tipa.
Recimo da imamo ovakav fajl:
Code:

######
#@   #####
# $ $  ..#
##########

UcitajFajl će za ovaj fajl da vrati sledeću matricu (predstavljena kao tabela):
Code:

  1   2   3   4   5   6   7   8   9   10
+---+---+---+---+---+---+---+---+---+---+
| # | # | # | # | # | # |   |   |   |   | 1
+---+---+---+---+---+---+---+---+---+---+
| # | @ |   |   |   | # | # | # | # | # | 2
+---+---+---+---+---+---+---+---+---+---+
| # |   | $ |   | $ |   |   | . | . | # | 3
+---+---+---+---+---+---+---+---+---+---+
| # | # | # | # | # | # | # | # | # | # | 4
+---+---+---+---+---+---+---+---+---+---+

dakle to radi UcitajFajl, a kako to radi o tome ćemo kasnije.

Kada dobije rezultat od UcitajFajl, UcitajNivo funkcija prvo proverava ispravnost podataka
koje je vratila UcitajFajl, tj proverava UBound (Upper Bound, gornja granica) obe dimenzije
i ukoliko je bar jedna manja od 1 vraća false.
Zatim podešava promenljive duzina i sirina, i koristeći njih redimenzioniše (širi) niz nivo u
koji ćemo da stavimo podatke o nivou. U dvostrukoj For..Next petlji se pomoću Select Case
komande podešavaju svi parametri nivoa. Pri tome se vodi računa da se igrač ne definiše dva
puta.
Po izlasku iz obe petlje (kada su svi podaci uspešno parsirani) vrši se finalna provera
ispravnosti nivoa, tj proverava se da broj kutija odgovara broju ciljnih mesta (tačaka) i da
je igrač postavljen (ukoliko se u fajlu nije nalazio ni @ ni + karakter, koji označava igrača
onda će igrac.X biti jednak -1).

Već smo objasnili šta radi UcitajFajl, sada da vidimo kako to radi:
prvo se resetuje ret matrica na (0,0) onda se fajl otvori For Input i isčitava se
liniju po liniju pomoću While petlje i Line Input komande. Liniju iz fajla učitavamo u line
promenljivu. Odmah po učitavanju linije (posle Line Input) uklanjamo sve razmake sa desne strane
tj pozivamo RTrim (ne koristimo Trim jer ne želimo da diramo razmake na početku linije) za slučaj
da je neko ostavio jedan (ili više) razmak viška na kraju linije.
Zatim se proverava ispravnost linije, tj poziva se ispravniPodaci funkcija koja će da vrati True
samo ako se u liniji nalaze samo dozvoljeni karakteri, ukoliko je bar jedan karakter nedozvoljen
izlazi se iz funkcije i vraća se ono što je već učitano.
Posle provere (to znači da linija sadrži ispravne podatke) se upoređuje dužina linije sa predhodno
najdužom linijom (dužina najduže linije se čuva u W promenljivoj), i ukoliko je trenutna linija
duža od svih predhodnih onda se podešava W promenljiva. Zatim se dodaje novi red u matricu, to
radimo pomoću Ubound (da utvrdimo trenutni broj redova, da bi uvećali taj broj za 1) i ReDimMatrix
funkcije (više o njoj nešto kasnije). Kada smo dodali red ostalo je samo da ga popunimo sa karakterima
iz line promenljive.

ispravniPodaci je veoma jednostavna funkcija i njen zadatak je da potvrdi ispravnost prosleđene joj
linije. To radi tako što proverava svaki karakter linije upoređujući ga sa dozvoljenim karakterima.

ReDimMatrix je "workaround" funkcija za nemogućnost VB-a da promeni veličinu matrice
(višedimenzionalnih nizova) a da pri tom sačuva podatke koji se u njoj nalaze (ReDim Preserve).
Sa ReDim Preserve možemo samo da menjamo veličinu poslednje dimenzije u matrici, tj ako imate
ovakvu matricu:
Code:

Dim matrica() As Byte

ReDim matrica(2, 6)

dakle matrica koja ima 3 kolone (0 To 2) i 7 redova (0 To 6), ako želimo da promenimo broj
kolona:
Code:

ReDim Preserve matrica(3, 6)

dobićemo grešku, ali zato ako hoćemo da promenimo broj redova:
Code:

ReDim Preserve matrica(2, 25)

neće biti problema. Dakle ReDimMatrix nam omogućava da zaobiđemo ovaj nedostatak, i to radi na
veoma jednostavan način, prvo proširi ret matricu (koju ćemo da vratimo) do željene veličine
i zatim kroz dvostruku For..Next petlju iskopira podatke iz source matrice u ret.

Ok to bi bilo to! Pre nego što proverimo kako ovaj kod radi sačuvajte modGame!
Evo šta se trenutno nalazi u njemu (u modGame modulu):
Code:

Option Explicit

Public Type Pozicija

    X       As Long
    Y       As Long

End Type

Public nivo()       As Byte         ' matrica koja sadrzi podatke o nivou
Public igrac        As Pozicija     ' trenutna pozicija igraca
Public ukupnoKutija As Long         ' broj kutija u nivou
Public postavljenih As Long         ' broj kutija koje su postavljene
Public polja        As Long         ' broj ciljnih polja
Public duzina       As Long         ' velicina matrice "po horizontali"
Public sirina       As Long         ' velicina matrice po vertikali
'

' ova funkcija ucitava nivo iz fajla (vraca false ako dodje do greske)
Public Function UcitajNivo(fajl As String) As Boolean

    UcitajNivo = False

    ' brisemo predhodni nivo
    ReDim nivo(0, 0)
    duzina = 0
    sirina = 0

    ' pomeramo igraca van tabele (pomaze nam da ispitamo ispravnost nivoa)
    igrac.X = -1
    igrac.Y = -1

    ' resetujemo broj kutija i polja (i broj postavljenih kutija)
    ukupnoKutija = 0
    polja = 0 ' polja na koja treba staviti kutije
    postavljenih = 0

    Dim sok()   As String
    Dim X       As Long
    Dim Y       As Long

    sok = UcitajFajl(fajl) ' iscitavamo iz fajla sve sto mozemo da prepoznamo

    ' proveravamo da li je ispravan fajl, matrica ce imati 0 elementata ako nije
    If UBound(sok, 1) > 0 And UBound(sok, 2) > 0 Then

        ' ispravan je fajl
        duzina = UBound(sok, 1)
        sirina = UBound(sok, 2)

        ReDim nivo(1 To duzina, 1 To sirina)

        For X = 1 To duzina
            For Y = 1 To sirina

                Select Case sok(X, Y)

                    Case " ", "" ' prazno polje
                        nivo(X, Y) = POLJE

                    Case "#" ' zid
                        nivo(X, Y) = ZID

                    Case "$" ' kutija
                        nivo(X, Y) = KUTIJA

                        ukupnoKutija = ukupnoKutija + 1


                    Case "@" ' igrac
                        nivo(X, Y) = POLJE

                        If igrac.X > -1 Then Exit Function ' dupliran igrac

                        ' pozicioniramo igraca
                        igrac.X = X
                        igrac.Y = Y

                    Case "." ' mesto na koje treba postaviti kutiju ("tacka")
                        nivo(X, Y) = CILJ
                        polja = polja + 1

                    Case "*" ' kutija na jednoj od "tacaka"
                        nivo(X, Y) = ZGODITAK ' :)
                        polja = polja + 1
                        ukupnoKutija = ukupnoKutija + 1
                        postavljenih = postavljenih + 1

                    Case "+" ' igrac na jednoj od "tacaka"
                        nivo(X, Y) = CILJ

                        If igrac.X > -1 Then Exit Function ' dupliran igrac

                        igrac.X = X
                        igrac.Y = Y

                        polja = polja + 1

                End Select

            Next
        Next

        ' proveravamo validnost ucitanih podataka
        If (ukupnoKutija = polja) And igrac.X > -1 Then UcitajNivo = True

    End If

End Function
'

' ova funkcija "izvlaci" iz fajla sve sto moze da prepozna kao
' validni "level info", tj cita samo one karaktere koji su predvidjeni za
' opis nivoa (citanje se prekida kada se naidje na liniju koja sadrzi bar
' jedan neodgovarajuci karakter)
Private Function UcitajFajl(fajl As String) As String()

    ' ova funkcija vraca dvodimenzionalni niz (matricu)
    Dim ret()   As String

    Dim fn      As Integer

    Dim X       As Long
    Dim Y       As Long
    Dim W       As Long

    Dim line    As String


    ReDim ret(0 To 0, 0 To 0) ' isto sto i ReDim ret(0, 0) ali lepse :)

    fn = FreeFile
    Open fajl For Input As #fn

        While Not EOF(fn)

            Line Input #fn, line

            line = RTrim(line)

            If Not ispravniPodaci(line) Then

                UcitajFajl = ret
                Exit Function

            End If

             ' ova linija je duza od svih predhodnih
            If Len(line) > W Then W = Len(line)

            ' dodajemo novi red u matricu
            Y = UBound(ret, 2) + 1

            ReDimMatrix ret, W, Y

            ' i popunjavamo ga:
            For X = 1 To Len(line)

                ret(X, Y) = Mid(line, X, 1)

            Next

        Wend

    Close #fn

    UcitajFajl = ret

End Function
'

' ova funkcija vraca true ako se u liniji nalaze samo podrzani karakteri
Private Function ispravniPodaci(linija As String) As Boolean

    Const dozvoljeniKarakteri = "# @.$+*"

    Dim i           As Integer
    Dim karakter    As String

    ispravniPodaci = False

    If Len(linija) = 0 Then Exit Function

    For i = 1 To Len(linija)

        karakter = Mid(linija, i, 1)

        If InStr(dozvoljeniKarakteri, karakter) < 1 Then Exit Function

    Next

    ispravniPodaci = True

End Function
'

' jedan od nacina da se zaobidje vb-ova ogranicenost po pitanju menjanja
' velicine (2D) matrice sa cuvanjem podataka (ReDim Preserve)
Private Sub ReDimMatrix(ByRef source() As String, W As Long, H As Long)

    Dim ret()   As String
    Dim X       As Long
    Dim Y       As Long

    ReDim ret(W, H)

    For X = 1 To UBound(source, 1)
        For Y = 1 To UBound(source, 2)
            ret(X, Y) = source(X, Y)
        Next
    Next

    source = ret

End Sub
'

 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 22:52 - pre 185 meseci
Sada otvorite CodeView frmGame-a i izaberite Load iz desnog comboboxa (u levom je Form selektovano)
Unesite sledeći kod:
Code:

Private Sub Form_Load()

    Debug.Print UcitajNivo("E:\Projects\vbSokoban\src\levels\01.sok")

End Sub

E:\Projects\vbSokoban\src\levels\01.sok zamenite sa apsolutnom putanjom do vašeg 01.sok fajla.

Pokrenite program i u Immediate prozoru će vam se ispisati True, ništa više... ali to je znak da
je nivo (01.sok) uspešno učitan! Pa dobro, učitan je... ali gde je? E sada ćemo da odgovorimo
na to pitanje.
Dodajte sledeći kod u modDraw:
Code:

' ova funkcija crta trenutni izgled nivoa i poziciju igraca
Public Sub DrawFrame()

    Dim X   As Long
    Dim Y   As Long

    For X = 1 To duzina
        For Y = 1 To sirina

            If nivo(X, Y) <> POLJE Then ' prazna polja necemo da crtamo :)

                DrawImage nivo(X, Y), (X - 1) * 40, (Y - 1) * 40

            End If

        Next
    Next

    ' crtamo igraca
    DrawImage SMAJLI, (igrac.X - 1) * 40, (igrac.Y - 1) * 40

    Render ' prikazujemo novi frejm

End Sub

DrawFrame funkcija (kao što ste i pretpostavili) crta frejm na ekran. Pomoću dvostruke For..Next petlje
se iscrtava nivo (pri tome vodimo računa da ne crtamo prazna polja), ali ono što vam možda nije jasno to
je pozicioniranje te sličice, tj ovo (X - 1) * 40 i (Y - 1) * 40. Naša matrica je bazirana na osnovi 1
(1 based) tj njene granice (bounds) su od 1 do duzina za prvu dimenziju i od 1 do sirina za drugu
dimenziju i zbog toga moramo oduzeti 1 od vrednosti X i Y pre nego što ih pomnožimo sa 40 (40 je dužina
i širina jednog polja u pixelima). Kada izađemo iz petlji iscrtamo igrača i na kraju prikažemo frejm
na ekranu.
Ok, hajde da vidimo kako to radi. Otvorite frmGame i dodajte poziv ka DrawFrame u Form_Load funkciji.
Form_Load treba da vam izgleda ovako:
Code:

Private Sub Form_Load()

    UcitajNivo "E:\Projects\vbSokoban\src\levels\01.sok"

    DrawFrame

End Sub

(uklonio sam Debug.Print iz razloga što smo se već uverili u ispravnost funkcije za učitavanje)

Pokrenite program, dobićete nešto slično ovome:



dakle izgleda da se sve lepo iscrtava, samo što se ne vidi ceo nivo.
Otvorite modGame i dodajte sledeću funkciju:
Code:

Public Sub PodesiVelicinuTable()

    ' sirimo picLevel i picBuffer u zavisnosti od velicine nivoa
    frmGame.picLevel.Width = 40 * duzina
    frmGame.picLevel.Height = 40 * sirina

    frmGame.picBuffer.Width = 40 * duzina
    frmGame.picBuffer.Height = 40 * sirina

    Call frmGame.Form_Resize ' centriramo picLevel

End Sub

dakle kao što vidite, PodesiVelicinuTable podešava veličinu picLevel-a i picBuffer-a, i ona bi
trebala da se poziva po uspešnom učitavanju nivoa, za početak dodajte je u Form_Load (pre poziva
DrawFrame funkciji):
Code:

Private Sub Form_Load()

    UcitajNivo "E:\Projects\vbSokoban\src\levels\01.sok"

    PodesiVelicinuTable

    DrawFrame

End Sub

Pre nego što pokrenete program morate napraviti jednu malu izmenu u kodu frmGame-a.
U PodesiVelicinuTable pozivamo Form_Resize koji je deklarisan kao Private Sub, ukoliko
pokrenete sada program dobićete "Method or data member not found" grešku. Da bi rešili
ovo samo promenite Private u Public kod Form_Resize, dakle evo kako treba da vam izgleda ceo
kod u frmGame:
Code:

Option Explicit
'


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    'DrawImage SMAJLI, 50, 50
    'Render

End Sub
'

Private Sub Form_Load()

    UcitajNivo "E:\Projects\vbSokoban\src\levels\01.sok"

    PodesiVelicinuTable

    DrawFrame

End Sub
'

Public Sub Form_Resize()

    picLevel.Move (Me.ScaleWidth - picLevel.Width) / 2, _
                  (Me.ScaleHeight - picLevel.Height) / 2

End Sub

(ja sam komentovao kod u Form_KeyDown jer nam više ne treba, ali nemojte ga brisati još uvek)

Pokrenite program i... voila:



Super izgleda, zar ne?

Samo što se meni ne sviđa ova "default" boja pozadine prozora (tj forme), ja ću da je promenim
(BackColor frmGame-a) u neku drugu, recimo u &H00808080& (depresivno sivu ), vi odaberite boju
koja se vama sviđa (ili nemojte da menjate boju uopšte, na vama je da odlučite)...
Prikačeni fajlovi
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 22:56 - pre 185 meseci
Sada je pred nama najteži deo izrade ove igre: kretanje igrača i pomeranje kutija.
Ali videćete da je to samo "gomila" If..Then blokova, za početak dodajte sledeći kod u Form_KeyDown:
Code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    Select Case KeyCode

        Case vbKeyLeft
            Debug.Print "Levo Hugo, levo!"

        Case vbKeyRight
            Debug.Print "Desno Hugo, desno!"

        Case vbKeyUp
            Debug.Print "Gore Hugo, gore!"

        Case vbKeyDown
            Debug.Print "Dole Hugo, dole!"

        Case vbKeyR
            Debug.Print "reset"

        Case vbKeyZ
            If Shift = vbCtrlMask Then Debug.Print "undo"

        Case Else
            Exit Sub ' nije jedan od podrzanih tastera

    End Select

End Sub

Pokrenite program i pritiskajte "podržane" tastere (to su "strelice", R i Ctrl+Z kombinacija), dobićete
odgovarajuće poruke. Dakle na taj način ćemo da znamo koji taster je korisnik pritisnuo.
Krenućemo sa tasterima za kretanje (R i Ctrl+Z ćemo nešto kasnije implementirati):
Code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    Dim dX  As Integer
    Dim dY  As Integer

    Select Case KeyCode

        Case vbKeyLeft
            dX = -1

        Case vbKeyRight
            dX = 1

        Case vbKeyUp
            dY = -1

        Case vbKeyDown
            dY = 1

        Case vbKeyR
            Debug.Print "reset"

        Case vbKeyZ
            If Shift = vbCtrlMask Then Debug.Print "undo"

        Case Else
            Exit Sub ' nije jedan od podrzanih tastera

    End Select

    Dim newX    As Long
    Dim newY    As Long

    newX = igrac.X + dX
    newY = igrac.Y + dY

End Sub

Uveli smo prvo dve nove promenljive dX i dY koje predstavljaju pomeranje (d kao delta) po
horizontali odnosno po vertikali. Kada je dX -1 onda se pomeramo u levo, kada je 1 onda u desno
a kada je dX jednako 0 onda nema pomeranja po x osi, analogno važi i za dY.
Kada dodelimo vrednost promenljivama dX i dY (njihova vrednost zavisi od pritisnutog tastera)
uvodimo još dve promenljive: newX i newY koje predstavljaju koordinate polja na koje bi trebalo
da pomerimo igrača ("željeno polje").
Sada treba da proverimo da li je željeno polje (newX, newY) unutar dimenzija lavirinta:
Code:

If (newX > 0 And newX <= duzina) And (newY > 0 And newY <= sirina) Then

End If

zatim proverimo da li se na željenom mestu nalazi zid (jer kretanje po zidovima nije dozvoljeno):
Code:

If nivo(newX, newY) <> ZID Then

End If

zatim proveravamo da li se na željenom polju nalazi kutija:
Code:

If (nivo(newX, newY) = KUTIJA) Or (nivo(newX, newY) = ZGODITAK) Then

Else

End If

Ukoliko nema kutije (Else) pomeramo igrača jer je željeno polje prazno.

Dakle evo kako do sada izgleda kada se sve sklopi:
Code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    Dim dX  As Integer
    Dim dY  As Integer

    Select Case KeyCode

        Case vbKeyLeft
            dX = -1

        Case vbKeyRight
            dX = 1

        Case vbKeyUp
            dY = -1

        Case vbKeyDown
            dY = 1

        Case vbKeyR
            Debug.Print "reset"

        Case vbKeyZ
            If Shift = vbCtrlMask Then Debug.Print "undo"

        Case Else
            Exit Sub ' nije jedan od podrzanih tastera

    End Select

    Dim newX    As Long
    Dim newY    As Long

    newX = igrac.X + dX
    newY = igrac.Y + dY

    If (newX > 0 And newX <= duzina) And (newY > 0 And newY <= sirina) Then

        If nivo(newX, newY) <> ZID Then

            If (nivo(newX, newY) = KUTIJA) Or (nivo(newX, newY) = ZGODITAK) Then

            Else

                igrac.X = newX
                igrac.Y = newY

            End If

        End If

    End If

    DrawFrame

End Sub

Pokrenite program i pomerajte igrača, moći će samo da se kreće levo i desno (jer je sa gornje
i donje strane ograničen zidom i kutijama). Odlično za sada!
Hajde sad da obradimo situaciju kada se na željenom polju nalazi kutija:

prvo moramo da proverimo da se kutija slučajno ne nalazi negde na ivici nivoa (mada bi nivo uvek
trebao da bude oivičen zidom, ali za svaki slučaj):
Code:

If (newX > 1 And newX < duzina) And ((newY > 1 And newY < sirina)) Then

End If

zatim proveravamo da se ispred kutije (u pravcu u kom je guramo) nalazi prazno polje:
Code:

If (nivo(newX + dX, newY + dY) = POLJE) Or (nivo(newX + dX, newY + dY) = CILJ) Then

End If

i sada nam je ostalo samo da pomerimo kutiju i igrača, pri čemu moramo da vodimo računa o
tome da li se kutija već nalazila na ciljnom mestu (ZGODITAK) i da li će posle pomeranja
biti na ciljnom mestu:
Code:

If nivo(newX, newY) = ZGODITAK Then

    nivo(newX, newY) = CILJ
    postavljenih = postavljenih - 1

Else

    nivo(newX, newY) = POLJE

End If

If nivo(newX + dX, newY + dY) = CILJ Then

    nivo(newX + dX, newY + dY) = ZGODITAK
    postavljenih = postavljenih + 1

Else

    nivo(newX + dX, newY + dY) = KUTIJA

End If

igrac.X = newX
igrac.Y = newY

Prvo proverimo da li se kutija već nalazila na "tački" (nivo(newX, newY) = ZGODITAK) i kao jeste
onda za to polje stavljamo vrednost na CILJ i smanjujemo broj postavljenih kutija, a ako se nije
nalazila na tački onda jednostavno podesimo vrednost tog polja na POLJE (tj prazno polje).
Zatim proveravamo da li se na polju na koje treba da pomerimo kutiju (newX + dX, newY + dY) nalazi
tačka ili ne. Ukoliko je vrednost tog polja CILJ onda mu dodeljujemo vrednost ZGODITAK i povećavamo
broj postavljenih kutija, a ukoliko je to polje prazno onda mu podešavamo vrednost na KUTIJA.
I na kraju pomeramo igrača na novu poziciju.
Evo kako sve to izgleda kada se sklopi:
Code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    Dim dX  As Integer
    Dim dY  As Integer

    Select Case KeyCode

        Case vbKeyLeft
            dX = -1

        Case vbKeyRight
            dX = 1

        Case vbKeyUp
            dY = -1

        Case vbKeyDown
            dY = 1

        Case vbKeyR
            Debug.Print "reset"

        Case vbKeyZ
            If Shift = vbCtrlMask Then Debug.Print "undo"

        Case Else
            Exit Sub ' nije jedan od podrzanih tastera

    End Select

    Dim newX    As Long
    Dim newY    As Long

    newX = igrac.X + dX
    newY = igrac.Y + dY

    If (newX > 0 And newX <= duzina) And (newY > 0 And newY <= sirina) Then

        If nivo(newX, newY) <> ZID Then

            If (nivo(newX, newY) = KUTIJA) Or (nivo(newX, newY) = ZGODITAK) Then

                If (newX > 1 And newX < duzina) And ((newY > 1 And newY < sirina)) Then

                    If (nivo(newX + dX, newY + dY) = POLJE) Or (nivo(newX + dX, newY + dY) = CILJ) Then

                        If nivo(newX, newY) = ZGODITAK Then

                            nivo(newX, newY) = CILJ
                            postavljenih = postavljenih - 1

                        Else

                            nivo(newX, newY) = POLJE

                        End If

                        If nivo(newX + dX, newY + dY) = CILJ Then

                            nivo(newX + dX, newY + dY) = ZGODITAK
                            postavljenih = postavljenih + 1

                        Else

                            nivo(newX + dX, newY + dY) = KUTIJA

                        End If

                        igrac.X = newX
                        igrac.Y = newY

                    End If

                End If

            Else

                igrac.X = newX
                igrac.Y = newY

            End If

        End If

    End If

    DrawFrame

End Sub

Pokrenite program i pomerajte igrača i gurajte kutije... RADI!



Dakle to je bio najteži deo a kao što vidite uopšte nije teško! Samo treba dobro analizirati
problem i obraditi svaku moguću situaciju.
Prikačeni fajlovi
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 23:00 - pre 185 meseci
Dobro, kretanje radi ali mi još uvek nismo završili igru (pri kraju smo); kada složimo sve
kutije na svoja mesta ništa se ne dešava! Hajde prvo to da ispravimo:
kada smo pomerali kutiju mi smo ili povećavali ili smanjivali vrednost postavljenih promenljive,
znači kada sve kutije složimo vrednost promenljive postavljenih treba da bude ista kao i
vrednost promenljive ukupnoKutija (obe ove promenljive smo već definisali u modGame).
Znači ovako proveravamo da li je nivo završen:
Code:

If postavljenih = ukupnoKutija Then

End If

ok, dodajte to na kraj Form_KeyDown funkcije:
Code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    Dim dX  As Integer
    Dim dY  As Integer

    Select Case KeyCode

        Case vbKeyLeft
            dX = -1

        Case vbKeyRight
            dX = 1

        Case vbKeyUp
            dY = -1

        Case vbKeyDown
            dY = 1

        Case vbKeyR
            Debug.Print "reset"

        Case vbKeyZ
            If Shift = vbCtrlMask Then Debug.Print "undo"

        Case Else
            Exit Sub ' nije jedan od podrzanih tastera

    End Select

    Dim newX    As Long
    Dim newY    As Long

    newX = igrac.X + dX
    newY = igrac.Y + dY

    If (newX > 0 And newX <= duzina) And (newY > 0 And newY <= sirina) Then

        If nivo(newX, newY) <> ZID Then

            If (nivo(newX, newY) = KUTIJA) Or (nivo(newX, newY) = ZGODITAK) Then

                If (newX > 1 And newX < duzina) And ((newY > 1 And newY < sirina)) Then

                    If (nivo(newX + dX, newY + dY) = POLJE) Or (nivo(newX + dX, newY + dY) = CILJ) Then

                        If nivo(newX, newY) = ZGODITAK Then

                            nivo(newX, newY) = CILJ
                            postavljenih = postavljenih - 1

                        Else

                            nivo(newX, newY) = POLJE

                        End If

                        If nivo(newX + dX, newY + dY) = CILJ Then

                            nivo(newX + dX, newY + dY) = ZGODITAK
                            postavljenih = postavljenih + 1

                        Else

                            nivo(newX + dX, newY + dY) = KUTIJA

                        End If

                        igrac.X = newX
                        igrac.Y = newY

                    End If

                End If

            Else

                igrac.X = newX
                igrac.Y = newY

            End If

        End If

    End If

    DrawFrame

    If postavljenih = ukupnoKutija Then

        MsgBox "Nivo uspesno zavrsen!"

    End If

End Sub

Pokrenite program i postavite sve kutije na označena mesta, dobićete poruku da ste uspešno
završili nivo (što ste i znali, jelte ). Dobro ovde bi trebali da učitamo sledeći nivo (ukoliko
on postoji) ali da bi to uradili prvo moramo da vidimo na koji način ćemo da učitavamo fajlove iz
levels foldera (koji treba da se nalazi u istom folderu kao i vaš projekat, odnosno program).
Znači treba nam neki način da učitamo sve *.sok fajlove iz levels foldera (tj samo da negde smestimo
podatke o njima, da bi ih lakše učitavali po potrebi)... ovde bi mogao da se koristi FSO kao i VB-ova
ugrađena funkcija Dir, ali ja neću koristiti ni jedan od ova dva načina već treći, još jednostavniji,
FileListBox kontrolu.
Ok, postavite na formu jednu FileListBox kontrolu i promenite joj ime iz File1 u flbLevels, podesite
joj Visible na False.
Sada izmenite kod u Form_Load u ovo:
Code:

Private Sub Form_Load()

    Dim levelsPath  As String

    levelsPath = Replace$(App.Path & "\levels", "\\", "\")

    ' prvo da proverimo da li uopste postoji leves folder
    If Len(Dir(levelsPath, vbDirectory)) = 0 Then

        ' nepostoji levels folder!
        MsgBox "levels folder nije pronadjen!", vbCritical
        Unload Me

    Else

        ' ucitavamo sve nivoe u FileListBox kontrolu
        flbLevels.Path = levelsPath
        flbLevels.Pattern = "*.sok"

        ' sada proveravamo da li se nalazi bar jedan *.sok fajl u levels folderu
        If levels.ListCount > 0 Then

            trenutniNivo = -1 ' u UcitajSledeciNivo ovo ce se povecati na 0

            UcitajSledeciNivo

        Else

            MsgBox "Nije pronadjen ni jedan nivo u levels folderu!", vbCritical
            Unload Me

        End If
    End If

End Sub

Dakle, prvo podešavamo levelsPath promenljivu, tj putanju do levels foldera koji bi trebalo da
se nalazi u istom folderu kao i naš program (App.Path), ovde koristimo Replace iz razloga što će
App.Path biti string koji se završava sa \ ukoliko se naš program nalazi u rootu diska (recimo da je
putanja do programa C:\prog.exe) a ukoliko je program bilo gde sem u rootu (recimo C:\prog\prog.exe)
App.Path će biti string bez \ na kraju.
Zatim proveravamo da li folder postoji, za to koristimo VB-ovu Dir funkciju sa vbDirectory kao drugim
parametrom, ukoliko Dir vrati string koji nije prazan znači da folder postoji. Ukoliko folder postoji
onda podešavamo Path property flbLevels-a na levelsPath a Pattern na *.sok (tako će se u flbLevels učitati
samo fajlovi sa ekstenzijom .sok).
Proveravamo da li je broj pronađenih .sok fajlova veći od nule (da li ih ima) i ako jeste onda podešavamo
trenutniNivo promenljivu na -1, pozivamo UcitajSledeciNivo i potom i DrawFrame.
E sad, ovde ima nepozntaih stvari, to su trenutniNivo promenljiva i UcitajSledeciNivo funkcija.
U trenutniNivo promenljivoj se čuva Index iz flbLevels koji odgovara fajlu koji je trenutno učitan, a
UcitajSledeciNivo fukcija povećava vrednost trenutniNivo promenljive i učitava sledeći fajl iz liste.
trenutniNivo i UcitajSledeci nivo ćemo definisati u modGame:
Code:

Public trenutniNivo As Long         ' index fajla iz flbLevels koji je trenutno ucitan
'

' ova funkcija ucitava sledeci fajl iz liste
Public Sub UcitajSledeciNivo()

    Dim success As Boolean
    Dim fajl    As String

    success = False

    While Not success

        trenutniNivo = trenutniNivo + 1

        If trenutniNivo = frmGame.flbLevels.ListCount Then trenutniNivo = 0


        fajl = frmGame.flbLevels.Path & "\" & frmGame.flbLevels.List(trenutniNivo)

        success = UcitajNivo(fajl)

    Wend

    frmGame.Caption = "vbSokoban [" & fajl & "]"

    PodesiVelicinuTable

    DrawFrame

End Sub

Dakle u While petlji pokušavamo da učitamo sledeći nivo (uvećavajući trenutniNivo svakim
prolaskom kroz petlju), ukoliko vrednost u trenutniNivo bude veća od broja fajlova u listi
resetujemo trenutniNivo na 0 (tj ponovo učitavamo prvi nivo iz liste). Petlja će se izvršavati
sve dok se uspešno ne učita fajl (što može da dovede do tzv "endless loop" tj petlje bez kraja
ukoliko se u levels folderu ne nalazi ni jedan isrpavan fajl! ali pošto je ovo jednostavan
tutorijal nećemo se obazirati na to i podrazumevaćemo da će se u levels folderu uvek nalaziti
bar jedan ispravan fajl). Kada se učita nivo, raširi se veličina tabele i iscrta se nivo na ekranu.

Ok sad možete da pokrenete igru. Ne primećujete nikakvu razliku, zar ne? I dalje se po završetku nivoa
samo prikaže ona poruka... Pa hajde da MsgBox zamenimo sa UcitajSledeciNivo:
Code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    Dim dX  As Integer
    Dim dY  As Integer

    Select Case KeyCode

        Case vbKeyLeft
            dX = -1

        Case vbKeyRight
            dX = 1

        Case vbKeyUp
            dY = -1

        Case vbKeyDown
            dY = 1

        Case vbKeyR
            Debug.Print "reset"

        Case vbKeyZ
            If Shift = vbCtrlMask Then Debug.Print "undo"

        Case Else
            Exit Sub ' nije jedan od podrzanih tastera

    End Select

    Dim newX    As Long
    Dim newY    As Long

    newX = igrac.X + dX
    newY = igrac.Y + dY

    If (newX > 0 And newX <= duzina) And (newY > 0 And newY <= sirina) Then

        If nivo(newX, newY) <> ZID Then

            If (nivo(newX, newY) = KUTIJA) Or (nivo(newX, newY) = ZGODITAK) Then

                If (newX > 1 And newX < duzina) And ((newY > 1 And newY < sirina)) Then

                    If (nivo(newX + dX, newY + dY) = POLJE) Or (nivo(newX + dX, newY + dY) = CILJ) Then

                        If nivo(newX, newY) = ZGODITAK Then

                            nivo(newX, newY) = CILJ
                            postavljenih = postavljenih - 1

                        Else

                            nivo(newX, newY) = POLJE

                        End If

                        If nivo(newX + dX, newY + dY) = CILJ Then

                            nivo(newX + dX, newY + dY) = ZGODITAK
                            postavljenih = postavljenih + 1

                        Else

                            nivo(newX + dX, newY + dY) = KUTIJA

                        End If

                        igrac.X = newX
                        igrac.Y = newY

                    End If

                End If

            Else

                igrac.X = newX
                igrac.Y = newY

            End If

        End If

    End If

    DrawFrame

    If postavljenih = ukupnoKutija Then

        UcitajSledeciNivo

    End If

End Sub

Pokrenite sad igru, kada složite sve kutije na označena mesta automatski će vam se resetovati nivo,
zapravo igra će pokušati da učita sledeći nivo a pošto vam se u levels folderu (verovatno) nalazi
samo 01.sok onda će njega učitati ponovo. Evo još jednog nivoa (02.sok):
Code:

    #####
    #   #
    #$  #
  ###  $##
  #  $ $ #
### # ## #   ######
#   # ## #####  ..#
# $  $          ..#
##### ### #@##  ..#
    #     #########
    #######

Nivo:  02.sok
Autor: <nepoznat>

ubacite i njega u levels folder. Pokušajte ponovo, sada će vam se (kada završite prvi nivo) učitati
sledeći (02.sok), a kad završite njega opet će vam se učitati prvi itd...
Ovde primećujemo dva nedostatka: nivoi se odmah menjaju, tj nema neke pauze; i kada se učita drugi
nivo koji je veći od prvog, on se ne vidi ceo.
Drugi "nedostatak" i nije zapravo nedostatak jer se maximizovanjem prozora rešava problem, ali
pošto će većina ostalih nivoa biti malo veći ne bi bilo loše da se prozor automatski maximizuje.
A za to nam ne treba ni linija koda! Samo podesite WindowState frmGame-a na 2 - Maximized.
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 23:03 - pre 185 meseci
Ostaje nam problem sa pauzom, tj nedostatkom pauze. Pa, najjednostavnije rešenje je da vratimo onaj
MsgBox pre nego što učitamo sledeći nivo. Onaj MsgBox nas je samo informisao o tome da smo uspešno
složili sve kutije, što i nije baš neka informacija, zar ne? Zašto ne bismo na kraju nivoa prikazali
MsgBox sa porukom koja kaže koliko je poteza napravio korisnik? Zvuči lako izvodljivo... zato što i
jeste. Ostaje samo pitanje da li ćemo da brojimo bukvalno svaki korak ili da brojimo samo kada se
neka kutija pomeri. Ja sam za to da pod potezom podrazumevamo samo pokret koji će da uzrokuje pomeranje
neke kutije.
Dakle dodajte u modGame još jednu promenljivu:
Code:

Public brojPoteza   As Long     ' brojac poteza koje je napravio igrac

zatim u UcitajNivo dodajte sledeće:
Code:

brojPoteza = 0

dobro mesto za ovu naredbu je pre deklaracija sok(), X i Y.
Evo kako bi trebalo sad da vam izgleda UcitajNivo:
Code:

' ova funkcija ucitava nivo iz fajla (vraca false ako dodje do greske)
Public Function UcitajNivo(fajl As String) As Boolean
    
    UcitajNivo = False
    
    ' brisemo predhodni nivo
    ReDim nivo(0, 0)
    duzina = 0
    sirina = 0
    
    ' pomeramo igraca van tabele (pomaze nam da ispitamo ispravnost nivoa)
    igrac.X = -1
    igrac.Y = -1
    
    ' resetujemo broj kutija i polja (i broj postavljenih kutija)
    ukupnoKutija = 0
    polja = 0 ' polja na koja treba staviti kutije
    postavljenih = 0
    
    brojPoteza = 0
    
    Dim sok()   As String
    Dim X       As Long
    Dim Y       As Long
    
    sok = UcitajFajl(fajl) ' iscitavamo iz fajla sve sto mozemo da prepoznamo
    
    ' proveravamo da li je ispravan fajl, matrica ce imati 0 elementata ako nije
    If UBound(sok, 1) > 0 And UBound(sok, 2) > 0 Then
        
        ' ispravan je fajl
        duzina = UBound(sok, 1)
        sirina = UBound(sok, 2)
        
        ReDim nivo(1 To duzina, 1 To sirina)
        
        For X = 1 To duzina
            For Y = 1 To sirina
                
                Select Case sok(X, Y)
                    
                    Case " ", "" ' prazno polje
                        nivo(X, Y) = POLJE
                    
                    Case "#" ' zid
                        nivo(X, Y) = ZID
                    
                    Case "$" ' kutija
                        nivo(X, Y) = KUTIJA
                        
                        ukupnoKutija = ukupnoKutija + 1
                    
                    
                    Case "@" ' igrac
                        nivo(X, Y) = POLJE
                        
                        If igrac.X > -1 Then Exit Function ' dupliran igrac
                        
                        ' pozicioniramo igraca
                        igrac.X = X
                        igrac.Y = Y
                    
                    Case "." ' mesto na koje treba postaviti kutiju ("tacka")
                        nivo(X, Y) = CILJ
                        polja = polja + 1
                        
                    Case "*" ' kutija na jednoj od "tacaka"
                        nivo(X, Y) = ZGODITAK ' :)
                        polja = polja + 1
                        ukupnoKutija = ukupnoKutija + 1
                        postavljenih = postavljenih + 1
                        
                    Case "+" ' igrac na jednoj od "tacaka"
                        nivo(X, Y) = CILJ
                        
                        If igrac.X > -1 Then Exit Function ' dupliran igrac
                        
                        igrac.X = X
                        igrac.Y = Y
                        
                        polja = polja + 1
                
                End Select
                
            Next
        Next
        
        ' proveravamo validnost ucitanih podataka
        If (ukupnoKutija = polja) And igrac.X > -1 Then UcitajNivo = True
           
    End If

End Function

Otvorite frmGame i izmenite Form_KeyDown:
Code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    
    Dim dX  As Integer
    Dim dY  As Integer
    
    Select Case KeyCode
        
        Case vbKeyLeft
            dX = -1
            
        Case vbKeyRight
            dX = 1
            
        Case vbKeyUp
            dY = -1
        
        Case vbKeyDown
            dY = 1
        
        Case vbKeyR
            Debug.Print "reset"
        
        Case vbKeyZ
            If Shift = vbCtrlMask Then Debug.Print "undo"
        
        Case Else
            Exit Sub ' nije jedan od podrzanih tastera
            
    End Select
    
    Dim newX    As Long
    Dim newY    As Long
    
    newX = igrac.X + dX
    newY = igrac.Y + dY
    
    If (newX > 0 And newX <= duzina) And (newY > 0 And newY <= sirina) Then
        
        If nivo(newX, newY) <> ZID Then
            
            If (nivo(newX, newY) = KUTIJA) Or (nivo(newX, newY) = ZGODITAK) Then
                
                If (newX > 1 And newX < duzina) And ((newY > 1 And newY < sirina)) Then
                    
                    If (nivo(newX + dX, newY + dY) = POLJE) Or (nivo(newX + dX, newY + dY) = CILJ) Then
                        
                        If nivo(newX, newY) = ZGODITAK Then
                            
                            nivo(newX, newY) = CILJ
                            postavljenih = postavljenih - 1
                            
                        Else
                            
                            nivo(newX, newY) = POLJE
                            
                        End If
                        
                        If nivo(newX + dX, newY + dY) = CILJ Then
                            
                            nivo(newX + dX, newY + dY) = ZGODITAK
                            postavljenih = postavljenih + 1
                            
                        Else
                            
                            nivo(newX + dX, newY + dY) = KUTIJA
                        
                        End If
                        
                        brojPoteza = brojPoteza + 1
                        
                        igrac.X = newX
                        igrac.Y = newY
                    
                    End If
                
                End If
            
            Else
                
                igrac.X = newX
                igrac.Y = newY
                
            End If
        
        End If
        
    End If
    
    DrawFrame
    
    If postavljenih = ukupnoKutija Then
        
        MsgBox "Nivo uspesno zavrsen!" & vbNewLine & vbNewLine & _
               "Broj poteza: " & brojPoteza, vbInformation
        
        UcitajSledeciNivo
        
    End If
    
End Sub

Pokrenite igru i isprobajte.



Eto, sad imamo kakvu-takvu pauzu između nivoa.
Prikačeni fajlovi
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 23:06 - pre 185 meseci
Hajde da se pozabavimo sa preostalim tasterima, ostalo nam je još:
R - resetovanje trenutnog nivoa
Ctrl+Z - vraćanje predhodno odigranog poteza

Krenućemo od R(eset) jer je jednostavnije. Reset komanda treba da resetuje trenutni nivo, tj
da ga ponovo učita.
Dodajte sledeću funkciju u modGame:
Code:

Public Sub ResetujNivo()
    
    If MsgBox("Da li ste sigurni da zelite da resetujete ovaj nivo?", _
              vbQuestion + vbYesNo) = vbYes Then
        
        UcitajNivo trenutniFajl
        
        PodesiVelicinuTable ' nije bas potrebno, ali za svaki slucaj :)

        DrawFrame
        
    End If

End Sub

Ok imamo novu promenljivu to je trenutniFajl. Deklarišite je u modGame:
Code:

Public trenutniFajl As String   ' putanja do ucitanog nivoa

i izmenite UcitajSledeciNivo:
Code:

' ova funkcija ucitava sledeci fajl iz liste
Public Sub UcitajSledeciNivo()
    
    Dim success As Boolean
    Dim fajl    As String
    
    success = False
    
    While Not success
    
        trenutniNivo = trenutniNivo + 1
        
        If trenutniNivo = frmGame.flbLevels.ListCount Then trenutniNivo = 0
        
        
        fajl = frmGame.flbLevels.Path & "\" & frmGame.flbLevels.List(trenutniNivo)
        
        success = UcitajNivo(fajl)
        
    Wend
    
    frmGame.Caption = "vbSokoban [" & fajl & "]"
    
    trenutniFajl = fajl
    
    PodesiVelicinuTable
    
    DrawFrame
    
End Sub

sada je ostalo još samo da pozovemo ResetujNivo kada je R taster pritisnut, izmenite Form_KeyDown:
Code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    
    Dim dX  As Integer
    Dim dY  As Integer
    
    Select Case KeyCode
        
        Case vbKeyLeft
            dX = -1
            
        Case vbKeyRight
            dX = 1
            
        Case vbKeyUp
            dY = -1
        
        Case vbKeyDown
            dY = 1
        
        Case vbKeyR
            ResetujNivo
            Exit Sub
        
        Case vbKeyZ
            If Shift = vbCtrlMask Then Debug.Print "undo"
        
        Case Else
            Exit Sub ' nije jedan od podrzanih tastera
            
    End Select
    
    Dim newX    As Long
    Dim newY    As Long
    
    newX = igrac.X + dX
    newY = igrac.Y + dY
    
    If (newX > 0 And newX <= duzina) And (newY > 0 And newY <= sirina) Then
        
        If nivo(newX, newY) <> ZID Then
            
            If (nivo(newX, newY) = KUTIJA) Or (nivo(newX, newY) = ZGODITAK) Then
                
                If (newX > 1 And newX < duzina) And ((newY > 1 And newY < sirina)) Then
                    
                    If (nivo(newX + dX, newY + dY) = POLJE) Or (nivo(newX + dX, newY + dY) = CILJ) Then
                        
                        If nivo(newX, newY) = ZGODITAK Then
                            
                            nivo(newX, newY) = CILJ
                            postavljenih = postavljenih - 1
                            
                        Else
                            
                            nivo(newX, newY) = POLJE
                            
                        End If
                        
                        If nivo(newX + dX, newY + dY) = CILJ Then
                            
                            nivo(newX + dX, newY + dY) = ZGODITAK
                            postavljenih = postavljenih + 1
                            
                        Else
                            
                            nivo(newX + dX, newY + dY) = KUTIJA
                        
                        End If
                        
                        brojPoteza = brojPoteza + 1
                        
                        igrac.X = newX
                        igrac.Y = newY
                    
                    End If
                
                End If
            
            Else
                
                igrac.X = newX
                igrac.Y = newY
                
            End If
        
        End If
        
    End If
    
    DrawFrame
    
    If postavljenih = ukupnoKutija Then
        
        MsgBox "Nivo uspesno zavrsen!" & vbNewLine & vbNewLine & _
               "Broj poteza: " & brojPoteza, vbInformation
        
        UcitajSledeciNivo
        
    End If
    
End Sub

Sada pokrenite igru i kada napravite neku grešku jednostavno pritisnite R!
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 23:09 - pre 185 meseci
A sada ćemo da implementiramo Ctrl+Z tj Undo komandu.
Dakle sa Undo komandom će moći da se vraća prethodno odigrani potez, što znači
da moramo da pamtimo svaki potez. Postavlja se pitanje da li ćemo da ograničimo
broj mogućih vraćanja (recimo Paint pamti samo poslednje 3 operacije) ili ćemo
da koristimo tzv neograničen undo bafer (koji je ograničen količinom raspložive
memorije). Ja sam za to da broj Undo komandi bude neograničen.
Sada da vidimo gde ćemo da pamtimo poteze, tj u promenljivoj kakvog tipa.
Najefikasnije bi bilo kada bi taj bafer implementirali kao niz, ali najjednostavnije
je da sve čuvamo u jednoj string promenljivoj. Pošto je ovo jednostavan tutorijal
(namenjen početnicima) nećemo se igrati sa nizovima već ćemo da koristimo string
promenljivu. Ok, dodajte novu deklaraciju u modGame:
Code:

Public undoBuffer   As String   ' bafer u kome cuvamo odigrane poteze

Sada izmenite Form_KeyDown:
Code:

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    
    Dim dX  As Integer
    Dim dY  As Integer
    
    Select Case KeyCode
        
        Case vbKeyLeft
            dX = -1
            
        Case vbKeyRight
            dX = 1
            
        Case vbKeyUp
            dY = -1
        
        Case vbKeyDown
            dY = 1
        
        Case vbKeyR
            ResetujNivo
            Exit Sub
        
        Case vbKeyZ
            If Shift = vbCtrlMask Then
                Undo
                DrawFrame
                Exit Sub
            End If
        
        Case Else
            Exit Sub ' nije jedan od podrzanih tastera
            
    End Select
    
    Dim newX    As Long
    Dim newY    As Long
    
    newX = igrac.X + dX
    newY = igrac.Y + dY
    
    Dim promena As String
    
    ' sacuvamo trenutnu poziciju igraca i broj postavljenih kutija
    promena = igrac.X & "," & igrac.Y & "," & postavljenih & ";"
    
    If (newX > 0 And newX <= duzina) And (newY > 0 And newY <= sirina) Then
        
        If nivo(newX, newY) <> ZID Then
            
            If (nivo(newX, newY) = KUTIJA) Or (nivo(newX, newY) = ZGODITAK) Then
                
                If (newX > 1 And newX < duzina) And ((newY > 1 And newY < sirina)) Then
                    
                    If (nivo(newX + dX, newY + dY) = POLJE) Or (nivo(newX + dX, newY + dY) = CILJ) Then
                         
                        ' cuvamo ono sto se nalazi na (newx, newy)
                        promena = promena & newX & "," & newY & _
                                             "," & nivo(newX, newY) & ";"
                                                    
                        If nivo(newX, newY) = ZGODITAK Then
                            
                            nivo(newX, newY) = CILJ
                            postavljenih = postavljenih - 1
                            
                        Else
                            
                            nivo(newX, newY) = POLJE
                            
                        End If
                        
                        ' onda cuvamo (newx + dx, newy + dy)
                        promena = promena & newX + dX & "," & newY + dY & _
                                      "," & nivo(newX + dX, newY + dY)
                        
                        If nivo(newX + dX, newY + dY) = CILJ Then
                            
                            nivo(newX + dX, newY + dY) = ZGODITAK
                            postavljenih = postavljenih + 1
                            
                        Else
                            
                            nivo(newX + dX, newY + dY) = KUTIJA
                        
                        End If
                        
                        brojPoteza = brojPoteza + 1
                        
                        igrac.X = newX
                        igrac.Y = newY
                    
                    End If
                
                End If
            
            Else
                
                igrac.X = newX
                igrac.Y = newY
                
            End If
        
        End If
        
    End If
    
    ' cuvamo odigrani potez:
    undoBuffer = undoBuffer & "|" & promena
    
    DrawFrame
    
    If postavljenih = ukupnoKutija Then
        
        MsgBox "Nivo uspesno zavrsen!" & vbNewLine & vbNewLine & _
               "Broj poteza: " & brojPoteza, vbInformation
        
        UcitajSledeciNivo
        
    End If
    
End Sub

Undo funckiju dodajte u modGame:
Code:

' ova funkcija vraca predhodno odigrani potez
Public Sub Undo()
    
    If Len(undoBuffer) > 0 Then ' prvo proveravamo da li je odigran bar jedan potez
        
        Dim predhodni   As String
        Dim s()         As String
        Dim X           As Long
        Dim Y           As Long
        
        ' citamo poslednji potez sa kraja stringa
        predhodni = Right$(undoBuffer, Len(undoBuffer) - InStrRev(undoBuffer, "|"))
        
        ' uklanjamo ga iz liste
        undoBuffer = Left(undoBuffer, Len(undoBuffer) - Len(predhodni) - 1)
        
        ' delimo ga po ; (da dobijemo podatke o igracu i eventualno o kutijama)
        s = Split(predhodni, ";")
        
        ' vracamo igraca na predhodnu poziciju
        igrac.X = CLng(Split(s(0), ",")(0))
        igrac.Y = CLng(Split(s(0), ",")(1))
        
        ' vracamo broj postavljenih kutija
        postavljenih = CLng(Split(s(0), ",")(2))
        
        ' proveravamo da li je pomerena neka kutija u predhodnom potezu
        If UBound(s) > 1 Then
            
            ' vracamo kutiju na polje na kom je predhodno bila
            X = CLng(Split(s(1), ",")(0))
            Y = CLng(Split(s(1), ",")(1))
            
            nivo(X, Y) = CByte(Split(s(1), ",")(2))
            
            ' vracamo vrednost polja na koji je pomerena kutija
            X = CLng(Split(s(2), ",")(0))
            Y = CLng(Split(s(2), ",")(1))
            
            nivo(X, Y) = CByte(Split(s(2), ",")(2))
        
        End If
        
    End If

End Sub

I ostalo je još da u UcitajNivo resetujemo undoBuffer:
Code:

' ova funkcija ucitava nivo iz fajla (vraca false ako dodje do greske)
Public Function UcitajNivo(fajl As String) As Boolean
    
    UcitajNivo = False
    
    ' brisemo predhodni nivo
    ReDim nivo(0, 0)
    duzina = 0
    sirina = 0
    
    ' pomeramo igraca van tabele (pomaze nam da ispitamo ispravnost nivoa)
    igrac.X = -1
    igrac.Y = -1
    
    ' resetujemo broj kutija i polja (i broj postavljenih kutija)
    ukupnoKutija = 0
    polja = 0 ' polja na koja treba staviti kutije
    postavljenih = 0
    
    brojPoteza = 0
    
    undoBuffer = ""
    
    Dim sok()   As String
    Dim X       As Long
    Dim Y       As Long
    
    sok = UcitajFajl(fajl) ' iscitavamo iz fajla sve sto mozemo da prepoznamo
    
    ' proveravamo da li je ispravan fajl, matrica ce imati 0 elementata ako nije
    If UBound(sok, 1) > 0 And UBound(sok, 2) > 0 Then
        
        ' ispravan je fajl
        duzina = UBound(sok, 1)
        sirina = UBound(sok, 2)
        
        ReDim nivo(1 To duzina, 1 To sirina)
        
        For X = 1 To duzina
            For Y = 1 To sirina
                
                Select Case sok(X, Y)
                    
                    Case " ", "" ' prazno polje
                        nivo(X, Y) = POLJE
                    
                    Case "#" ' zid
                        nivo(X, Y) = ZID
                    
                    Case "$" ' kutija
                        nivo(X, Y) = KUTIJA
                        
                        ukupnoKutija = ukupnoKutija + 1
                    
                    
                    Case "@" ' igrac
                        nivo(X, Y) = POLJE
                        
                        If igrac.X > -1 Then Exit Function ' dupliran igrac
                        
                        ' pozicioniramo igraca
                        igrac.X = X
                        igrac.Y = Y
                    
                    Case "." ' mesto na koje treba postaviti kutiju ("tacka")
                        nivo(X, Y) = CILJ
                        polja = polja + 1
                        
                    Case "*" ' kutija na jednoj od "tacaka"
                        nivo(X, Y) = ZGODITAK ' :)
                        polja = polja + 1
                        ukupnoKutija = ukupnoKutija + 1
                        postavljenih = postavljenih + 1
                        
                    Case "+" ' igrac na jednoj od "tacaka"
                        nivo(X, Y) = CILJ
                        
                        If igrac.X > -1 Then Exit Function ' dupliran igrac
                        
                        igrac.X = X
                        igrac.Y = Y
                        
                        polja = polja + 1
                
                End Select
                
            Next
        Next
        
        ' proveravamo validnost ucitanih podataka
        If (ukupnoKutija = polja) And igrac.X > -1 Then UcitajNivo = True
           
    End If

End Function

Sačuvajte sve i pokrenite igru. Namerno odgurnite jednu kutiju skroz do zida, onda sa
Ctrl+Z vratite potez(e)... radi, odlično!

Ukoliko vam nije iz koda jasno kako pamtimo poteze evo objašnjenja:
svaki potez počinje sa

X,Y,P;

gde su X i Y koordinate igrača, a P je broj postavljenih kutija.
Ukoliko je neka kutija pomerena pamte se još i sledeći podaci:

X1,Y1,V1;X2,Y2,V2;

X1 i Y1 su koordinate polja na kojem se nalazila kutija, V1 je vrednost polja
nivo(X1, Y1) i to će uvek biti ili 2 (KUTIJA) ili 3 (ZGODITAK), X2 i Y2 su
koordinate polja na koje je kutija pomerena, a V2 je vrednost polja nivo(X2, Y2)
i može biti ili 0 (CILJ) ili 5 (POLJE).

Dakle ukoliko je samo igrač pomeren (ni jedna kutija nije promenila mesto) potez
će u našem zapisu da izgleda ovako:

X,Y,P;

a ukoliko je pomerena neka kutija onda je potez zapisan kao:

X,Y,P;X1,Y1,V1;X2,Y2,V2;

potezi se odvajaju sa pajpom (|), evo primer tri napravljena poteza:

|8,6,1;|9,6,1;9,5,2;9,4,5|9,5,1;9,4,2;9,3,5

nije mnogo komplikovano, zar ne?
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 23:10 - pre 185 meseci
Pa to bi bilo to, naša igra ima sve što smo planirali. Ali (uvek ima neko ali)
zamislite da neko počne da igra našu igru i stigne do 10 nivoa i onda mora da
isključi računar. Kada posle ponovo pokrene našu igru videće da nema načina da
krene odmah od 10-og nivoa već će ponovo morati sve nivoe da prelazi!
To je malo ružno, složićete se...
Možemo da uvedemo mogućnost čuvanja i kasnijeg učitavanja igre, što i nije tako
loše, ali jednostavnije je da jednostavno ponudimo mogućnost učitavanja željenog
nivoa. Hajde onda to da uradimo...

Dodajte novu formu u projekat (Project->Add Form) nazovite je frmLevel i podesite
joj sledeće propertije:
BorderStyle: 3 - Fixed Dialog
Caption: Ucitaj nivo
StartUpPosition: 1 - CenterOwner

dodajte na formu dva CommandButton-a, nazovite ih cmdUcitaj i cmdCancel
podesite sledeća svojstva cmdUcitaj kontroli:
Caption: Ucitaj
Default: True

a cmdOtkazi:
Caption: Otkazi
Cancel: True

dodajte jedan ComboBox, nazovite ga cmbLevels, podesite mu Style na 2 - Dropdown List

složite kontrole kao na slici (ja sam dodao i jedan Label):


otvorite Code View frmLevel-a i repišite sledeći kod:
Code:

Option Explicit
'

Private Sub cmdOtkazi_Click()
    
    Unload Me
    
End Sub
'

Private Sub cmdUcitaj_Click()
    
    trenutniNivo = cmbLevels.ListIndex
    trenutniFajl = frmGame.flbLevels.Path & "\" & cmbLevels.List(trenutniNivo)
    
    ' ucitavamo nivo
    UcitajNivo trenutniFajl
    
    PodesiVelicinuTable
    
    DrawFrame ' crtamo nivo
    
    frmGame.Caption = "vbSokoban [" & trenutniFajl & "]" ' podesavamo naslov
    
    Unload Me ' zatvaramo ovu formu
    
End Sub

kod je sam po sebi jasan: ukoliko se klikne na Otkazi forma se zatvara i nikakve
izmene se ne prave, a ukoliko se klikne na Ucitaj onda se ucitava izabrani nivo.

Pre nego što napišemo kod koji poziva frmLevel i popunjava cmbLevels sa imenima
nivoa, moramo prvo dodati meni na glavnu formu (frmGame).
Otvorite frmGame (Design View) i izaberite Menu Editor iz Tools menija. Dodajte
prvo Igra meni:



zatim pritisnite Next pa strelicu u desno (->), unesite sledeće:



Pritisnite OK. Sada se na formi pojavio menu bar, izaberite Igra meni (jedini )
i kliknite na 'Ucitaj nivo', otvoriće vam se Code View, prekucajte sledeći kod:
Code:

Private Sub mnuUcitaj_Click()
    
    Dim i   As Long
    
    ' ucitavao formu za odabir nivoa
    Load frmLevel
    
    ' popunjavamo cmbLevels
    For i = 0 To flbLevels.ListCount - 1
        frmLevel.cmbLevels.AddItem flbLevels.List(i)
    Next
    
    ' selektujemo trenutni nivo:
    frmLevel.cmbLevels.ListIndex = trenutniNivo
    
    ' prikazujemo formu:
    frmLevel.Show vbModal, Me

End Sub

Pokrenite igru i pritisnite Ctrl+U (ili izaberite komandu iz menija),
izaberite nivo i pritisnite Ucitaj. Super radi i to!
Znači sve je gotovo... ali (rekoh da uek ima neko ali ) zar nije malo
neobično da meni ima samo jednu komandu? Da je bar Exit tu...
Možemo za kraj da dodamo par opcija u meni, čisto da bi izgledao malo
"običnije". Ubacićemo komandu za Reset, za Undo i za Izlaz.
Opet otvorite Menu Editor i dodajte ove komande, ja sam ih nazvao ovako:
mnuReset
mnuUndo (shortcut: Ctrl+Z)
mnuIzlaz (shortcut: Ctrl+X)

dodao sam i dva separatora (da napravite separator samo stavite - kao
Caption, ali pazite da im Name bude različito):



evo i koda za njih:
Code:

Private Sub mnuIzlaz_Click()
    
    If MsgBox("Da li ste sigurni da zelite da izadjete iz igre?", _
              vbQuestion + vbYesNo) = vbYes Then
        
        Unload Me
              
    End If

End Sub
'

Private Sub mnuReset_Click()
    
    Form_KeyDown vbKeyR, 0

End Sub
'

Private Sub mnuUndo_Click()
    
    Form_KeyDown vbKeyZ, vbCtrlMask

End Sub


Ostala je još samo jedna sitnica: kada smo pravili meni za Vrati potez i za Ucitaj nivo
postavili smo shortcut key, dok za Reset nismo iz razloga što VB ne dozvoljava da jedan
taster bude shortcut za neki meni, ali nama to i ne treba (da se pomocu jednog tastera
pozica Click događaj tog menija) već samo da piše R sa desne strane. To ćemo da uradimo
sledećom komandom:
Code:

mnuReset.Caption = "&Resetuj nivo" & vbTab & "R"

to dodajte u Form_Load


Ok, sačuvajte sve i ... to je to! Konačno smo završili!
Prikačeni fajlovi
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 23:16 - pre 185 meseci
evo sada i ceo kod:

frmGame:
Code:

Option Explicit
'


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    
    Dim dX  As Integer
    Dim dY  As Integer
    
    Select Case KeyCode
        
        Case vbKeyLeft
            dX = -1
            
        Case vbKeyRight
            dX = 1
            
        Case vbKeyUp
            dY = -1
        
        Case vbKeyDown
            dY = 1
        
        Case vbKeyR
            ResetujNivo
            Exit Sub
        
        Case vbKeyZ
            If Shift = vbCtrlMask Then
                Undo
                DrawFrame
                Exit Sub
            End If
        
        Case Else
            Exit Sub ' nije jedan od podrzanih tastera
            
    End Select
    
    Dim newX    As Long
    Dim newY    As Long
    
    newX = igrac.X + dX
    newY = igrac.Y + dY
    
    Dim promena As String
    
    ' sacuvamo trenutnu poziciju igraca i broj postavljenih kutija
    promena = igrac.X & "," & igrac.Y & "," & postavljenih & ";"
    
    If (newX > 0 And newX <= duzina) And (newY > 0 And newY <= sirina) Then
        
        If nivo(newX, newY) <> ZID Then
            
            If (nivo(newX, newY) = KUTIJA) Or (nivo(newX, newY) = ZGODITAK) Then
                
                If (newX > 1 And newX < duzina) And ((newY > 1 And newY < sirina)) Then
                    
                    If (nivo(newX + dX, newY + dY) = POLJE) Or (nivo(newX + dX, newY + dY) = CILJ) Then
                         
                        ' cuvamo ono sto se nalazi na (newx, newy)
                        promena = promena & newX & "," & newY & _
                                             "," & nivo(newX, newY) & ";"
                                                    
                        If nivo(newX, newY) = ZGODITAK Then
                            
                            nivo(newX, newY) = CILJ
                            postavljenih = postavljenih - 1
                            
                        Else
                            
                            nivo(newX, newY) = POLJE
                            
                        End If
                        
                        ' onda cuvamo (newx + dx, newy + dy)
                        promena = promena & newX + dX & "," & newY + dY & _
                                      "," & nivo(newX + dX, newY + dY)
                        
                        If nivo(newX + dX, newY + dY) = CILJ Then
                            
                            nivo(newX + dX, newY + dY) = ZGODITAK
                            postavljenih = postavljenih + 1
                            
                        Else
                            
                            nivo(newX + dX, newY + dY) = KUTIJA
                        
                        End If
                        
                        brojPoteza = brojPoteza + 1
                        
                        igrac.X = newX
                        igrac.Y = newY
                    
                    End If
                
                End If
            
            Else
                
                igrac.X = newX
                igrac.Y = newY
                
            End If
        
        End If
        
    End If
    
    ' cuvamo odigrani potez:
    undoBuffer = undoBuffer & "|" & promena

    DrawFrame
    
    If postavljenih = ukupnoKutija Then
        
        MsgBox "Nivo uspesno zavrsen!" & vbNewLine & vbNewLine & _
               "Broj poteza: " & brojPoteza, vbInformation
        
        UcitajSledeciNivo
        
    End If
    
End Sub
'

Private Sub Form_Load()
    
    Dim levelsPath  As String
    
    levelsPath = Replace$(App.Path & "\levels", "\\", "\")
    
    ' prvo da proverimo da li uopste postoji leves folder
    If Len(Dir(levelsPath, vbDirectory)) = 0 Then
        
        ' nepostoji levels folder!
        MsgBox "levels folder nije pronadjen!", vbCritical
        Unload Me
    
    Else
        
        ' ucitavamo sve nivoe u FileListBox kontrolu
        flbLevels.Path = levelsPath
        flbLevels.Pattern = "*.sok"
        
        ' sada proveravamo da li se nalazi bar jedan *.sok fajl u levels folderu
        If flbLevels.ListCount > 0 Then
            
            ' "hack" :)
            mnuReset.Caption = "&Resetuj nivo" & vbTab & "R"
            
            trenutniNivo = -1 ' u UcitajSledeciNivo ovo ce se povecati na 0
            
            UcitajSledeciNivo
        
        Else
             
            MsgBox "Nije pronadjen ni jedan nivo u levels folderu!", vbCritical
            Unload Me
            
        End If
    End If
    
End Sub
'

Public Sub Form_Resize()
    
    picLevel.Move (Me.ScaleWidth - picLevel.Width) / 2, _
                  (Me.ScaleHeight - picLevel.Height) / 2
                  
End Sub
'

Private Sub mnuIzlaz_Click()
    
    If MsgBox("Da li ste sigurni da zelite da izadjete iz igre?", _
              vbQuestion + vbYesNo) = vbYes Then
        
        Unload Me
              
    End If

End Sub
'

Private Sub mnuReset_Click()
    
    Form_KeyDown vbKeyR, 0

End Sub
'

Private Sub mnuUcitaj_Click()
    
    Dim i   As Long
    
    ' ucitavao formu za odabir nivoa
    Load frmLevel
    
    ' popunjavamo cmbLevels
    For i = 0 To flbLevels.ListCount - 1
        frmLevel.cmbLevels.AddItem flbLevels.List(i)
    Next
    
    ' selektujemo trenutni nivo:
    frmLevel.cmbLevels.ListIndex = trenutniNivo
    
    ' prikazujemo formu:
    frmLevel.Show vbModal, Me

End Sub
'

Private Sub mnuUndo_Click()
    
    Form_KeyDown vbKeyZ, vbCtrlMask

End Sub


frmLevel:
Code:

Option Explicit
'

Private Sub cmdOtkazi_Click()
    
    Unload Me
    
End Sub
'

Private Sub cmdUcitaj_Click()
    
    trenutniNivo = cmbLevels.ListIndex
    trenutniFajl = frmGame.flbLevels.Path & "\" & cmbLevels.List(trenutniNivo)
    
    ' ucitavamo nivo
    UcitajNivo trenutniFajl
    
    PodesiVelicinuTable
    
    DrawFrame ' crtamo nivo
    
    frmGame.Caption = "vbSokoban [" & trenutniFajl & "]" ' podesavamo naslov
    
    Unload Me ' zatvaramo ovu formu
    
End Sub


modDraw:
Code:

Option Explicit

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Public Const CILJ       As Byte = 0
Public Const SMAJLI     As Byte = 1
Public Const KUTIJA     As Byte = 2
Public Const ZGODITAK   As Byte = 3
Public Const ZID        As Byte = 4

Public Const POLJE      As Byte = 5
'

' ova funkcija crta odredjenu slicicu na odredjeno mesto u bafer
Public Sub DrawImage(ImageId As Byte, X As Long, Y As Long)
    
    ' crtamo sliku u bafer
    BitBlt frmGame.picBuffer.hDC, X, Y, 40, 40, _
           frmGame.picImage(ImageId).hDC, 0, 0, vbSrcCopy
    
End Sub
'

' ova funkcija kopira sadrzaj bafera na ekran
Public Sub Render()
    
    ' preslikavamo ceo bafer na ekran
    BitBlt frmGame.picLevel.hDC, 0, 0, frmGame.picLevel.ScaleWidth, _
           frmGame.picLevel.ScaleHeight, frmGame.picBuffer.hDC, 0, 0, vbSrcCopy
    
    frmGame.picBuffer.Cls ' cistimo sadrzaj bafera
    
     ' osvezavamo nas picturebox da bi se izmene pokazale na ekranu
    frmGame.picLevel.Refresh
    
End Sub
'

' ova funkcija crta trenutni izgled nivoa i poziciju igraca
Public Sub DrawFrame()
    
    Dim X   As Long
    Dim Y   As Long
    
    For X = 1 To duzina
        For Y = 1 To sirina
            
            If nivo(X, Y) <> POLJE Then ' prazna polja necemo da crtamo :)
            
                DrawImage nivo(X, Y), (X - 1) * 40, (Y - 1) * 40
            
            End If
            
        Next
    Next
    
    ' crtamo igraca
    DrawImage SMAJLI, (igrac.X - 1) * 40, (igrac.Y - 1) * 40
    
    Render ' prikazujemo novi frejm

End Sub
'


modGame:
Code:

Option Explicit

Public Type Pozicija
    
    X       As Long
    Y       As Long

End Type

Public nivo()       As Byte     ' matrica koja sadrzi podatke o nivou
Public igrac        As Pozicija ' trenutna pozicija igraca
Public ukupnoKutija As Long     ' broj kutija u nivou
Public postavljenih As Long     ' broj kutija koje su postavljene
Public polja        As Long     ' broj ciljnih polja
Public duzina       As Long     ' velicina matrice "po horizontali"
Public sirina       As Long     ' velicina matrice po vertikali
Public trenutniNivo As Long     ' index fajla iz flbLevels koji je trenutno ucitan
Public brojPoteza   As Long     ' brojac poteza koje je napravio igrac
Public trenutniFajl As String   ' putanja do ucitanog nivoa
Public undoBuffer   As String   ' bafer u kome cuvamo odigrane poteze
'

' ova funkcija ucitava sledeci fajl iz liste
Public Sub UcitajSledeciNivo()
    
    Dim success As Boolean
    Dim fajl    As String
    
    success = False
    
    While Not success
    
        trenutniNivo = trenutniNivo + 1
        
        If trenutniNivo = frmGame.flbLevels.ListCount Then trenutniNivo = 0
        
        
        fajl = frmGame.flbLevels.Path & "\" & frmGame.flbLevels.List(trenutniNivo)
        
        success = UcitajNivo(fajl)
        
    Wend
    
    frmGame.Caption = "vbSokoban [" & fajl & "]"
    
    trenutniFajl = fajl
    
    PodesiVelicinuTable
    
    DrawFrame
    
End Sub
'

' ova funkcija ucitava nivo iz fajla (vraca false ako dodje do greske)
Public Function UcitajNivo(fajl As String) As Boolean
    
    UcitajNivo = False
    
    ' brisemo predhodni nivo
    ReDim nivo(0, 0)
    duzina = 0
    sirina = 0
    
    ' pomeramo igraca van tabele (pomaze nam da ispitamo ispravnost nivoa)
    igrac.X = -1
    igrac.Y = -1
    
    ' resetujemo broj kutija i polja (i broj postavljenih kutija)
    ukupnoKutija = 0
    polja = 0 ' polja na koja treba staviti kutije
    postavljenih = 0
    
    brojPoteza = 0
    
    undoBuffer = ""
    
    Dim sok()   As String
    Dim X       As Long
    Dim Y       As Long
    
    sok = UcitajFajl(fajl) ' iscitavamo iz fajla sve sto mozemo da prepoznamo
    
    ' proveravamo da li je ispravan fajl, matrica ce imati 0 elementata ako nije
    If UBound(sok, 1) > 0 And UBound(sok, 2) > 0 Then
        
        ' ispravan je fajl
        duzina = UBound(sok, 1)
        sirina = UBound(sok, 2)
        
        ReDim nivo(1 To duzina, 1 To sirina)
        
        For X = 1 To duzina
            For Y = 1 To sirina
                
                Select Case sok(X, Y)
                    
                    Case " ", "" ' prazno polje
                        nivo(X, Y) = POLJE
                    
                    Case "#" ' zid
                        nivo(X, Y) = ZID
                    
                    Case "$" ' kutija
                        nivo(X, Y) = KUTIJA
                        
                        ukupnoKutija = ukupnoKutija + 1
                    
                    
                    Case "@" ' igrac
                        nivo(X, Y) = POLJE
                        
                        If igrac.X > -1 Then Exit Function ' dupliran igrac
                        
                        ' pozicioniramo igraca
                        igrac.X = X
                        igrac.Y = Y
                    
                    Case "." ' mesto na koje treba postaviti kutiju ("tacka")
                        nivo(X, Y) = CILJ
                        polja = polja + 1
                        
                    Case "*" ' kutija na jednoj od "tacaka"
                        nivo(X, Y) = ZGODITAK ' :)
                        polja = polja + 1
                        ukupnoKutija = ukupnoKutija + 1
                        postavljenih = postavljenih + 1
                        
                    Case "+" ' igrac na jednoj od "tacaka"
                        nivo(X, Y) = CILJ
                        
                        If igrac.X > -1 Then Exit Function ' dupliran igrac
                        
                        igrac.X = X
                        igrac.Y = Y
                        
                        polja = polja + 1
                
                End Select
                
            Next
        Next
        
        ' proveravamo validnost ucitanih podataka
        If (ukupnoKutija = polja) And igrac.X > -1 Then UcitajNivo = True
           
    End If

End Function
'

' ova funkcija "izvlaci" iz fajla sve sto moze da prepozna kao
' validni "level info", tj cita samo one karaktere koji su predvidjeni za
' opis nivoa (citanje se prekida kada se naidje na liniju koja sadrzi bar
' jedan neodgovarajuci karakter)
Private Function UcitajFajl(fajl As String) As String()
    
    ' ova funkcija vraca dvodimenzionalni niz (matricu)
    Dim ret()   As String
    
    Dim fn      As Integer
    
    Dim X       As Long
    Dim Y       As Long
    Dim W       As Long
    
    Dim line    As String
    
    
    ReDim ret(0 To 0, 0 To 0) ' isto sto i ReDim ret(0, 0) ali lepse :)
    
    fn = FreeFile
    Open fajl For Input As #fn
        
        While Not EOF(fn)
                    
            Line Input #fn, line
                        
            line = RTrim(line)
             
            If Not ispravniPodaci(line) Then
                
                UcitajFajl = ret
                Exit Function
            
            End If
            
             ' ova linija je duza od svih predhodnih
            If Len(line) > W Then W = Len(line)
            
            ' dodajemo novi red u matricu
            Y = UBound(ret, 2) + 1
            
            ReDimMatrix ret, W, Y
            
            ' i popunjavamo ga:
            For X = 1 To Len(line)
                
                ret(X, Y) = Mid(line, X, 1)
                
            Next
             
        Wend
    
    Close #fn
    
    UcitajFajl = ret

End Function
'

' ova funkcija vraca true ako se u liniji nalaze samo podrzani karakteri
Private Function ispravniPodaci(linija As String) As Boolean
    
    Const dozvoljeniKarakteri = "# @.$+*"
    
    Dim i           As Integer
    Dim karakter    As String
    
    ispravniPodaci = False
    
    If Len(linija) = 0 Then Exit Function
    
    For i = 1 To Len(linija)
        
        karakter = Mid(linija, i, 1)
        
        If InStr(dozvoljeniKarakteri, karakter) < 1 Then Exit Function
    
    Next
    
    ispravniPodaci = True
    
End Function
'

' jedan od nacina da se zaobidje vb-ova ogranicenost po pitanju menjanja
' velicine (2D) matrice sa cuvanjem podataka (ReDim Preserve)
Private Sub ReDimMatrix(ByRef source() As String, W As Long, H As Long)
    
    Dim ret()   As String
    Dim X       As Long
    Dim Y       As Long
    
    ReDim ret(W, H)
    
    For X = 1 To UBound(source, 1)
        For Y = 1 To UBound(source, 2)
            ret(X, Y) = source(X, Y)
        Next
    Next
    
    source = ret

End Sub
'

Public Sub PodesiVelicinuTable()
    
    ' sirimo picLevel i picBuffer u zavisnosti od velicine nivoa
    frmGame.picLevel.Width = 40 * duzina
    frmGame.picLevel.Height = 40 * sirina
    
    frmGame.picBuffer.Width = 40 * duzina
    frmGame.picBuffer.Height = 40 * sirina
    
    Call frmGame.Form_Resize ' centriramo picLevel
    
End Sub
'

' ova funkcija resetuje trenutni nivo (ponovo ga ucitava)
Public Sub ResetujNivo()
    
    If MsgBox("Da li ste sigurni da zelite da resetujete ovaj nivo?", _
              vbQuestion + vbYesNo) = vbYes Then
        
        UcitajNivo trenutniFajl
        
        PodesiVelicinuTable ' nije bas potrebno, ali za svaki slucaj :)
        
        DrawFrame
        
    End If

End Sub
'

' ova funkcija vraca predhodno odigrani potez
Public Sub Undo()
    
    If Len(undoBuffer) > 0 Then ' prvo proveravamo da li je odigran bar jedan potez
        
        Dim predhodni   As String
        Dim s()         As String
        Dim X           As Long
        Dim Y           As Long
        
        ' citamo poslednji potez sa kraja stringa
        predhodni = Right$(undoBuffer, Len(undoBuffer) - InStrRev(undoBuffer, "|"))
        
        ' uklanjamo ga iz liste
        undoBuffer = Left(undoBuffer, Len(undoBuffer) - Len(predhodni) - 1)
        
        ' delimo ga po ; (da dobijemo podatke o igracu i eventualno o kutijama)
        s = Split(predhodni, ";")
        
        ' vracamo igraca na predhodnu poziciju
        igrac.X = CLng(Split(s(0), ",")(0))
        igrac.Y = CLng(Split(s(0), ",")(1))
        
        ' vracamo broj postavljenih kutija
        postavljenih = CLng(Split(s(0), ",")(2))
        
        ' proveravamo da li je pomerena neka kutija u predhodnom potezu
        If UBound(s) > 1 Then
            
            ' vracamo kutiju na polje na kom je predhodno bila
            X = CLng(Split(s(1), ",")(0))
            Y = CLng(Split(s(1), ",")(1))
            
            nivo(X, Y) = CByte(Split(s(1), ",")(2))
            
            ' vracamo vrednost polja na koji je pomerena kutija
            X = CLng(Split(s(2), ",")(0))
            Y = CLng(Split(s(2), ",")(1))
            
            nivo(X, Y) = CByte(Split(s(2), ",")(2))
        
        End If
        
    End If

End Sub


ovako kad se sve stavi jedno ispod drugog i ne izgleda tako malo

elem u zipu koji sam okačio imate sve ove fajlove kao i 60-ak nivoa...
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 23:18 - pre 185 meseci
Zakljucak:
Dakle videli ste, uopšte nije neka nauka napraviti igru u VBu, čak je
i zabavno, ali, kao što možda već znate, VB nije pogodan za izradu
zahtevnijih igara (sa ultra-mega-giga 3d grafikom) ali za ove male
desktop igre (kako ja volim da ih zovem) je odlično rešenje (zamislite
samo koliki bi bio kod da smo ovu igru napisali u c++u!)...

Nadam se da je neko naučio nešto novo iz ovoga, ako ništa više onda
bar možemo da organizujemo vbSokoban turnir, da vidimo ko je bolji
magacioner

Pozdrav svima!

p.s.
okačio sam uz poruku:
- vbSokoban_src.zip (izvorni kod, sličice, nivoi i ceo ovaj text)
- vbSokoban_bin.zip (sadrži samo igru sa nivoima, za one koji nemaju VB ili bi samo da igraju )
Prikačeni fajlovi
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 23:23 - pre 185 meseci
(ovo samo odgovaram da ne bi bilo 13 baksuznih postova )

elem, dajem vam nekoliko dana da ovo procitate pa ocekujem neke komentare
 
Odgovor na temu

icobh
Igor Pejašinović
Network Admin
Navigo SC d.o.o.
Banja Luka

Član broj: 18738
Poruke: 1319
*.inecco.net.

Sajt: www.nsc.ba


+4 Profil

icon Re: vbSokoban: Hajde da napravimo igru!02.11.2006. u 23:44 - pre 185 meseci
Nešto ovako:

I ♥ ♀

Ovaj post je zlata vrijedan!
Prikačeni fajlovi
 
Odgovor na temu

Shadowed
Vojvodina

Član broj: 649
Poruke: 12816



+4751 Profil

icon Re: vbSokoban: Hajde da napravimo igru!03.11.2006. u 02:03 - pre 185 meseci
Eto mene u skoro 3h... Procitao sam skoro sve. Preskocio sam Undo i Reset i ovo posle... Pogledacu mozda kasnije, ali ne verujem da bih imao nekih zamerki.
Dobar je tutorijal. Lepo si objasnio sve delove i igra je kompletna. Dobro je i to sto se nisi zadrzavao previ se na sintaksi.
Imam i par komentara/zamerki :).
Turorijal:
•Bolje bi bilo da si objavljivao poruku po poruku tako da mozes manje iskusnima da dodatno objasnis sta/kako/zasto je uradjeno u tom koraku
•Kada pises u Notepad-u, pre nego sto kopiras tekst iskljuci Word wrap :).
Code:
•Mnogo proreda :). Npr. kod case-ova i udnezdenih if. Kad imas vise koda, to je previse skrolovanja i postaje nepregledno (ne mislim na ovaj tut. vec uopste)
•Ne znam vise napamet, ali kod ucitavanja nivoa iz fajla, imas gomilu ReDim-ova (tj. nema ih mnogo nego se ponavljaju). Posto je ReDim zahtevnija operacija (premetacina u memoriji i ponovni maloc()), a fajlovi su ionako mali, predlazem da se prvo jednom izcita fajl i utvrde dimenzije, izvrsi jedan ReDim a zatim ponovo izcita fajl i upise. OK, moglo bi ovo i sa jednim citanjem... ali da ne komplikujemo previse :).
Nacin implementacije:
•Ovaj projekat vapi za apstrakcijom (i koriscenjem OOP-a). Mnogo bolje resenje je da cela igra bude jedna klasa sa uredjenom strukturom i metodima i da sve radi unutar nje umesto da je sve toliko povezano.
Primer: iz modula crtas direktno na formu (tj. picbox na formi). Bolji nacin je da funkciji u modulu prosledis hdc na koji ce crtati. Tako onda mozes iscrtavati gde ti je potrebno.
Mozda jednom uradim (ako me ne preteknes) OOP verziju sokoban sutorijala (inace moja omiljena igra) ali ce to verovatno biti vb.net pa se mozemo sinhronizovati/crosslinkovati :).
Sto se ove poslednje tacke tice, tutorijal lepo prikazuje kako se igra moze jednostavno napraviti ali mozda nije lose da prikazuje na nacin kako se to dobro radi :).

Ovo je jedan od retkih a ovako opsirnih tutorijala na srpskom jeziku i zasluzuje sve pohvale.
Svaka cas'.

P.S. ;)
 
Odgovor na temu

Zed Mc Jack
Programer
Bečej

Član broj: 93120
Poruke: 137
*.adanet.co.yu.

Sajt: www.subakov.com


Profil

icon Re: vbSokoban: Hajde da napravimo igru!03.11.2006. u 07:52 - pre 185 meseci
Svaka čast za ovaj tutorijal!

Ovo je upravo ono što je potrebno da bi se ukazalo ljudima koji su zainteresovani za pravljenje igara kako se to radi na primeru dovoljno jednostavnom da ne zahteva pisanje knjige.

Još jednom čestitke.

Nastavite u istom stilu, bez obzira ko piše i u kom alatu.
www.subakov.com Jedini Visual FoxPro sajt u Srbiji
 
Odgovor na temu

tasman_76_82
Beograd

Član broj: 117316
Poruke: 39
212.200.218.*



Profil

icon Re: vbSokoban: Hajde da napravimo igru!03.11.2006. u 21:05 - pre 185 meseci
:-) Sta reci.. Svaka cast... ja se ovde ubih praveci neki glupavi programcic koji povezujeVB i excel, a ti... igricu.. Svaka cast! I, sto je najbitnije, extra je objasnjeno...
A sta mislis da mi dajes casove VB-a?
 
Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net


+44 Profil

icon Re: vbSokoban: Hajde da napravimo igru!03.11.2006. u 23:50 - pre 185 meseci
Citat:

Imam i par komentara/zamerki :).

jednom zakeralo, uvek zakeralo :D (sala mala)

Citat:

•Bolje bi bilo da si objavljivao poruku po poruku tako da mozes manje iskusnima da dodatno objasnis sta/kako/zasto je uradjeno u tom koraku

kada sam zapoceo ovaj tutorijal (davno to bese, spremao sam ga za vbcoding...) mislio sam da cu ga objaviti u chm formatu tako da je zbog toga ispalo ovako neprekledno (da bar es ima expand/collapse code block opciju), sledeci put ce biti urednije! :D

Citat:

•Kada pises u Notepad-u, pre nego sto kopiras tekst iskljuci Word wrap :).

nispam pisao u Notepadu vec u Editplusu i nikada ne koristim Word Wrap :) (mislim da sam ja jedini kome nikad nece biti jasno sta opcija Word Wrap trazi u code editoru)

Citat:

•Mnogo proreda :). Npr. kod case-ova i udnezdenih if. Kad imas vise koda, to je previse skrolovanja i postaje nepregledno (ne mislim na ovaj tut. vec uopste)

proredi su moj stil kodiranja :)
meni nekad moze da bude neprekledno ako nema razmaka izmedju If..Then linije i linije ispod nje, isto vazi i za Select Case i ostale Case-ove... mada jeste nezgodno ovako na netu skrolovati ovoliki text (sreca pa imam skrol na tastaturi da ne potezem za pacovom non-stop :D)

Citat:

•Ne znam vise napamet, ali kod ucitavanja nivoa iz fajla, imas gomilu ReDim-ova (tj. nema ih mnogo nego se ponavljaju). Posto je ReDim zahtevnija operacija (premetacina u memoriji i ponovni maloc()), a fajlovi su ionako mali, predlazem da se prvo jednom izcita fajl i utvrde dimenzije, izvrsi jedan ReDim a zatim ponovo izcita fajl i upise. OK, moglo bi ovo i sa jednim citanjem... ali da ne komplikujemo previse :).

tacno je da je kod dosta neoptimizovan, ali nisam hteo da idem toliko u detalje (kao sto si primetio nigde nema ni traga od error hendlinga) jer je ovaj tutorijal namenjen skoro apsolutnim pocetnicima (moraju da znaju sta je to niz i ReDim jer to nisam objasnjavao :D)

Citat:

•Ovaj projekat vapi za apstrakcijom (i koriscenjem OOP-a). Mnogo bolje resenje je da cela igra bude jedna klasa sa uredjenom strukturom i metodima i da sve radi unutar nje umesto da je sve toliko povezano.
Primer: iz modula crtas direktno na formu (tj. picbox na formi). Bolji nacin je da funkciji u modulu prosledis hdc na koji ce crtati. Tako onda mozes iscrtavati gde ti je potrebno.
Mozda jednom uradim (ako me ne preteknes) OOP verziju sokoban sutorijala (inace moja omiljena igra) ali ce to verovatno biti vb.net pa se mozemo sinhronizovati/crosslinkovati :).
Sto se ove poslednje tacke tice, tutorijal lepo prikazuje kako se igra moze jednostavno napraviti ali mozda nije lose da prikazuje na nacin kako se to dobro radi :).

ovde nisam ni pomisljao da uvodim oop (mada je vb sav u objektima tako da hteli-nehteli mi koristimo oop, ali znas na sta mislim) jer kao sto sam naveo negde u tekstu: ovaj tutorijal samo treba da olaksa prve korake ka (ne i u) svetu programiranja igara.

bice i "full-oop" tutorijal (dali cce biti igra ili ne, to ne znam jos uvek)

a cilj tutorijala mi je bio da pokazem kako se jednostavno pravi igra, ne i kako se dobro pravi :D (bice i to, cim uhvatim malo vremena)


@tasman_76_82:
tesko ce ici to za casove, jer si ti iz bg-a a ja iz cacka (mada bih sledece godine trebao da predjem za bg :D) ali prati ti ovaj forum, imam ja u planu jos par tutorijala, ne samo vezanih za igre


 
Odgovor na temu

[es] :: Visual Basic 6 :: vbSokoban: Hajde da napravimo igru!

Strane: 1 2

[ Pregleda: 12519 | Odgovora: 38 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.