udeling af kort

Kan du ikke gemme værdien af udtrukne kort i et array og så checke mod arrayet?

Lav et array på 52 kort. Du blander det med en random funktion, og så tager du kortene fra en ende af.

Her har du en kortblander, så skal du bare udele kort..

'----------------------------- Form1 -----------------------------
'Husk en List1 og en Command1

Option Explicit

Public Sub Vis_Kort(ByRef kortstak() As Integer)
Dim i As Integer
Dim farver As Variant
Dim valører As Variant

  farver = Array("Spar", "Klør", "Ruder", "Hjerter")
  valører = Array("2", "3", "4", "5", "6", "7", "8", "9", "10", "Knægt", "Dame", "Konge", "Es")

  lstKort.Clear

  For i = 0 To UBound(kortstak)
    lstKort.AddItem farver(kortstak(i) Mod 4) & " " & valører(kortstak(i) Mod 13)
  Next
End Sub

Private Sub Command1_Click()

Const antalkort = 52                    'antal kort

Dim Bunke(antalkort - 1) As Integer    '2 arrays med 52 pladser
Dim TempBunke(antalkort - 1) As Integer '..........
Dim i As Integer                        'tæller til For-Next løkke
Dim AktueltKort As Integer              'kortet vi skriver til bunke
Dim Tilbage As Integer                  'tæller -hvor mange kort mangler vi?

  For i = 0 To antalkort - 1
    TempBunke(i) = i                    'giv hvert kort en unik værdi mellem 0 og 51
    Bunke(i) = -1                      'nulstil alle kort(-1 =tom)
  Next i

  Randomize                            'start tilfældigheds-generator

  Tilbage = antalkort
  For i = 0 To antalkort - 1                    'gentag denne løkke 52 gange
    AktueltKort = Int(Tilbage * Rnd)            'vælg tilfældigt tal mellem 1 og Tilbage
    Bunke(i) = TempBunke(AktueltKort)          'dette kort sættes på i i bunken
    Tilbage = Tilbage - 1                      'nu er der et kort færre
    TempBunke(AktueltKort) = TempBunke(Tilbage) 'dette kort fjernes fra TempBunke
  Next i

  Vis_Kort Bunke()                              'indeholder nu de 52 kort i tilfældig rækkefølge
End Sub
'----------------------------- Form1 -----------------------------

Min ide: Lav et kort-objekt. Det skal have egenskaber som: Farve, værdi, uddelt/ikke uddelt. Derefter laver du en collection af 52 objekter.
Har selv lavet et spil 31 engang, og det fylder nærmest ingenting (i kodelinier) når man laver det objektorienteret.

Har du mod på at give dig i kast med Classes, så er der meget vundet. Jeg er dog ikke helt frisk i det længere, så det er ikke mig du skal spørge.

Bare et indspark

synes sjh's ide er rigtig fed da det også er meget nemt at arbejde med når man skal give sig i kast med netværks muligheder af spillet. Her skal man jo helst sende tekststrenge så mange tak til sjh. Har dog et bonus spørgsmål. har virkeligt siddet længe for at finde den smarteste løsning til at sortere kortene når de først er blevet uddelt. ved ikke helt hvordan jeg laver det smartest. De ting jeg fik lavet var alt for kludrede.. min kode uden sortering af kortene ser således ud:




Option Explicit



Public Sub Vis_Kort(ByRef kortstak() As Integer)
Dim farver As Variant
Dim valører As Variant
Dim joker(52 To 55) As String
Dim forløb As Integer
Dim spillere(0 To 54), spiller1(0 To 12), spiller2(13 To 25), spiller3(26 To 38), spiller4(39 To 51), kortbunke(52 To 54) As String

  farver = Array("Spar", "Klør", "Ruder", "Hjerter")
  valører = Array("2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14")    '11, 13, 14 bliver brugt som substitutter for
                                                                                            'billedkortene da det er nemmere at arbejde med værdier
    For i = 0 To 54
        If kortstak(i) >= 52 Then
            spillere(i) = "joker"                          'sørger for at jokerne også bliver talt med (de har ingen farve)
        Else
          spillere(i) = farver(kortstak(i) Mod 4) & " " & valører(kortstak(i) Mod 13)
        End If
    Next
    For i = 0 To 54

            If i < 13 Then
                spiller1(i) = spillere(i)
            ElseIf i > 12 And i < 26 Then
                spiller2(i) = spillere(i)
            ElseIf i > 25 And i < 39 Then
                spiller3(i) = spillere(i)
            ElseIf i > 38 And i < 52 Then
                spiller4(i) = spillere(i)
            Else
                kortbunke(i) = spillere(i)
            End If
    Next
