Yatzy prosjekt i VB6.0, terning trøbbel ;)

[sxxxe83]

Har holdt på med Visual Basic 6.0 3t i uka(undervisning) siden skolestart nå i høst, så noen racer i VB er jeg ikke.

 

Vi har et lite Yatzy prosjekt pågående, ting begynner å ta form, men jeg har noen små problemer:

 

Da jeg begynte med Yatzy hadde jeg lblTerninger(1 to 5), og plassering av sum skjer også i en label, henholdsvis lblVerdi(1 to 18) der (1) til (6) er over strek, en til seksere, (7) er sum, (8) er bonus, (9) er et par osv (18) er total sum. Summering med lblTerningene fungerer smertefritt, med unntak av at jeg ikke er helt ferdig med 2 par utregningen, og noen andre ting.

 

Greia var at jeg ville prøve ut med bilder på terningene så dette ser litt mere "livlig" ut.

Da har jeg picTerning(1 to 5).Picture, loading av terning bildene random fungerer som det skal, problemet med bilde terningene er at jeg IKKE får plassert noen sum i summering "labelen", og jeg klarer rett og slett ikke å se hva som er problemet.

 

Mulig noen av dere her inne har vært borti samme problem en eller annen gang, anyway, legger ut litt av koden her så kan dere se selv:

 

Layouten er som følger, HovedMeny, velge antall spillere, taste inn navn på spiller 1 , spiller to er ikke ferdig =)(Form2), IN game (Form1) og en frmAbout (Form3)

 

Kasting av lbl Terninger fungerer bra!

'Triller 5 terninger, huk av, og terningen blir husket på
For i = 1 To 5
If chkSjekk(i).Value = Unchecked Then
Randomize 'Frisker opp rnd slik at tallet blir tilfeldig
Terning(i) = Int(Rnd * 6) + 1
lblTerning(i).Caption = Terning(i)
End If
Next i

 

Kasting av pic terninger fungerer også bra!

'Triller 5 terninger, huk av, og terningen blir husket på
For j = 1 To 5
If chkSjekk(j).Value = Unchecked Then
Randomize
Terning(j) = Int(Rnd * 6) + 1 'Frisker opp rnd slik at tallet blir tilfeldig
For i = 1 To 6
If Terning(j) = i Then
picTerning(j).Picture = LoadPicture("c:\" & i & ".jpg")
End If
Next i
End If
Next j

 

Plassering av sum med label terningene, dette er over KUN over streken

Private suben heter: Private Sub lblVerdi_Click(Index As Integer)

If lblVerdi(Index) = "" Then
If Index < 7 Then
For i = 1 To 5 'terningene er indexsert fra 1 til 5
If Val(lblTerning(i).Caption) = Index Then
'terningenes verdi skal være det samme som indeksen
verdi = verdi + Index
End If
lblTerning(i).Caption = "" 'Fjerner label terningene
Next i
lblVerdi(Index).Caption = verdi 'skriver ut til lblVerdi  
lblTellkast.Caption = ""   'Sletter tell kast labelen

If Kast < 2 Then ' Plasser verdi, så får du nye kast
Kast = 0
ElseIf Kast > Val(2) Then ' Spilleren har tre mulige kast
Kast = 0
ElseIf Kast > Val(1) Then ' Spilleren har tre mulige kast
Kast = 0
End If
lblUt.Caption = "" 'Sletter DU HAR KUN TRE KAST labelen
End If

Plassering av sum med picTerningene er nesten identisk med den over men kan jo ta den med! Kan jo si at bildene heter 1.jpg, 2.jpg, 3.jåg, 4.jpg, 5.jpg, 6.jpg og i dette tilfellet ligger de på c:\ skal visstnok gå ann å ha bildene i "prosjekt" mappa men fikk det ikke til, prøvde noe som

 

picTerning(j).Picture = LoadPicture("pics\" & i & ".jpg") da ligger bildene i mappen pics, sammen med koden.

 

Men det fungerer selvsagt ikke..

 

Dette er også KUN over streken

 

If lblVerdi(Index) = "" Then
If Index < 7 Then
For i = 1 To 5 'terningene er indexsert fra 1 til 5
If Val(picTerning(i).Picture) = Index Then
'terningenes verdi skal være det samme som indeksen
verdi = verdi + Index
End If
picTerning(i).Picture = LoadPicture() 'Fjerner terning bildene
Next i
lblVerdi(Index).Caption = verdi 'skriver ut til lblVerdi
lblTellkast.Caption = ""   'Sletter tell kast labelen
            
If Kast < 2 Then ' Plasser verdi, så får du nye kast
Kast = 0
ElseIf Kast > Val(2) Then ' Spilleren har tre mulige kast
Kast = 0
ElseIf Kast > Val(1) Then ' Spilleren har tre mulige kast
Kast = 0
End If
lblUt.Caption = "" 'Sletter DU HAR KUN TRE KAST labelen
End If

 

Mulig jeg har gjort det litt vanskelig med tellkast greiene og begrensingen av antall kast, men det fungerer som det skal nå =), det ferdige produktet må nok har en litt bedre løsning.

 

Håper noen har vært borti lignende og kan "SPARKE" meg i riktig retning

 

Mvh Torgeir

Endret 25. november 2006 av sxxxe83

[GeirGrusom]

For i = 1 To 5 'terningene er indexsert fra 1 til 5
If Val(picTerning(i).Picture) = Index Then
'terningenes verdi skal være det samme som indeksen
verdi = verdi + Index
End If
picTerning(i).Picture = LoadPicture() 'Fjerner terning bildene
Next i

 

Val(picTerning(i).Picture) vil enten gi feil, eller alltid null

Du kan lagre verdien i object.Tag for enkelhetens skyld.

Value = Val(picTerning.Tag)

 

Men du skriver heller aldri Set når du endrer en klasse:

Set picTerning(i).Picture = LoadPicture(...)

Set picTerning(i).Picture = Nothing

[aadnk]

Terning(i) = Int(Rnd * 6) + 1

7354444[/snapback]

Bemerk at denne koden vil til enkelte tider også gi tallet 7 (når Rnd er én), hvilket du kan løse på følgende måte:

Terning(i) = 1 + Fix(Rnd * 5.99)

 

picTerning(j).Picture = LoadPicture("pics\" & i & ".jpg") da ligger bildene i mappen pics, sammen med koden.

 

Men det fungerer selvsagt ikke..

7354444[/snapback]

Legg først inn følgende funksjon i modulen:

Public Function ValidPath(Path As String) As String

 

    ' Legger til et adskilletegn i slutten av teksten dersom den ikke finnes

    ValidPath = Path & IIf(Right(Path, 1) = "\", "", "\")

 

End Function

Bruk dernest følgende kode:

Set picTerning(j).Picture = LoadPicture(ValidPath(App.Path) & "pics\" & i & ".jpg")

 

Men, du bør lagre terningverdiene på en annen måte, eksempelvis i .Tag-egenskapen, slik GeirGrusom nevnte, eller i en Array. Da sparer du deg for masse unødvendig arbeid.

 

For øvrig har jeg òg laget et Yatzy-spill i VB6. Det er nok enda litt for komplisert for ditt nivå, men du kan muligens benytte deler av koden i ditt program (eller få inspirasjon). Blant annet benytter jeg ikke bilder til å tegne terningene, tvert imot gjøres det ved å tegne primitive geometriske figurer:

Public Sub DrawDice(Control As Object, X As Long, Y As Long, Width As Long, Height As Long, Number As Long, Optional PointSpace As Double, Optional Background As Long = vbWhite, Optional CircleColor As Long = vbBlack, Optional CircleBorder As Long = vbBlack, Optional BorderColor As Long = vbBlack)

 

    Dim Radius As Double, cX As Long, cY As Long

 

    ' Firstly draw the dice itself

    Control.Line (X, Y)-(X + Width, Y + Height), Background, BF

 

    ' Then draw the border

    Control.FillStyle = 1

    Control.Line (X, Y)-(X + Width, Y + Height), BorderColor, B

 

    ' Calculate the radius of the circles

    Radius = Width / 10

 

    ' Set the fillstyle and fillcolor

    Control.FillColor = CircleColor

    Control.FillStyle = 0

   

    ' The position of the center

    cX = X + (Width / 2)

    cY = Y + (Height / 2)

   

    ' Default space

    If PointSpace <= 0 Then

        PointSpace = (Radius * 2.5)

    End If

   

    ' All these dices has a point in the middle

    If Number = 1 Or Number = 3 Or Number = 5 Then

        Control.Circle (cX, cY), Radius, CircleBorder

    End If

 

    ' And finaly draw the rest of the circles

    Select Case Number

    Case 2, 3

        Control.Circle (cX + PointSpace, cY - PointSpace), Radius, CircleBorder

        Control.Circle (cX - PointSpace, cY + PointSpace), Radius, CircleBorder

   

    Case 4, 5

        Control.Circle (cX - PointSpace, cY - PointSpace), Radius, CircleBorder

        Control.Circle (cX + PointSpace, cY - PointSpace), Radius, CircleBorder

        Control.Circle (cX - PointSpace, cY + PointSpace), Radius, CircleBorder

        Control.Circle (cX + PointSpace, cY + PointSpace), Radius, CircleBorder

   

    Case 6

        Control.Circle (cX - PointSpace, cY - PointSpace), Radius, CircleBorder

        Control.Circle (cX - PointSpace, cY), Radius, CircleBorder

        Control.Circle (cX - PointSpace, cY + PointSpace), Radius, CircleBorder

        Control.Circle (cX + PointSpace, cY - PointSpace), Radius, CircleBorder

        Control.Circle (cX + PointSpace, cY), Radius, CircleBorder

        Control.Circle (cX + PointSpace, cY + PointSpace), Radius, CircleBorder

   

    End Select

 

End Sub

For å benytte denne funksjonen, kaller du den med følgende paramentre: kontrollen som skal tegnes på (en bildeboks eller selve formen), X-posisjonen relativt til kontrollen hvor den skal tegnes (gjør det mulig å inngå å bruke en kontrollarray), Y-posisjonen, bredden, høyden og nummeret (fra 1-6) som skal tegnes:

DrawDice Me, 0, 0, 32, 32, Fix(Rnd * 5.99) + 1

Du bør også sette AutoRedraw og ScaleMode til henholdsvis True og Pixel i kontrollen det skal tegnes til.

Endret 25. november 2006 av aadnk

[sxxxe83]

Val(picTerning(i).Picture) vil enten gi feil, eller alltid null

Du kan lagre verdien i object.Tag for enkelhetens skyld.

Value = Val(picTerning.Tag)

 

Men du skriver heller aldri Set når du endrer en klasse:

Set picTerning(i).Picture = LoadPicture(...)

Set picTerning(i).Picture = Nothing

7354802[/snapback]

 

Ok, takker for svar/løsning, skal prøve ut litt så jeg har fått i meg noe mat..

[sxxxe83]

WOW =)

Her var det litt av hvert ja, skal ta tak i, prøve ut og kommentere så raskt jeg har fått i meg noe mat, kom akkurat hjem fra en liten lørdags jobbing.

 

Har fått med meg hjemmesiden din, er veldig imponert, og jeg ble veldig inspirert av dette.

Men mye er altfor komplisert, er nok en del ting jeg må lære først før jeg, i det hele tatt klarer å skjønne hva som skjer i koden.

 

Har prøvd ut Yatzy`n din, og er mektig imponert. Men virket veldig avansert, har ikke vært borti modul før, må nok lese litt, mye interessant en finner om vb på internett, og sider som din er jo bare helt genial for sånne som meg

Legg først inn følgende funksjon i modulen:

 

 

Public Function ValidPath(Path As String) As String

 

    ' Legger til et adskilletegn i slutten av teksten dersom den ikke finnes

    ValidPath = Path & IIf(Right(Path, 1) = "\", "", "\")

 

End Function

Endret 25. november 2006 av sxxxe83

[sxxxe83]

Legg først inn følgende funksjon i modulen:

 

 

Public Function ValidPath(Path As String) As String

 

    ' Legger til et adskilletegn i slutten av teksten dersom den ikke finnes

    ValidPath = Path & IIf(Right(Path, 1) = "\", "", "\")

 

End Function

 

Bruk dernest følgende kode:

 

Set picTerning(j).Picture = LoadPicture(ValidPath(App.Path) & "pics\" & i & ".jpg")

 

Modul var grei å sette opp, loading av bilder fra kode mappa, fungerte bra. Sliter litt med å få picTerning verdien til å legges i TAG funksjonen Picturebox har, for så å legge den verdien i lblVerdien... Sliter litt med fremgangsmåten å tenke på, men skal ikke gi opp nå...