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