AW: Fenster immer im Vordergrund
22.09.2010 15:42:44
Kawensmann
Hallo,
ich habe dazu mal was aus dem Netz zusammenkopiert ...
Statt mit "Shell" musst du calc.exe dabei mit "Shell2hWnd" aufrufen.
Option Explicit
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
ByVal hwnd As Long, _
lpdwProcessId As Long) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" ( _
ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetParent Lib "user32" ( _
ByVal hwnd As Long) As Long
Private Const GW_HWNDNEXT = 2
Sub calcTest()
Dim hwnd As Long
hwnd = Shell2hWnd("calc.exe", vbNormalFocus)
SetTopMostWindow hwnd, True
End Sub
Public Function SetTopMostWindow(hwnd As Long, Topmost As Boolean) As Long
' Function sets a window as always on top, or turns this off
' hwnd - handle the the window to affect
' Topmost - do you want it always on top or not
On Error GoTo ErrHandler
If Topmost = True Then 'Make the window topmost
SetTopMostWindow = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
Else
SetTopMostWindow = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
'SetTopMostWindow = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, FLAGS)
SetTopMostWindow = False
End If
Exit Function
ErrHandler:
Select Case Err.Number
Case Else
Err.Raise Err.Number, Err.Source & "+modAPIStuff/SetTopMostWindow", Err.Description
End Select
End Function
' Anwendung starten und Fenster-Handle zurückgeben
Private Function Shell2hWnd(ByVal sFilename As String, _
Optional ByVal Mode As VbAppWinStyle)
Dim lngAppTaskID As Long
Dim lngProcTaskID As Long
Dim lnghWnd As Long
' TaskID der zu startenden Anwendung
lngAppTaskID = Shell(sFilename, Mode)
' Anwendung konnte nicht gestartet werden
If lngAppTaskID = 0 Then Exit Function
' Fenster durchlaufen und nach Process-ID suchen
lnghWnd = FindWindow(vbNullString, vbNullString)
Do While lnghWnd 0
' Existiert kein Eltern-Fenster, dann ProcssID
' ermitteln und mit TaskID vergleichen
If GetParent(lnghWnd) = 0 Then
GetWindowThreadProcessId lnghWnd, lngProcTaskID
' Handelt es sich um die gesuchte TaskID?
If lngProcTaskID = lngAppTaskID Then
' Fenster-Handle zurückgeben und Schleife
' verlassen!
Shell2hWnd = lnghWnd
Exit Do
End If
End If
' Nächstes Fenster
lnghWnd = GetWindow(lnghWnd, GW_HWNDNEXT)
Loop
End Function
Gruß
Kawensmann