D
Dave D-C
Hello,
' I'm 'Shell'ing Photoshop Elements, which
' takes awhile to get settled. Using
' Sendkeys "{END}", True and then
' WaitForInputIdle(..) does the job,
' but the Wait, although correctly waiting,
' always returns -1&=WAIT_FAILED.
' It should be 0& (or &H102&=WAIT_TIMEOUT).
' Q - why WAIT_FAILED?
' Run this routine, then open any another application.
' It prints the hWnd, Class, Title, and the
' time it takes for WaitForInputIdle.
' That can be over 1 second for Photoshop.
' This is all XL97/WIN98. D-C Dave
' API Declarations
Declare Function GetClassName& _
Lib "user32" _
Alias "GetClassNameA" ( _
ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal lLen As Long)
Declare Function GetForegroundWindow& _
Lib "user32" ()
Declare Function GetWindowText& _
Lib "user32" _
Alias "GetWindowTextA" ( _
ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal lLen As Long)
Declare Function GetWindowThreadProcessId& _
Lib "user32" ( _
ByVal hwnd As Long, _
lpdwProcessId As Long)
Declare Function WaitForInputIdle& _
Lib "user32" ( _
ByVal hProcess As Long, _
ByVal dwMilliseconds As Long)
Public Const WAIT_FAILED = -1&
Public Const WAIT_TIMEOUT = &H102&
Public Const INFINITE = -1&
Sub TraceForegroundWindows()
Dim hWndNew&, hWndOld&, Pid&, Tid&, s1$, l1&, zTime1!
Do ' forever until you stop it
hWndNew = GetForegroundWindow()
If hWndNew <> 0 And hWndNew <> hWndOld Then ' if new FG window,
hWndOld = hWndNew
' print window stuff
zTime1 = Timer ' beginning time (secs)
Debug.Print "hWnd: " & hWndNew & ", " & FormatSecs(zTime1)
Debug.Print "Class: " & zGetWindowClass(hWndNew)
Debug.Print "Title: " & zGetWindowTitle(hWndNew)
' wait for it to settle and print delay
Pid = GetWindowThreadProcessId(hWndNew, Tid)
SendKeys "{END}", True ' some input
l1 = WaitForInputIdle(Pid, (INFINITE))
' I never get anything but WAIT_FAILED,
' but yet it does wait.
If l1 <> WAIT_FAILED Then Stop
Debug.Print "Delay: " & FormatSecs(Timer - zTime1) & vbCrLf
End If
DoEvents
Loop
End Sub
Function zGetWindowClass$(phWnd&)
Dim s1$, l1&
s1 = Space$(260)
l1 = GetClassName(phWnd, s1, 260)
zGetWindowClass = Left$(s1, l1)
End Function
Function zGetWindowTitle$(phWnd&)
Dim s1$, l1$
s1 = Space$(260)
l1 = GetWindowText(phWnd, s1, 260)
zGetWindowTitle = Left$(s1, l1)
End Function
Function FormatSecs$(pT!)
Dim HH%, MM%, SS!, sHH$, sMM$, sSS$
HH = Int(pT) \ 3600&
MM = Int(pT - HH * 3600&) \ 60&
SS = pT - HH * 3600& - MM * 60&
sHH = Format(HH, "00")
sMM = Format(MM, "00")
sSS = Format(SS, "00.000")
FormatSecs = sHH & ":" & sMM & ":" & sSS
End Function
' I'm 'Shell'ing Photoshop Elements, which
' takes awhile to get settled. Using
' Sendkeys "{END}", True and then
' WaitForInputIdle(..) does the job,
' but the Wait, although correctly waiting,
' always returns -1&=WAIT_FAILED.
' It should be 0& (or &H102&=WAIT_TIMEOUT).
' Q - why WAIT_FAILED?
' Run this routine, then open any another application.
' It prints the hWnd, Class, Title, and the
' time it takes for WaitForInputIdle.
' That can be over 1 second for Photoshop.
' This is all XL97/WIN98. D-C Dave
' API Declarations
Declare Function GetClassName& _
Lib "user32" _
Alias "GetClassNameA" ( _
ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal lLen As Long)
Declare Function GetForegroundWindow& _
Lib "user32" ()
Declare Function GetWindowText& _
Lib "user32" _
Alias "GetWindowTextA" ( _
ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal lLen As Long)
Declare Function GetWindowThreadProcessId& _
Lib "user32" ( _
ByVal hwnd As Long, _
lpdwProcessId As Long)
Declare Function WaitForInputIdle& _
Lib "user32" ( _
ByVal hProcess As Long, _
ByVal dwMilliseconds As Long)
Public Const WAIT_FAILED = -1&
Public Const WAIT_TIMEOUT = &H102&
Public Const INFINITE = -1&
Sub TraceForegroundWindows()
Dim hWndNew&, hWndOld&, Pid&, Tid&, s1$, l1&, zTime1!
Do ' forever until you stop it
hWndNew = GetForegroundWindow()
If hWndNew <> 0 And hWndNew <> hWndOld Then ' if new FG window,
hWndOld = hWndNew
' print window stuff
zTime1 = Timer ' beginning time (secs)
Debug.Print "hWnd: " & hWndNew & ", " & FormatSecs(zTime1)
Debug.Print "Class: " & zGetWindowClass(hWndNew)
Debug.Print "Title: " & zGetWindowTitle(hWndNew)
' wait for it to settle and print delay
Pid = GetWindowThreadProcessId(hWndNew, Tid)
SendKeys "{END}", True ' some input
l1 = WaitForInputIdle(Pid, (INFINITE))
' I never get anything but WAIT_FAILED,
' but yet it does wait.
If l1 <> WAIT_FAILED Then Stop
Debug.Print "Delay: " & FormatSecs(Timer - zTime1) & vbCrLf
End If
DoEvents
Loop
End Sub
Function zGetWindowClass$(phWnd&)
Dim s1$, l1&
s1 = Space$(260)
l1 = GetClassName(phWnd, s1, 260)
zGetWindowClass = Left$(s1, l1)
End Function
Function zGetWindowTitle$(phWnd&)
Dim s1$, l1$
s1 = Space$(260)
l1 = GetWindowText(phWnd, s1, 260)
zGetWindowTitle = Left$(s1, l1)
End Function
Function FormatSecs$(pT!)
Dim HH%, MM%, SS!, sHH$, sMM$, sSS$
HH = Int(pT) \ 3600&
MM = Int(pT - HH * 3600&) \ 60&
SS = pT - HH * 3600& - MM * 60&
sHH = Format(HH, "00")
sMM = Format(MM, "00")
sSS = Format(SS, "00.000")
FormatSecs = sHH & ":" & sMM & ":" & sSS
End Function