tswitch.frm

大量优秀的vb编程

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "任务管理器"
   ClientHeight    =   3720
   ClientLeft      =   3048
   ClientTop       =   2148
   ClientWidth     =   3924
   Icon            =   "TSwitch.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3720
   ScaleWidth      =   3924
   ShowInTaskbar   =   0   'False
   Begin VB.ListBox lstApp 
      Height          =   2928
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   3855
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出程序"
      Height          =   495
      Left            =   2640
      TabIndex        =   2
      Top             =   3120
      Width           =   1215
   End
   Begin VB.CommandButton cmdSwitch 
      Caption         =   "切换任务"
      Height          =   495
      Left            =   1320
      TabIndex        =   1
      Top             =   3120
      Width           =   1215
   End
   Begin VB.CommandButton cmdRefresh 
      Caption         =   "刷新"
      Height          =   495
      Left            =   0
      TabIndex        =   0
      Top             =   3120
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'WIN16/32 Directive
#If Win16 Then
    Declare Function ShowWindow Lib "User" (ByVal hWnd As Integer, ByVal flgs As Integer) As Integer
    Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
    Declare Function GetWindowWord Lib "User" (ByVal hWnd As Integer, ByVal wIndx As Integer) As Integer
    Declare Function GetWindowLong Lib "User" (ByVal hWnd As Integer, ByVal wIndx As Integer) As Long
    Declare Function GetWindowText Lib "User" (ByVal hWnd As Integer, ByVal lpSting As String, ByVal nMaxCount As Integer) As Integer
    Declare Function GetWindowTextLength Lib "User" (ByVal hWnd As Integer) As Integer
    Declare Function SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal insaft As Integer, ByVal x%, ByVal y%, ByVal cx%, ByVal cy%, ByVal flgs As Integer) As Integer
#Else
    Private Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal flgs As Long) As Long
    Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
    Private Declare Function GetWindowWord Lib "User32" (ByVal hWnd As Long, ByVal wIndx As Long) As Long
    Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal wIndx As Long) As Long
    Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpSting As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
    Private Declare Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal insaft As Long, ByVal x%, ByVal y%, ByVal cx%, ByVal cy%, ByVal flgs As Long) As Long
#End If

Const WS_MINIMIZE = &H20000000  ' Style bit 'is minimized'
Const HWND_TOP = 0              ' Move to top of z-order
Const SWP_NOSIZE = &H1          ' Do not re-size window
Const SWP_NOMOVE = &H2          ' Do not reposition window
Const SWP_SHOWWINDOW = &H40     ' Make window visible/active
Const GW_HWNDFIRST = 0          ' Get first Window handle
Const GW_HWNDNEXT = 2           ' Get next window handle
Const GWL_STYLE = (-16)         ' Get Window's style bits
Const SW_RESTORE = 9            ' Restore window
Dim IsTask As Long              ' Style bits for normal task

' The following bits will be combined to define properties
' of a 'normal' task top-level window.  Any window with ' these set will be
' included in the list:
Const WS_VISIBLE = &H10000000      ' Window is not hidden
Const WS_BORDER = &H800000         ' Window has a border

' Other bits that are normally set include:
Const WS_CLIPSIBLINGS = &H4000000  ' can clip windows
Const WS_THICKFRAME = &H40000      ' Window has thick border
Const WS_GROUP = &H20000           ' Window is top of group
Const WS_TABSTOP = &H10000         ' Window has tabstop

Sub cmdExit_Click()
Unload Me               ' Get me out of here!
'Set Me = Nothing  ' Kill Form reference for good measure
End Sub

Sub cmdRefresh_Click()
FindAllApps  ' Update list of tasks
End Sub

               Sub cmdSwitch_Click()
               Dim hWnd As Long    ' handle to window
               Dim x As Long          ' work area
               Dim lngWW As Long      ' Window Style bits
               If lstApp.ListIndex < 0 Then Beep: Exit Sub
               ' Get window handle from listbox array
               hWnd = lstApp.ItemData(lstApp.ListIndex)
               ' Get style bits for window
               lngWW = GetWindowLong(hWnd, GWL_STYLE)
               ' If minimized do a restore
               If lngWW And WS_MINIMIZE Then
                       x = ShowWindow(hWnd, SW_RESTORE)
               End If
               ' Move window to top of z-order/activate; no move/resize
               x = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                       SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW)
               End Sub

Sub FindAllApps()
Dim hwCurr As Long
Dim intLen As Long
Dim strTitle As String
' process all top-level windows in master window list
lstApp.Clear
hwCurr = GetWindow(Me.hWnd, GW_HWNDFIRST)  ' get first window
Do While hwCurr  ' repeat for all windows
  If hwCurr <> Me.hWnd And TaskWindow(hwCurr) Then
    intLen = GetWindowTextLength(hwCurr) + 1 ' Get length
    strTitle = Space$(intLen) ' Get caption
    intLen = GetWindowText(hwCurr, strTitle, intLen)
    If intLen > 0 Then ' If we have anything, add it
      lstApp.AddItem strTitle
' and let's save the window handle in the itemdata array
      lstApp.ItemData(lstApp.NewIndex) = hwCurr
    End If
  End If
  hwCurr = GetWindow(hwCurr, GW_HWNDNEXT)
Loop
End Sub


Sub Form_Load()
IsTask = WS_VISIBLE Or WS_BORDER  ' Define bits for normal task
FindAllApps                       ' Update list
End Sub

               Sub Form_Paint()
               FindAllApps  ' Update List
               End Sub

Sub Label1_Click()
FindAllApps  ' Update list
End Sub

               Sub lstApp_DblClick()
               cmdSwitch.Value = True
               End Sub

Function TaskWindow(hwCurr As Long) As Long
Dim lngStyle As Long
lngStyle = GetWindowLong(hwCurr, GWL_STYLE)
If (lngStyle And IsTask) = IsTask Then TaskWindow = True
End Function