Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Cliquez ici pour mettre ce site au démarrage de votre navigateur

AccueilCodesTutorielsForumsEmploiLivresGuide achatConnexion

begin process at 2009 07 06 00:47:07

SILVERLIGHT 3 : COMMUNICATION ET MULTICAST par KooKiz

[PERSO] DéCOUVERTES ESTIVALES : LINUX (PART I) par FREMYCOMPANY

[REFACTORING] RESHARPER POUR VISUAL STUDIO 2010 (PREVIEW) par tja

[REFACTORING] ANALYSER VOS EXCEPTIONS AVEC RESHARPER EXCEPTIONAL par tja

SHAREPOINT 2007 : PATTERNS & PRACTICES SHAREPOINT GUIDANCE par phil

RECUPERER LE RESULTAS AFFICHER PAR LINVITE DE COMMANDE par liehuos001

RE : LORSQUE JE VEUX FAIRE LES ENREGISTREMENT DANS MA TABLE EN VB.NET UN MESSAGE S'AFFICHE EN ME DISANT QUE LE CHAMPS EST PETIT. QUE FAIE? par PCPT

RE : BUFFERING par pingouin84k

RE : SIMULER CTRL+A PUIS CTRL+C NE MARCHE PAS TOUT LE TEMPS .. POURQUOI ? par Renfield

RE : PROBLEME DANS BASE DE DONNéES par PCPT

+ de logiciels à télécharger

1 464 951 membres
8 nouveaux aujourd'hui
15 046 membres club

Trouver une ressource

Trouvez une ressource parmi 40 095 codes, 1 303 043 messages d'aide etc...

Recherche: dans [ Dernières recherches ]

Filtre:Tous les codes.NET uniquementExclure .NET

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é: 14 563 / 409

Auteur : Nocturne

Site perso

Ecrire un message privé

Ce membre participe au partage de revenus publicitaires

Note :

10,00 / 10

Commentaire sur cette source (5)

Ajouter un commentaire et/ou une note

Description

Cliquez pour voir la capture en taille normale

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

Fichier Zip

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

Tirage_Loto
- Fdj.gif 2 473 octets
- Form1.frm 14 750 octets
- Form1.frx7 312 octets
- Koker.gif 2 286 octets
- mssccprj.scc194 octets
- Projet1.csi90 octets
- Projet1.exe32 768 octets
- Projet1.vbp 808 octets
- Projet1.vbw 49 octets
- Tirage_Loto.jpg 42 303 octets
- Toto.gif 2 517 octets

Télécharger le zip

Sources du même auteur

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

Toutes les sources de Nocturne

Sources de la même categorie

JEU 2D STYLE (SUPERMARIO) AVEC SCORES par reacen

DÉMINEUR COMPLET EN VB.NET | COMPLETE MINESWEEPER IN VB.NET par GabSoftware

MON YAHTZEE par jodu35

BANG BANG (SHOOTEZ DANS VOTRE ECRAN) par hackoo

JEU DE CARTES CELEBRE ONLINE par EvildarkEurope

Toutes les sources de la catégorie Jeux

Commentaires et avis

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+

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 ^_^

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

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.