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

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

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)