Attribute VB_Name = "mdlBase"
'*************************************************************************
'**模 塊 名：mdlBase
'**說    明：YFHome 版權所有2003 - 2004(C)
'**創 建 人：楊軍
'**日    期：2003年04月17日
'**修 改 人：
'**日    期：
'**描    述：
'**版    本：V1.0
'*************************************************************************
Option Explicit

Public OldWindowProc As Long       '舊的窗口進程號
Public TheForm As Form             '保存的窗體信息
Public TheMenu As Menu             '保存菜單信息

'將消息傳答窗口函數
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'設置窗口附加內存長型數值
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'發送修改任務欄圖標
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2

Public Type NOTIFYICONDATA      'ICON圖標數據信息
  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 TheData As NOTIFYICONDATA

Public 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

Public Const SWP_NOMOVE = 2
Public Const SWP_NOSIZE = 1

Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2

Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
'-----

'*************************************************************************
'**函 數 名：KeepOnTop
'**輸    入：F(Form) -
'**輸    出：無
'**功能描述：窗體放在最前
'**全局變量：
'**調用模塊：
'**作    者：楊軍
'**日    期：2003年04月17日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Sub KeepOnTop(F As Form)
  Const SWP_NOMOVE = 2
  Const SWP_NOSIZE = 1

  Const HWND_TOPMOST = -1
  Const HWND_NOTOPMOST = -2

  SetWindowPos F.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

'*************************************************************************
'**函 數 名：NewWindowProc
'**輸    入：ByVal hwnd(Long)   -
'**        ：ByVal Msg(Long)    -
'**        ：ByVal wParam(Long) -
'**        ：ByVal lParam(Long) -
'**輸    出：(Long) -
'**功能描述：新的窗口進程
'**全局變量：
'**調用模塊：
'**作    者：楊軍
'**日    期：2003年04月17日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If Msg = TRAY_CALLBACK Then

    ' 用戶單擊托盤中的圖標
    If lParam = WM_LBUTTONUP Then  '單擊左鍵顯示窗體
      '窗體狀態為最小化
      If TheForm.WindowState = vbMinimized Then TheForm.WindowState = TheForm.LastState
      TheForm.Visible = True
      TheForm.SetFocus
      Exit Function
    End If

    If lParam = WM_RBUTTONUP Then  '單擊右鍵鍵顯示菜單
      TheForm.PopupMenu TheMenu
      Exit Function
    End If

  End If
  '發送其余的消息到原先的窗口信息處理進程
  NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End Function

'*************************************************************************
'**函 數 名：AddToTray
'**輸    入：frm(Form) -
'**        ：mnu(Menu) -
'**輸    出：無
'**功能描述：在托盤中增加窗體的圖標
'**全局變量：
'**調用模塊：
'**作    者：楊軍
'**日    期：2003年04月17日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
  '必須在設計狀態下設置ShowInTaskbar為false，因為在運行狀態下該屬性只讀。

  ' 保存當前窗體和菜單信息
  Set TheForm = frm
  Set TheMenu = mnu

  ' 設置新的窗口信息處理進程             '窗口進程        '窗口進程地址
  OldWindowProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)

  ' 設置窗體圖標的信息
  With TheData
    .uID = 0
    .hwnd = frm.hwnd
    .cbSize = Len(TheData)
    .hIcon = frm.Icon.Handle
    .uFlags = NIF_ICON
    .uCallbackMessage = TRAY_CALLBACK
    .uFlags = .uFlags Or NIF_MESSAGE
    .cbSize = Len(TheData)
  End With

  '把圖標放到圖盤
  Shell_NotifyIcon NIM_ADD, TheData
End Sub

'*************************************************************************
'**函 數 名：RemoveFromTray
'**輸    入：無
'**輸    出：無
'**功能描述：刪除托盤內的圖標
'**全局變量：
'**調用模塊：
'**作    者：楊軍
'**日    期：2003年04月17日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Public Sub RemoveFromTray()
  '刪除托盤內的圖標

  With TheData
    .uFlags = 0
  End With
  Shell_NotifyIcon NIM_DELETE, TheData

  ' 恢復原來窗口信息處理進程.
  SetWindowLong TheForm.hwnd, GWL_WNDPROC, OldWindowProc
End Sub

'*************************************************************************
'**函 數 名：SetTrayTip
'**輸    入：tip(String) -
'**輸    出：無
'**功能描述：設置新的托盤圖標提示
'**全局變量：
'**調用模塊：
'**作    者：楊軍
'**日    期：2003年04月17日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Public Sub SetTrayTip(tip As String)
  With TheData
    .szTip = tip & vbNullChar
    .uFlags = NIF_TIP
  End With
  Shell_NotifyIcon NIM_MODIFY, TheData
End Sub

'*************************************************************************
'**函 數 名：SetTrayIcon
'**輸    入：pic(Picture) -
'**輸    出：無
'**功能描述：設置新的托盤圖標
'**全局變量：
'**調用模塊：
'**作    者：楊軍
'**日    期：2003年04月17日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Public Sub SetTrayIcon(pic As Picture)
  ' 如果圖片的格式不是ICON類型，則退出
  If pic.Type <> vbPicTypeIcon Then Exit Sub

  '更新托盤圖標
  With TheData
    .hIcon = pic.Handle
    .uFlags = NIF_ICON
  End With
  Shell_NotifyIcon NIM_MODIFY, TheData
End Sub