Déplacer le curseur de la souris [Résolu]

Messages postés
330
Date d'inscription
mercredi 6 décembre 2000
Statut
Membre
Dernière intervention
26 octobre 2017
- - Dernière réponse : ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
- 3 déc. 2012 à 10:29
Bonjour,

Je souhaiterais déplacer le curseur de la souris d'un point A vers un point B ou dans le sens B vers le point A.
Jusque là, pas de problème. La difficulté se corse lorsque le déplacement du curseur doit être visible et lent.

Bien entendu, le déplacement doit de pouvoir se faire quelque soit la position de la ligne A-B

Comme je suis fatigué de chercher la solution, je fais appel à celui qui aurait réalisé cette source.

Merci à lui.
Afficher la suite 

14 réponses

Meilleure réponse
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
1
Merci
Voilà donc (un peu bâclé, mais ...bon

On a donc dit ;
Un Form sans aucune bordure ni barre de titre

Dans cette démonstration :

1) Important : j'ai mis la propriété ScaleMode du Form à 1 - Twip
Si tu l'as veut en une autre échelle, tu dis (calculs à adapter). C'est pour cela, que j'ai dit "bâclé"

2) J'ai tracé aléatoirement des lignes, dans des directions "au hasard", obliques ou non. Ce n'est que pour te permettre de "voir". Toi, il te suffit de donner les valeurs réelles (au lieu du hasard).

Un form avec un bouton de commande Command1 et un shape Line1

Option Explicit
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private x0 As Integer, y1 As Integer, y0 As Integer, x1 As Integer
Private Sub Command1_Click()
    x0 = Image1.Left
    y0 = Image1.Top
    x1 = Int(((Me.Width - Image1.Width) * Rnd))
    y1 = Int(((Me.Height - Image1.Height) * Rnd))
    With Line1
      .x1 = x0
      .x2 = x1
      .y1 = y0
      .y2 = y1
    End With
    Timer1.Interval = 1 'ne pas toucher à cet intervalle
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
  Dim fract As Integer, pas As Integer, k As Integer, x2 As Integer, y2 As Integer, a As Single, b As Single, fin As Boolean ', i As Integer
  fract = 250 'ici la fraction à parcourir à chaque intervalle (influe donc sur la rapidité)
  'plus fract est petit, plus la rapidité est grande
  Static i  As Integer
  If x1 <> x0 Then
    a = (y1 - y0) / (x1 - x0)
    b = y1 - a * x1
    k = IIf(x1 < x0, -1, 1)
    pas = Abs((x1 - x0) \ fract)
    x2 = x0 + (i * pas * k)
    y2 = (a * (x2)) + b
    If x2 > x1 And x1 > x0 Then fin = True
    If x2 < x1 And x1 < x0 Then fin = True
  Else
    k = IIf(y1 < y0, -1, 1)
    pas = Abs((y1 - y0) / fract)
    x2 = x0
    y2 = y0 + (i * pas * k)
    If y2 > y1 And y1 > y0 Then fin = True
    If y2 < y1 And y1 < y0 Then fin = True
  End If
  If fin Then Timer1.Enabled False: i 0: fin = False: Exit Sub
  SetCursorPos ((x2 / 15) + Me.Left / 15), ((y2 / 15) + Me.Top / 15)
  SetCursorPos ScaleX(x2 + Me.Left, Me.ScaleMode, vbPixels), ScaleY(y2 + Me.Top, Me.ScaleMode, vbPixels)
  Image1.Move x2, y2
  i = i + 1
End Sub


Regarde bien la ligne disant :
fract = 250 'ici la fraction à parcourir à chaque intervalle (influe donc sur la rapidité)
'plus fract est petit, plus la rapidité est grande
Elle te permettra d'ajuster la vitesse

Lance ===>> clique sur command1 ===>> vois ===>> reclique ===> vois , etc ...

