begin process at 2008 07 06 03:05:20
1 205 441 membres
21 nouveaux aujourd'hui
14 119 membres club

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

TIRAGE DU LOTO


Information sur la source

Catégorie :Jeux Niveau : Débutant Date de création : 19/04/2004 Vu / téléchargé: 12 616 / 368

Note :
10 / 10 - par 2 personnes
10,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10

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


Description

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.

Source

  • '**********************
  • '**********************
  • '**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
'**********************
'**********************
'**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

Conclusion

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

  • signaler à un administrateur
    Commentaire de Nocturne le 19/04/2004 01:09:57

    Ce qui serait cool, c'est d'avoir un code source qui pourrais nous donner les bon chiffres du Loto a une date precise.
    Je suis preneur.
    A+

  • signaler à un administrateur
    Commentaire de TOM_KILLERz le 19/04/2004 10:06:06

    Pas mal du tout cette source.
    J'esperais avoir été le premier a creer un prog de tirage de LOTO ...
    Tant pis lol.
    Si un jour je trouve un programme qui file les bon numeros du LOTO avant le tirage je te ferais signe ^_^

  • signaler à un administrateur
    Commentaire de Nocturne le 19/04/2004 11:34:20

    Merci TOM_KILLERz.
    Ta source est pas mal egalement, en plus tu l as fait en .Net
    Bonne Prog à toi.
    Nocturne

  • signaler à un administrateur
    Commentaire de cheyenne le 19/04/2004 13:32:10

    Bonjour,

    Il y a moyen de faire beaucoup plus simple pour éviter les doublons :

       Randomize
       Dim i As Integer,  n As Integer
       Dim t(1 To 49) As Boolean     '  nombres déjà sortis,  Vrai ou Faux
       Dim num(1 To 7) As Integer   '  tableau du tirage sans doublons

       For i = 1 To 7
          Do:  n = Int(Rnd * 49) + 1:  Loop Until t(n) = False
          t(n) = True :  num(i) = n
       Next

    Elle est pas belle la vie ?

    Bonne continuation.

  • signaler à un administrateur
    Commentaire de Nocturne le 19/04/2004 15:30:19

    Bien vu cheyenne, je n'avais pas pensé à cette astuce.
    Merci pour l'info, ca va me servir dans mes futures developpement.
    Bonne prog à toi.
    Nocturne

Ajouter un commentaire

Pub



Appels d'offres

Plugin Dialer outlook
Budget : 2 000€
Travail graphique- ill...
Budget : 1 000€
creation de marque et ...
Budget : 1 000€

CalendriCode

Juillet 2008
LMMJVSD
 123456
78910111213
14151617181920
21222324252627
28293031   

VS Express FR Gratuit !

VS Express en français et 100% gratuit !

Boutique

Boutique de goodies CodeS-SourceS