XProfan

 {$cleq}
const appTitle=TrayApp
//messages
const m_base=wm_user+4096
const m_tray_TrackMenu_exitApp=m_base+0
//defaults
const d_hwndSizeX=300
const d_hwndSizeY=450
long hwnd.showMode=1
windowTitle apptitle
windowStyle 2 | 4 | 8 | 16 | 512 | 1024
window maxx,maxy - 0,0
hwnd.showWindow(false)
moveWindow(hwnd,(maxx/2-d_hwndSizeX/2),(maxy*0.4-d_hwndSizeY/2),d_hwndSizeX,d_hwndSizeY,false)
long tray.iconH=tray.init()
userMessages wm_close

do {

    select TrayIcon(msg,1)

        caseof wm_lButtonDown,wm_lButtonDblClk : hwnd.showWindow(true-hwnd.showMode)

        caseof wm_rButtonDown

        select tray.trackMenu()

            caseof m_tray_TrackMenu_exitApp : break

        endSelect

    endSelect

    select uMessage

        caseof wm_close : hwnd.showWindow(false)

    endSelect

    waitinput

}

tray.close(tray.iconH)
end

tray.init{

    long h=create(hIcon,A)
    trayIcon(add,hWnd,1,h,appTitle)
    return h

}

tray.close(long h){

    int bVal=trayIcon(delete,hWnd,1)
    deleteObject h
    return bVal

}

tray.trackMenu{

    createMenu
    appendMenu m_tray_TrackMenu_exitApp,Beenden
    setActiveWindow(hWnd)
    int bVal=trackMenu()
    setMenuitem 0
    return bVal

}

hwnd.showWindow(int mode){

    ifnot hwnd.showMode==mode {

        showWindow(hWnd,mode)

    }

    if mode {

        setForeGroundWindow(hwnd)
        setActiveWindow(hwnd)

    }

    hwnd.showMode=mode
    return true

}

REM XProfan v11.0ß S8-NT
Def %MyMenu_InfoApp $1400
Def %MyMenu_ExitApp $1401
Def $DefTooltip (Was sucht denn dieses Programm hier?)
Struct TrayData = hAppWin&, hIcon&, ShowMode%, ToolTip$(63)
Class Tray = -TrayData,
+Tray@, +Start@, +Stop@,
+SetIcon@, +SetText@, +SetIconAndText@,
+Menu@,
+ShowWindow@, +SwitchWindow@

Proc Tray.Tray

    Initialisiert den Datenbereich
    .ShowMode% = 1 : .hAppWin& = 0 : .hIcon& = 0 : .ToolTip$ = $DefTooltip
    Return 1

EndProc

Proc Tray.Start

    Tray.Start(hAppWin&,{Icon$|Icon&|0},{Tooltip$|})
    Par 1 - hAppWin&
    Par 2 - IconName$ oder IconHandle& oder 0 (Null) (dann vorher: .SetIcon)
    Par 3 - ToolTip$ oder  (dann vorher: .SetText)
    (Das IconHandle& wird intern über Tray.Stop entfernt.)
    Declare Typ$, AppWin&, ErrMsg$, erg% : Clear erg%  0 = Fehler, 1 = Ok
    ErrMsg$ = Tray.Start benötigt drei (3) Parameter
    Tray.Start( hAppWin&, {Icon$|Icon&|0}, {Tooltip$|qq} )

    If %PCount <> 3

        MessageBox(ErrMsg$,Parameter-Fehler (Anzahl),16 + 4096 + 262144)

    Else

        Typ$ = PType$(2)

        Select Left$(Typ$,1)

            CaseOf &  es wurde ein IconHandle angegeben

            Parameters p1a&,p2a&,p3a$
            AppWin& = p1a& : erg% = .SetIconAndText(p2a&,p3a$)

            CaseOf $  es wurde der Name eines internen Icons angegeben

            Parameters p1b&,p2b$,p3b$
            AppWin& = p1b& : erg% = .SetIconAndText(p2b$,p3b$)
            Otherwise
            MessageBox(ErrMsg$,Parameter-Fehler (Typ),16 + 4096 + 262144)

        EndSelect

        .hAppWin& = AppWin&
        CaseNot .hAppWin& : Clear erg%

        If erg%

            CaseNot .hIcon& : .hIcon& = Create(hIcon,A)
            Case .Tooltip$ =  : .ToolTip$ = $DefTooltip
            TrayIcon(Add,.hAppWin&,1,.hIcon&,.ToolTip$)

        EndIf

    EndIf

    Return erg%

