Voila voilà ...
version 2 beaucoup plus éllaborée et commentée !
vous avez besoin :
- d'un form (form1) au fond bleu nuit
- d'un timer (timer1)réglé sur 25ms
- d'un label (label1) au fond transparent
- de 3 Shapes rectangles (Shape1, 2 et 3)
copiez tout ça dans (Déclarations) et hop !
Source / Exemple :
'-*-*-*-*-*-*-*
'! Par Setaou !
'*-*-*-*-*-*-*-
'[ http://setaou.ctw.cc ]
Private Type Floc 'Type de variable "Flocon"
X As Integer
Y As Integer
End Type
Dim Flocon() As Floc 'Tableau contenant les flocons
Dim Maxi As Integer 'Nombre max de flocons
Dim Tas() As Long 'Tableau de hauteur de chaque "colonne" du tas
Dim HTas() As Long 'Hauteur de la base " " " " "
Dim FlocTas As Long 'Nombre de flocons tombés sur le tas
Private Sub Form_Click()
Timer1.Enabled = Not Timer1.Enabled 'Arrête ou remet le timer
End Sub
Private Sub Form_Resize()
Form1.ScaleMode = 3
Form1.Cls 'Efface le form
Maxi = (Form1.Width + Form1.Height) / 100 ' Caclule le nombre max de flocons
ReDim Flocon(Maxi) 'Redimmentionne les tableaux
ReDim Preserve Tas(Form1.ScaleWidth)
ReDim HTas(Form1.ScaleWidth)
'Définition de la hauteur de la base du tas suivant la hauteur des obstacles
For i = 0 To Form1.ScaleWidth: HTas(i) = Form1.ScaleHeight: Next i
'*** En suivant l'exemple de la première ligne, rajoutez les objets qui font obstacle
For i = Shape1.Left To Shape1.Left + Shape1.Width: HTas(i) = Shape1.Top: Next i
For i = Shape2.Left To Shape2.Left + Shape2.Width: HTas(i) = Shape2.Top: Next i
For i = Shape3.Left To Shape3.Left + Shape3.Width: HTas(i) = Shape3.Top: Next i
'***
For i = 1 To Maxi 'Place aléatoirement les flocons sur le form
Flocon(i).X = Int(Rnd * Form1.ScaleWidth + 1)
Flocon(i).Y = Int(Rnd * Form1.ScaleHeight + 1)
Next i
For i = 1 To Form1.ScaleWidth 'Re-dessin du tas
Line (i, HTas(i) - Tas(i))-(i, HTas(i)), vbWhite
Next i
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
For i = 1 To Maxi ' Pour chaque flocon
PSet (Flocon(i).X, Flocon(i).Y), Form1.BackColor 'Efface l'ancienne position du flocon
Flocon(i).Y = Flocon(i).Y + Int(Rnd * 10 + 1) ' Calcule la nouvelle position
Flocon(i).X = Flocon(i).X + Int(Rnd * 10 - 5)
If Flocon(i).X < 0 Then Flocon(i).X = Form1.ScaleWidth ' Si le flocon sort par la gauche
If Flocon(i).X > Form1.ScaleWidth Then Flocon(i).X = 1 ' ou par la droite
'*** si le flocon tombe sur le tas
If Flocon(i).Y >= HTas(Flocon(i).X) - Tas(Flocon(i).X) Then
FlocTas = FlocTas + 1 'Compte le nombre de flocons tombés
'(petite) gestion de la "pente" pour éviter de trop grandes différences de hauteur
Select Case Tas(Flocon(i).X)
Case Is > Tas(Flocon(i).X + 2): Tas(Flocon(i).X + 2) = Tas(Flocon(i).X + 2) + 1: Line (Flocon(i).X + 2, HTas(Flocon(i).X) - Tas(Flocon(i).X + 2))-(Flocon(i).X + 2, HTas(Flocon(i).X)), vbWhite 'Dessine une partie du tas
Case Is > Tas(Flocon(i).X - 2): Tas(Flocon(i).X - 2) = Tas(Flocon(i).X - 2) + 1: Line (Flocon(i).X - 2, HTas(Flocon(i).X) - Tas(Flocon(i).X - 2))-(Flocon(i).X - 2, HTas(Flocon(i).X)), vbWhite 'Dessine une partie du tas
Case Is > Tas(Flocon(i).X + 1): Tas(Flocon(i).X + 1) = Tas(Flocon(i).X + 1) + 1: Line (Flocon(i).X + 1, HTas(Flocon(i).X) - Tas(Flocon(i).X + 1))-(Flocon(i).X + 1, HTas(Flocon(i).X)), vbWhite 'Dessine une partie du tas
Case Is > Tas(Flocon(i).X - 1): Tas(Flocon(i).X - 1) = Tas(Flocon(i).X - 1) + 1: Line (Flocon(i).X - 1, HTas(Flocon(i).X) - Tas(Flocon(i).X - 1))-(Flocon(i).X - 1, HTas(Flocon(i).X)), vbWhite 'Dessine une partie du tas
Case Else: Tas(Flocon(i).X) = Tas(Flocon(i).X) + 1: Line (Flocon(i).X, HTas(Flocon(i).X) - Tas(Flocon(i).X))-(Flocon(i).X, HTas(Flocon(i).X)), vbWhite 'Dessine une partie du tas
End Select
Flocon(i).Y = 0 'Replace le flocon en haut ...
Flocon(i).X = Int(Rnd * Form1.ScaleWidth + 1) '... à un endroit aléatoire
End If
'***
PSet (Flocon(i).X, Flocon(i).Y), vbWhite 'Affiche le flocon
Next i
'Statistiques
For i = 1 To Form1.ScaleWidth 'Moyenne de hauteur du tas
j = j + Tas(i)
Next i
j = j / Form1.ScaleWidth
Label1.Caption = Maxi & " Flocons de neige"
Label1.Caption = Label1.Caption & vbCrLf & "Epaisseur moyenne de la neige : " & Format(j, "0.000") & "px"
Label1.Caption = Label1.Caption & vbCrLf & FlocTas & " flocons au sol"
End Sub
Conclusion :
Just have FUN !
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.