home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1999 April / CD_Shareware_Magazine_31.iso / Free / Prg / FindPart.exe / FINDPART.BAS < prev    next >
Encoding:
BASIC Source File  |  1998-03-02  |  4.6 KB  |  117 lines

  1. Attribute VB_Name = "MFindPartLoop"
  2. ' *********************************************************************
  3. '  Copyright ⌐1995-97 Karl E. Peterson, All Rights Reserved
  4. ' *********************************************************************
  5. '  You are free to use this code within your own applications, but you
  6. '  are expressly forbidden from selling or otherwise distributing this
  7. '  source code without prior written consent.
  8. ' *********************************************************************
  9. Option Explicit
  10.  
  11. #If Win16 Then
  12.    DefInt A-Z
  13.    ' Required Win16 API declarations
  14.    Private Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
  15.    Private Declare Function SetActiveWindow Lib "User" (ByVal hWnd As Integer) As Integer
  16.    Private Declare Function ShowWindow Lib "User" (ByVal hWnd As Integer, ByVal nCmdShow As Integer) As Integer
  17.    Private Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
  18.    Private Declare Function GetWindowText Lib "User" (ByVal hWnd As Integer, ByVal lpString As String, ByVal aint As Integer) As Integer
  19.    Private Declare Function GetParent Lib "User" (ByVal hWnd As Integer) As Integer
  20.    Private Declare Function IsIconic Lib "User" (ByVal hWnd As Integer) As Integer
  21. #ElseIf Win32 Then
  22.    DefLng A-Z
  23.    ' Required Win32 API declarations
  24.    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  25.    Private Declare Function SetActiveWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hWnd As Long) As Long
  26.    Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
  27.    Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
  28.    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  29.    Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
  30.    Private Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long
  31. #End If
  32.  
  33. ' Constants used with APIs
  34. Private Const SW_RESTORE = 9
  35.  
  36. ' Constant used by GetWindowWord to find next window
  37. Private Const GW_HWNDNEXT = 2
  38.  
  39. ' Constants used by FindWindowPartial
  40. Public Const FWP_STARTSWITH = 0
  41. Public Const FWP_CONTAINS = 1
  42.  
  43. Public Sub AppActivatePartial(TitleContains$, Method%)
  44.    Dim hWndApp 'As SysInt
  45.    Dim nRet As Long
  46.    '
  47.    ' Retrieve window handle for first top-level window
  48.    ' that starts with or contains the passed string.
  49.    '
  50.    hWndApp = FindWindowPartial(TitleContains, Method)
  51.    If hWndApp Then
  52.       '
  53.       ' Switch to it, restoring if need be.
  54.       '
  55.       If IsIconic(hWndApp) Then
  56.          Call ShowWindow(hWndApp, SW_RESTORE)
  57.       End If
  58.       nRet = SetActiveWindow(hWndApp)
  59.    Else
  60.       '
  61.       ' Alert user that request failed.
  62.       '
  63.       MsgBox "No matching applications found."
  64.    End If
  65. End Sub
  66.  
  67. Public Function FindWindowPartial(TitleStart$, Method%) As Long
  68.    Dim hWndTmp 'As SysInt
  69.    Dim nRet 'As SysInt
  70.    Dim TitleTmp As String
  71.    '
  72.    ' Find first window and loop through all subsequent
  73.    ' windows in master window list.
  74.    '
  75.    hWndTmp = FindWindow(vbNullString, vbNullString)
  76.    Do Until hWndTmp = 0
  77.       '
  78.       ' Make sure this window has no parent.
  79.       '
  80.       If GetParent(hWndTmp) = 0 Then
  81.          '
  82.          ' Retrieve caption text from current window.
  83.          '
  84.          TitleTmp = Space(256)
  85.          nRet = GetWindowText(hWndTmp, TitleTmp, Len(TitleTmp))
  86.          If nRet Then
  87.             '
  88.             ' Clean up return string, preparing for
  89.             ' case-insensitive comparison.
  90.             '
  91.             TitleTmp = UCase(Left(TitleTmp, nRet))
  92.             '
  93.             ' Use appropriate method to determine if
  94.             ' current window's caption either starts
  95.             ' with or contains passed string.
  96.             '
  97.             Select Case Method
  98.                Case FWP_STARTSWITH
  99.                   If InStr(TitleTmp, UCase(TitleStart)) = 1 Then
  100.                      FindWindowPartial = hWndTmp
  101.                      Exit Do
  102.                   End If
  103.                Case FWP_CONTAINS
  104.                   If InStr(TitleTmp, UCase(TitleStart)) Then
  105.                      FindWindowPartial = hWndTmp
  106.                      Exit Do
  107.                   End If
  108.             End Select
  109.          End If
  110.       End If
  111.       '
  112.       ' Get next window in master window list and continue.
  113.       '
  114.       hWndTmp = GetWindow(hWndTmp, GW_HWNDNEXT)
  115.    Loop
  116. End Function
  117.