EndProc

Proc Tray.SetIcon

    Tray.SetIcon( {Icon$|Icon&} )
    Par 1 - IconName$ oder IconHandle&
    Declare Typ$, ErrMsg$, erg% : Clear erg%  0 = Fehler, 1 = Ok
    ErrMsg$ = Tray.SetIcon benötigt einen (1) Parameter
    Tray.SetIcon( {Icon$ | Icon&} )

    If %PCount <> 1

        MessageBox(ErrMsg$,Parameter-Fehler (Anzahl),16 + 4096 + 262144)

    Else

        Typ$ = PType$(1)

        Select Left$(Typ$,1)

            CaseOf &  es wurde ein IconHandle angegeben

            Parameters p1a&

            If .hIcon& : Case .hIcon& <> p1a& : DeleteObject .hIcon& : EndIf

                .hIcon& = p1a&
                Case .hAppWin& : TrayIcon(SetIcon,.hAppWin&,1,.hIcon&)
                inc erg%

                CaseOf $  es wurde der Name eines internen Icons angegeben

                Parameters p1b$
                Case .hIcon& : DeleteObject .hIcon&
                .hIcon& = Create(hIcon,p1b$)
                Case .hAppWin& : TrayIcon(SetIcon,.hAppWin&,1,.hIcon&)
                inc erg%
                Otherwise
                MessageBox(ErrMsg$,Parameter-Fehler (Typ),16 + 4096 + 262144)

            EndSelect

        EndIf

        Return erg%

    EndProc

    Proc Tray.SetText

        Tray.SetText( Tooltip$ )
        Par 1 - ToolTip$
        Parameters Txt$
        Declare ErrMsg$, erg% : Clear erg%  0 = Fehler, 1 = Ok
        ErrMsg$ = Tray.SetText benötigt einen (1) Parameter
        Tray.SetText( Tooltip$ )

        If %PCount <> 1

            MessageBox(ErrMsg$,Parameter-Fehler (Anzahl),16 + 4096 + 262144)

        Else

            .Tooltip$ = Txt$
            Case .hAppWin& : TrayIcon(SetText,.hAppWin&,1,.Tooltip$)
            inc erg%

        EndIf

        Return erg%

    EndProc

    Proc Tray.SetIconAndText

        Tray.SetIcon( {Icon$|Icon&}, Tooltip$ )
        Par 1 - IconName$ oder IconHandle&
        Par 2 - ToolTip$
        Declare Typ$, ErrMsg$, erg% : Clear erg%  0 = Fehler, 1 = Ok
        ErrMsg$ = Tray.SetIconAndText benötigt zwei (2) Parameter
        Tray.SetIconAndText( {Icon$|Icon&}, Tooltip$ )

        If %PCount <> 2

            MessageBox(ErrMsg$,Parameter-Fehler (Anzahl),16 + 4096 + 262144)

        Else

            Typ$ = PType$(1)

            Select Left$(Typ$,1)

                CaseOf &  es wurde ein IconHandle angegeben

                Parameters p1a&,p2a$
                erg% = .SetIcon(p1a&)
                Case erg% : erg% = .SetText(p2a$)

                CaseOf $  es wurde der Name eines internen Icons angegeben

                Parameters p1b$,p2b$
                erg% = .SetIcon(p1b$)
                Case erg% : erg% = .SetText(p2b$)
                Otherwise
                MessageBox(ErrMsg$,Parameter-Fehler (Typ),16 + 4096 + 262144)

            EndSelect

        EndIf

        Return erg%

    EndProc

    Proc Tray.Stop

        Declare erg%, h&
        Case .hAppWin& : TrayIcon(Delete,.hAppWin&,1)
        Case .hIcon& : DeleteObject .hIcon&
        .Tray()
        Return 1

    EndProc

    Proc Tray.ShowWindow

        Parameters mode%
        CaseNot .ShowMode% = mode% : ShowWindow(.hAppWin&,mode%)

        If mode%

            External(user32,SetForegroundWindow,.hAppWin&)
            SetActiveWindow(.hAppWin&)

        EndIf

        .ShowMode% = mode%
        Return 1

    EndProc

    Proc Tray.SwitchWindow

        .ShowWindow( 1 - .ShowMode% )
        Return 1

    EndProc

    Proc Tray.Menu

        Declare erg%
        CreateMenu
        AppendMenu %MyMenu_InfoApp,Info
        Separator
        AppendMenu %MyMenu_ExitApp,Beenden
        SetActiveWindow(.hAppWin&)
        erg% = TrackMenu()
        SetMenuItem 0
        Return erg%

    EndProc

    rem -----------------------------------------------------------------------
    rem ------- MAIN ----------------------------------------------------------
    rem -----------------------------------------------------------------------
    Declare appTitle$
    appTitle$ = Par$(0)
    WindowStyle 2 | 4 | 8 | 16 | 512 | 1024
    WindowTitle appTitle$ +  - XProfan v + $ProfVer
    Cls
    Print die linke Maustaste ändert den Fensterstatus
    Print die rechte Maustaste bringt ein Menü (Info=ohne Hauptfenster)
    Print
    Print Wieso wird in diesem Programm das Beenden nicht ausgeführt (Menü).
    Print
    Print Wenn ich das Fenster schliesse, dann klappt es.
    Print
    Print Wo ist hier der Fehler?
    Print
    Print
    Declare oTray#
    oTray# = New(Tray)
    Declare extIcon& : extIcon& = Create(hIcon,c:\windows\system32\moricons.dll,14)

    IfNot oTray#.Start( %hWnd, extIcon&, appTitle$ )  Aufruf mit Handle eines externen Icons

        Das Icon wird durch oTray#.Stop freigegeben

        IfNot oTray#.Start( %hWnd, 0, appTitle$ )  ohne Iconauswahl

            IfNot oTray#.Start( %hWnd, EDITOR, appTitle$ )  Name eines internen Icons

                MessageBox(Programm gestoppt, weil es nicht fehlerfrei arbeitet.,Programm-Abbruch,16 + 4096 + 262144)
                oTray#.Stop()
                Dispose oTray#
                END

            EndIf

            UserMessages 16  wm_close
            Declare ende% : Clear ende%

            WhileNot ende%

                Select TrayIcon(Msg,1)

                     $201:L,$202:l,$203:LL, $204:R,$205:r,$206:RR, $207:M,$208:m,$209:MM

                    CaseOf $201  links

                    oTray#.SwitchWindow()

                    CaseOf $204  rechts

                    Select oTray#.Menu()

                        CaseOf %MyMenu_InfoApp

                        oTray#.ShowWindow( 0 )
                        MessageBox(TrayInfo-Anwendung,Info,0)

                        CaseOf %MyMenu_ExitApp

                        Inc ende%
                        BREAK

                    EndSelect

                EndSelect

                Select %uMessage

                    CaseOf 16

                    Inc ende%
                    BREAK

                EndSelect

                Case ende% : BREAK
                CaseNot ende% : WaitInput
                Print Key:;%Key,
                , MenuItem:;%MenuItem,
                , MWnd:;%MWnd,
                , Message:;%Message
                Print wParam:;&wParam,($;Hex$(&wParam);),
                , lParam:;&lParam,($;Hex$(&lParam);)

            EndWhile

            oTray#.ShowWindow( 1 )
            oTray#.Stop()
            Dispose oTray#
            UserMessages -16  Messages wieder entfernen
            End