| SetForegroundWindow, PostMessageLong, Shell_NotifyIcon, SetWindowLong, CallWindowProc |
| |
| |
| Prozedur im Formular | |
| Konstanten | |
| Const WM_MOUSEMOVE As Long = &H200 |
| Const WM_LBUTTONDOWN As Long = &H201 | |
| Const WM_LBUTTONUP As Long = &H202 | |
| Const WM_LBUTTONDBLCLK As Long = &H203 | Das SysTray-Programm sollte über Sub Main gestartet werden, |
| Const WM_MBUTTONDOWN As Long = &H207 | damit die Form nicht sofort angezeigt wird. Main lädt lediglich |
| Const WM_MBUTTONUP As Long = &H208 | die Form. Im Load Event der Form wird sie ans SysTray |
| Const WM_MBUTTONDBLCLK As Long = &H209 | angemeldet (stStart Me). Im QueryUnload Event sollte |
| Const WM_RBUTTONDOWN As Long = &H204 | vermieden werden, daß die Form entladen wird. Stattdessen |
| Const WM_RBUTTONUP As Long = &H205 | wird sie nur ausgeblendet. Im Unload Ereignis meldet sich |
| Const WM_RBUTTONDBLCLK As Long = &H206 | die Form vom SysTray ab (stEnde Me). |
| |
| API Deklarationen | Mit der Prozedur SetIcon kann man den SysTray Icon wechseln. |
| Private Declare Function SetForegroundWindow Lib "user32" _ | Dabei wird ein benannter Icon aus einer dem Projekt zugefügten |
| (ByVal hwnd As Long) As Long | Ressourcendatei geladen. SetIcon wurde in diesem Beispiel |
| Private Declare Function PostMessageLong Lib "user32" _ | recht naiv implementiert (NIM_DELETE und NIM_ADD). Eine |
| Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _ | bessere Lösung verspricht NIM_MODIFY. |
| ByVal wParam As Long, ByVal lParam As Long) As Long | |
| Hinweis: Im Modul SysTrayBas.bas gibt es in der Prozedur |
| Nächster auszuführender Befehl (= Index Pulldown Menü) | WindowProc einen benannten Verweis auf die Form. Dieser |
| Private Befehl% | muß entsprechend angepaßt werden, wenn der Form Name |
| geändert wurde. An allen anderen Stellen ruft das Form-Modul |
| Verarbeiten der Windows Nachrichten | die SysTray-Funktionen mit dem Me Argument auf. |
| Public Sub ProcMsg(ByVal hwnd As Long, ByVal uMsg As Long, _ | |
| ByVal wParam As Long, ByVal lParam As Long) | Das Programm merkt sich den Index des gewählten Menüpunkts, |
| On Error Resume Next | startet einen 100msec Timer und fährt mit der Windows |
| Select Case uMsg | Nachrichtenbehandlung fort. Das Timer Event wird zur |
| Case WM_MYHOOK | zentralen Programmverzweigung und führt die gewünschte |
| Select Case lParam | Aktion aus - in diesem Fall wird das Programm beendet. |
| Case WM_MOUSEMOVE | In der IDE sollte das Programm nicht über den Stop Button |
| Case WM_LBUTTONDOWN | abgebrochen werden. |
| Case WM_LBUTTONUP | |
| Case WM_LBUTTONDBLCLK | |
| Call SetForegroundWindow(hwnd) | Direkten Befehl mit Id 2 absetzen: Dialog anzeigen. |
| Befehl = 2 | |
| BTimer.Enabled = True | |
| Call PostMessageLong(hwnd, WM_USER, 0, 0) | |
| Case WM_RBUTTONDOWN | |
| Case WM_RBUTTONUP: | |
| Call SetForegroundWindow(hwnd) | Popupmenü anzeigen. |
| PopupMenu zmnuFile | |
| Call PostMessageLong(hwnd, WM_USER, 0, 0) | |
| End Select | |
| End Select | |
| End Sub | |
| |
| Private Sub BTimer_Timer() | Befehlszentrale. |
| BTimer.Enabled = False | |
| Select Case Befehl | |
| Case 0: Unload Me | |
| Case 1 | Strich. |
| Case 2: Me.Show | |
| Case 3 | |
| setIcon "ICON4", Me | Anderes Icon anzeigen. |
| Case Else: MsgBox "Befehl " & Befehl & " wurde gewählt!", vbInformation, "SysTray MenuHandler" |
| End Select | |
| End Sub | |
| |
| Private Sub Form_Load() | |
| stStart Me | Anmelden ans SysTray. |
| End Sub | |
| |
| Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) |
| If UnloadMode = 0 Then | Verhindern, daß die Form entladen wird, wenn man auf X klickt. |
| Hide | Form wird aber trotzdem ausgeblendet. |
| Cancel = Not Cancel | Aber kein Unload. |
| End If | |
| End Sub | |
| |
| Private Sub Form_Unload(Cancel As Integer) | |
| stEnde Me | Abmelden vom SysTray. |
| End Sub | |
| |
| Private Sub zBefehl_Click(Index As Integer) | |
| Befehl = Index | |
| BTimer.Enabled = True | |
| End Sub | |
| |
| |
| Prozedur im Modul | |
| Konstanten | |
| Const NIM_ADD As Long = &H0 | |
| Const NIM_DELETE As Long = &H2 | |
| Const NIF_ICON As Long = &H2 | Adding an ICON. |
| Const NIF_TIP As Long = &H4 | Adding a TIP. |
| Const NIF_MESSAGE As Long = &H1 | Want return messages. |
| |
| Get/SetWindowLong messages. | |
| Const GWL_WNDPROC As Long = (-4) | |
| Public Const WM_USER As Long = &H400 | |
| Public Const WM_MYHOOK As Long = WM_USER + 1 | |
| |
| TYPEs. | |
| 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 | |
| |
| Variablen. | |
| Private NID As NOTIFYICONDATA | |
| isSubclassed: flag indicating that subclassing has been done. | |
| Provides the means to call the correct message-handler. | |
| Private isSubclassed As Boolean | |
| defWindowProc: Variable to hold the ID of the default window | |
| message processing procedure. Returned by SetWindowLong. | |
| Private defWindowProc As Long | |
| |
| API Deklarationen. | |
| Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias _ | |
| "Shell_NotifyIconA" (ByVal dwMessage As Long, _ | |
| lpData As NOTIFYICONDATA) As Long | |
| Private Declare Function SetWindowLong Lib "user32" Alias _ | |
| "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _ | |
| ByVal dwNewLong As Any) As Long | |
| Private Declare Function CallWindowProc Lib "user32" Alias _ | |
| "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _ | |
| ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, _ | |
| ByVal lParam As Long) As Long | |
| |
| Private Function ShellTrayAdd(f As Form) As Long | |
| Dim r As Long | |
| With NID | |
| .cbSize = LenB(NID) | |
| .hwnd = f.hwnd | |
| .uID = 125& | |
| .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE | |
| .uCallbackMessage = WM_MYHOOK | |
| .hIcon = f.Icon | |
| .szTip = "SysTray Demo (TTT)" & Chr$(0) | Tooltiptext. |
| End With | |
| r = Shell_NotifyIcon(NIM_ADD, NID) | |
| End Function | |
| |
| Public Sub stEnde(f As Form) | Ans SysTray abmelden. |
| Dim h& | |
| Call Shell_NotifyIcon(NIM_DELETE, NID) | SysTray Icon ausblenden. |
| If defWindowProc Then | SysTray Ereignisempfang aus. |
| h = f.hwnd | |
| SetWindowLong h, GWL_WNDPROC, defWindowProc | |
| defWindowProc = 0 | |
| End If | |
| End Sub | |
| |
| Public Sub stStart(f As Form) | Ans SysTray anmelden. |
| Dim h& | Form-Name muß auch im WindowProc angegeben werden. |
| ShellTrayAdd f | SysTray Icon einblenden. |
| On Error Resume Next | SysTray Ereignisempfang an. |
| h = f.hwnd | |
| defWindowProc = SetWindowLong(h, GWL_WNDPROC, AddressOf WindowProc) |
| End Sub | |
| |
| Public Sub setIcon(ib$, f As Form) | Icon wechseln. |
| On Error GoTo Fehler | |
| 1 stEnde f | |
| 2 Set f.Icon = LoadResPicture(ib, vbResIcon) | |
| 3 stStart f | |
| 4 | |
| Exit Sub | |
| Fehler: | |
| Beep | |
| MsgBox "Fehler " & Err & " in " & Erl & vbCr & Err.Description & _ | |
| vbCr & "setIcon " & ib, vbCritical, "Geo7 Quick Fehler" | |
| End Sub | |
| |
| Sub Main() | |
| Load fSysTray | Fenster laden, aber nicht anzeigen. |
| End Sub | |
| |
| Public Function WindowProc(ByVal hwnd&, ByVal uMsg&, _ | Windows Nachrichten Routine. |
| ByVal wParam&, ByVal lParam&) As Long | |
| On Error Resume Next | |
| If hwnd = fSysTray.hwnd Then | Sind Nachrichten für unser SysTray Fenster dabei? |
| fSysTray.ProcMsg hwnd, uMsg, wParam, lParam | |
| End If | |
| If isSubclassed = True Then | Weiterleiten an "Standard" Routine. |
| WindowProc = CallWindowProc(defWindowProc, hwnd, uMsg, wParam, ByVal lParam) |
| Else | |
| isSubclassed = False | Warum ist das nur doppelt drin ? |
| isSubclassed = True | |
| End If | |
| End Function | |
| |
zurück