A rebixav : tu comprends, maintenant, que les "choses" ne tournaient pas autour de SetCursorPos (un détail) et d'un timer dont on modifierais l'intervalle (ce qui donnerait des résultats curieux en fonction de l'oblicité éventuelle) ?
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

Dire « Merci » 1

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 127 internautes nous ont dit merci ce mois-ci

Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
0
Merci
Bonjour,
Peux-tu s'il te plait nous montrer le code utilisé ?
Car il est probable que ce sera là, qu'il nous faudra intervenir.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Commenter la réponse de ucfoutu
Messages postés
130
Date d'inscription
dimanche 16 décembre 2007
Statut
Membre
Dernière intervention
28 janvier 2013
0
Merci
oui tu doit être fatiguer, mais chacun à son tour
pour vb :

Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

cela s'utilise comme cela :
SetCursorPos X%, Y%

et pour faire un déplacement à une certaine vitesse un peu de prog avec un timer.intervalle=lavitesse
Commenter la réponse de rebixav
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
0
Merci
pour faire un déplacement à une certaine vitesse un peu de prog avec un timer.intervalle=lavitesse

C'est cette partie du code, que j'ai besoin de voir !
Le setcursorpos n'est qu'un détail !

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Commenter la réponse de ucfoutu
Messages postés
330
Date d'inscription
mercredi 6 décembre 2000
Statut
Membre
Dernière intervention
26 octobre 2017
0
Merci
Bonjour Mr Ucfoutu,

J'ai passé la journée (parce que j'ai tout mon temps) à chercher la solution du problème que j'ai posté un peu plus haut. Fatigué, j'ai détruit une grande partie du code. Il ne reste plus que ce qui est ci-dessous et qui reste à reconstruire et à compléter.
-----------------------------------------------------------------------------------

If Parm1 = "Personnage" Then
NAM.Label15.FontSize = 14
NAM.Label15.Caption = vbCrLf & "Choisir son Personnage"
NAM.Label15.Visible = True
Call Pause(2)
I1 = 0

Tabb(I1) "Gauche": Tabx(I1) 920: Taby(I1) = 279: Tabk(I1) = 0: I1 = I1 + 1
Tabb(I1) "Gauche": Tabx(I1) 919: Taby(I1) = 437: Tabk(I1) = 0: I1 = I1 + 1
Tabb(I1) "Gauche": Tabx(I1) 920: Taby(I1) = 564: Tabk(I1) = 0: I1 = I1 + 1
Tabb(I1) "Gauche": Tabx(I1) 916: Taby(I1) = 705: Tabk(I1) = 0: I1 = I1 + 1
Tabb(I1) "Gauche": Tabx(I1) 922: Taby(I1) = 288: Tabk(I1) = 0: I1 = I1 + 1

Call Traitement
Exit Sub
End If


End Sub

'--------------------------------------------------------------------------------'
' '
' Simulation d'un Click Souris '
' '
'--------------------------------------------------------------------------------'

Sub Traitement()
Dim J1 As Integer

For J1 = 0 To UBound(Tabx)
If Tabx(J1) = 0 Then Exit For
SetCursorPos Tabx(J1), Taby(J1)
Call Pause(0.17)
Call mouse_event(&H2 Or &H4, Tabx(J1), Taby(J1), 0, 0)
Call Pause(1.5)
Next J1
End Sub

------------------------------------------------------------------------------------------

Bonjour Mr Rebixav.
C'est gentil de me répondre. C'est exact, je suis fatigué de chercher d'ou ma question.
Mon problème ne se situe pas au niveau du SetCursor comme vous pouvez le constater.



Merci encore.
Commenter la réponse de Cjvg
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
0
Merci
Bon ...
Je vais te faire un code polyvalent...
Juste une chose (importante pour des calculs exacts) : j'ai besoin de savoir :
- si ton form a sa barre de titre visible
- si ton form a ses bordures visibles
Dès ta réponse à ces deux questions, je m'y mets (après dîner, toutefois).



________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Commenter la réponse de ucfoutu
Messages postés
330
Date d'inscription
mercredi 6 décembre 2000
Statut
Membre
Dernière intervention
26 octobre 2017
0
Merci
- La Barre de Titre est cachée
- Les bordures sont invisibles

Merci encore.
Commenter la réponse de Cjvg
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
0
Merci
Ah pardon ===>>
Dans mon test, j'ai ajouté un contrôle image Image1, que j'ai rendu invisible mais ai oublié de supprimer. Mets-en un pour l'instant.
On verra après comment s'en dispenser, bien évidemment.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
0
Merci
On s'en débarrasse de suite, d'ailleurs :

[del]'x0 = Image1.Left
'y0 = Image1.Top
'x1 = Int(((Me.Width - Image1.Width) * Rnd))
'y1 = Int(((Me.Height - Image1.Height) * Rnd))/del
devient :

x0 = Int(Me.Width * Rnd)
y0 = Int(Me.Height * Rnd)
x1 = Int((Me.Width) * Rnd)
y1 = Int((Me.Height * Rnd))*
et tu supprimes (tout en bas) :
Image1.Move x2, y2

