"系统托盘"问题，多谢jamex(亲亲吾爱) 的回复，请过来

Question

谢谢！交个朋友 [email protected]

Answer 1

Option  Explicit
  
  Public  OldWindowProc  As  Long
  Public  TheForm  As  Form
  Public  TheMenu  As  Menu
  Public  LastState  As  Integer
  
  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
  Declare  Function  SetWindowLong  Lib  "user32"  Alias  "SetWindowLongA"  (ByVal  hwnd  As  Long,  ByVal  nIndex  As  Long,  ByVal  dwNewLong  As  Long)  As  Long
  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
          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
  '  *********************************************
  '  The  replacement  window  proc.
  '  *********************************************
  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
                  '  The  user  clicked  on  the  tray  icon.
                  '  Look  for  click  events.
                  If  lParam  =  WM_LBUTTONUP  Then
                          '  On  left  click,  show  the  form.
                          If  TheForm.WindowState  =  vbMinimized  Then  _
                                  TheForm.WindowState  =  TheForm.LastState
                          TheForm.Visible  =  True
                          TheForm.SetFocus
                          Exit  Function
                  End  If
                  If  lParam  =  WM_RBUTTONUP  Then
                          '  On  right  click,  show  the  menu.
                          TheForm.PopupMenu  TheMenu
                          Exit  Function
                  End  If
          End  If
          
          '  Send  other  messages  to  the  original
          '  window  proc.
          NewWindowProc  =  CallWindowProc(  _
                  OldWindowProc,  hwnd,  Msg,  _
                  wParam,  lParam)
  End  Function
  '  *********************************************
  '  Add  the  form's  icon  to  the  tray.
  '  *********************************************
  Public  Sub  AddToTray(frm  As  Form,  mnu  As  Menu)
          '  ShowInTaskbar  must  be  set  to  False  at
          '  design  time  because  it  is  read-only  at
          '  run  time.
  
          '  Save  the  form  and  menu  for  later  use.
          Set  TheForm  =  frm
          Set  TheMenu  =  mnu
          
          '  Install  the  new  WindowProc.
          OldWindowProc  =  SetWindowLong(frm.hwnd,  _
                  GWL_WNDPROC,  AddressOf  NewWindowProc)
          
          '  Install  the  form's  icon  in  the  tray.
          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
  '  *********************************************
  '  Remove  the  icon  from  the  system  tray.
  '  *********************************************
  Public  Sub  RemoveFromTray()
          '  Remove  the  icon  from  the  tray.
          With  TheData
                  .uFlags  =  0
          End  With
          Shell_NotifyIcon  NIM_DELETE,  TheData
          
          '  Restore  the  original  window  proc.
          SetWindowLong  TheForm.hwnd,  GWL_WNDPROC,  _
                  OldWindowProc
  End  Sub
  '  *********************************************
  '  Set  a  new  tray  tip.
  '  *********************************************
  Public  Sub  SetTrayTip(tip  As  String)
          With  TheData
                  .szTip  =  tip  &    vbNullChar
                  .uFlags  =  NIF_TIP
          End  With
          Shell_NotifyIcon  NIM_MODIFY,  TheData
  End  Sub
  '  *********************************************
  '  Set  a  new  tray  icon.
  '  *********************************************
  Public  Sub  SetTrayIcon(pic  As  Picture)
          '  Do  nothing  if  the  picture  is  not  an  icon.
          If  pic.Type  <  >    vbPicTypeIcon  Then  Exit  Sub
  
          '  Update  the  tray  icon.
          With  TheData
                  .hIcon  =  pic.Handle
                  .uFlags  =  NIF_ICON
          End  With
          Shell_NotifyIcon  NIM_MODIFY,  TheData
  End  Sub
  
  
  Private  Sub  Form_Load()
          'tray  init
          If  WindowState  =  vbMinimized  Then
                  LastState  =  vbNormal
          Else
                  LastState  =  WindowState
          End  If
  
          AddToTray  Me,  mnuTray
          SetTrayTip  "Chat  Client"
  End  Sub
  
  Private  Sub  Form_Resize()
        Select  Case  WindowState
                  Case  vbMinimized
                          Me.Visible  =  False
                  Case  vbMaximized
                          
                  Case  vbNormal
                          
          End  Select
          
        If  WindowState  <  >    vbMinimized  Then  _
                  LastState  =  WindowState
                  
  End  Sub
  
  Private  Sub  Form_Unload(Cancel  As  Integer)
          RemoveFromTray
  End  Sub 
Top 
 
 
  将以上代码贴到一个form里，试一下，我几天前就是这样做的 

Answer 2

我记我跟很多人说过，在VB里用字类化技术代价很高，要实现SysTray，
根本就不需要字类化，因为有现成的uCallBackMessage，如下：
   With Tray
    .cbSize = Len(Tray)
    .hwnd = Me.hwnd
    .hIcon = Inactive.Picture
    .uId = vbNull
    .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    .szTip = "InterCommVB II DDE Server" & vbNullChar
    .uCallBackMessage = WM_MOUSEMOVE
  End With然后就可以直接在Form里用：
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case X
    Case WM_RBUTTONUP
        Me.PopupMenu Me.TrayMenu
    End Select
End Sub这才是在VB里实现SysTray最经济的方法。
还有用子类化，VB光盘里有现成的SysTray的控件。