XProfan

'###############################################
'#                                             #
'# TrayIcon mittels NOTIFYICONDATAA/W erzeugen #
'#                                             #
'#          Georg Teles am 21.09.2020          #
'#                                             #
'###############################################
'$U lat2cyr.pcu = l2cPCU. ' Unit wird nécessaire, um kyrillischen Text trop erzeugen
Déclarer 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 Taille = 128 marque
Struct NIDataW = cbSize&, hWnd&, uID&, uFlags&, uCallbackMessage&, hIcon&, szTip$(256)'nécessaire doppelte Taille comment ANSI daher = 256 chez 128 marque
'-------------# Programme
Set("Fastmode", 1)' Avancé Messages
Set("TrueColor",1)
Windowtitle "NotifyIconData"
Fenêtre Style 2+4+8+16+512
Fenêtre 355,282
ico& = Créer("hIcon",Par$(0),0)' Icon erwünscht ?
SendMessage(%HWnd,$80,1,ico&)' Icon mettons
'SetWindowLong(%HWnd,-16,$92CE0000) ' Fensterstil alternativ mettons = derslebe comment 2+4+8+16 s.o. mais OHNE 512 !
'-------------# NOTIFYICON pour %HWnd erzeugen ! Beispiel 3 Icônes
Déclarer NID#, NID2#, NID3#
'-------------# ICON #1
Faible 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 suis Icon #1 !"+Chr$(0)
Shell_NotifyIconA(&NIM_ADD,NID#)' Erzeuge Icon #1
'-------------# ICON #2
Faible 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 suis Icon #2 !"+Chr$(0)
Shell_NotifyIconA(&NIM_ADD,NID2#)' Erzeuge Icon #2
'-------------# ICON #3
Faible 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 suis Icon #3 !"+Chr$(0))

Proc ansi2wideFAST

    Paramètres text$
    Déclarer textneu$

    WhileLoop 0,Len(text$)-1

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

    Endwhile

    Retour textneu$

ENDPROC

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

Proc WindowProc

    Paramètres hWnd&, Message&, wParam&, lParam&

    Si Message& = &TRAYMSG' Message auffangen

        ' alternativ ID des Icônes vorschalten mittels wParam& = ID qui Icônes

        Si lParam& = $201

            imprimer "links 1x angeklickt sur Icon ID"+Str$(wParam&)

        ElseIf lParam& = $203

            imprimer "links DBL-Klick sur Icon ID"+Str$(wParam&)

        ElseIf lParam& = $204

            imprimer "rechts 1x angeklickt sur Icon ID"+Str$(wParam&)

        ElseIf lParam& = $206

            imprimer "rechts DBL-Klick sur Icon ID"+Str$(wParam&)

        EndIf

    EndIf

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

ENDPROC

OldWndProc& = GetWindowLong(%hWnd,-4)' original WndProc Sauver
SetWindowLong(%hWnd,-4,ProcAddr("WindowProc",4))' WindowProc zuweisen
' Icon #1 effacer, erzeugen, changement
var btk& = Créer("Button",%hWnd,"KILL #1",100,100,100,20)
var bts& = Créer("Button",%hWnd,"CREATE #1",100,130,100,20)
var btu& = Créer("Button",%hWnd,"UPDATE #1",100,160,100,20)

WhileNot e%

    Waitinput

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

        Inc e%

    EndIf

    ' Icon #1 effacer, erzeugen, changement

    Si Clicked(btk&)

        Shell_NotifyIconA(&NIM_DELETE,NID#)' Effacer

    ElseIf Clicked(bts&)

        Shell_NotifyIconA(&NIM_ADD,NID#)' Erzeugen

    ElseIf Clicked(btu&)

        NID#.szTip$ = "Ich suis Icon #1, l'heure ist: "+Time $(0)+»+Time $(1)+Chr$(0)
        Cas ico2&:DeleteObject ico2&
        ico2& = Créer("hIcon",Par$(0),1)
        NID#.hIcon& = ico2&' un d'autre 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#