générateur de tournois! HHHHHHHHHHEEEEEEEEEELLLLLP

Question

Je ne sais ps commt faire pour que le prog génèrent aléatoirement les places des noms mis dans des textbox,jusque dans un tableau ou les noms devront étre mis a des places différentes a chaque clique sur généré.

Makabey · Answer

Voici ce que j'ai composé pour toi, tes TextBox doivent êtres indexés.


Private Function TirerNombres(ByRef OutTbl() As Integer, ByVal InNombre As Integer, ByVal InBorneMax As Integer, ByVal InUnique As Boolean) As Integer
  '
  '  Tire InNombre chiffres entre 0 et InBorneMax, si InUnique est vrai, s'assure
  '  que chaque nombre est unique.
  '
  '  Au retour, un tableau basé 0, dont les élément vont de 0 à InNombre
  '
  '  Retourne:
  '           0 : A-Ok
  '           1 : InNombre sous 1
  '           2 : InBorneMax sous 1
  '           3 : InBorneMax sous InNombre alors que InUnique = False
  '
  Dim iCmpt As Integer
  Dim iTmpNbr As Integer
  Dim boChiffreNonUnique As Boolean
  Dim iPtrBoucle As Integer
  
  If (InNombre < 0) Then
      TirerNombres = 1
      Exit Function
    'Else
  End If
  
  If (InBorneMax < 0) Then
      TirerNombres = 2
      Exit Function
    'Else
  End If
  
  If (((InBorneMax + 1) < InNombre) And InUnique) Then
      TirerNombres = 3
      Exit Function
    'Else
  End If
  
  InNombre = InNombre - 1
  ReDim OutTbl(0 To InNombre)
  For iTmpNbr = 0 To InNombre
    OutTbl(iTmpNbr) = -1
  Next iTmpNbr
  Do While (iCmpt <= InNombre)
    Randomize
    iTmpNbr = Int(InBorneMax * Rnd) ' + 1)
  
    If (InUnique) Then
        boChiffreNonUnique = False
        iPtrBoucle = 0
        Do          If (iTmpNbr OutTbl(iPtrBoucle)) Then boChiffreNonUnique True
          iPtrBoucle = iPtrBoucle + 1
        Loop Until (boChiffreNonUnique Or (iPtrBoucle > iCmpt))
        
        If (Not boChiffreNonUnique) Then
            OutTbl(iCmpt) = iTmpNbr
            iCmpt = iCmpt + 1
          'Else
        End If
      Else
        OutTbl(iCmpt) = iTmpNbr
        iCmpt = iCmpt + 1
    End If
  Loop
End Function

Private Sub Command1_Click()
  Dim iUBTxt As Integer
  Dim iCmpt As Integer
  Dim astrText() As String
  Dim aiPlaces() As Integer
  Dim iRslt As Integer
  
  iUBTxt = Text1.UBound
  ReDim astrText(iUBTxt)
  For iCmpt = 0 To iUBTxt
    astrText(iCmpt) = Text1(iCmpt)
  Next iCmpt
  
  iRslt = TirerNombres(aiPlaces, 4, iUBTxt + 1, True)
  
  If (iRslt = 0) Then
      For iCmpt = 0 To iUBTxt
        Text1(iCmpt) = astrText(aiPlaces(iCmpt))
      Next iCmpt
    Else
      Text2 = Str$(iRslt)
  End If
End Sub

Générateur de tournois! HHHHHHHHHHEEEEEEEEEELLLLLP

1 réponse

Discussions similaires