ETOILE QUI ROULE N'AMMASE PAS MOUSSE...
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/1374-etoile-qui-roule-n-ammase-pas-mousse
https://codes-sources.commentcamarche.net/source/1374-etoile-qui-roule-n-ammase-pas-mousse
24 juin 2001 à 14:36
24 juin 2001 à 08:56
@+
fabs
24 juin 2001 à 08:54
W95.space 1445 enfin toujours le meme depui 3 mois !!!!
enlève l'exe du zip pour eviter les risques
23 juin 2001 à 23:11
merci quand meme
23 juin 2001 à 14:03
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
23 juin 2001 à 13:59
(tu es sûr que "n'ammase" c'est français ???)