Tu dis.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
0
Merci
Hé bé (trop bu au repas, moi ...)
Supprime également la ligne :
SetCursorPos ((x2 / 15) + Me.Left / 15), ((y2 / 15) + Me.Top / 15)
écrite pour le test et remplacée ensuite....

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
0
Merci
Je viens de trouver un léger bug dans le code que je t'ai donné plus haut (un cas particulier passé au travers).
J'ai corrigé, mais ne te donnerai cette correction qu'après avoir eu confirmation que c'est bien ce que tu cherches.
J'en profiterai alors pour aller plus loin dans la polyvalence (barre de titre ou non, bordures ou pas et quelle que soit l'échelle (scalemode).
Je verrai ta réponse demain.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Commenter la réponse de ucfoutu
Messages postés
330
Date d'inscription
mercredi 6 décembre 2000
Statut
Membre
Dernière intervention
26 octobre 2017
0
Merci
Bonjour,

Je viens de faire un essai. Cette source correspond exactement à ce que je cherchais et que je n'ai pas trouvé. Je vais l'utiliser pour la démo d'un jeu que j'ai fais pour mes petits enfants.

Maintenant, il va falloir que je la décortique pour la comprendre. Je suis certain qu'elle
va intéresser beaucoup de personnes qui se sont creusés comme moi pour essayer de faire la même chose.


Encore Merci.
Commenter la réponse de Cjvg
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
0
Merci
Bon ...
Alors la voilà maintenant avec :
1) la correction du petit bug (cas particulier)
3) la polyvalence (que la barre de titre soit visible ou non, que les bords soient cachés ou non, et pour les trois échelles (pixels, twips ou points principales).
Option Explicit
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private x0 As Integer, y1 As Integer, y0 As Integer, x1 As Integer
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Dim barre As Boolean, bords As Boolean, plusb As Integer, plusc As Integer

Private Sub Command1_Click()
  Randomize Timer
  If Me.BorderStyle = 0 Then
     barre = False
     bords = False
  Else
     If ControlBox False Then barre False Else barre = True
     bords = True
  End If
  If barre Then plusb GetSystemMetrics(4) Else plusb 0
  If bords Then plusc GetSystemMetrics(5) Else plusc 0
  x0 = ScaleX(Int(Me.Width * Rnd), vbTwips, Me.ScaleMode)
  y0 = ScaleY(Int(Me.Height * Rnd), vbTwips, Me.ScaleMode)
  x1 = ScaleX(Int((Me.Width) * Rnd), vbTwips, Me.ScaleMode)
  y1 = ScaleY(Int((Me.Height * Rnd)), vbTwips, Me.ScaleMode)
  With Line1
    .x1 = x0
    .x2 = x1
    .y1 = y0
    .y2 = y1
  End With
  Timer1.Interval = 1 'ne pas toucher à cet intervalle
  Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
  Dim fract As Integer, pas As Integer, k As Integer, x2 As Integer, y2 As Integer, a As Single, b As Single, fin As Boolean ', i As Integer
  fract = 250 'ici la fraction à parcourir à chaque intervalle (influe donc sur la rapidité)
  'plus fract est petit, plus la rapidité est grande
  If Me.ScaleMode vbPixels Then fract fract / 2
  If Me.ScaleMode vbPoints Then fract fract / 4
  Static i  As Integer
  If x1 <> x0 Then
    a = (y1 - y0) / (x1 - x0)
    b = y1 - a * x1
    k = IIf(x1 < x0, -1, 1)
    pas = Abs((x1 - x0) \ fract)
    If pas 0 Then pas 1
    x2 = x0 + (i * pas * k)
    y2 = (a * (x2)) + b
    If x2 >= x1 And x1 > x0 Then
      fin = True
    ElseIf x2 <= x1 And x1 < x0 Then
      fin = True
    ElseIf y2 <= y1 And y1 < y0 Then
      fin = True
    ElseIf y2 >= y1 And y1 > y0 Then
      fin = True
    End If
  Else
    k = IIf(y1 < y0, -1, 1)
    pas = Abs((y1 - y0) / fract)
    x2 = x0
    y2 = y0 + (i * pas * k)
    If y2 >y1 And y1 > y0 Then fin True
    If y2 <y1 And y1 < y0 Then fin True
  End If
  If fin Then Timer1.Enabled False: i 0: fin = False: Exit Sub
  SetCursorPos ScaleX(x2, Me.ScaleMode, vbPixels) + ScaleX(Me.Left, vbTwips, vbPixels) + plusc, ScaleY(y2, Me.ScaleMode, vbPixels) + ScaleY(Me.Top, vbTwips, vbPixels) + plusb + (2 * plusc)
  i = i + 1
End Sub


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
0
Merci
Ah oui ===>>
il va falloir que je la décortique pour la comprendre

J'y utilise simplement :
- pour ce qui est des positions successives : l'algèbre (système de 2 équations linéaires)
- pour ce qui est du reste : (vitesse de défilement, début et fin) l'arithmétique

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.
Commenter la réponse de ucfoutu