Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[18.207.161.212] |
|
Сообщ.
#1
,
|
|
|
Здравствуйте, товарищи!
Подскажите, пожалуйста, как можно гарантированно переключиться в приложение? Уже полдня просидел, так ничего не могу сообразить. Написал такой код, но он не всегда срабатывает. Скорее не срабатывает. Надо, чтобы была 100% гарантия, что приложение будет на переднем плане. Подскажите, пожалуйста, как это сделать? Я весь интернет уже облазил, ничего не могу найти. На заднем плане нужная программа появляется, раскрывается, но как её на передний план поставить? Option Explicit Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type POINTAPI x As Long y As Long End Type Private Type WINDOWPLACEMENT Length As Long flags As Long showCmd As Long ptMinPosition As POINTAPI ptMaxPosition As POINTAPI rcNormalPosition As RECT End Type Private Const SW_NORMAL = 1 Private Const SW_MAXIMIZE = 3 ' Развернуть окно Private Const SW_RESTORE = 9 ' Активизировать и отобразить окно. Если окно свернуто или развернуто, Windows восстанавливает его исходный размер и положение Private Const SW_SHOW = 5 ' Активизировать окно Private Const SWP_NOSIZE = &H1 Private Const SWP_NOMOVE = &H2 Private Const SWP_SHOWWINDOW = &H40 Private Const HWND_TOP = 0 Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long 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 OpenIcon Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function SetFocusApp Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Sub WndShow(ByVal hWnd_x As Long) OpenIcon hWnd_x ShowWindow hWnd_x, SW_SHOW ShowWindow hWnd_x, SW_NORMAL SetActiveWindow hWnd_x SetFocusApp hWnd_x SetForegroundWindow hWnd_x ShowWindow hWnd_x, SW_RESTORE ShowWindow hWnd_x, 10 End Sub Private Sub SetWindowState(ByVal hWnd_x As Long) Dim lWindowState As Long Dim tWinPlace As WINDOWPLACEMENT Dim tek_hWnd As Long Dim tek_hWnd1 As Long tWinPlace.Length = Len(tWinPlace) Call GetWindowPlacement(hWnd_x, tWinPlace) tWinPlace.showCmd = SW_NORMAL Call SetWindowPlacement(hWnd_x, tWinPlace) WndShow hWnd_x SetWindowPos hWnd_x, HWND_TOP, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW tek_hWnd = GetForegroundWindow If tek_hWnd <> hWnd_x And GetParent(tek_hWnd) = 0 Then WndShow hWnd_x tek_hWnd1 = GetActiveWindow If tek_hWnd1 <> hWnd_x And GetParent(tek_hWnd1) = 0 Then WndShow hWnd_x End Sub Private Sub Timer1_Timer() Dim hWnd_x As Long ShellExecute Form1.hwnd, "Open", App.Path & "\1.txt", 0, 0, SW_NORMAL hWnd_x = FindWindow(vbNullString, "1.txt - AkelPad") SetWindowState hWnd_x End Sub Прикреплённый файлHWND_TOP.zip (5,46 Кбайт, скачиваний: 232) |
Сообщ.
#2
,
|
|
|
Что-то сделал, вроде, стало лучше. Но у меня вопрос: если это моё приложение, оно будет стабильнее работать? Просто я разницы особо не заметил, своё (сам себя) или чужое раскрывать/скрывать.
Заметил особенность: после появление окна, оно серое (неактивное), пока не сделаешь клик там. Я осуществил такое решение, но оно слишком безобразное. Нельзя ли как-то клик в приложении осуществить более цивилизованным образом? If GetForegroundWindow = hWnd_x And GetActiveWindow = hWnd_x Then GetCursorPos coord_old WindowGetCoord hWnd_x, coord_x, coord_y, 0, 0 SetCursorPos coord_x, coord_y mouse_event MOUSEEVENTF_LEFTDOWN, coord_x, coord_y, 0, 0 mouse_event MOUSEEVENTF_LEFTUP, coord_x, coord_y, 0, 0 SetCursorPos coord_old.x, coord_old.y End If Общее итоговое решение потом размещу в конце, как решу эту задачу. |
Сообщ.
#3
,
|
|
|
Смастерил как-то, не знаю, мне кажется, лучше не будет. Тут надо разбираться в деталях, а я в них никак не разбираюсь.
Public Sub WindowSetState(ByVal hWnd_x As Long, ByVal WindState As WNDSTATE, Optional ByVal SW As SWS = 0) ' ShowNative = 0 ' разворачивание простое ' = 1 ' разворачивание сложное (сворачивает текущее приложение) ' MinNative = 2 ' сворачивание простое Dim tek_hWnd As Long Dim tek_hWnd1 As Long Dim lWindowState As Long Dim tWinPlace As WINDOWPLACEMENT Dim currentThread As Long Dim activeThread As Long Dim windowThread As Long Dim activeWindow As Long Dim activeProcess As Long Dim windowProcess As Long Dim oldTimeout As Long Dim newTimeout As Long 'LockSetForegroundWindow LSFW_UNLOCK ''''''Unlock setforegroundwindow calls ' apiAllowSetForegroundWindow (ASFW_ANY) ''''''''Allow setforeground window calls ' KeyEvent( VK_MENU, False, True, -12) '''''''''''''''Lift menu key if pressed, and it also allows the foreground window to be set ' ForceForeground = CBool(apiSetForegroundWindow(hwnd)) 'Set foreground window ' apiLockSetForegroundWindow (LSFW_LOCK) ''''''''Lock other apps from using setforegroundwindow If lpPrevWndProc <= 0 Then currentThread = GetCurrentThreadId activeWindow = GetForegroundWindow activeThread = GetWindowThreadProcessId(activeWindow, activeProcess) windowThread = GetWindowThreadProcessId(hWnd_x, windowProcess) If currentThread <> activeThread Then AttachThreadInput currentThread, activeThread, True If windowThread <> currentThread Then AttachThreadInput windowThread, currentThread, True Call SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0&, oldTimeout, 0) Call SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0&, newTimeout, 0) LockSetForegroundWindow LSFW_UNLOCK AllowSetForegroundWindow ASFW_ANY Sleep 200 'End If ' Form1.Label10.Caption = MyThreadID ' Form1.Label11.Caption = ActiveThreadID ' Form1.Label12.Caption = AttachThread End If tWinPlace.Length = Len(tWinPlace) Call GetWindowPlacement(hWnd_x, tWinPlace) 'AppMinAll If SW = 0 Then ' разворачивание простое WNDShow hWnd_x, WindState ElseIf SW = 1 Then ' разворачивание сложное WNDShow hWnd_x, WindState tek_hWnd = GetForegroundWindow If tek_hWnd <> hWnd_x And GetParent(tek_hWnd) = 0 Then WNDShow hWnd_x, WindState ShowWindow tek_hWnd, SW_MINIMIZE End If tek_hWnd1 = GetActiveWindow If tek_hWnd1 <> hWnd_x And GetParent(tek_hWnd1) = 0 Then WNDShow hWnd_x, WindState ShowWindow tek_hWnd1, SW_MINIMIZE End If ElseIf SW = 2 Then ' сворачивание простое ShowWindow hWnd_x, WindState End If 'If tWinPlace.showCmd <> WindState Then tWinPlace.showCmd = WindState Call SetWindowPlacement(hWnd_x, tWinPlace) 'End If Call SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0&, oldTimeout, 0) If currentThread <> activeThread Then AttachThreadInput currentThread, activeThread, False If windowThread <> currentThread Then AttachThreadInput windowThread, currentThread, False End Sub Public Sub WNDShow(ByVal hWnd_x As Long, ByVal WindState As WNDSTATE) Dim coord_x As Integer Dim coord_y As Integer Dim coord_old As POINTAPI Dim SW As LogVar If WindState = SW_RESTORE Or WindState = SW_NORMAL Or WindState = SW_SHOW Or WindState = SW_MAXIMIZE Then SW = 1 Else SW = 0 End If OpenIcon hWnd_x '################################# SetForegroundWindow hWnd_x SetActiveWindow hWnd_x BringWindowToTop hWnd_x ShowWindow hWnd_x, SW_RESTORE '################################# ShowWindow hWnd_x, 10 ShowWindow hWnd_x, SW_SHOW ShowWindow hWnd_x, WindState SetFocusApp hWnd_x 'Exit Sub SetWindowPos hWnd_x, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOSIZE Or SWP_NOMOVE Sleep 50 If Win_TPM = 0 Then SetWindowPos hWnd_x, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE ''' Sleep 100 If SW = 1 And lpPrevWndProc <= 0 And GetForegroundWindow = hWnd_x And GetActiveWindow = hWnd_x Then GetCursorPos coord_old WindowGetCoord hWnd_x, coord_x, coord_y, 0, 0 coord_x = coord_x + 30 coord_y = coord_y + 15 SetCursorPos coord_x, coord_y 'Sleep 50 mouse_event MOUSEEVENTF_LEFTDOWN, coord_x, coord_y, 0, 0 mouse_event MOUSEEVENTF_LEFTUP, coord_x, coord_y, 0, 0 '''Sleep 50 ' mouse_event MOUSEEVENTF_LEFTDOWN, coord_x, coord_y, 0, 0 ' mouse_event MOUSEEVENTF_LEFTUP, coord_x, coord_y, 0, 0 SetCursorPos coord_old.x, coord_old.y End If End Sub |