|
| Lav et virtuelt sæt kort og bland dem - hj~ Fra : Mathias |
Dato : 30-04-04 19:43 |
|
Hej NG.
Jeg prøver på at lave et modul der opretter et virtuelt sæt kort, og
derefter (prøver på at) blande dem. Men det går ikke så godt. Resultatet
skal vises i en MsgBox, men jeg får bare 52 linier med det samme kort.
Kortet er forskelligt hver gang jeg kører modulet, men alle 52 linier er
ens. F.eks. først får jeg måske 52 linier med "Club 7", og derefter 52
linier med "Spade Queen".
Min source:
Option Explicit
Const AppTitle As String = "Shuffle Cards"
Sub Main()
Dim I As Integer, I2 As Integer, Cards(1 To 52) As String
Dim SymbolName(1 To 4) As String, NumberNames(1 To 13) As String
Dim Num As Integer, CardsShuffled(1 To 52) As String
Dim IsInThere As Boolean, sResult As String
Dim Item
SymbolName(1) = "Spade "
SymbolName(2) = "Heart "
SymbolName(3) = "Club "
SymbolName(4) = "Diamond "
NumberNames(1) = "Ace"
For I = 2 To 10
NumberNames(I) = I
Next
NumberNames(11) = "Jack"
NumberNames(12) = "Queen"
NumberNames(13) = "King"
For I = 1 To 4
For I2 = 1 To 13
Cards(I2 + (I - 1) * 13) = SymbolName(I) & NumberNames(I2)
Next
Next
Randomize
Num = Round(Rnd() * 52) + 1
CardsShuffled(1) = Cards(Num)
For I = 2 To 52
Do Until Not IsInThere
Randomize
Num = Round(Rnd() * 52) + 1
For Each Item In CardsShuffled
IsInThere = False
If Item = Cards(Num) Then
IsInThere = True
End If
Next
Loop
CardsShuffled(I) = Cards(Num)
Next
For Each Item In CardsShuffled
sResult = sResult & Item & vbCrLf
Next
MsgBox sResult, , AppTitle
End Sub
Det burde virke så vidt jeg kan se, men kan nogle af jer eksperter se
hvad der er galt?
--
Mathias
| |
Tomas Christiansen (30-04-2004)
| Kommentar Fra : Tomas Christiansen |
Dato : 30-04-04 23:59 |
|
Mathias skrev:
> Det burde virke så vidt jeg kan se, men kan nogle af jer eksperter se
> hvad der er galt?
Der er flere kedelige ting i din kode!
> Option Explicit
> Const AppTitle As String = "Shuffle Cards"
>
> Sub Main()
> Dim I As Integer, I2 As Integer, Cards(1 To 52) As String
> Dim SymbolName(1 To 4) As String, NumberNames(1 To 13) As String
> Dim Num As Integer, CardsShuffled(1 To 52) As String
> Dim IsInThere As Boolean, sResult As String
> Dim Item
Hvis du tilføjer As Variant, viser du at det ikke er en forglemmelse...
> SymbolName(1) = "Spade "
> SymbolName(2) = "Heart "
> SymbolName(3) = "Club "
> SymbolName(4) = "Diamond "
> NumberNames(1) = "Ace"
> For I = 2 To 10
> NumberNames(I) = I
> Next
> NumberNames(11) = "Jack"
> NumberNames(12) = "Queen"
> NumberNames(13) = "King"
> For I = 1 To 4
> For I2 = 1 To 13
> Cards(I2 + (I - 1) * 13) = SymbolName(I) & NumberNames(I2)
> Next
> Next
Allerede her kan jeg se at du har lagt op til en metode, som kræver mange
CPU-cykler for at få det hele til at gå op. Hvis du i stedet smider dine
kort ind i f.eks. en Collection og FJERNER dem, når de bruges, behøver du
ikke hver gang gennemsøge hele molevitten for at checke om kortet skulle
have været udtrukket.
> Randomize
> Num = Round(Rnd() * 52) + 1
Her går det da helt galt. Der er halvt så stor chance for at få det første
es som for at få noget andet kort. Til gengæld er der lige så stor stor
chance for at få kort nummer 53 som at få det første es!!!
Jeg tror at du mener: Num = Int(Rnd * 52 + 1)
> CardsShuffled(1) = Cards(Num)
> For I = 2 To 52
> Do Until Not IsInThere
> Randomize
Hvorfor nu det? Man bruger Randomize én (læs: 1) gang i sit program. Det
giver ikke _mere_ "tilfældige" tal bruge Randomize flere gange.
> Num = Round(Rnd() * 52) + 1
Igen: Udskift Round med Int.
> For Each Item In CardsShuffled
> IsInThere = False
> If Item = Cards(Num) Then
> IsInThere = True
> End If
> Next
Gal igen. Du glemmer altså for hver eneste kort du checker, om der tidligere
skulle være fundet et kort. Din initialisering af IsInThere skal naturligvis
ligge _udenfor_ løkken. Der er heller ingen grund til at fortsætte med at
lede, når du _har_ fundet kortet. Se her:
IsInThere = False
For Each Item In CardsShuffled
If Item = Cards(Num) Then
IsInThere = True
Exit For
End If
Next
> Loop
> CardsShuffled(I) = Cards(Num)
> Next
> For Each Item In CardsShuffled
> sResult = sResult & Item & vbCrLf
> Next
Strengt taget er det unødvendigt med en ekstra For-løkke til at gennemløbe
kortene igen. Du kan i stedet indsætte følgende linie som sidste linie i den
foregående For-løkke:
sResult = sResult & Cards(Num) & vbCrLf
> MsgBox sResult, , AppTitle
> End Sub
Jeg har ikke afprøvet de rettelser, som jeg er kommet med, men er rimelig
fortrøstningsfuld mht. resultatet.
-------
Tomas
| |
Tomas Christiansen (01-05-2004)
| Kommentar Fra : Tomas Christiansen |
Dato : 01-05-04 00:27 |
|
Mathias skrev:
> Jeg prøver på at lave et modul der opretter et virtuelt sæt kort, og
> derefter (prøver på at) blande dem.
Ja, jeg kunne altså ikke holde fingrene fra tasterne.
Her er en lidt anden måde at gøre det på:
Sub GiveMeADeck()
Dim SortedDeck As Collection
Dim CardCol As Variant
Dim CardVal As Variant
Dim CardNo As Long
Dim Result As String
Randomize
Set SortedDeck = New Collection
For Each CardCol In Array("Spar", "Ruder", "Klør", "Hjerter")
For Each CardVal In Array("es", "2", "3", "4", "5", "6", "7", "8",
"9", "10", "bonde", "dame", "konge")
SortedDeck.Add CardCol & " " & CardVal
Next
Next
Do
CardNo = Int(Rnd * SortedDeck.Count + 1)
Result = Result & SortedDeck(CardNo) & vbCr
SortedDeck.Remove CardNo
Loop Until SortedDeck.Count = 0
MsgBox Result
End Sub
-------
Tomas
| |
Mathias (27-08-2004)
| Kommentar Fra : Mathias |
Dato : 27-08-04 17:57 |
|
Jeg takker for hjælpen!
| |
SENygaard (27-08-2004)
| Kommentar Fra : SENygaard |
Dato : 27-08-04 18:34 |
|
Sendte deg et komplett Reversi kortspill i VB. Du finner mye snadder der.
www.vapsim.com
| |
SENygaard (27-08-2004)
| Kommentar Fra : SENygaard |
Dato : 27-08-04 18:36 |
|
"Fake" email? Hvorfor? Du spør om hjelp men er så frekk at du er anonym?
www.vapsim.com
| |
Tomas Christiansen (28-08-2004)
| Kommentar Fra : Tomas Christiansen |
Dato : 28-08-04 00:24 |
|
SENygaard skrev:
> "Fake" email? Hvorfor? Du spør om hjelp men er så frekk at du er anonym?
Ingen som er ved deres fulde fem, opgiver sin rigtige e-mail adresse i
klartekst i en nyhedsgruppe.
Det er den sikre vej til at blive spammet!
Jeg gør det dog, men, så snart spamningen bliver for voldsom, skifter jeg
adressen ud med en ny (rart at have den mulighed).
Min faste bekendtskaber er naturligvis bekendt med min faste
ikke-udskiftelige e-mail adresse.
-------
Tomas
| |
KS (28-08-2004)
| Kommentar Fra : KS |
Dato : 28-08-04 08:58 |
|
Lige-ud-af-landevejen-løsningen:
Lav en datastruktur i et array 4X14 og fyld dem vilkårligt op med tallene
1-14 - så er de 4 farver blandet.
Tag så vilkårligt en farve og et 'kort' fra denne farve og FLYT det
vilkårligt over i et array 1-52 - husk at nulstille 'kortet', så du kan se
hvilke der ER flyttet !
Det var 'en måde - der er 117 andre måder at gøre det på
Mvh KS
"Tomas Christiansen" <toc-01-nospam@blikroer.dk> skrev i en meddelelse
news:cgofog$1qfk$1@news.cybercity.dk...
> SENygaard skrev:
> > "Fake" email? Hvorfor? Du spør om hjelp men er så frekk at du er anonym?
>
> Ingen som er ved deres fulde fem, opgiver sin rigtige e-mail adresse i
> klartekst i en nyhedsgruppe.
> Det er den sikre vej til at blive spammet!
>
> Jeg gør det dog, men, så snart spamningen bliver for voldsom, skifter jeg
> adressen ud med en ny (rart at have den mulighed).
> Min faste bekendtskaber er naturligvis bekendt med min faste
> ikke-udskiftelige e-mail adresse.
>
> -------
> Tomas
>
| |
Tomas Christiansen (28-08-2004)
| Kommentar Fra : Tomas Christiansen |
Dato : 28-08-04 19:58 |
|
KS skrev:
> Lige-ud-af-landevejen-løsningen:
> Lav en datastruktur i et array 4X14 og fyld dem vilkårligt op med tallene
> 1-14 - så er de 4 farver blandet.
> Tag så vilkårligt en farve og et 'kort' fra denne farve og FLYT det
> vilkårligt over i et array 1-52 - husk at nulstille 'kortet', så du kan se
> hvilke der ER flyttet !
>
> Det var 'en måde - der er 117 andre måder at gøre det på
Er det mere "lige ud af landevejen" end det forslag, jeg stillede d. 1/5
2004 kl. 01.27?
-------
Tomas
| |
|
|