Soyez le premier à donner votre avis sur cette source.
Snippet vu 4 060 fois - Téléchargée 21 fois
Option Explicit Private Type mes_params coef As Single constante As Single incli As String sensx As Integer sensy As Integer End Type Private encours As Boolean Private Sub Form_Activate() 'tout ce qui estr ici est sans intérêt : juste pour initialiser chaque chose. With Me .AutoRedraw = True .ScaleMode = vbPixels DoEvents .WindowState = vbMaximized End With With temoin .Move 100, 100, 20, 20 .BackColor = vbWhite .BackStyle = 1 End With With Line1 .BorderStyle = 1 .BorderColor = vbBlack .BorderWidth = 1 .x1 = 0 .y1 = 200 End With Me.Print "Chaque fois que vous cliquerez sur ce Form :" Me.Print "vous déplacerez laz seconde extrêmité de la ligne Line1" Me.Print "le coin supérieur gauche du petit carré blanc (shape temoin) se mettra alors à parcourir le chemin ainsi défini" Me.Print "attendez la fin du parcours puis cliquez à nouveau où vous voulez" Me.Print "un nouveau chemin, du dernier point, vers un nouveau point, sera celui qui sera maintenant parcouru, etc..." End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'chaque fois que l'on clique sur le form, on modifie la position de l'extrêmité et on donne à la première les coordonées de la précédente If encours Then Exit Sub Line1.x1 = Line1.x2 Line1.y1 = Line1.y2 Line1.x2 = X Line1.y2 = Y allons End Sub Private Sub allons() ' on utilise ici les résultats algébriques (mais aussi autres) de la fonction param_droite encours = True Dim x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer, i As Integer, duree As Double, pas As Integer x1 = Line1.x1 x2 = Line1.x2 y1 = Line1.y1 y2 = Line1.y2 '============================réglages vitesse ============== duree = 0.005 'durée d'attente entre deux positions, en secondes pas = 5 ' pas d'avancement sur le segment '====================================================== With param_droite(x1, x2, y1, y2) Select Case .incli Case "V" ' on traite bien évidemment différemment le cas d'une droite parfaitement verticale For i = y1 To y2 Step pas * .sensy If Not encours Then Exit Sub temoin.Left = x1 temoin.Top = i attente duree Next encours = False Case "H" ' ' on traite bien évidemment différemment le cas d'une droite parfaitement horizontale For i = x1 To x2 Step pas * .sensx If Not encours Then Exit Sub temoin.Left = i temoin.Top = y1 attente duree Next encours = False Case Else ' pour "modérer" la vitesse, on va détermier le "décalage" le plus important : celui des ordonnées ou celui des abscisses ? If Abs(x1 - x2) >= Abs(y1 - y2) Then ' si décalage abscisses plus important ; on fit varier les abscisses For i = x1 To x2 Step pas * .sensx ' sensx = -1 ou +1 selon que abscisses décroissantes ou croissantes If Not encours Then Exit Sub temoin.Left = i temoin.Top = (.coef * i) + .constante attente duree Next Else ' si décalage ordonnées plus important, on fait varier les ordonnées For i = y1 To y2 Step pas * .sensy ' sensx = -1 ou +1 selon que ordonnées décroissantes ou croissantes If Not encours Then Exit Sub temoin.Top = i temoin.Left = (i - .constante) / .coef attente duree Next End If End Select End With temoin.Move x2, y2 encours = False End Sub Private Function param_droite(x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer) As mes_params 'voilà la seule fonction intéressante : celle qui utilise l'algèbre ' et traite les cas particuliers (horizontale et verticales pures) With param_droite .sensx = 1 .sensy = 1 If x1 = x2 Then .coef = 0 .constante = 0 .incli = "V" If y2 < y1 Then .sensy = -1 Else If y1 = y2 Then .incli = "H" .coef = (y1 - y2) / (x1 - x2) .constante = y1 - (.coef * x1) If x2 < x1 Then .sensx = -1 ' on est dans le cas d'abscisses décroissantes If y2 < y1 Then .sensy = -1 ' on est dans le cas d'ordonnées décroissantes End If End With End Function Private Sub attente(duree As Double) 'ce n'est là qu'un petit "tempo" pour éviter d'ajouter un timer Dim deb As Single deb = Timer Do While Timer < deb + duree DoEvents Loop End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) encours = False End Sub
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.