Kirjautuminen

Haku

Tehtävät

Keskustelu: Ohjelmointikysymykset: VB6: Korttipeli

Sivun loppuun

zigilii [21.06.2004 14:37:10]

#

Oon tekemässä korttipeliä joka arpoo 2 korttia ja katsoo kumpi on suurempi kortti. Toi onnistui, mutta sitten huomasin virheen: Joskus se arpo kaksi samaa korttia
Tietenkin näin on mahdollista tapahtua jos koodi on sellainen kun se on tällä hetkellä.
Eli mitä täytyisi tehdä että se korjaisi tuon virheen. Ja miten saisi tehtyä pakan (siis laittaisi kortit johonkin sattuman varaiseen järjestykseen ja jokaista korttia olisi vain yksi).

Koodi:

Private Sub Form_Click()

For i = 0 To 1 'korttien määrä

    Randomize 'lisätään satunnaisuutta

    kortti = Int(Rnd * 52) 'arvotaan kortti

    X = cdtDraw(Me.hdc, i * 70, 0, kortti, 0, 0) 'piirretään kortti

Next

End Sub

Private Sub Form_Load()
'Aluksi on kutsuttava cdtInit-funktiota, joka palauttaa
'kortin leveyden ja korkeuden

X = cdtInit(leveys, korkeus)
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Lopuksi kutsutaan cdtTerm-käskyä, joka lopettaa cards.dll:n käytön.

cdtTerm
End Sub

ja moduuliin

Declare Function cdtInit Lib "cards.dll" (dx As Long, dy As Long) As Long

Declare Function cdtDrawExt Lib "cards.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal iCard As Long, ByVal iDraw As Long, ByVal clr As Long) As Long

Declare Function cdtDraw Lib "cards.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal iCard As Long, ByVal iDraw As Long, ByVal clr As Long) As Long

Declare Function cdtAnimate Lib "cards.dll" (ByVal hdc As Long, ByVal cd As Long, ByVal X As Long, ByVal Y As Long, ByVal ispr As Long) As Long

Declare Function cdtTerm Lib "cards.dll" () As Long

Koodi on kopioitu Korttipeliohjelmointi-oppaasta.

tuomas [21.06.2004 14:42:14]

#

Tee aluksi kaksi muuttujaa Kortti1 ja Kortti2.
Arvo ensimmäinen kortti ja laita sen arvo muuttujaan kortti1.
Arvo sen jälkeen se toinen kortti ja sijoita sen arvo muuttujaan Kortti2.
Sitten vertailet kortti1:n ja Kortti2:n arvoja näin:

If Kortti1 = Kortti2 Then
'arvo kortti2 uudestaan
End If

'Kannattaa tehdä tuota vertailua varten vaikka uusi aliohjelma joka ajetaan joka kerta kun kortti on arvottu.

zigilii [21.06.2004 15:04:19]

#

Näinhän se kannattaa tehdä!
Ei tullut mieleen kun lähetin viestiäni tänne.
Mutta miten korttipakan voisi rakentaa

tuomas [21.06.2004 15:05:47]

#

Arvot siis ohjelmassa vain kaksi korttia 52:sta?
Tarkenna hieman vielä tuota "pakan rakentamista"

zigilii [21.06.2004 15:09:54]

#

zigilii kirjoitti:

Ja miten saisi tehtyä pakan (siis laittaisi kortit johonkin sattuman varaiseen järjestykseen ja jokaista korttia olisi vain yksi).

kun on normaali korttipakka ja siittä nostaa kortteja -> samaa korttia ei tulisi uudestaan

tuomas [21.06.2004 15:11:47]

#

Siis kun kortti on arvottu se siirretään pois pakasta ja sitä ei enää tule uudestaan?

zigilii [21.06.2004 15:14:19]

#

Just silleen

tuomas [21.06.2004 15:21:31]

#

No, tee vaikka taulukko jossa kortit ovat

Dim Kortit(1 To 52)

ja sitten teet aliohjelman jossa on silmukka joka laittaa
aina yhden kortin yhteen taulukon soluun.

Private Sub UusiPeli()
'käydään taulukko läpi
For i = 1 To 52
   'käydään kortit läpi
   For j = 1 To 52

    Kortit(i) = kortti(j)

   Next

Next
End Sub

Sitten kun jokin kortti arvotaan se poistetaan taulukosta.
Muokkaa myös arvonta sellaiseksi että se arpoo kortteja taulukosta eikä jostain lukumäärästä.
Yritä vaikka itse ensin, ja jos ei onnistu niin pyydä apua uudelleen.

zigilii [21.06.2004 15:51:22]

#

Ähh, en vaan osaa.
EI EI EI EI
Päässä pyörii kaikenlaista koodia mutta mikään ei toimi.

tuomas [21.06.2004 17:08:21]

#

No autetaan hieman lisää...

tehdään toinen taulukko jossa on tieto siitä mitkä kortit ovat arvottu(arvo on taulukossa 0 jos ei ole arvottu ja 1 jos on arvottu):

Dim Arvotut(1 To 50)

Sitten lisää seuraava koodi Uusipeli subbariin:

For i = 1 To 52
    Arvotut(i) = 0
Next

Sitten suoritetaan arvonta(tee tälle myös oma aliohjelma):

Kortti = Kortit(Int(rnd * 52))

If Arvotut(kortti) = 0 then
   'näytetään kortti
   Arvotut(kortti) = 1
