Problem med Rnd + ein ting til

[Scix]

satt her og mekka i går kveld, da eg plutselig merka at rnd koden min ga den samme rekka med tall kvar gang.

første trykk : 75523707

andre trykk: 87048739

restarter programmet

første trykk: 75523707

andre trykk: 87048739

 

og slik forsetter det. kva er feil. lasta ned programmet på ei anna maskin. samme problemet der

Dim iTall, iTeller As Integer
Dim strTallene As String

For iTeller = 0 To 7
   iTall = Int(10 * Rnd)
   strTallene = strTallene & iTall
Next iTeller

Label1.Caption = strTallene

 

 

så sitter eg å lager eit litt større "Trip Trap Tresko" spill

 

korleis kan eg få programmet til å sjøl telle kor mange X-ar og O-ar det er på rekke. det er ein vinnar når det er 5 på rekke. brette er 10x10 ruter

[j000rn]

Kjør "Randomize" funksjonen først.

[Scix]

slik meiner du

Dim iTall, iTeller As Integer
Dim strTallene As String

For iTeller = 0 To 7
  iTall = Int(Rnd * 10)
  strTallene = strTallene & iTall
Next iTeller

Label1.Caption = strTallene

 

Det hjelper i alle fall ikkje

[aadnk]

Det er litt vanskelig å hjelpe deg med Trip-trapp-tresko spørsmålet da jeg ikke vet hvordan du lagrer de respektive brikkene i spillet. Kan du spesifisere litt mer nøyaktig hvordan du lagrer informasjonen? Er det med kontroller, eller er det med en array i minnet?

 

Og når det gjelder å få tilfeldighetsgeneratoren med "tilfeldig", må du gjøre slik:

 

Dim iTall, iTeller As Integer
Dim strTallene As String

Randomize

For iTeller = 0 To 7
 iTall = Int(Rnd * 10)
 strTallene = strTallene & iTall
Next iTeller

Label1.Caption = strTallene

Endret 29. mai 2004 av aadnk

[Scix]

det er heilt vanlige kontrollere i trip-trap-tresko. bruker trykker på ei rute, og det kommer ein X eller O i ruta, alt ettersom kven som trykte sist

[aadnk]

Legg følgende kode inn i formen:

 

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Public Function IsGameWon(Form As Form, lpPoint() As Object) As Long

Dim lpArray() As Object, Cnt&, Tell&, N&, CurrentSmallest&
Dim RetVal As Long, Point() As Long, Control As Control

For Each Control In Form
   If IsNumeric(Control.Tag) Then
       ReDim Preserve lpArray(Cnt)
   
       Set lpArray(Cnt) = Control
       Cnt = Cnt + 1
   End If
Next

If Cnt = 0 Then
   IsGameWon = -1
   Exit Function
End If

' Sorter matrisen
For Tell = LBound(lpArray) To UBound(lpArray)
   
   CurrentSmallest = Tell

   For N = Tell To UBound(lpArray)
       If Val(lpArray(N).Tag) < Val(lpArray(CurrentSmallest).Tag) Then
           CurrentSmallest = N
       End If
   Next
   
   If CurrentSmallest <> Tell Then Swap lpArray(Tell), lpArray(CurrentSmallest)
Next

RetVal = CheckArray(lpArray, Point)

If RetVal = -1 Then
   IsGameWon = -1
   Exit Function
End If

ReDim lpPoint(UBound(Point))

For Tell = LBound(Point) To UBound(Point)
   Set lpPoint(Tell) = lpArray(Point(Tell))
Next

IsGameWon = RetVal

End Function

Private Function CheckArray(lpArray() As Object, lpPoint() As Long) As Long

Dim Tell&, LastVal$, Cnt&, Tmp&, Buff$, Way&, Num&, Player&

' Sjekk alle horisontale, vertikale og diagonale pontensielle vinner-rekker
For Way = 0 To 2
   For Tell = 0 To IIf(Way = 2, 10, 9)
       
       Cnt = 0
       LastVal = ""
       
       For Tmp = 0 To 9
           
           ReDim Preserve lpPoint(Cnt)
           
           If Way = 0 Then
               lpPoint(Cnt) = Tmp + (Tell * 10)
           ElseIf Way = 1 Then
               lpPoint(Cnt) = Tell + (Tmp * 10)
           Else
               Num = (5 + Tell) - 2 * IIf(Tell > 5, Tell - 5, 0)
               If Tmp >= Num Then Exit For
               lpPoint(Cnt) = (Num + (Tmp * 9) - 1 + IIf(Tell > 5, 11 * (Tell - 5), 0))
           
               If Way = 3 Then
                   Num = Val(Mid(lpPoint(Cnt) + 10, 2, 1))
                   lpPoint(Cnt) = lpPoint(Cnt) + (8 - (2 * Num)) + 1
               End If
           End If
           
           Buff = lpArray(lpPoint(Cnt)).Caption
           If LastVal = "" Then LastVal = Buff
                      
           If Buff = LastVal And Buff <> "" Then
               Cnt = Cnt + 1
               Player = IIf(UCase(Buff) = "O", 0, 1)
           Else
               Erase lpPoint
               Cnt = 0
           End If
           
           LastVal = Buff
           
           If Cnt = 4 Then
               ' Vi har en vinner!
               CheckArray = Player
               Exit Function
           End If
       Next
   Next
Next

' Ingen vinner
Erase lpPoint
CheckArray = -1

End Function

Private Function Swap(ObjectOne As Control, ObjectTwo As Control)

Dim Tmp&

CopyMemory Tmp, ByVal VarPtr(ObjectOne), 4
CopyMemory ByVal VarPtr(ObjectOne), ByVal VarPtr(ObjectTwo), 4
CopyMemory ByVal VarPtr(ObjectTwo), Tmp, 4

End Function

 

Etter dette kan du kalle funksjonen IsGameWon for å sjekke om noen har vunnet. Du bruker koden slik:

 

Dim Point() As Object, Ret As Long

Ret = IsGameWon(Me, Point)

 

Ret er -1 hvis ingen har vunnet, 0 hvis spiller 1 har vunnet (X) og 1 hvis spiller 2 har vunnet (O). Point er en array over de kontrollene som vinnerrekken innbefatter.

 

I tillegg må du sette ett tall i Tag egenskapen hos alle kontrollene. Begynn på kontrollen helt til venstre og på toppen og sett den til 0. Gå så videre mot venstre med et stadig høyere tall. Når du kommer til den siste kontrollen går du ned ett hakk og fortsetter.

 

I koden har jeg antatt at du bruker labels, så gjør du det ikke, er jeg redd du må gjøre alt om til labeler for å få koden til å virke.

 

Bare si ifra hvis du oppdager bugs. Jeg ikke har fått mulighet å teste hele koden, kun små deler av den, så det er mulig at det er ett par.

 

Mvh,

aadnk.

Endret 29. mai 2004 av aadnk