In the below module is a playback mouse movement procedure.The attached files are 1bitmap.dat,1bitmap.jpg ,2bitmap.dat & 2bitmap.jpg. Mouse files are .dat. All the attached files are to be copied to 'C\:' for the below code to work. Now i need to load the 1bitmap.jpg onto a picture box & play 1bitmap.dat. Then load the 2bitmap.jpg onto a picture box & play 2bitmap.dat. But my problem is that i cannot follow this order as the first .dat file has not finished executing, thw 2bitmap.jpg has already been loaded onto picture box. You can load 1bitmap.jpg & play 1bitmap.dat only by changing variable 'p' in command button to 1. To play both change 'p' to 2.
'in your form put 1 picturebox & 1 command button.
Private Sub Command1_Click()
On Error GoTo PROC_ERR
ChDir "C:/"
Dim p As Long
For p = 1 To 2
sBMP = CStr(p) + "bitmap"
sWAV = sBMP & ".wav"
sDat = sBMP & ".dat"
sBMP = sBMP & ".jpg"
'Call sndPlaySound(sWAV, SND_ASYNC)
Picture1 = LoadPicture(sBMP)
'voice at playmouse
'Load DAT...
'Do whatever with sDAT Dat file here.
' sndPlaySound sWAV, SND_ASYNC
LoadTheEvents
'RetVal = PlaySound(sWAV, 0, SND_ASYNC)
Call PlayBackMouse
'Sleep 10000
Next
'Sleep 10000
Exit Sub
PROC_ERR:
MsgBox Err.Description, vbInformation
Unload Me
End Sub
Option Explicit
'Public i As Long
'Public g As Long
Public y As Long
Public f As Long
Public k As Long
Public Const SND_SYNC = &H0
Public sBMP As String, sWAV As String
Public Const SND_ASYNC = &H1
Public RetVal As Long
Public Const SND_PURGE = &H2
Public Type EVENTMSG
message As Long
paramL As Long
paramH As Long
time As Long
hWnd As Long
End Type
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type msg
hWnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public 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
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Const WH_JOURNALRECORD = 0
Public Const WH_JOURNALPLAYBACK = 1
Public Const HC_GETNEXT = 1
Public Const HC_SKIP = 2
Public Const WH_GETMESSAGE = 3
Public Const WH_CALLWNDPROC = 4
Public Const WM_CANCELJOURNAL = &H4B
Public Const WM_MOUSEMOVE = &H200
Public lHookID As Long
Public lAppHookID As Long
Public tEventList() As EVENTMSG
Public tEVENTMSG As EVENTMSG
Public lMsgCount As Long
Public lMsgCountMax As Long
Public sDat As String
Public mousepos As String
Public Function PlayBackMouse() As Boolean
'Playback the Journal Recorded with JournalRecord
If lHookID <> 0 Then Exit Function
lMsgCount = 1
tEVENTMSG = tEventList(1)
Sleep 5500
'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 Function
'Public Function isPlayBackMouse() As Boolean
'While PlayBackMouseStop <> False
' isPlayBackMouse = False
'Wend
'End Function
Public Function PlayBackMouseStop() As Boolean
PlayBackMouseStop = False
'Stop Journal Playback
If lHookID <> 0 Or lAppHookID <> 0 Then
Call UnhookWindowsHookEx(lAppHookID)
Call UnhookWindowsHookEx(lHookID)
lHookID = 0
lAppHookID = 0
Debug.Print "Playback Stopped."
PlayBackMouseStop = True
End If
End Function
Public 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
Public Sub LoadEvents(ByVal sFilename As String, ByRef tEventArray() As EVENTMSG)
Dim iFile As Integer
Dim lIndex As Long
If FileLen(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 LoadTheEvents()
Call LoadEvents(sDat, tEventList)
lMsgCountMax = UBound(tEventList)
End Sub
Public 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
Call 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
Sleep 0.09
'End With
SetCursorPos iX, iY
'If this isn't the 1st message pause before processing the next message
If lMsgCount > 1 Then
Sleep lTime '*****changes
'Sleep 100
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
Playback mouse movement & JPEG file
Reply With Quote