Else
   'kortti on jo arvottu
end if

En ole testannut koodia, mutta luulisin että se toimii.

hunajavohveli [21.06.2004 18:09:10]

#

Enpä ole ikinä korttipeliä yrittänyt väsätä, mutta kolmen ja puolen kokemuksella ohjelmoinnista sanoisin, että ei todellakaan tarvita mitään "Kortit", tai "Arvotut"-taulukoita, vaan sen sijaan tarvitaan taulukot niille paikoille, joissa kortteja voi olla, eli siis pelistä riippuen esimerkiksi "Pakka", "Käsi", jne.

Tämä on ensinnäkin oikea lähtökohta:

Type Kortit
   Maa As Integer
   Väri As Integer
End Type

Dim Pakka(1 To 52) As Kortit
Dim Käsi(1 To 7) As Kortit    'jos 7 on vaikka maksimi määrä kortteja kädessä

Koska voin noin 95% varmuudella sanoa, että jollain toisella systeemillä tehdessä tulee myöhemmin huomattavia ongelmia. En siis ole koskaan korttipeliä koodannut, mutta kylläkin pelejä, joissa on tämäntyyppisiä systeemejä, ja voin sanoa, että itse olen havainnut tämän ainoaksi järkeväksi tavaksi.
Tuosta koodista voi sitten oman järjen mukaan jatkaa eteenpäin, tai jos ei onnistu, niin kysy lisää.

tuomas [21.06.2004 18:28:23]

#

tuohan on paljon kätevämpi :)
No, itse en silti omista omituisista ohjelmointi tavoistani luovu.
Mutta zigilii, käytä tuota soodan tapaa.

hunajavohveli [21.06.2004 18:31:38]

#

tuomas kirjoitti:

Mutta zigilii, käytä tuota soodan tapaa.

Mitä tapaa oikein tarkoitat? Eihän sooda ole vastannut koko aiheeseen. :)

tuomas [21.06.2004 18:51:12]

#

hups, sekosin nimissä :)
Elä suutu.

Antti Laaksonen [22.06.2004 00:13:02]

#

Pakassa olevat kortit kannattaa tosiaan tallentaa taulukkoon oman tietotyypin avulla. Jokaisesta kortista tallennetaan ainakin maa (= väri, 0 - 3), arvo (1 - 13) ja tila (pakassa, pelaajan kädessä, poispantuna...). Tämän jälkeen pakan voi sekoittaa esimerkiksi seuraavilla tavoilla:

  1. Kortit laitetaan järjestyksessä pakkaan. Tämän jälkeen arvotaan tietty määrä korttipareja, jotka vaihtavat keskenään paikkaa pakassa. Mitä useampi pari arvotaan, sitä perusteellisempi sekoitus on.
  2. Kortit laitetaan järjestyksessä apupakkaan. Arvotaan 52 satunnaislukua, joka kerralla arvonnan yläraja on apupakan koko ja apupakasta otetaan viimeksi arvottu kortti pois. Varsinaiseen pakkaan laitetaan näin arvotut kortit.

Esimerkki molemmista sekoitustyyleistä:

Private Type KORTTI
    maa As Integer   'kortin maa, 0 - 13
    arvo As Integer  'kortin arvo, 1 - 13
    tila As Integer  'kortin tila, aluksi esim. 0
End Type

Dim Pakka(51) As KORTTI

Sub Sekoitus1()
    Dim i As Integer, v As KORTTI
    Dim k1 As Integer, k2 As Integer

    'laitetaan kortit järjestyksessä pakkaan
    For i = 0 To 51
        Pakka(i).maa = i Mod 4
        Pakka(i).arvo = i \ 4 + 1
        Pakka(i).tila = 0
    Next

    'vaihdetaan korttiparien paikat 5000 kertaa
    For i = 1 To 5000
        'arvotaan vaihdettavat kortit
        k1 = Int(Rnd * 52)
        k2 = Int(Rnd * 52)
        'vaihto apumuuttujan avulla
        v = Pakka(k2)
        Pakka(k2) = Pakka(k1)
        Pakka(k1) = v
    Next
End Sub

Sub Sekoitus2()
    Dim i As Integer, j As Integer
    Dim ap(51) As KORTTI, a As Integer

    'laitetaan kortit järjestyksessä apupakkaan
    For i = 0 To 51
        ap(i).maa = i Mod 4
        ap(i).arvo = i \ 4 + 1
        ap(i).tila = 0
    Next

    'arvotaan kaikki 51 korttia
    For i = 51 To 0 Step -1
        'arvotaan uusi kortti jäljelläolevista
        a = Int(Rnd * (i + 1))
        'lisätään kortti pakkaan
        Pakka(i) = ap(a)
        'poistetaan arvottu kortti apupakasta
        For j = a To i - 1
            ap(j) = ap(j + 1)
        Next
    Next
End Sub

Sub NaytaPakka()
    Dim i As Integer, t As String, m As String
    m = "parurihe"
    'muodostetaan merkkijono kaikista pakan korteista
    For i = 0 To 51
        t = t & Mid(m, Pakka(i).maa * 2 + 1, 2) & Pakka(i).arvo & " "
    Next
    MsgBox t
End Sub

Private Sub Form_Load()
    Randomize Timer
    'sekoitustyyli 1
    Sekoitus1
    NaytaPakka
    'sekoitustyyli 2
    Sekoitus2
    NaytaPakka
End Sub

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta