Keskustelu: Ohjelmointikysymykset: VB6: Fokuksen vaihto

Option Explicit

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Private Const TH32CS_SNAPPROCESS = 2
Private Const MAX_PATH = 260
Private Const GW_HWNDNEXT = 2

Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szexeFile As String * MAX_PATH
End Type

' etsii prosessin tunnuksen nimen perusteella
Function ProsessinID(nimi As String) As Long
    Dim prosessit As Long
    Dim tiedot As PROCESSENTRY32
    Dim tila As Long

    nimi = LCase(nimi)
    prosessit = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    tiedot.dwSize = Len(tiedot)
    tila = Process32First(prosessit, tiedot)

    Do While tila
        If LCase(Left(tiedot.szexeFile, InStr(tiedot.szexeFile, Chr(0)) - 1)) = nimi Then
            ProsessinID = tiedot.th32ProcessID
            Exit Do
        End If
        tila = Process32Next(prosessit, tiedot)
    Loop

    CloseHandle prosessit
End Function

' aktivoi prosessin sen nimen perusteella
Sub AktivoiProsessi(nimi As String)
    Dim ikkuna As Long, prosessi As Long
    Dim haettava As Long

    haettava = ProsessinID(nimi)

    ikkuna = FindWindow(vbNullString, vbNullString)
    Do While ikkuna
        If GetParent(ikkuna) = 0 Then
            GetWindowThreadProcessId ikkuna, prosessi
            If prosessi = haettava Then
                SetForegroundWindow ikkuna
            End If
        End If
        ikkuna = GetWindow(ikkuna, GW_HWNDNEXT)
    Loop
End Sub

Private Sub Form_Click()
    ' aktivoidaan pasianssi
    AktivoiProsessi "SOL.EXE"
End Sub

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 Type POINTAPI
        x As Long
        y As Long
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom 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_SHOWMINIMIZED = 2
Private Const SW_RESTORE = 9

' aktivoi ja tuo näkyviin ikkunan
Sub AktivoiIkkuna(ikkuna As Long)
    Dim tiedot As WINDOWPLACEMENT

    SetForegroundWindow ikkuna

    tiedot.Length = Len(tiedot)
    GetWindowPlacement ikkuna, tiedot
    If tiedot.showCmd = SW_SHOWMINIMIZED Then
        tiedot.showCmd = SW_RESTORE
        SetWindowPlacement ikkuna, tiedot
    End If
End Sub