Traceur de cercles point par point aléatoire

Soyez le premier à donner votre avis sur cette source.

Vue 2 307 fois - Téléchargée 173 fois

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

VBbigineure
Messages postés
169
Date d'inscription
vendredi 27 septembre 2002
Statut
Membre
Dernière intervention
27 février 2009
1 -
Voui ! ça peut servir.
Mais je cherchais la formule dont nous nous servions pour faire des ronds avec nos Z80 des années 80... qui plottait des points avec une formule sinus / cosinus... Si toi ou kunkun peut m'aider ???
merci d'avance.
Un 8/10 pour l'originalité du code.
cs_Overflow
Messages postés
5
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
2 décembre 2003
-
j'ai trouvé la formule et je l'ai intégrée dans un autre code :)
http://www.vbfrance.com/article.aspx?Val=7175
VBbigineure
Messages postés
169
Date d'inscription
vendredi 27 septembre 2002
Statut
Membre
Dernière intervention
27 février 2009
1 -
Vu, et je me suis permis de te la corriger (Oh !!! quel culot...).
Je m'étais trouvé une autre méthode, mais celle là, qui est bien celle que je connaissais à l'avantage d'être plus simple.
merci merci. Arthur.

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.