home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD988.psc / APISTUFF.BAS next >
Encoding:
BASIC Source File  |  1998-06-29  |  4.8 KB  |  151 lines
  1. Attribute VB_Name = "APIStuff"
  2. Option Explicit
  3.  
  4. Public OldWindowProc As Long
  5. Public TheForm As Form
  6. Public TheMenu As Menu
  7.  
  8. 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
  9. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  10. Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
  11.  
  12. Public Const WM_USER = &H400
  13. Public Const WM_LBUTTONUP = &H202
  14. Public Const WM_MBUTTONUP = &H208
  15. Public Const WM_RBUTTONUP = &H205
  16. Public Const TRAY_CALLBACK = (WM_USER + 1001&)
  17. Public Const GWL_WNDPROC = (-4)
  18. Public Const GWL_USERDATA = (-21)
  19. Public Const NIF_ICON = &H2
  20. Public Const NIF_TIP = &H4
  21. Public Const NIM_ADD = &H0
  22. Public Const NIF_MESSAGE = &H1
  23. Public Const NIM_MODIFY = &H1
  24. Public Const NIM_DELETE = &H2
  25.  
  26. Public Type NOTIFYICONDATA
  27.     cbSize As Long
  28.     hwnd As Long
  29.     uID As Long
  30.     uFlags As Long
  31.     uCallbackMessage As Long
  32.     hIcon As Long
  33.     szTip As String * 64
  34. End Type
  35.  
  36. Private TheData As NOTIFYICONDATA
  37. ' *********************************************
  38. ' The replacement window proc.
  39. ' *********************************************
  40. Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  41. Const WM_SYSCOMMAND = &H112
  42. Const SC_MAXIMIZE = &HF030&
  43. Const SC_MINIMIZE = &HF020&
  44. Const SC_RESTORE = &HF120&
  45.     
  46.     If Msg = TRAY_CALLBACK Then
  47.         ' The user clicked on the tray icon.
  48.         ' Look for click events.
  49.         If lParam = WM_LBUTTONUP Then
  50.             ' On left click, show the form.
  51.             TheForm.Show
  52.             If TheForm.WindowState = vbMinimized Then _
  53.                 TheForm.WindowState = TheForm.LastState
  54.             TheForm.SetFocus
  55.             Exit Function
  56.         End If
  57.         If lParam = WM_RBUTTONUP Then
  58.             ' On right click, show the menu.
  59.             TheForm.PopupMenu TheMenu
  60.             Exit Function
  61.         End If
  62.     End If
  63.     
  64.     If Msg = WM_SYSCOMMAND Then
  65.         If wParam = SC_MINIMIZE Then
  66.             TheForm.Hide
  67.             TheForm.SetTrayMenuItems vbMinimized
  68.             Exit Function
  69.         ElseIf wParam = SC_RESTORE Then
  70.             If Not TheForm.Visible Then
  71.                 TheForm.Show
  72.                 TheForm.SetTrayMenuItems vbNormal
  73.                 Exit Function
  74.             End If
  75.         End If
  76.     End If
  77.     
  78.     ' Send other messages to the original
  79.     ' window proc.
  80.     NewWindowProc = CallWindowProc( _
  81.         OldWindowProc, hwnd, Msg, _
  82.         wParam, lParam)
  83. End Function
  84. ' *********************************************
  85. ' Add the form's icon to the tray.
  86. ' *********************************************
  87. Public Sub AddToTray(frm As Form, mnu As Menu)
  88.     ' ShowInTaskbar must be set to False at
  89.     ' design time because it is read-only at
  90.     ' run time.
  91.  
  92.     ' Save the form and menu for later use.
  93.     Set TheForm = frm
  94.     Set TheMenu = mnu
  95.     
  96.     ' Install the new WindowProc.
  97.     OldWindowProc = SetWindowLong(frm.hwnd, _
  98.         GWL_WNDPROC, AddressOf NewWindowProc)
  99.     
  100.     ' Install the form's icon in the tray.
  101.     With TheData
  102.         .uID = 0
  103.         .hwnd = frm.hwnd
  104.         .cbSize = Len(TheData)
  105.         .hIcon = frm.Icon.Handle
  106.         .uFlags = NIF_ICON
  107.         .uCallbackMessage = TRAY_CALLBACK
  108.         .uFlags = .uFlags Or NIF_MESSAGE
  109.         .cbSize = Len(TheData)
  110.     End With
  111.     Shell_NotifyIcon NIM_ADD, TheData
  112. End Sub
  113. ' *********************************************
  114. ' Remove the icon from the system tray.
  115. ' *********************************************
  116. Public Sub RemoveFromTray()
  117.     ' Remove the icon from the tray.
  118.     With TheData
  119.         .uFlags = 0
  120.     End With
  121.     Shell_NotifyIcon NIM_DELETE, TheData
  122.     
  123.     ' Restore the original window proc.
  124.     SetWindowLong TheForm.hwnd, GWL_WNDPROC, _
  125.         OldWindowProc
  126. End Sub
  127. ' *********************************************
  128. ' Set a new tray tip.
  129. ' *********************************************
  130. Public Sub SetTrayTip(tip As String)
  131.     With TheData
  132.         .szTip = tip & vbNullChar
  133.         .uFlags = NIF_TIP
  134.     End With
  135.     Shell_NotifyIcon NIM_MODIFY, TheData
  136. End Sub
  137. ' *********************************************
  138. ' Set a new tray icon.
  139. ' *********************************************
  140. Public Sub SetTrayIcon(pic As Picture)
  141.     ' Do nothing if the picture is not an icon.
  142.     If pic.Type <> vbPicTypeIcon Then Exit Sub
  143.  
  144.     ' Update the tray icon.
  145.     With TheData
  146.         .hIcon = pic.Handle
  147.         .uFlags = NIF_ICON
  148.     End With
  149.     Shell_NotifyIcon NIM_MODIFY, TheData
  150. End Sub
  151.