windowapi.bas

此文档为VB公共模块

Attribute VB_Name = "WindowApi"
Option Explicit
'*************************窗口相关***************************
'*作者：谢建军                                              *
'*创建日期：2002年11月18日  20：47                          *
'************************************************************
'*  1.AlwaysOnTop(TorFalse As Boolean, lHWnd As Long)       *
'*  2.FlashWindowF(ByVal WindHwnd As Long,                  *
'*                 ByVal TimeLong As Integer,秒为单位       *
'*                 ByVal InterVal As Integer)百分之一秒为单位
'*  3.AddIconToTray(ByVal cHwnd As Long,                    *
'*                  ByVal cIco As Long,                     *
'*         Optional ByVal cTip As String)                   *
'*  4.ModifyIconToTray(ByVal cHwnd As Long,                 *
'*                     ByVal cIco As Long,                  *
'*            Optional ByVal cTip As String)                *
'*  5.DeleteIconFromTray()                                  *
'************************************************************

'Set Window
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
'Flash window
Private Declare Function FlashWindow Lib "user32" (ByVal hWnd As Long, ByVal bInvert As Long) As Long

Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
'***********************托盘程序
'定义消息
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
'定义标识位
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
'定义MouseMove消息，该消息将被发送到窗体的MouseMove事件处理函数中处理。
Private Const WM_MOUSEMOVE = &H200
'定义鼠标消息常数
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209

Private Type NOTIFYICONDATA
  cbSize As Long
  hWnd As Long
  uID As Long
  uFlags As Long
  uCallbackMessage As Long
  hIcon As Long
  szTip As String * 64
End Type

Private mtIconData As NOTIFYICONDATA
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Long


'*************
'设置窗体一直在上
'*************
Public Function AlwaysOnTop(TorF As Boolean, lHWnd As Long) As Boolean
  
  Dim lWinPos As Long
  Dim l As Long
  Select Case TorF
    Case Is = False
      lWinPos = HWND_NOTOPMOST
    Case Is = True
      lWinPos = HWND_TOPMOST
    Case Else
      Exit Function
  End Select
If SetWindowPos(lHWnd, lWinPos, 0, 0, 300, 70, SWP_NOMOVE + SWP_NOSIZE) Then
  AlwaysOnTop = True
End If
End Function

'***************
'让窗口闪烁
'***************
Public Sub FlashWindowF(ByVal WindHwnd As Long, ByVal TimeLong As Integer, ByVal InterVal As Integer)
  Dim tMax As Single, tNow As Single, tFlash As Boolean
  tMax = Timer + TimeLong
  tNow = Timer + InterVal / 100
  Do Until Timer > tMax
    If Timer > tNow Then
      FlashWindow WindHwnd, tFlash
      tNow = Timer + InterVal / 100
      tFlash = Not tFlash
    End If
    DoEvents
  Loop
End Sub

'********************
'添加图标到任务栏
'********************
Public Function AddIconToTray(ByVal cHwnd As Long, _
                              ByVal cIco As Long, _
                     Optional ByVal cTip As String, _
                     Optional ByVal cCallBackMsg As Long) As Boolean
  
  With mtIconData
    .cbSize = Len(mtIconData)
    .hWnd = cHwnd
    .uCallbackMessage = IIf(cCallBackMsg = 0, WM_MBUTTONDOWN, cCallBackMsg)
    .uID = 1&
    .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    .hIcon = cIco
    .szTip = cTip & Chr$(0)
    If Shell_NotifyIcon(NIM_ADD, mtIconData) = 0 Then
      AddIconToTray = False
    Else
      AddIconToTray = True
    End If
  End With
End Function

'*******************
'修改任务栏的图标
'*******************
Public Function ModifyIconToTray(ByVal cHwnd As Long, _
                                 ByVal cIco As Long, _
                        Optional ByVal cTip As String) As Boolean
  
  With mtIconData
    .hWnd = cHwnd
    .hIcon = cIco
    .szTip = cTip & Chr$(0)
  End With
  If Shell_NotifyIcon(NIM_MODIFY, mtIconData) = 0 Then
    ModifyIconToTray = False
  Else
    ModifyIconToTray = True
  End If
End Function

'*******************
'删除任务栏的图标
'*******************
Public Function DeleteIconFromTray() As Boolean
  If Shell_NotifyIcon(NIM_DELETE, mtIconData) = 0 Then
    DeleteIconFromTray = False
  Else
    DeleteIconFromTray = True
  End If
End Function