How can i implement a journalplayback procedure whcih records mouse movement at a time interval of 1ms ?
Printable View
How can i implement a journalplayback procedure whcih records mouse movement at a time interval of 1ms ?
Could you explain what exactly a journalplayback is?
If you want to record the mouse positions, you need to create a timer
of 1ms interval and use the GetCursorPos api call to get the value of current position of the mouse cursor. The api call returns X and Y
coordinates, so you need to define a two dimensional array whihc will
store the value. Also every time yo store a new value, you will have
to redim the array from its previous value to previous value + 1
Journalplayback is a callback window hook . Then if i use a timer as u said to capture mouse position, is it possible to save the mouse position into a file so that i can playback the mouse position.
Lucky for you, I don't like to delete anything I write, so here's an example of exactly what you're looking for that I put together a while ago... (Not many comments, pet peeve, but you should be able to figure out what's going on.)
In a Module:In a Form with 5 Command Buttons; cmdRecord, cmdStop, cmdPlay, cmdLoad & cmdSave:Code:Option Explicit
Private Type EVENTMSG
message As Long
paramL As Long
paramH As Long
time As Long
hwnd As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const WH_JOURNALRECORD = 0
Private Const WH_JOURNALPLAYBACK = 1
Private Const HC_GETNEXT = 1
Private Const HC_SKIP = 2
Private Const WH_GETMESSAGE = 3
Private Const WH_CALLWNDPROC = 4
Private Const WM_CANCELJOURNAL = &H4B
Private Const WM_MOUSEMOVE = &H200
Private lHookID As Long
Private lAppHookID As Long
Private tEventList() As EVENTMSG
Private tEVENTMSG As EVENTMSG
Private lMsgCount As Long
Private lMsgCountMax As Long
Public Sub RecordMouse()
'Record the Mouse Events
If lHookID <> 0 Then Exit Sub
lMsgCountMax = 0
lMsgCount = 0
ReDim tEventList(0)
'Set an application hook to monitor for messages sent to this app
lAppHookID = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMessageProc, App.hInstance, App.ThreadID)
'Set the Journal Hook to allow us to record all Mouse Movements
lHookID = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, 0&, 0&)
Debug.Print "Recording..."
End Sub
Public Sub RecordMouseStop()
'Stop Recording the Mouse Events
If lHookID <> 0 Or lAppHookID <> 0 Then
Call UnhookWindowsHookEx(lAppHookID)
Call UnhookWindowsHookEx(lHookID)
lHookID = 0
lAppHookID = 0
Debug.Print "Recording Stopped - " & lMsgCountMax & " messages recorded."
End If
End Sub
Public Sub PlayBackMouse()
'Playback the Journal Recorded with JournalRecord
If lHookID <> 0 Then Exit Sub
lMsgCount = 1
tEVENTMSG = tEventList(1)
'Set an application hook to monitor for messages sent to this app
lAppHookID = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMessageProc, App.hInstance, App.ThreadID)
lHookID = SetWindowsHookEx(WH_JOURNALPLAYBACK, AddressOf JournalPlaybackProc, 0&, 0&)
Debug.Print "Playing..."
End Sub
Public Sub PlayBackMouseStop()
'Stop Journal Playback
If lHookID <> 0 Or lAppHookID <> 0 Then
Call UnhookWindowsHookEx(lAppHookID)
Call UnhookWindowsHookEx(lHookID)
lHookID = 0
lAppHookID = 0
Debug.Print "Playback Stopped."
End If
End Sub
Private Function GetMessageProc(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tMSG As MSG
If Code < 0 Then
'Pass the message along...
GetMessageProc = CallNextHookEx(lAppHookID, Code, wParam, ByVal lParam)
Else
'Grab the MSG structure
CopyMemory tMSG, ByVal lParam, Len(tMSG)
Select Case tMSG.message
Case WM_CANCELJOURNAL
'An external process has requested us to stop this operation
Call UnhookWindowsHookEx(lHookID)
lHookID = 0
End Select
End If
End Function
Private Function JournalRecordProc(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo LogError
If Code < 0 Then
'Pass this message along...
JournalRecordProc = CallNextHookEx(lHookID, Code, wParam, ByVal lParam)
Else
'Grab the Event Message Structure
CopyMemory tEVENTMSG, ByVal lParam, Len(tEVENTMSG)
'Only record MOUSE_MOVE events
If tEVENTMSG.message = WM_MOUSEMOVE Then
lMsgCountMax = lMsgCountMax + 1
ReDim Preserve tEventList(lMsgCountMax)
tEventList(lMsgCountMax) = tEVENTMSG
End If
JournalRecordProc = 0
End If
Exit Function
LogError:
Debug.Print "Error in JournalRecordProc()"
End Function
Private Function JournalPlaybackProc(ByVal Code As Long, ByVal wParam As Long, ByRef lParam As Long) As Long
Dim iX As Integer, iY As Integer, lTime As Long
On Error GoTo LogError
Select Case Code
Case HC_SKIP
'Select the Next Event Message
lMsgCount = lMsgCount + 1
If lMsgCount >= lMsgCountMax Then
'Last Message processed, so remove the Journal Hook
PlayBackMouseStop
Else
tEVENTMSG = tEventList(lMsgCount)
End If
JournalPlaybackProc = 0
Case HC_GETNEXT
'Grab the Event Message Structure and Process the Message
lParam = VarPtr(tEVENTMSG)
With tEVENTMSG
If .message = WM_MOUSEMOVE Then
iX = .paramL
iY = .paramH
'Pause time for processing lag (calculated as time between this and prev. message)
lTime = (.time - tEventList(lMsgCount - 1).time) - 7
'Pause can't be less than 0
If lTime < 0 Then lTime = 0
'Move the Cursor accordingly
SetCursorPos iX, iY
'If this isn't the 1st message pause before processing the next message
If lMsgCount > 1 Then
Sleep lTime
End If
End If
End With
Case Else
'Pass this message along...
JournalPlaybackProc = CallNextHookEx(lHookID, Code, wParam, ByVal lParam)
Exit Function
End Select
Exit Function
LogError:
Debug.Print "Error in JournalPlaybackProc():" & Err.Description, lMsgCount, lMsgCountMax
End Function
Public Sub SaveEvents(ByVal sFilename As String, ByRef tEventArray() As EVENTMSG)
Dim iFile As Integer
Dim lIndex As Long
If Len(Dir(sFilename)) Then Kill sFilename
iFile = FreeFile
Open sFilename For Random Access Write As iFile
For lIndex = LBound(tEventArray) To UBound(tEventArray)
Put #iFile, , tEventArray(lIndex)
Next
Close iFile
End Sub
Public Sub LoadEvents(ByVal sFilename As String, ByRef tEventArray() As EVENTMSG)
Dim iFile As Integer
Dim lIndex As Long
If Len(Dir(sFilename)) = 0 Then Exit Sub
iFile = FreeFile
Open sFilename For Random Access Read As iFile
While Not EOF(iFile)
ReDim Preserve tEventArray(lIndex)
Get #iFile, , tEventArray(lIndex)
lIndex = lIndex + 1
Wend
Close iFile
End Sub
Public Sub SaveTheEvents()
Call SaveEvents("C:\Events.dat", tEventList)
End Sub
Public Sub LoadTheEvents()
Call LoadEvents("C:\Events.dat", tEventList)
lMsgCountMax = UBound(tEventList)
End Sub
Code:Private Sub cmdLoad_Click()
LoadTheEvents
End Sub
Private Sub cmdPlay_Click()
PlayBackMouse
End Sub
Private Sub cmdRecord_Click()
RecordMouse
End Sub
Private Sub cmdSave_Click()
SaveTheEvents
End Sub
Private Sub cmdStop_Click()
RecordMouseStop
End Sub
Hi , i have gottten this code from other newsgroup. I have been trying to alter the journalrecord proc so that i can record mmouse position every 30 ms using a timer but unable to do so. Do you have any idea to obtaining this objective ?
In the JournalRecordProc() add a clause to the If staement that checks for the specified time interval, i.e.I don't know is using that high a resolution will work for you though.Code:Private Function JournalRecordProc(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static tTimer As Single
On Error GoTo LogError
If Code < 0 Then
'Pass this message along...
JournalRecordProc = CallNextHookEx(lHookID, Code, wParam, ByVal lParam)
Else
'Grab the Event Message Structure
CopyMemory tEVENTMSG, ByVal lParam, Len(tEVENTMSG)
'Only record MOUSE_MOVE events
If tEVENTMSG.message = WM_MOUSEMOVE And (Timer - tTimer) > 0.003 Then
lMsgCountMax = lMsgCountMax + 1
ReDim Preserve tEventList(lMsgCountMax)
tEventList(lMsgCountMax) = tEVENTMSG
tTimer = Timer
End If
JournalRecordProc = 0
End If
Exit Function
LogError:
Debug.Print "Error in JournalRecordProc()"
End Function
Hi , it work for me. Thanks. But if i want to detect if the mouse playback has finished , then how can i do it ?
Simply put your code into PlayBackMouseStop() it's called to unhook the Journal Hook when playback has completed or been canceled.
Actually , i need to detect the end of playing back in one of my command button click event in my code. How can i achieve it ?
What do you mean?You mean you want the Command buttons Click event to be triggered when the playback stops? (Makes no sense.)Quote:
..in one of my command button click event..
Or do you mean you want to Stop playback from the Command button Click event? If so, simply call the PlayBackMouseStop() event from within your Command Buttons Click event.
Sorry for not making myself clear. I mean that in my command button click event , i will playback a mouse file & after playing back i want to detect if the playback has finished.
OK, just define a Public Boolean variable to use as a flag, then set it to True in the PlayBackMouseStop() function, then in the Command Button's Click() event, start the playback then use a While loop to wait until the Flaf is set to True indicating the playback has finished, i.e.In Your Form:Code:Option Explicit
Public bDone As Boolean
Private Type EVENTMSG
message As Long
paramL As Long
paramH As Long
time As Long
hwnd As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const WH_JOURNALRECORD = 0
Private Const WH_JOURNALPLAYBACK = 1
Private Const HC_GETNEXT = 1
Private Const HC_SKIP = 2
Private Const WH_GETMESSAGE = 3
Private Const WH_CALLWNDPROC = 4
Private Const WM_CANCELJOURNAL = &H4B
Private Const WM_MOUSEMOVE = &H200
Private lHookID As Long
Private lAppHookID As Long
Private tEventList() As EVENTMSG
Private tEVENTMSG As EVENTMSG
Private lMsgCount As Long
Private lMsgCountMax As Long
Public Sub RecordMouse()
'Record the Mouse Events
If lHookID <> 0 Then Exit Sub
lMsgCountMax = 0
lMsgCount = 0
ReDim tEventList(0)
'Set an application hook to monitor for messages sent to this app
lAppHookID = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMessageProc, App.hInstance, App.ThreadID)
'Set the Journal Hook to allow us to record all Mouse Movements
lHookID = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, 0&, 0&)
Debug.Print "Recording..."
End Sub
Public Sub RecordMouseStop()
'Stop Recording the Mouse Events
If lHookID <> 0 Or lAppHookID <> 0 Then
Call UnhookWindowsHookEx(lAppHookID)
Call UnhookWindowsHookEx(lHookID)
lHookID = 0
lAppHookID = 0
Debug.Print "Recording Stopped - " & lMsgCountMax & " messages recorded."
End If
End Sub
Public Sub PlayBackMouse()
'Playback the Journal Recorded with JournalRecord
If lHookID <> 0 Then Exit Sub
lMsgCount = 1
tEVENTMSG = tEventList(1)
'Set an application hook to monitor for messages sent to this app
lAppHookID = SetWindowsHookEx(WH_GETMESSAGE, AddressOf GetMessageProc, App.hInstance, App.ThreadID)
lHookID = SetWindowsHookEx(WH_JOURNALPLAYBACK, AddressOf JournalPlaybackProc, 0&, 0&)
Debug.Print "Playing..."
End Sub
Public Sub PlayBackMouseStop()
'Stop Journal Playback
If lHookID <> 0 Or lAppHookID <> 0 Then
Call UnhookWindowsHookEx(lAppHookID)
Call UnhookWindowsHookEx(lHookID)
lHookID = 0
lAppHookID = 0
Debug.Print "Playback Stopped."
bDone = True
End If
End Sub
Private Function GetMessageProc(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tMSG As MSG
If Code < 0 Then
'Pass the message along...
GetMessageProc = CallNextHookEx(lAppHookID, Code, wParam, ByVal lParam)
Else
'Grab the MSG structure
CopyMemory tMSG, ByVal lParam, Len(tMSG)
Select Case tMSG.message
Case WM_CANCELJOURNAL
'An external process has requested us to stop this operation
Call UnhookWindowsHookEx(lHookID)
lHookID = 0
End Select
End If
End Function
Private Function JournalRecordProc(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo LogError
If Code < 0 Then
'Pass this message along...
JournalRecordProc = CallNextHookEx(lHookID, Code, wParam, ByVal lParam)
Else
'Grab the Event Message Structure
CopyMemory tEVENTMSG, ByVal lParam, Len(tEVENTMSG)
'Only record MOUSE_MOVE events
If tEVENTMSG.message = WM_MOUSEMOVE Then
lMsgCountMax = lMsgCountMax + 1
ReDim Preserve tEventList(lMsgCountMax)
tEventList(lMsgCountMax) = tEVENTMSG
End If
JournalRecordProc = 0
End If
Exit Function
LogError:
Debug.Print "Error in JournalRecordProc()"
End Function
Private Function JournalPlaybackProc(ByVal Code As Long, ByVal wParam As Long, ByRef lParam As Long) As Long
Dim iX As Integer, iY As Integer, lTime As Long
On Error GoTo LogError
Select Case Code
Case HC_SKIP
'Select the Next Event Message
lMsgCount = lMsgCount + 1
If lMsgCount >= lMsgCountMax Then
'Last Message processed, so remove the Journal Hook
PlayBackMouseStop
Else
tEVENTMSG = tEventList(lMsgCount)
End If
JournalPlaybackProc = 0
Case HC_GETNEXT
'Grab the Event Message Structure and Process the Message
lParam = VarPtr(tEVENTMSG)
With tEVENTMSG
If .message = WM_MOUSEMOVE Then
iX = .paramL
iY = .paramH
'Pause time for processing lag (calculated as time between this and prev. message)
lTime = (.time - tEventList(lMsgCount - 1).time) - 7
'Pause can't be less than 0
If lTime < 0 Then lTime = 0
'Move the Cursor accordingly
SetCursorPos iX, iY
'If this isn't the 1st message pause before processing the next message
If lMsgCount > 1 Then
Sleep lTime
End If
End If
End With
Case Else
'Pass this message along...
JournalPlaybackProc = CallNextHookEx(lHookID, Code, wParam, ByVal lParam)
Exit Function
End Select
Exit Function
LogError:
Debug.Print "Error in JournalPlaybackProc():" & Err.Description, lMsgCount, lMsgCountMax
End Function
Public Sub SaveEvents(ByVal sFilename As String, ByRef tEventArray() As EVENTMSG)
Dim iFile As Integer
Dim lIndex As Long
If Len(Dir(sFilename)) Then Kill sFilename
iFile = FreeFile
Open sFilename For Random Access Write As iFile
For lIndex = LBound(tEventArray) To UBound(tEventArray)
Put #iFile, , tEventArray(lIndex)
Next
Close iFile
End Sub
Public Sub LoadEvents(ByVal sFilename As String, ByRef tEventArray() As EVENTMSG)
Dim iFile As Integer
Dim lIndex As Long
If Len(Dir(sFilename)) = 0 Then Exit Sub
iFile = FreeFile
Open sFilename For Random Access Read As iFile
While Not EOF(iFile)
ReDim Preserve tEventArray(lIndex)
Get #iFile, , tEventArray(lIndex)
lIndex = lIndex + 1
Wend
Close iFile
End Sub
Public Sub SaveTheEvents()
Call SaveEvents("C:\Events.dat", tEventList)
End Sub
Public Sub LoadTheEvents()
Call LoadEvents("C:\Events.dat", tEventList)
lMsgCountMax = UBound(tEventList)
End Sub
Code:Private Sub Command1_Click()
bDone = False
PlayBackMouse
While Not bDone
DoEvents
Wend
End Sub
Thanks Aaron
Is it possible to synchronize the playback of mouse wav with the playing back of a wav file using sndplaysound api function? I mean making the playing back of the mouse & wav file at the same rate ?