Idle Track Class
Tracks when the mouse is idle with an easy to use Class Module. Download VB6 project. (12 downloads)
frmIdle.frm - Example Form
cIdle.cls - Idle Track Class
Tracks when the mouse is idle with an easy to use Class Module. Download VB6 project. (12 downloads)
frmIdle.frm - Example Form
Option Explicit
' =======================================================
' this example shows how to use system idle with a timer
' =======================================================
' when you are away from the system it will go idle mode
' when you move the mouse or touch a key system is active
' -------------------------------------------------------
' to manually reset user input in code: Call ResetInput
' =======================================================
Private WithEvents IdleTrack As cIdle
Attribute IdleTrack.VB_VarHelpID = -1
' program start
Private Sub Form_Load()
Set IdleTrack = New cIdle ' start class
Call IdleTrack.StartIdle(Timer1, 10) ' timer|interval
End Sub
' program exit
Private Sub Form_Unload(Cancel As Integer)
Set IdleTrack = Nothing ' end class
End Sub
' active event
Private Sub IdleTrack_OnActive()
Debug.Print "MY ACTIVE CODE" ' active code
Me.Show
End Sub
' idle event
Private Sub IdleTrack_OnIdle()
Debug.Print "MY IDLE CODE" ' idle code
Me.Hide
End Sub
|
cIdle.cls - Idle Track Class
Option Explicit
Private Const KEYEVENTF_KEYUP = &H2
Private Const INPUT_KEYBOARD = 1
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Private Type KEYBDINPUT
wVk As Integer
wScan As Integer
dwFlags As Long
time As Long
dwExtraInfo As Long
End Type
Private Type GENERALINPUT
dwType As Long
xi(0 To 23) As Byte
End Type
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function GetLastInputInfo Lib "user32" (plii As Any) As Long
Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
Public Event OnIdle() ' idle event for form
Public Event OnActive() ' active event for form
Private mIdleMode As Long ' 1=idle, 2=active
Private mIdleCnt As Long ' idle for count
Private mInterval As Long ' interval, eg. 10 (secs)
Private WithEvents mTimer As Timer ' timer on form
' set idle mode
Public Property Let IdleMode(ByVal pIdleMode As Long)
mIdleMode = pIdleMode
End Property
' get idle mode
Public Property Get IdleMode() As Long
IdleMode = mIdleMode
End Property
' set idle for count
Public Property Let IdleCnt(ByVal pIdleCnt As Long)
mIdleCnt = pIdleCnt
End Property
' get idle for count
Public Property Get IdleCnt() As Long
IdleCnt = mIdleCnt
End Property
' start the idle mode
Public Sub StartIdle(pTimer As Timer, Optional ByVal pInterval As Long = 10)
On Error GoTo Error_Handler
mIdleMode = 2
If mTimer Is Nothing Then Set mTimer = pTimer
mInterval = pInterval
If Not mTimer Is Nothing Then
mTimer.Interval = 1000 ' idle timer start
mTimer.Enabled = True
'=============================
Debug.Print "IDLE TIMER START"
'-----------------------------
Exit Sub
End If
Error_Handler:
'=============================
Debug.Print "IDLE START ERROR"
'-----------------------------
End Sub
' reset the idle time
Public Sub ResetInput()
'this is similar to send keys
'just need to simulate user input
'so no copy memory in this one
Dim GInput(0) As GENERALINPUT
Dim KInput As KEYBDINPUT
KInput.wVk = vbKeyEscape
GInput(0).dwType = INPUT_KEYBOARD
Call SendInput(1, GInput(0), Len(GInput(0)))
'=============================
Debug.Print "RESET USER INPUT"
'-----------------------------
End Sub
' raise the idle event
Public Sub RaiseIdle()
RaiseEvent OnIdle
End Sub
' raise the active event
Public Sub RaiseActive()
RaiseEvent OnActive
End Sub
' get and set idle modes
Private Function CheckIdle()
mIdleCnt = IdleTime
If mIdleCnt > mInterval Then ' idle
If mIdleMode = 2 Then
mIdleMode = 1
'=============================
Debug.Print "SYSTEM IS IDLE"
'-----------------------------
Call RaiseIdle
'-----------------------------
End If
Else
If mIdleMode = 1 Then ' active
mIdleMode = 2
'=============================
Debug.Print "SYSTEM IS ACTIVE"
'-----------------------------
Call RaiseActive
'-----------------------------
End If
If mIdleCnt > 0 Then
'============================================
Debug.Print "IDLE FOR: " & mIdleCnt & " secs"
'--------------------------------------------
End If
End If
End Function
' timer event on form
Private Sub mTimer_Timer()
Call CheckIdle
End Sub
' finish the idle mode
Private Sub FinishIdle()
If Not mTimer Is Nothing Then
mTimer.Interval = 0 ' idle timer end
mTimer.Enabled = False
'=============================
Debug.Print "IDLE TIMER END"
'-----------------------------
End If
End Sub
' get the idle time
Private Function IdleTime() As Long
Dim lii As LASTINPUTINFO
lii.cbSize = Len(lii)
Call GetLastInputInfo(lii)
IdleTime = FormatNumber((GetTickCount() - lii.dwTime) / 1000, 2)
End Function
' end the timer on exit
Private Sub Class_Terminate()
Call FinishIdle
End Sub
|
