1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Souris, Clavier, etc…
  5. Distance qu'a parcourue la souris (mètrique)

Distance qu'a parcourue la souris (mètrique)

5/5 (5 avis)

Vue 8 083 fois - Téléchargée 439 fois

Télécharger le projet
Commenter

Description

C tou simple !
Regarder dans le zip y'a l'exemple concret ! ;-)

sinon,dans l'exemple ci-dessous, il vous faut un timer (timer1) et un label (label1)

Source / Exemple : 


Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim Pos As POINTAPI
Dim LastPos As POINTAPI

Dim DecPixel As Integer 'Décalage en pixel de la souris
Dim CmSouris As Integer 'Cm k'a parcourue la souris
Dim MSouris As Integer 'M k'a parcourue la souris
Dim KmSouris As Integer 'Km k'a parcourue la souris

Private Sub Timer1_Timer()
GetCursorPos Pos 'met les positions de la souris dans pos

If Pos.x <> LastPos.x Or Pos.y <> LastPos.y Then  'Si la souris bouge
DecPixel = DecPixel + Abs(Pos.x - LastPos.x) 'Calcul de combien de pixel elle a bougé
DecPixel = DecPixel + Abs(Pos.y - LastPos.y)
If DecPixel >= 38 Then CmSouris = CmSouris + 1: DecPixel = 0  'Kan elle a bougé de 38 pixel , alors ca fait 1 centimère
If CmSouris >= 100 Then CmSouris = 0: MSouris = MSouris + 1 '100 cm ca fait 1 m
If MSouris >= 1000 Then MSouris = 0: KmSouris = KmSouris + 1 '1000m ca fait 1 km

End If

GetCursorPos LastPos 'Met la position de la souris dans la valeur oldpos pour pouvoir comparer si la souris bouge

Label1 = KmSouris & " Km " & MSouris & " M " & CmSouris & " Cm"

End Sub

Conclusion :


Ca marche parfaitement en 1024*768
mais dans les autres résolution, ca risque d'être faussé car un centimètre ne fait plus 38 pixel.
je vais voir ce ke je peu faire...
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
fabiin Messages postés 329 Date d'inscription mercredi 4 avril 2001 Statut Membre Dernière intervention 8 décembre 2009 6
5 sept. 2002 à 21:22
Salut, lol Fido
Cela fait maintenant plus d'un an ke je ne programme plus en vb :), j'invite donc les gens a modifier cette source, en modifiant effectivement ma grosse erreur :) et donc en utilisant effectivement Pythagore pour calculer l'hypoténuse :)
Toutefois je veu bien faire ceci en delphi, lol
cs_FidoDido Messages postés 3 Date d'inscription mardi 24 octobre 2000 Statut Membre Dernière intervention 16 juin 2002
5 sept. 2002 à 18:18
deja ya une grosse faute a ton truc ..si il bouge en x et y on a joute pas la distance des 2 , on fait le carre des 2, on les ajoute et puis la racine , merci pythagore ^^
cs_max12 Messages postés 1491 Date d'inscription dimanche 19 novembre 2000 Statut Modérateur Dernière intervention 7 juillet 2014
13 juil. 2002 à 19:20
Faut-il changer la boule a toute les 5000 km ? (lol)

@+
Nexum
23 mai 2001 à 00:02
Hey pour ton prob au début de l'exécution quand on le pars pour la rpemiere fois tas juste a demander quel est la résolution pis paramètres a partir de ca

ben comment on fais pour trouver comment égale un centimetre dans dautres résolutions
Nexum
22 mai 2001 à 23:59
MMMMMMMEEEEEERRRRRRCCCCCIIIIII !!!!!
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 (fabiin)