For i = 0 To 12
kort(i).Picture = LoadPicture("H:\VB\whist\billeder\" & farver(kortstak(i) Mod 4) & "\" & valører(kortstak(i) Mod 13) & ".gif")  'indlæser et billede der svarer til det kort man har fået uddelt
Next
End Sub

Private Sub Command1_Click()
Const antalkort = 55                    'antal kort

Dim Bunke(antalkort - 1) As Integer    '2 arrays med 52 pladser
Dim TempBunke(antalkort - 1) As Integer '..........
Dim i As Integer                        'tæller til For-Next løkke
Dim AktueltKort As Integer              'kortet vi skriver til bunke
Dim tilbage As Integer                  'tæller -hvor mange kort mangler vi?

  For i = 0 To antalkort - 1
    TempBunke(i) = i                    'giv hvert kort en unik værdi mellem 0 og 55
    Bunke(i) = -1                      'nulstil alle kort(-1 = tom)
  Next i

  Randomize                            'start tilfældigheds-generator

  tilbage = antalkort
  For i = 0 To antalkort - 1                    'gentag denne løkke 52 gange
    AktueltKort = Int(tilbage * Rnd)            'vælg tilfældigt tal mellem 1 og Tilbage
    Bunke(i) = TempBunke(AktueltKort)          'dette kort sættes på i i bunken
    tilbage = tilbage - 1                      'nu er der et kort færre
    TempBunke(AktueltKort) = TempBunke(tilbage) 'dette kort fjernes fra TempBunke
  Next i

  Vis_Kort Bunke()                              'indeholder nu de 52 kort i tilfældig rækkefølge
End Sub

Private Sub kort_Click(Index As Integer)
kort(Index).Top = 3360
kort(Index).Left = 4080
End Sub

der må selvfølgelig gerne rettes/optimeres i den kode jeg har indtil videre.. vil jeg faktisk blive glad for tusind tak på forhånd :)

hilsen en spørgefuld kortspiller

sortering af kort.. skulle de ikke være tilfældig??
kan ikke lige se hvad dit næste problem er.. ;)

jov jov selvfølgelig skal det være tilfældigt. forklarer det lige nærmere :)

har lavet det sådan at man kun kan se sine "egne" kort så spillet skal udbygges med netværksdel. De kort man så har fået skal så sorteres så spar 2 står før spar 4 som står før spar 5 osv... Således at man har styr over sine egne kort

Jeg fandt lidt som du nok kunne bruge...


' Quicksort -> http://www.vb-helper.com/howto_sorted_dir.html

Public Sub Vis_Kort(ByRef kortstak() As Integer)
Dim i As Integer
Dim farver As Variant
Dim valører As Variant

  farver = Array("Spar", "Klør", "Ruder", "Hjerter")
  ' Her bliver man nødtil at tilføje et 0 forand tal som er mindre end 10
  valører = Array("02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", "13", "14")

  ReDim arrSort(UBound(kortstak)) As String
  For i = 0 To UBound(kortstak)
    arrSort(i) = farver(kortstak(i) Mod 4) & " " & valører(kortstak(i) Mod 13)
  Next

  ' Sortering..
  Call Quicksort(arrSort, 0, UBound(kortstak))

  ' Udskriver test ;)
  List1.Clear
  For i = 0 To UBound(arrSort)
    List1.AddItem arrSort(i)
  Next

End Sub

Private Sub Quicksort(list() As String, ByVal min As Long, ByVal max As Long)
Dim mid_value As String
Dim hi As Long
Dim lo As Long
Dim i As Long

    ' If there is 0 or 1 item in the list,
    ' this sublist is sorted.
    If min >= max Then Exit Sub

    ' Pick a dividing value.
    i = Int((max - min + 1) * Rnd + min)
    mid_value = list(i)

    ' Swap the dividing value to the front.
    list(i) = list(min)

    lo = min
    hi = max
    Do
        ' Look down from hi for a value < mid_value.
        Do While list(hi) >= mid_value
            hi = hi - 1
            If hi <= lo Then Exit Do
        Loop
        If hi <= lo Then
            list(lo) = mid_value
            Exit Do
        End If

        ' Swap the lo and hi values.
        list(lo) = list(hi)

        ' Look up from lo for a value >= mid_value.
        lo = lo + 1
        Do While list(lo) < mid_value
            lo = lo + 1
            If lo >= hi Then Exit Do
        Loop
        If lo >= hi Then
            lo = hi
            list(hi) = mid_value
            Exit Do
        End If

        ' Swap the lo and hi values.
        list(hi) = list(lo)
    Loop

    ' Sort the two sublists.
    Quicksort list, min, lo - 1
    Quicksort list, lo + 1, max
End Sub

Du kan bare gøre sådan for at fjerne 0 igen ;)

  ' Udskriver test ;)
  List1.Clear
  For i = 0 To UBound(arrSort)
    If InStr(1, arrSort(i), " 0") Then
      arrSort(i) = Replace(arrSort(i), " 0", " ")
    End If
    List1.AddItem arrSort(i)
  Next

http://fedepriser.dk/shop/kortblander-hurtig-levering-890p.html