Un ecran de veille avec des triangles

Soyez le premier à donner votre avis sur cette source.

Vue 4 311 fois - Téléchargée 675 fois

Description

avec direct X, on peut tout faire, et même des écrans de veille avec des triangles qui pivote !!!

tout est calculer mathématiquement puis afficher par le moteur graphique sur un fond noir.

au démarage, le moteur affiche un cadre de la taille de l'écran ; la fin est activer par la pression d'une touche, ou du mouvement de la souris

Source / Exemple :


Dim TaBl(50000, 2, 10)
Dim ComPte(15), CentreX(15), CentreY(15), Rayon(15)
Dim i(15), j(15)
Public REp As Boolean
Dim a(15), b(15), c(15), d(15)
'condition pour sortir du jeu
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Timer1.Enabled = False
BActif = False
End
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Timer1.Enabled = False
BActif = False
End
End Sub

Private Sub Picture1_KeyPress(KeyAscii As Integer)
Timer1.Enabled = False
BActif = False
End
End Sub

Private Sub form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static sngX     As Single
Static sngY     As Single
Static blnInit  As Boolean
If blnInit = False Then
    sngX = X
    sngY = Y
    blnInit = True
    Exit Sub
End If

If sngX + 5 < X Or sngX - 5 > X Or sngY + 5 < Y Or sngY - 5 > Y Then
Timer1.Enabled = False
BActif = False
End
End If
End Sub
''''''''''''''''''''''''''''
Private Sub Form_Click()
Timer1.Enabled = False
BActif = False
End
End Sub

Private Sub Form_Unload(Cancel As Integer)
'déchargement des objets de leur mémoire, important sinon bugg le pc

BActif = False

Set D3d = Nothing
Set D3dDevice = Nothing
Set Dx = Nothing

End Sub
Private Sub Form_Load()
CentreX(1) = Int(Rnd * 760)
CentreY(1) = Int(Rnd * 760)
Rayon(1) = 90

CentreX(2) = Int(Rnd * 760)
CentreY(2) = Int(Rnd * 760)
Rayon(2) = 75

CentreX(3) = Int(Rnd * 760)
CentreY(3) = Int(Rnd * 760)
Rayon(3) = 70

CentreX(4) = 750
CentreY(4) = 250
Rayon(4) = 60

CentreX(5) = 760
CentreY(5) = 250
Rayon(5) = 80

CentreX(6) = 500
CentreY(6) = 200
Rayon(6) = 90

CentreX(7) = 520
CentreY(7) = 250
Rayon(7) = 85

REp = True
Call cercle

For k = 1 To 7
i(k) = 2
j(k) = 2
Dim d As Integer
d = Int(Rnd * 4)
If d = 1 Then
    If d = 3 Then
    j(k) = j(k) * -1
    i(k) = i(k) * -1
    Else
i(k) = i(k) * -1
End If
End If
Next

Timer1.Enabled = True
Timer2.Enabled = True
BActif = True
Rendu

End Sub
Sub cercle()
'------------------------------------------------------
''''''''''''''''''''''la boule magik''''''''''''''''
'----------------------------------------------------

For k = 1 To 7

Dim Pi, AnGle As Single
Pi = 3.14159264

ComPte(k) = 0

AnGle = 0
Do While AnGle < Pi * 2

  X = (Cos(AnGle) * Rayon(k)) + CentreX(k)
  Y = (Sin(AnGle) * Rayon(k)) + CentreY(k)
  DrawWidth = 1
  'Changer d'angle
  AnGle = AnGle + 0.005

  'enregistre dans le tableau les coordonnées du cercle parfait
'sans de pset pour le cercle
  TaBl(ComPte(k), 1, k) = X
  TaBl(ComPte(k), 2, k) = Y
  ComPte(k) = ComPte(k) + 1
Loop
ComPte(k) = ComPte(k) - 1

Next

''------------------------------------------------------
If REp = True Then

For k = 1 To 7

a(k) = 0
b(k) = (ComPte(k) / 5)
c(k) = 3 * b(k)

Next
REp = False
End If
End Sub

Private Sub Timer1_Timer()

'and ..
For k = 1 To 7

CentreX(k) = CentreX(k) + i(k)
CentreY(k) = CentreY(k) + j(k)
'au cas ou les points touchent les bords
If CentreX(k) <= Rayon(k) Then i(k) = i(k) * -1
If CentreX(k) >= 1024 - Rayon(k) Then i(k) = i(k) * -1
If CentreY(k) <= Rayon(k) Then j(k) = j(k) * -1
If CentreY(k) >= 768 - Rayon(k) Then j(k) = j(k) * -1

Next

Call cercle

End Sub

Private Sub Timer2_Timer()

a(1) = a(1) - 1
If a(1) <= 0 Then a(1) = ComPte(1)
b(1) = b(1) - 1
If b(1) <= 0 Then b(1) = ComPte(1)
c(1) = c(1) - 1
If c(1) <= 0 Then c(1) = ComPte(1)
Ax = TaBl(a(1), 1, 1)
Ay = TaBl(a(1), 2, 1)
Bx = TaBl(b(1), 1, 1)
By = TaBl(b(1), 2, 1)
cx = TaBl(c(1), 1, 1)
cy = TaBl(c(1), 2, 1)

a(3) = a(3) + 2
If a(3) >= ComPte(3) Then a(3) = 0
b(3) = b(3) + 2
If b(3) >= ComPte(3) Then b(3) = 0
c(3) = c(3) + 2
If c(3) >= ComPte(3) Then c(3) = 0
Dx2 = TaBl(a(3), 1, 3)
Dy2 = TaBl(a(3), 2, 3)
Ex2 = TaBl(b(3), 1, 3)
Ey2 = TaBl(b(3), 2, 3)
Fx2 = TaBl(c(3), 1, 3)
Fy2 = TaBl(c(3), 2, 3)

a(4) = a(4) + 1
If a(4) >= ComPte(4) Then a(4) = 0
b(4) = b(4) + 1
If b(4) >= ComPte(4) Then b(4) = 0
c(4) = c(4) + 1
If c(4) >= ComPte(4) Then c(4) = 0
Dx3 = TaBl(a(4), 1, 4)
Dy3 = TaBl(a(4), 2, 4)
Ex3 = TaBl(b(4), 1, 4)
Ey3 = TaBl(b(4), 2, 4)
Fx3 = TaBl(c(4), 1, 4)
Fy3 = TaBl(c(4), 2, 4)

a(2) = a(2) + 2
If a(2) >= ComPte(2) Then a(2) = 0
b(2) = b(2) + 2
If b(2) >= ComPte(2) Then b(2) = 0
c(2) = c(2) + 2
If c(2) >= ComPte(2) Then c(2) = 0
Dx1 = TaBl(a(2), 1, 2)
Dy1 = TaBl(a(2), 2, 2)
Ex1 = TaBl(b(2), 1, 2)
Ey1 = TaBl(b(2), 2, 2)
Fx1 = TaBl(c(2), 1, 2)
Fy1 = TaBl(c(2), 2, 2)

a(5) = a(5) - 2
If a(5) <= 0 Then a(5) = ComPte(5)
b(5) = b(5) - 2
If b(5) <= 0 Then b(5) = ComPte(5)
c(5) = c(5) - 2
If c(5) <= 0 Then c(5) = ComPte(5)
Dx4 = TaBl(a(5), 1, 5)
Dy4 = TaBl(a(5), 2, 5)
Ex4 = TaBl(b(5), 1, 5)
Ey4 = TaBl(b(5), 2, 5)
Fx4 = TaBl(c(5), 1, 5)
Fy4 = TaBl(c(5), 2, 5)

a(6) = a(6) + 2
If a(6) >= ComPte(6) Then a(6) = 0
b(6) = b(6) + 2
If b(6) >= ComPte(6) Then b(6) = 0
c(6) = c(6) + 2
If c(6) >= ComPte(6) Then c(6) = 0
Dx5 = TaBl(a(6), 1, 6)
Dy5 = TaBl(a(6), 2, 6)
Ex5 = TaBl(b(6), 1, 6)
Ey5 = TaBl(b(6), 2, 6)
Fx5 = TaBl(c(6), 1, 6)
Fy5 = TaBl(c(6), 2, 6)

a(7) = a(7) + 1
If a(7) >= ComPte(7) Then a(7) = 0
b(7) = b(7) + 1
If b(7) >= ComPte(7) Then b(7) = 0
c(7) = c(7) + 1
If c(7) >= ComPte(7) Then c(7) = 0
Dx6 = TaBl(a(7), 1, 7)
Dy6 = TaBl(a(7), 2, 7)
Ex6 = TaBl(b(7), 1, 7)
Ey6 = TaBl(b(7), 2, 7)
Fx6 = TaBl(c(7), 1, 7)
Fy6 = TaBl(c(7), 2, 7)

GeomEtrIe

End Sub

Codes Sources

A voir également

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.