Måte å lage et "muse-meter"?

[Stig Jøran]

Vet ikke hva det heter, men jeg kaller det for "muse-meter", sånn som måler hvor mye man beveger musa. Finns det en måte å lage en egen sånn sak i vb?

[Richard87]

det spørs, skal du måle hvor lang ti det tar for en bruker fra og bevege musen en pixel, eller hvor mange pixler en bruker bevegr musen på f.eks 1mS?

[Jonas]

Kode for å finne musens posisjon:

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

Private Sub Form_Load()
   GetCursorPos POINTAPI
   MsgBox "X: " & POINTAPI.x & vbNewLine & _
          "Y: " & POINTAPI.y
End Sub

Å finne ut hvor langt, i meter, en har flyttet på musa blir litt vannskelig.

Man finner jo lett ut hvor mange pixler den er flytta, men hvor mange pixler er det i en meter? Da må du finne ut hvor stor en pixel er på brukerens skjerm.

 

Antall tommer (Skjermen) / oppløsning

 

Blir litt triksy, og jeg skønner egentlig ikke hvordan "mouse 'o' meter" greiene funker..

[aadnk]

Vel, det burde ikke være så altfor vanskelig. Alt man trenger å gjøre, er jo å måle hvor mange piksler musepekeren har beveget seg siden siste måling, og dernest konvertere dette til et mer generelt mål som meter. Man kan eksempelvis gjøre det som følger:

 

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Type POINTAPI
   X As Long
   Y As Long
End Type

' Den totale lengden
Dim TotalLenght As Double

' Den siste muse-posisjonen
Dim lastPos As POINTAPI

' Benyttes for å avslutte løkken
Dim bExit As Boolean

Private Function CalcDist(posDest As POINTAPI, posRef As POINTAPI) As Double

   Dim lngDistPixel As Long
   
   ' Kalkuler først avstanden i piksler
   lngDistPixel = Abs(posDest.X - posRef.X) + Abs(posDest.Y - posRef.Y)

   ' Omregn dette til centimeter
   CalcDist = Me.ScaleX(lngDistPixel, vbPixels, vbCentimeters)

End Function

Private Sub SetPosition(refPos As POINTAPI, X As Long, Y As Long)

   refPos.X = X
   refPos.Y = Y

End Sub

Private Sub Form_Load()

   Dim posNew As POINTAPI

   ' Vis denne formen
   Show

   ' Bruk gjeldende posisjon
   GetCursorPos lastPos

   Do Until bExit
   
       ' Hent den nye posisjonen
       GetCursorPos posNew
   
       ' Kalkuler avstanden i centimeter
       TotalLenght = TotalLenght + CalcDist(posNew, lastPos)
   
       ' Lagre denne nye posisjonen
       SetPosition lastPos, posNew.X, posNew.Y
   
       ' Vis denne nye avstanden
       Me.Caption = "Musepekeren har beveget seg " & Round(TotalLenght, 2) & " cm."
       
       Sleep 10
       DoEvents
   Loop

End Sub

Private Sub Form_Unload(Cancel As Integer)
   
   ' Avslutt løkken
   bExit = True

End Sub

[Jonas]

Hvordan vet PCen hvor mange pixler det er i en centimeter?