Etoile qui roule n'ammase pas mousse...

Soyez le premier à donner votre avis sur cette source.

Vue 4 050 fois - Téléchargée 258 fois

Description

Une petite étoile qui roule...
Et quelques explications trees basiques sur le cercle trigonometrique
et sans virus

Conclusion :


en cliquand avec le bouton gauche on augemente la taille de la trianer et avec le bouton droit on la diminue...

Codes Sources

Ajouter un commentaire Commentaires
merci fabiin
Sinon bah c super joli ton truc !!! :-D

@+
fabs
aille !!! t'as un virus mon gard !!!
W95.space 1445 enfin toujours le meme depui 3 mois !!!!
enlève l'exe du zip pour eviter les risques
désolé flint je l'ai un peu modifié depuis :-)
merci quand meme
Module :

Public Type Col
R As Long
G As Long
B As Long
End Type
Public Const NbStar = 20
Public Const Pi = 3.14159265358979
Public XX As Long, YY As Long, Ad As Double, Rot(100) As Double
Public XXX(100) As Long, YYY(100) As Long
Public Coul(100) As Double
Public COUL_Degrad1
Public COUL_Degrad2



Public Function Couleur(R, G, B)
Couleur = B * 256 * 256 + G * 256 + R
End Function

Public Function CoulPoint(Coul) As Col ' Donne les valeurs RGB d'une couleur
Dim R As Long
Dim v As Long
Dim B As Long
Dim Couleur1
Dim Couleur2
Couleur1 = Coul
Couleur2 = Couleur1
bd = ((((Couleur2 &H10000) And &HFF) * 50) + (((Couleur1 &H10000) And &HFF) * 50)) 100
vd = ((((Couleur2 &H100) And &HFF) * 50) + (((Couleur1 &H100) And &HFF) * 50)) 100
rd = (((Couleur2 And &HFF) * 50) + ((Couleur1 And &HFF) * 50)) 100
CoulPoint.R = rd
CoulPoint.G = vd
CoulPoint.B = bd
End Function

Public Function Deg2Rad(Degre As Double) ' Donne la valeur en radien d'un angle en degré
Deg2Rad = Degre * Pi / 180
End Function


Public Function SetVariables()
XX = 50
YY = 20
Ad = 2
Randomize Timer
COUL_Degrad1 = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
COUL_Degrad2 = vbBlack

R = CoulPoint(COUL_Degrad1).R
G = CoulPoint(COUL_Degrad1).G
B = CoulPoint(COUL_Degrad1).B

'Call CoulPoint(Coul_Light)


For n = 1 To NbStar

R = R + CoulPoint(COUL_Degrad2).R / NbStar - CoulPoint(COUL_Degrad1).R / NbStar
G = G + CoulPoint(COUL_Degrad2).G / NbStar - CoulPoint(COUL_Degrad1).G / NbStar
B = B + CoulPoint(COUL_Degrad2).B / NbStar - CoulPoint(COUL_Degrad1).B / NbStar
If R < 0 Then R 0 Else If R > 255 Then R 255
If G < 0 Then G 0 Else If G > 255 Then G 255
If B < 0 Then B 0 Else If B > 255 Then B 255
Coul(n) = RGB(R, G, B)
Next
End Function


Public Function DrawStar(X As Long, Y As Long, Couleur, Rota)
Dim Ang As Double
Dim C(10)
Dim S(10)
For n = 1 To 5
Ang = Deg2Rad(n * 72 + Rota)
C(n) = Cos(Ang) * 15 + X
S(n) = Sin(Ang) * 15 + Y
Next
Form1.Line (C(1), S(1))-(C(3), S(3)), Couleur
Form1.Line (C(3), S(3))-(C(5), S(5)), Couleur
Form1.Line (C(5), S(5))-(C(2), S(2)), Couleur
Form1.Line (C(2), S(2))-(C(4), S(4)), Couleur
Form1.Line (C(4), S(4))-(C(1), S(1)), Couleur
'Me.Circle (X, Y), 15, Couleur
End Function


Form : (fond noir pr la form)

Nécesstie un timer (TimStar) avec interval = 40





Private Sub Form_Activate()
SetVariables
End Sub





Private Sub Form_Unload(Cancel As Integer)
End
End Sub






Private Sub TimStar_Timer()
Me.Cls
Ad = Ad + 0.1
Rot(0) = Rot(0) + Ad * 360 / (30 * Pi)
XX = XX + Ad
If XX > Me.ScaleWidth - 20 Then XX Me.ScaleWidth - 20: Ad -Ad
If XX < 20 Then XX 20: Ad -Ad
For n = NbStar To 1 Step -1
If XXX(n) <> 0 Then DrawStar XXX(n), YY, Coul(n), Rot(n)
Next
DrawStar XX, YY, COUL_Degrad1, Rot(0)
For n = NbStar To 2 Step -1
XXX(n) = XXX(n - 1)
Rot(n) = Rot(n - 1)
Next
XXX(1) = XX
Rot(1) = Rot(0)
End Sub



wala wala
Afficher les 6 commentaires

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.