SysTray in Taskleiste anzeigen

Anzeigen des SysTray in der Taskleiste via 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% muss 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 muss 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
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt