На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! Правила раздела Visual Basic: Общие вопросы
Здесь обсуждаются вопросы по языку Visual Basic 1-6 (а так же по схожим языкам, как, например, PowerBASIC).
Вопросы по Visual Basic .NET (это который входит в состав Visual Studio 2002/2003/2005/2008+, для тех, кто не в курсе) обсуждаются в разделе .NET.

Обратите внимание:
1. Прежде чем начать новую тему или отправить сообщение, убедитесь, что Вы не нарушаете правил форума!
2. Обязательно воспользуйтесь поиском. Возможно, Ваш вопрос уже обсуждали. Полезные ссылки приведены ниже.
3. Темы с просьбой выполнить какую-либо работу за автора в этом разделе не обсуждаются. Студенты, вам сюда: ПОМОЩЬ СТУДЕНТАМ!
4. Используйте теги [ code=vba ] ...текст программы... [ /code ] для выделения текста программы подсветкой.
5. Помните, здесь телепатов нет. Формулируйте свой вопрос максимально грамотно и чётко: Как правильно задавать вопросы
6. Запрещено отвечать в темы месячной (и более) давности, без веских на то причин.

Полезные ссылки:
user posted image FAQ Сайта user posted image FAQ Раздела user posted image Кладовка user posted image Наши Исходники user posted image API-Guide user posted image Поиск по Разделу user posted image MSDN Library Online user posted image Google

Ваше мнение о модераторах: user posted image SCINER, user posted image B.V.
Модераторы: SCINER, B.V.
  
> Стабильное переключение в другое приложение , как по Alt+Tab
    Здравствуйте, товарищи!
    Подскажите, пожалуйста, как можно гарантированно переключиться в приложение?
    Уже полдня просидел, так ничего не могу сообразить.

    Написал такой код, но он не всегда срабатывает. Скорее не срабатывает.
    Надо, чтобы была 100% гарантия, что приложение будет на переднем плане.

    Подскажите, пожалуйста, как это сделать?
    Я весь интернет уже облазил, ничего не могу найти.

    На заднем плане нужная программа появляется, раскрывается, но как её на передний план поставить?


    ExpandedWrap disabled
      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)
    Сообщение отредактировано: salieri -
      Что-то сделал, вроде, стало лучше. Но у меня вопрос: если это моё приложение, оно будет стабильнее работать? Просто я разницы особо не заметил, своё (сам себя) или чужое раскрывать/скрывать.
      Заметил особенность: после появление окна, оно серое (неактивное), пока не сделаешь клик там.
      Я осуществил такое решение, но оно слишком безобразное. Нельзя ли как-то клик в приложении осуществить более цивилизованным образом?

      ExpandedWrap disabled
        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


      Общее итоговое решение потом размещу в конце, как решу эту задачу.
      Сообщение отредактировано: salieri -
        Смастерил как-то, не знаю, мне кажется, лучше не будет. Тут надо разбираться в деталях, а я в них никак не разбираюсь.

        ExpandedWrap disabled
          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
        Сообщение отредактировано: salieri -
        0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
        0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0308 ]   [ 19 queries used ]   [ Generated: 29.03.24, 09:10 GMT ]