Tastendrücke / Mausklicks Zählen

tlj

Mitglied
Ich möchte mir ne kleine Spielerei schreiben die die Klicks / Drücke der Einzelnen Tasten/Keys zählt und protokolliert

VB 6.0 ^^

Will einfach mal wissen was am meisten genutz wird

Nur mein Problem ist beim Dauertdrücken wird die Ganze zeit gezählt!
Bei der Maus habe ich das Problem nicht aber bei der Tastatur!

Außerdem ist es wichtig das es Systemschonend ist, Damit ich es im hintergrund laufen lassen kann

Ich möchte mir dann eine art Datenbank erstellen (Nach Tag,Tastendrücke usw) und diese wieder anzeigen lassen
Kann ich mit VB einfach eine excell / access oder eine ähnliche datenbank simpel schreiben?

hier der Code
('----' nur zur übersicht) und die controlls sind nat vorhanden
Code:
Option Explicit

Public LastDone As Long
Public LastDoneKey As Long

Private Declare Function GetAsyncKeyState Lib "user32" ( _
  ByVal vKey As Long) As Integer
  
Private Const KEY_PRESSED As Integer = -32767
Private Const VK_LBUTTON = &H1
Private Const VK_RBUTTON = &H2
Private Const VK_MBUTTON = &H4

----
Private Function CountMouse(MouseNum As Long) As Boolean
If MouseNum = LastDone Then
CountMouse = False

Else
    If GetAsyncKeyState(MouseNum) = KEY_PRESSED Then
    CountMouse = True
    End If
End If

txtPressed.Text = MouseNum
LastDone = MouseNum
End Function
----
Private Function CountKey(KeyNum As Long) As Boolean
If KeyNum = LastDoneKey Then
CountKey = False
Else
    If GetAsyncKeyState(KeyNum) = KEY_PRESSED Then
    CountKey = True
    End If
End If

txtPressed.Text = KeyNum
LastDoneKey = KeyNum
End Function
----
Private Sub Form_Load()
  Call GetAsyncKeyState(VK_LBUTTON)
End Sub
----
Private Sub Timer1_Timer()
  If CountMouse(VK_LBUTTON) = True Then
    txtLeftMouse.Text = txtLeftMouse.Text + 1
  ElseIf CountMouse(VK_RBUTTON) = True Then
    txtRightMouse.Text = txtRightMouse.Text + 1
  ElseIf CountMouse(VK_MBUTTON) = True Then
    txtDoubleMouse.Text = txtDoubleMouse.Text + 1
  ElseIf CountKey(vbKeyA) = True Then
    txtKeyA.Text = txtKeyA.Text + 1
  ElseIf CountKey(vbKeyB) = True Then
    txtKeyB.Text = txtKeyB.Text + 1
    End If
End Sub

Wenn ich es wie folgt mache werden klicks/Tastendrücke der selben Taste hintereinander nicht gezählt!

Code:
If KeyNum = LastDoneKey Then
CountKey = False
Else
    If GetAsyncKeyState(KeyNum) = KEY_PRESSED Then
    CountKey = True
    txtPressed.Text = KeyNum
    LastDoneKey = KeyNum
    End If
End If

jmd eine idee?
mfg liljawa

edit gelöst falls es jmd interessiert
Code:
Option Explicit

Public LastDone As Long
Public LastDoneKey As Long
Private ReDone As Boolean

Private Declare Function GetAsyncKeyState Lib "user32" ( _
      ByVal vKey As Long) As Integer
    
Private Declare Sub CopyMemory Lib "kernel32" Alias _
      "RtlMoveMemory" (lpDest As Any, lpSource As Any, _
      ByVal cBytes As Long)

Private Const KEY_PRESSED As Integer = -32767
Private Const VK_LBUTTON = &H1
Private Const VK_RBUTTON = &H2
Private Const VK_MBUTTON = &H4

Private Function LoWord(ByVal dwValue As Long) As Integer
  Call CopyMemory(LoWord, dwValue, 2&)
End Function

Private Function HiWord(ByVal dwValue As Long) As Integer
  Call CopyMemory(HiWord, ByVal VarPtr(dwValue) + 2, 2&)
End Function

Private Function CountMouse(MouseNum As Long) As Boolean
If MouseNum = LastDone Then
CountMouse = False
Else
    If GetAsyncKeyState(MouseNum) = KEY_PRESSED Then
    CountMouse = True
    txtPressed.Text = MouseNum
    End If
End If
    LastDone = MouseNum
End Function
Private Function CountKey(KeyNum As Long) As Boolean
'If KeyNum = LastDoneKey Then
'CountKey = False
'Else
 '   If GetAsyncKeyState(KeyNum) = KEY_PRESSED Then


 '  End If
  '      LastDoneKey = KeyNum
'End If


        If (HiWord(KeyNum) <> 0) Or (LoWord(KeyNum) <> 0) Then
            'Taste ist gerade gedrückt oder wurde gedrückt
            'Button absenken
            ReDone = False
        Else
            If ReDone = False Then
            'zurücksetzen, Taste nicht gedrückt
            ReDone = True
            CountKey = True
            End If
        End If
End Function

Private Sub Form_Load()
  ReDone = False
  Call GetAsyncKeyState(VK_LBUTTON)
End Sub

Private Sub tmrMouse_Timer()
  If CountMouse(VK_LBUTTON) = True Then
    txtLeftMouse.Text = txtLeftMouse.Text + 1
  ElseIf CountMouse(VK_RBUTTON) = True Then
    txtRightMouse.Text = txtRightMouse.Text + 1
  ElseIf CountMouse(VK_MBUTTON) = True Then
    txtDoubleMouse.Text = txtDoubleMouse.Text + 1
    End If
End Sub

Private Sub tmrKey_Timer()
  Dim i As Long
  Dim nRetVal As Long

    For i = KeyCodeConstants.vbKeyA To KeyCodeConstants.vbKeyC
        'Status der Taste auslesen
        nRetVal = GetAsyncKeyState(i)
        'If HiWord(nRetVal) <> 0 Then 'Taste wird gerade gedrückt
        'If LoWord(nRetVal) <> 0 Then 'Taste wurde seit dem letzten
                                     'Aufruf gedrückt
                                     
        If (HiWord(nRetVal) <> 0) Or (LoWord(nRetVal) <> 0) Then
            'Taste ist gerade gedrückt oder wurde gedrückt
            'Button absenken
            txtKey(i - 65).HelpContextID = 1
        Else
            If txtKey(i - 65).HelpContextID = 1 Then
            'zurücksetzen, Taste nicht gedrückt
            txtKey(i - 65).HelpContextID = 0
            txtPressed.Text = i
            txtKey(i - 65).Text = txtKey(i - 65).Text + 1
            End If
        End If
    Next i
End Sub
 
Zuletzt bearbeitet:
Zurück