findwindowsactive.bas

星级酒店管理系统（附带系统自写控件源码）

Attribute VB_Name = "modFindWindowAndActive"

Option Explicit

#If Win16 Then
   DefInt A-Z
   ' Win16 API
   Private Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
   Private Declare Function SetActiveWindow Lib "User" (ByVal Hwnd As Integer) As Integer
   Private Declare Function ShowWindow Lib "User" (ByVal Hwnd As Integer, ByVal nCmdShow As Integer) As Integer
   Private Declare Function GetWindow Lib "User" (ByVal Hwnd As Integer, ByVal wCmd As Integer) As Integer
   Private Declare Function GetWindowText Lib "User" (ByVal Hwnd As Integer, ByVal lpString As String, ByVal aint As Integer) As Integer
   Private Declare Function GetParent Lib "User" (ByVal Hwnd As Integer) As Integer
   Private Declare Function IsIconic Lib "User" (ByVal Hwnd As Integer) As Integer
#ElseIf Win32 Then
   DefLng A-Z
   ' Win32 API
   Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   Private Declare Function SetActiveWindow Lib "user32" Alias "SetForegroundWindow" (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 GetWindow Lib "user32" (ByVal Hwnd As Long, ByVal wCmd As Long) As Long
   Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal Hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
   Private Declare Function GetParent Lib "user32" (ByVal Hwnd As Long) As Long
   Private Declare Function IsIconic Lib "user32" (ByVal Hwnd As Long) As Long
#End If

' 状态
Private Const SW_RESTORE = 9
' 查找下一个窗口
Private Const GW_HWNDNEXT = 2
' 查找第一部分
Enum FindType
  
  startpart = 0
  Containt = 1
  
End Enum

Public Sub ShowIt(Hwnd As Long)

   Dim nRet As Long
  '如果是最小化时,恢复状态
    If IsIconic(Hwnd) Then
       Call ShowWindow(Hwnd, SW_RESTORE)
    End If
   '活动窗
    nRet = SetActiveWindow(Hwnd)
      
End Sub

Public Sub FindWindowAndActive(TitleContains$, Method As FindType, bAlert As Boolean)

   Dim hWndApp
   Dim nRet As Long
   
   On Error Resume Next
   
   hWndApp = FindWindowPartial(TitleContains, Method)
   If hWndApp Then
   
      '如果是最小化时,恢复状态
      If IsIconic(hWndApp) Then
         Call ShowWindow(hWndApp, SW_RESTORE)
      End If
     '活动窗
      nRet = SetActiveWindow(hWndApp)
      
   ElseIf bAlert = True Then
      '显示没有找到消息
       MsgBox "没有找到匹配的窗口,请重新输入试试。", vbExclamation, "提示："
   End If
   
End Sub

'查找窗口标题
Public Function FindWindowPartial(TitleStart$, Method As FindType) As Long
   
   Dim hWndTmp
   Dim nRet
   Dim TitleTmp As String
   
  '查找第一个窗口
   On Error Resume Next
   
   hWndTmp = FindWindow(vbNullString, vbNullString)
   Do Until hWndTmp = 0
   
     '确认为子窗口,无父窗口
      If GetParent(hWndTmp) = 0 Then
         
         TitleTmp = Space(256)
         nRet = GetWindowText(hWndTmp, TitleTmp, Len(TitleTmp))
         If nRet Then            '
            
            TitleTmp = UCase(Left(TitleTmp, nRet))
            Select Case Method
               Case 0
                  If InStr(TitleTmp, UCase(TitleStart)) = 1 Then
                     FindWindowPartial = hWndTmp
                     Exit Do
                  End If
               Case 1
                  If InStr(TitleTmp, UCase(TitleStart)) Then
                     FindWindowPartial = hWndTmp
                     Exit Do
                  End If
            End Select
         End If
      End If
     
    ' 给出下一个窗口
      hWndTmp = GetWindow(hWndTmp, GW_HWNDNEXT)
   Loop
   
End Function