XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Tray-Icon mit Balloon-Tips
Ab Profan 7.0
#######################
Thema : Tray-Icon
Balloon-Tips
#######################
Andreas Miethe
August 2003
#######################
Balloon-Tips sind nur verfügbar wenn in der Registry unter
HKEY_CURENT_USER SoftwareMicrosoftWindowsCurrentVersionExplorerAdvanced
der Wert EnableBalloonTips auf 1 steht.
Möglicherweise muss der Schlüssel erst angelegt werden.
#######################
DEF HiWord(1) And(&(1)>>16,$FFFF)
DEF LoWord(1) And(&(1),$FFFF)
DEF GetFileVersionInfoSize(2) ! Version,GetFileVersionInfoSizeA
DEF GetFileVersionInfo(4) ! Version,GetFileVersionInfoA
DEF VerQueryValue(4) ! Version,VerQueryValueA
DEF GetSysColor(1) ! user32,GetSysColor
DEF SetWindowPos(7) ! User32,SetWindowPos
DEF LoadIcon(2) ! User32,LoadIconA
DEF Shell_NotifyIcon(2) ! shell32,Shell_NotifyIconA
DEF RegisterWindowMessage(1) ! user32,RegisterWindowMessageA
DEF SetForegroundWindow(1) ! user32,SetForegroundWindow
DEF GetCursorPos(1) ! user32,GetCursorPos
DEF MapWindowPoints(4) ! user32,MapWindowPoints
DEF XSetTimer(4) ! user32,SetTimer
DEF &WM_USER $0400
DEF &COLOR_BTNFACE 15
DEF &SWP_NOACTIVATE $10
DEF &SWP_NOREDRAW $8
DEF &NIF_ICON $2
DEF &NIF_TIP $4
DEF &NIF_MESSAGE $1
DEF &NIF_INFO $10
DEF &NIM_ADD $0
DEF &NIM_DELETE $2
DEF &NIM_MODIFY $1
DEF &NIM_SETVERSION $4
DEF &NIM_SETFOCUS $3
Icons
DEF &NIIF_ERROR $3
DEF &NIIF_INFO $1
DEF &NIIF_NONE $0
DEF &NIIF_WARNING $2
DEF &NIF_STATE $8
DEF &NIS_HIDDEN $1
DEF &NIS_SHAREDICON $2
DEF &NIN_BALLOONSHOW  $0402
DEF &NIN_BALLOONHIDE  $0403
DEF &NIN_BALLOONTIMEOUT  $0404
DEF &NIN_BALLOONUSERCLICK $0405
DEF &WM_CLOSE $10
DEF &WM_LBUTTONDOWN $0201
DEF &WM_RBUTTONDOWN $0204
DEF &WM_SYSCOMMAND $0112
DEF &SC_RESTORE $F120
DEF &WM_SHELLNOTIFY $0405 &WM_USER + 5 shell notify message
DEF &uID 7777
DEF &NOTIFYICONDATA_V1_SIZE   88  pre-5.0 structure size
DEF &NOTIFYICONDATA_V2_SIZE  488 pre-6.0 structure size
DEF &NOTIFYICONDATA_V3_SIZE  504 6.0+ structure size
Declare NOTIFYICONDATASIZE&

Proc IsShellVersion

    Declare Retval&,K$
    Declare nBufferSize&,nUnUsed&
    Declare sDLLFile$
    Declare lpBuffer#,lplpBuffer&,lpBufferLenght&
    sDLLFile$ = Shell32
    nBufferSize& = GetFileVersionInfoSize(addr(sDLLFile$), addr(nUnused&))
    Dim lpBuffer#,nBufferSize&
    GetFileVersionInfo(addr(sDLLFile$),0,nBufferSize&,lpBuffer#)
    k$ = \
    VerQueryValue(lpBuffer#,addr(k$),addr(lplpBuffer&),Addr(lpBufferLenght&))
    RetVal& = Word(lplpBuffer&,10)
    Dispose lpBuffer#
    Return RetVal&

EndProc

Die Grösse der NotifyIcon- Struktur ist abhängig von der Version der
Shell32.dll, daher muss erst die Version geprüft werden.
IsShellVersion

If @&(0) = 5 Version = 5

    NOTIFYICONDATASIZE& = &NOTIFYICONDATA_V2_SIZE

ElseIf @&(0) = 6 Version = 6

    NOTIFYICONDATASIZE& = &NOTIFYICONDATA_V3_SIZE
    Else Version = vor 5
    NOTIFYICONDATASIZE& = &NOTIFYICONDATA_V1_SIZE

Endif

Declare Point#,TB_CREATED&
Declare InfoText$,InfoTitle$,Tip$,Icon$,RegMessage$
Tip$ = Balloon-Tips © Andreas Miethe * August 2003
InfoText$ = Dieses Tray-Icon reagiert auf die rechte wie auch auf die linke Maustaste
InfoText$ = InfoText$ +
+Tip$+chr$(0)
InfoTitle$ = INFO MAX 255 Zeichen
Icon$ =A
RegMessage$ = IconCreated
Struct Point = x&, y&
Struct Note  = cbSize&,hWnd&,uID&,uFlags&,uCallbackMessage&,hIcon&,szTip#(128),
dwState&,dwStateMask&,szInfo#(256),uTimeoutAndVersion&,szInfoTitle#(64),
dwInfoFlags&,guidItem#(16)
Declare Ende&,Note#
SetTrueColor 1
SetErrorlevel 0
Window -1000,0 - 0,0Fenster neben den Bildschirm
CLS GetSysColor(&COLOR_BTNFACE)
ShowWindow(%hwnd,0)Fenster verbergen
SetWindowPos(%hwnd,0,0,0,640,480,OR(&SWP_NOREDRAW,&SWP_NOACTIVATE))neue Position
Dim Note#,Note
Clear Note#
Note#.cbSize&           = NOTIFYICONDATASIZE&
Note#.hWnd&             = %hwnd
Note#.uID&              = &uID
Note#.hIcon&            = LoadIcon(%hInstance,ADDR(Icon$))
Note#.uFlags&           = Or(Or(Or(&NIF_ICON,&NIF_TIP),&NIF_MESSAGE),&NIF_STATE)
Note#.uCallbackMessage& = &WM_SHELLNOTIFY
Note#.szTip#            = Tip$
Note#.dwState&          = &NIS_SHAREDICON
Note#.dwStateMask&      = Or(&NIS_HIDDEN,&NIS_SHAREDICON)
Note#.uTimeoutAndVersion& = 50$3
normales Icon einfügen
Shell_NotifyIcon(&NIM_ADD, Note#)
Shell_NotifyIcon(&NIM_SETVERSION, Note#)
modifizieren für Balloon-Tips
Note#.uFlags& = &NIF_INFO
Note#.szInfo# = InfoText$
Note#.szInfoTitle# = InfoTitle$
Note#.dwInfoFlags& = &NIIF_INFO
Note#.uTimeoutAndVersion& = 16000TimeOut
Shell_NotifyIcon(&NIM_MODIFY,Note#)
TB_CREATED& = RegisterWindowMessage(ADDR(RegMessage$))
UserMessages &WM_SHELLNOTIFY,TB_CREATED&,&WM_CLOSE
ShowWindow(%hwnd,0)
settimer 15000

Whilenot Ende&

    Waitinput

    If %wmTimer

        Umweg falls MinTimeOut größer als 15 sekunden ist
        Killtimer
        Note#.szInfo# = chr$(0)
        Note#.szInfoTitle# = chr$(0)
        Shell_NotifyIcon(&NIM_MODIFY,Note#)
        MessageBox(Zeit abgelaufen,,0)
        Print Zeit abgelaufen

    Endif

    If %UMessage = &WM_CLOSE

        Shell_NotifyIcon(&NIM_DELETE,Note#)
        Ende& = 1

    Endif

    If %UMessage = TB_CREATED&Explorer-Crash. Icon neu anlegen

        Shell_NotifyIcon(&NIM_ADD,Note#)

    Endif

    If %UMessage = &WM_SHELLNOTIFY

        If &ULParam = &NIN_BALLOONTIMEOUT

            Killtimer
            MessageBox(Zeit abgelaufen,,0)
            Print Zeit abgelaufen

        Endif

        If &ULParam = &NIN_BALLOONUSERCLICK

            MessageBox(Klick,,0)
            Print Klick

        Endif

        If &ULParam = &NIN_BALLOONHIDE

            MessageBox(weg,,0)
            Print weg

        Endif

        If &ULParam = &WM_RBUTTONDOWNrechter Mausbutton

            SetForegroundWindow(%hWnd)
            Dim Point#,Point
            CreateMenu
            AppendMenu 100,Fenster verbergen
            AppendMenu 101,Fenster zeigen
            Separator
            AppendMenu 102,Ende
            GetCursorPos(Point#)
            MapWindowPoints(%Desktop,%hwnd,Point#,1)
            Trackmenu Point#.x&,Point#.y&
            Dispose Point#

        Endif

        If &ULParam = &WM_LBUTTONDOWNlinker Mausbutton

            SetForegroundWindow(%hWnd)
            Dim Point#,Point
            CreateMenu
            AppendMenu 200,Linker Button 1
            AppendMenu 201,Linker Button 2
            Separator
            AppendMenu 202,Linker Button 3
            GetCursorPos(Point#)
            MapWindowPoints(%Desktop,%hwnd,Point#,1)
            Trackmenu Point#.x&,Point#.y&
            Dispose Point#

        Endif

    Endif

    If MenuItem(100)

        ShowWindow(%hwnd,0)

    ElseIf Menuitem(101)

        SendMessage(%hwnd,&WM_SYSCOMMAND,&SC_RESTORE,0)

    ElseIf Menuitem(102)

        Shell_NotifyIcon(&NIM_DELETE,Note#)
        Ende& = 1

    ElseIf Menuitem(200)

        settimer 15000
        Shell_NotifyIcon(&NIM_MODIFY,Note#)Balloontip Montrer

    Endif

Wend