XProfan

'###############################################
'#                                             #
'# TrayIcon through NOTIFYICONDATAA/W produce #
'#                                             #
'#          Georg Teles on the 21.09.2020          #
'#                                             #
'###############################################
'$u lat2cyr.pcu = l2cPCU. ' Unit becomes needed, circa kyrillischen Text To produce
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
'-------------# Structures
Struct NIDataA = cbSize&, hWnd&, uID&, uFlags&, uCallbackMessage&, hIcon&, szTip$(128)'reserved Size = 128 characters
Struct NIDataW = cbSize&, hWnd&, uID&, uFlags&, uCallbackMessage&, hIcon&, szTip$(256)'needed double Size How ANSI therefore = 256 with 128 characters
'-------------# Program
Set("FastMode", 1)' erweiterte Messages
Set("TrueColor",1)
Windowtitle "NotifyIconData"
Window Style 2+4+8+16+512
Window 355,282
ico& = Create("hIcon",Par$(0),0)' Icon erwünscht ?
SendMessage(%HWnd,$80,1,ico&)' Icon settle
'SetWindowLong(%HWnd,-16,$92CE0000) ' Fensterstil alternatively settle = derslebe How 2+4+8+16 s.o. but OHNE 512 !
'-------------# NOTIFYICON to %HWnd produce ! example 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 be Icon #1 !"+Chr$(0)
Shell_NotifyIconA(&NIM_ADD,NID#)' beget 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 be Icon #2 !"+Chr$(0)
Shell_NotifyIconA(&NIM_ADD,NID2#)' beget 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 be 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 becomes needed !
'NID3#.szTip$ = l2cPCU.l2l("ein Gemischter Text - ")+l2cPCU.l2c("-Eto nebol-m-soj Test <>|\q!§$%&/()=´'?^@")+l2cPCU.l2l(" More Text"+Chr$(0))
Shell_NotifyIconW(&NIM_ADD,NID3#)' beget Icon #3
'-------------# WindowPROC / Auswertung the Icons

Proc WindowProc

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

    If Message& = &TRAYMSG' Message snatch

        ' alternatively ID the Icons vorschalten through wParam& = ID the Icons

        If lParam& = $201

            print "links 1x klicked on Icon ID"+Str $(wParam&)

        ElseIf lParam& = $203

            print "links DBL-Click on Icon ID"+Str $(wParam&)

        ElseIf lParam& = $204

            print "rechts 1x klicked on Icon ID"+Str $(wParam&)

        ElseIf lParam& = $206

            print "rechts DBL-Click on Icon ID"+Str $(wParam&)

        EndIf

    EndIf

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

ENDPROC

OldWndProc& = GetWindowLong(%hWnd,-4)' original WndProc Save
SetWindowLong(%hWnd,-4,ProcAddr("WindowProc",4))' WindowProc allocate
' Icon #1 delete, produce, Change
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 delete, produce, Change

    If Clicked(btk&)

        Shell_NotifyIconA(&NIM_DELETE,NID#)' Delete

    ElseIf Clicked(bts&)

        Shell_NotifyIconA(&NIM_ADD,NID#)' produce

    ElseIf Clicked(btu&)

        NID#.szTip$ = "Ich be Icon #1, Uhrzeit is: "+time$(0)+":"+time$(1)+Chr$(0)
        Case ico2&:DeleteObject ico2&
        ico2& = Create("hIcon",Par$(0),1)
        NID#.hIcon& = ico2&' one other Icon !
        Shell_NotifyIconA(&NIM_MODIFY,NID#)' update

    EndIf

EndWhile

SetWindowLong(%hWnd,-4,OldWndProc&)' original WndProc restore
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#