La neige qui tombe v2 ! gestion des obstacles !

Commenter

Contenu du snippet

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 !

A voir également

S'inscrire maintenant

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.

Du même auteur (Setaou)