XProfan

'###############################################
'#                                             #
'# TrayIcon mittels NOTIFYICONDATAA/W erzeugen #
'#                                             #
'#          Georg Teles am 21.09.2020          #
'#                                             #
'###############################################
'$U lat2cyr.pcu = l2cPCU. ' Unit wird necessario, um kyrillischen Text zu erzeugen
Declare OldWndProc&, ico&, ico2&, e%
'-------------# Definitionen
Def GetWindowLong(2)!"USER32","GetWindowLongA"
Def SetWindowLong(3)!"USER32","SetWindowLongA"
Def CallWindowProc(5)!"USER32","CallWindowProcA"
Def Shell_NotifyIconA(2)!"SHELL32","Shell_NotifyIconA"'ANSI
Def Shell_NotifyIconW(2)!"SHELL32","Shell_NotifyIconW"'WIDE
'-------------# NotifyIcon Konstanten
Def &TRAYMSG $500
Def &NIM_ADD $0
Def &NIM_MODIFY $1
Def &NIM_DELETE $2
Def &NIF_MESSAGE $1
Def &NIF_ICON $2
Def &NIF_TIP $4
'-------------# Strukturen
Struct NIDataA = cbSize&, hWnd&, uID&, uFlags&, uCallbackMessage&, hIcon&, szTip$(128)'reservierte Dimensione = 128 Zeichen
Struct NIDataW = cbSize&, hWnd&, uID&, uFlags&, uCallbackMessage&, hIcon&, szTip$(256)'necessario doppelte Dimensione wie ANSI daher = 256 bei 128 Zeichen
'-------------# Programm
Set("FastMode", 1)' erweiterte Messages
Set("TrueColor",1)
Windowtitle "NotifyIconData"
WindowStyle 2+4+8+16+512
Window 355,282
ico& = Create("hIcon",Par$(0),0)' Icon erwünscht ?
SendMessage(%HWnd,$80,1,ico&)' Icon Setzen
'SetWindowLong(%HWnd,-16,$92CE0000) ' Fensterstil alternativ setzen = derslebe wie 2+4+8+16 s.o. aber OHNE 512 !
'-------------# NOTIFYICON nach %HWnd erzeugen ! Beispiel 3 Icons
Declare NID#, NID2#, NID3#
'-------------# ICON #1
Dim NID#, NIDataA' ANSI
NID#.cbSize& = SizeOf(NID#)
NID#.hWnd& = %hWnd
NID#.uID& = 0' ID #0 !
NID#.uFlags& = &NIF_MESSAGE | &NIF_ICON | &NIF_TIP
NID#.uCallbackMessage& = &TRAYMSG
NID#.hIcon& = ico&
NID#.szTip$ = "Ich bin Icon #1 !"+Chr$(0)
Shell_NotifyIconA(&NIM_ADD,NID#)' Erzeuge Icon #1
'-------------# ICON #2
Dim NID2#, NIDataA' ANSI
NID2#.cbSize& = SizeOf(NID2#)
NID2#.hWnd& = %hWnd
NID2#.uID& = 1' ID #1 !
NID2#.uFlags& = &NIF_MESSAGE | &NIF_ICON | &NIF_TIP
NID2#.uCallbackMessage& = &TRAYMSG
NID2#.hIcon& = ico&
NID2#.szTip$ = "Ich bin Icon #2 !"+Chr$(0)
Shell_NotifyIconA(&NIM_ADD,NID2#)' Erzeuge Icon #2
'-------------# ICON #3
Dim NID3#, NIDataW' WIDE
NID3#.cbSize& = SizeOf(NID3#)
NID3#.hWnd& = %hWnd
NID3#.uID& = 2' ID #2 !
NID3#.uFlags& = &NIF_MESSAGE | &NIF_ICON | &NIF_TIP
NID3#.uCallbackMessage& = &TRAYMSG
NID3#.hIcon& = ico&
NID3#.szTip$ = ansi2wideFAST("Ich bin Icon #3 !"+Chr$(0))

Proc ansi2wideFAST

    Parameters text$
    Declare textneu$

    WhileLoop 0,Len(text$)-1

        textneu$ = textneu$+Mid$(text$,&loop+1,1)+Chr$(0)

    EndWhile

    Return textneu$

EndProc

' lat2cyr.pcu Unit wird necessario !
'NID3#.szTip$ = l2cPCU.l2l("ein Gemischter Text - ")+l2cPCU.l2c("-Eto nebol-m-soj test <>|\q!§$%&/()=´'?^@")+l2cPCU.l2l(" mehr Text"+Chr$(0))
Shell_NotifyIconW(&NIM_ADD,NID3#)' Erzeuge Icon #3
'-------------# WindowPROC / Auswertung der Icons

Proc WindowProc

    Parameters hWnd&, Message&, wParam&, lParam&

    If Message& = &TRAYMSG' Message auffangen

        ' alternativ ID des Icons vorschalten mittels wParam& = ID der Icons

        If lParam& = $201

            print "links 1x angeklickt auf Icon ID"+Str$(wParam&)

        ElseIf lParam& = $203

            print "links DBL-Klick auf Icon ID"+Str$(wParam&)

        ElseIf lParam& = $204

            print "rechts 1x angeklickt auf Icon ID"+Str$(wParam&)

        ElseIf lParam& = $206

            print "rechts DBL-Klick auf Icon ID"+Str$(wParam&)

        EndIf

    EndIf

    Return CallWindowProc(OldWndProc&, hWnd&, Message&, wParam&, lParam&)

EndProc

OldWndProc& = GetWindowLong(%hWnd,-4)' original WndProc speichern
SetWindowLong(%hWnd,-4,ProcAddr("WindowProc",4))' WindowProc zuweisen
' Icon #1 löschen, erzeugen, ändern
var btk& = Create("Button",%hWnd,"KILL #1",100,100,100,20)
var bts& = Create("Button",%hWnd,"CREATE #1",100,130,100,20)
var btu& = Create("Button",%hWnd,"UPDATE #1",100,160,100,20)

WhileNot e%

    Waitinput

    If ((%Key = 2) | (%Key = 27))

        Inc e%

    EndIf

    ' Icon #1 löschen, erzeugen, ändern

    If Clicked(btk&)

        Shell_NotifyIconA(&NIM_DELETE,NID#)' Löschen

    ElseIf Clicked(bts&)

        Shell_NotifyIconA(&NIM_ADD,NID#)' Erzeugen

    ElseIf Clicked(btu&)

        NID#.szTip$ = "Ich bin Icon #1, Uhrzeit ist: "+Time$(0)+":"+Time$(1)+Chr$(0)
        Case ico2&:DeleteObject ico2&
        ico2& = Create("hIcon",Par$(0),1)
        NID#.hIcon& = ico2&' ein anderes Icon !
        Shell_NotifyIconA(&NIM_MODIFY,NID#)' Aktualisieren

    EndIf

EndWhile

SetWindowLong(%hWnd,-4,OldWndProc&)' original WndProc wiederherstellen
Shell_NotifyIconA(&NIM_DELETE,NID#)' lösche Icon #1
Shell_NotifyIconA(&NIM_DELETE,NID2#)' lösche Icon #2
Shell_NotifyIconA(&NIM_DELETE,NID3#)' lösche Icon #3
SetFocus(%hWnd)
DeleteObject ico&, ico2&
DisPose NID#, NID2#, NID3#