Traceur de cercles point par point aléatoire

Télécharger le projet
Commenter

Description

Tout est dans le code, puisse-t-il vous être utile !

Source / Exemple : 


Dim BaseX As Double
Dim BaseX2 As Double
Dim DistMax As Double
Private Sub Command1_Click()
If L1.Visible = False Then L1.Visible = True
If Timer1.Enabled = False Then
Timer1.Enabled = True
Command1.Caption = "&Arrêter"
Else
Timer1.Enabled = False
Command1.Caption = "&Activer"
End If
End Sub
Private Sub Command2_Click()
Form1.Cls
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Form_Load()
txtBaseX.Text = L1.X2 - L1.X1
txtBaseX2.Text = l2.X2 - l2.X1
BaseX = L1.X2 - L1.X1
BaseX2 = l2.X2 - l2.X1
Randomize
End Sub

Private Sub Text1_Change()
If Val(Text1.Text) <> "0" Then
Form1.DrawWidth = Val(Text1.Text)
Else
MsgBox "La valeur doit être supérieure à zéro...", vbExclamation, "Erreur"
Text1.Text = "1"
Form1.DrawWidth = 1
End If
End Sub

Private Sub Timer1_Timer()
L1.X2 = Int(Rnd * Form1.Width) 'Position X random
L1.Y2 = Int(Rnd * Form1.Height) 'Position Y random
DistMax = (Sqr((L1.X2 - L1.X1) ^ 2 + (L1.Y2 - L1.Y1) ^ 2)) - BaseX 'Calcul de la distance du point(x,y) au centre et la compare avec la distance réglée
If DistMax < 0 Then
L1.X2 = L1.X1 + (BaseX * (L1.X2 - L1.X1)) / (BaseX + DistMax) 'Repositionnement
L1.Y2 = L1.Y1 + (BaseX * (L1.Y2 - L1.Y1)) / (BaseX + DistMax)
Else
L1.X2 = L1.X1 + (BaseX * (L1.X1 - L1.X2)) / (BaseX + DistMax)
L1.Y2 = L1.Y1 + (BaseX * (L1.Y1 - L1.Y2)) / (BaseX + DistMax)
End If
Form1.PSet (L1.X2, L1.Y2) 'Traçage du point

'Deuxième point
l2.X2 = Int(Rnd * Form1.Width)
l2.Y2 = Int(Rnd * Form1.Height)
DistMax = (Sqr((l2.X2 - l2.X1) ^ 2 + (l2.Y2 - l2.Y1) ^ 2)) - BaseX2
If DistMax < 0 Then
l2.X2 = l2.X1 + (BaseX2 * (l2.X2 - l2.X1)) / (BaseX2 + DistMax)
l2.Y2 = l2.Y1 + (BaseX2 * (l2.Y2 - l2.Y1)) / (BaseX2 + DistMax)
Else
l2.X2 = l2.X1 + (BaseX2 * (l2.X1 - l2.X2)) / (BaseX2 + DistMax)
l2.Y2 = l2.Y1 + (BaseX2 * (l2.Y1 - l2.Y2)) / (BaseX2 + DistMax)
End If
Form1.PSet (l2.X2, l2.Y2)
End Sub

Private Sub txtBaseX_Change()
BaseX = Val(txtBaseX.Text)
L1.X2 = L1.X1 + Val(txtBaseX.Text)
End Sub

Private Sub txtBaseX2_Change()
BaseX2 = Val(txtBaseX2.Text)
l2.X2 = l2.X1 + Val(txtBaseX2.Text)
End Sub
Télécharger le projet

Codes Sources

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 (cs_Overflow)