TIRAGE DU LOTO

---

Commentaire sur cette source (5)
Ajouter un commentaire et/ou une note

En reponse au code source de TOM_KILLERz http://www.vbfrance.com/code.aspx?ID=22052, "GENERATEUR DE NUMEROS POUR LE LOTO"

C'est un vieux code que j'avais fait en 2001, mais je le poste pour apporter un autre exemple.

'**********************
'**********************
'**Nocturne Mai 2001***
'**********************
'**********************

Option Explicit

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()

Dim N1 As Integer, N2 As Integer, N3 As Integer, N4 As Integer, N5 As Integer, N6 As Integer
Dim NT As Integer, Number As Integer
Dim N
Dim I As Integer, CTaire As Integer, x As Integer, Mano As Integer

Randomize 'inizialize la fonction Rnd (nombre hasard) en fonction du timer
Number = Int(Rnd(1) * 999) + 1 'tirage du numéro
'**********affichage Numéro (tirage) + date du jour + numéro Joker*********
Label1 = "Aujourd'hui, " & "nous vous proposons le tirage de 6 numéros et du complémentaire" & Chr(13) & Chr(13) & "Tirage Numéro : " & Number & " du " & Date
Label11 = Int(Rnd(1) * 999999999) + 1 'affichage du No Joker
'***********tirage des 6 numéros + le complémentaire et vérif. si pas de doublon************
For x = 1 To 7
    NT = Int(Rnd(1) * 49) + 1 'fonction et choix des nombres au hasard entre 1 to 49
    If x = 1 Then
        N1 = NT 'Tirage du No 1
        Else
        If x = 2 And NT <> N1 Then
            N2 = NT 'Tirage du No 2
            Else
            If x = 3 And NT <> N1 And NT <> N2 Then
                N3 = NT 'Tirage du No 3
                Else
                If x = 4 And NT <> N1 And NT <> N2 And NT <> N3 Then
                    N4 = NT 'Tirage du No 4
                    Else
                    If x = 5 And NT <> N1 And NT <> N2 And NT <> N3 And NT <> N4 Then
                        N5 = NT 'Tirage du No 5
                        Else
                        If x = 6 And NT <> N1 And NT <> N2 And NT <> N3 And NT <> N4 And NT <> N5 Then
                            N6 = NT 'Tirage du No 6
                            Else
                            If x = 7 And NT <> N1 And NT <> N2 And NT <> N3 And NT <> N4 And NT <> N5 And NT <> N6 Then
                                CTaire = NT 'Tirage du No complémentaire
                                Else
                                x = x - 1 'faire une boucle sup. en cas d'un tirage deux nombres identique
                                End If
                            End If
                        End If
                    End If
                End If
           End If
    End If
Next
'**********stockage des 6 numéros************************
N = Array(N1, N2, N3, N4, N5, N6)
'**********tri des six numéros par ordre croissant*******
For x = 1 To 5
    For I = 0 To 4
        If N(I) > N(I + 1) Then 'deplacement des contenus
            Mano = N(I)
            N(I) = N(I + 1)
            N(I + 1) = Mano
            Else
        End If
    Next
Next
'**********affichage des 6 numéros et du complémentaire
Label2(0).Caption = N(0) 'affichage du numéro le plus petit
Label2(1).Caption = N(1) 'affichage du numéro 2
Label2(2).Caption = N(2) 'affichage du numéro 3
Label2(3).Caption = N(3) 'affichage du numéro 4
Label2(4).Caption = N(4) 'affichage du numéro 5
Label2(5).Caption = N(5) 'affichage du numéro le plus grand
'**********récupération du numéro complémentaire dans la partie tirage de 6... par la variable CTaire***
Label8.Caption = CTaire 'affichage du numéro complémentaire

End Sub

Private Sub Form_Load()
Call Command3_Click
End Sub

A noter que j'aurais pu eviter les conditions mais a l'epoque je debutais en programmation.
Voici un autre systeme de tirage des 7 chiffres :

Dim Num_Hasard As Integer
Dim Stockage_Nombre()
Dim Nombre_Deja_Tire As Boolean, Tirage_1er_Chiffre As Boolean
Dim x As Integer, y As Integer
Dim Visu_Total_Nombre As String

Tirage_1er_Chiffre = False
For x = 1 To 7 'Nombre de chiffre à tiré
  Randomize 'Inizialise la fonction Rnd
  Num_Hasard = Int(Rnd(1) * 49) + 1 'Tirage du chiffre
  Nombre_Deja_Tire = False
  If Tirage_1er_Chiffre = False Then 'Enregistrement du 1er chiffre
    ReDim Preserve Stockage_Nombre(0)
    Stockage_Nombre(0) = Num_Hasard
    Tirage_1er_Chiffre = True
  Else
    For y = 0 To UBound(Stockage_Nombre)
      If Num_Hasard = Stockage_Nombre(y) Then 'Controle que le chiffre ne soit pas déjà enregistré
        Nombre_Deja_Tire = True
      End If
    Next y
    If Nombre_Deja_Tire = False Then  'Controle que le chiffre ne soit pas déjà enregistré
      ReDim Preserve Stockage_Nombre(UBound(Stockage_Nombre) + 1)
      Stockage_Nombre(UBound(Stockage_Nombre)) = Num_Hasard 'Enregistrement du chiffre tiré au hasard
    Else
      x = x - 1 'Permet de faire une boucle supplementaire si le chiffre à déjà été enregistré
      Nombre_Deja_Tire = False
    End If
  End If
Next x

Apres il est facile de recuperer nos 7 chiffres dans le tableau Stockage_Nombre

Bonne prog à tous.
Nocturne

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

• AJOUTER UNE LIGNE DANS UN FICHIER - API
• INFO-BULLE PERSONNALISÉE, MULTILIGNES AVEC QQ OPTONS
• INFORMATION DISQUE DUR
• RETROUVE LA DATE DE CRÉATION D'UN FICHIER - API
• ECHANGE DE MESSAGES WINDOWS ENTRE DEUX APPLICATIONS

• JEU DE WUMPUS BASIC EN VB6
• JEU DE REFLEXION ET D'ENTRAINEMENT OCULAIRE
• CASSE ASTÉROÏDE
• AUTOMATE CELLULAIRE (JEU DE LA VIE )
• CARDGENERATOR