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,terminate
    setActiveWindow(hWnd)
    int bVal=trackMenu()
    setMenuitem 0
    return bVal

}

hwnd.showWindow(int fashion){

    ifnot hwnd.showMode==fashion {

        showWindow(hWnd,fashion)

    }

    if fashion {

        setForeGroundWindow(hwnd)
        setActiveWindow(hwnd)

    }

    hwnd.showMode=fashion
    return true

}

REM XProfan v11.0ß s8-NT
Def %MyMenu_InfoApp $1400
Def %MyMenu_ExitApp $1401
Def $DefTooltip (what seek because this Program here?)
Struct TrayData = hAppWin&, hIcon&, ShowMode%, ToolTip$(63)
Class Tray = -TrayData,
+Tray@, +Start@, +Stop@,
+SetIcon@, +SetText@, +SetIconAndText@,
+Menu@,
+ShowWindow@, +SwitchWindow@

Proc Tray.Tray

    Initialisiert whom 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$ or IconHandle& or 0 (zero) (then before: .SetIcon)
    Par 3 - ToolTip$ or  (then before: .SetText)
    (the IconHandle& becomes intern über Tray.Stop away.)
    Declare type$, AppWin&, ErrMsg$, erg% : Clear erg%  0 = Error, 1 = OK
    ErrMsg$ = Tray.Start needed three (3) Parameter
    Tray.Start( hAppWin&, {Icon$|Icon&|0}, {Tooltip$|qq} )

    If %PCount <> 3

        MessageBox(ErrMsg$,Parameter-Error (amount),16 + 4096 + 262144)

    Else

        type$ = PType$(2)

        Select Left$(type$,1)

            CaseOf &  it watts one IconHandle indicated

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

            CaseOf $  it watts the name one internen Icons indicated

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

        EndSelect

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

        If erg%

            Casenote .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$ or IconHandle&
    Declare type$, ErrMsg$, erg% : Clear erg%  0 = Error, 1 = OK
    ErrMsg$ = Tray.SetIcon needed a (1) Parameter
    Tray.SetIcon( {Icon$ | Icon&} )

    If %PCount <> 1

        MessageBox(ErrMsg$,Parameter-Error (amount),16 + 4096 + 262144)

    Else

        type$ = PType$(1)

        Select Left$(type$,1)

            CaseOf &  it watts one IconHandle indicated

            Parameters p1a&

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

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

                CaseOf $  it watts the name one internen Icons indicated

                Parameters p1b$
                Case .hIcon& : DeleteObject .hIcon&
                .hIcon& = Create(hIcon,p1b$)
                Case .hAppWin& : TrayIcon(SetIcon,.hAppWin&,1,.hIcon&)
                inc erg%
                Otherwise
                MessageBox(ErrMsg$,Parameter-Error (type),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 = Error, 1 = OK
        ErrMsg$ = Tray.SetText needed a (1) Parameter
        Tray.SetText( Tooltip$ )

        If %PCount <> 1

            MessageBox(ErrMsg$,Parameter-Error (amount),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$ or IconHandle&
        Par 2 - ToolTip$
        Declare type$, ErrMsg$, erg% : Clear erg%  0 = Error, 1 = OK
        ErrMsg$ = Tray.SetIconAndText needed two (2) Parameter
        Tray.SetIconAndText( {Icon$|Icon&}, Tooltip$ )

        If %PCount <> 2

            MessageBox(ErrMsg$,Parameter-Error (amount),16 + 4096 + 262144)

        Else

            type$ = PType$(1)

            Select Left$(type$,1)

                CaseOf &  it watts one IconHandle indicated

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

                CaseOf $  it watts the name one internen Icons indicated

                Parameters p1b$,p2b$
                erg% = .SetIcon(p1b$)
                Case erg% : erg% = .SetText(p2b$)
                Otherwise
                MessageBox(ErrMsg$,Parameter-Error (type),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 fashion%
        Casenote .ShowMode% = fashion% : ShowWindow(.hAppWin&,fashion%)

        If fashion%

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

        EndIf

        .ShowMode% = fashion%
        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,terminate
        SetActiveWindow(.hAppWin&)
        erg% = TrackMenu()
        SetMenuItem 0
        Return erg%

    ENDPROC

    rem -----------------------------------------------------------------------
    rem ------- MAIN ----------------------------------------------------------
    rem -----------------------------------------------------------------------
    Declare appTitle$
    appTitle$ = Par$(0)
    Window Style 2 | 4 | 8 | 16 | 512 | 1024
    Window Title appTitle$ +  - XProfan v + $ProfVer
    Cls
    Print The left Mouse button ändert whom Fensterstatus
    Print The rights Mouse button bring one Menu (Info=without Mainwindow)
    Print
    Print Why becomes in this Program the terminate not carryed out (Menu).
    Print
    Print If I the Window close, then works it.
    Print
    Print where is here the Error?
    Print
    Print
    Declare oTray#
    oTray# = New(Tray)
    Declare extIcon& : extIcon& = Create(hIcon,c:\windows\system32\moricons.dll,14)

    Ifnot oTray#.Start( %hWnd, extIcon&, appTitle$ )  appeal with lever one external Icons

        the Icon becomes through oTray#.Stop released

        Ifnot oTray#.Start( %hWnd, 0, appTitle$ )  without Iconauswahl

            Ifnot oTray#.Start( %hWnd, EDITOR, appTitle$ )  name one internen Icons

                MessageBox(Program gestoppt, because it not fehlerfrei operates.,Program-discontinue,16 + 4096 + 262144)
                oTray#.Stop()
                Dispose oTray#
                END

            EndIf

            User Messages 16  wm_close
            Declare end% : Clear end%

            WhileNot end%

                Select TrayIcon(Msg,1)

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

                    CaseOf $201  left

                    oTray#.SwitchWindow()

                    CaseOf $204  right

                    Select oTray#.Menu()

                        CaseOf %MyMenu_InfoApp

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

                        CaseOf %MyMenu_ExitApp

                        Inc end%
                        BREAK

                    EndSelect

                EndSelect

                Select %uMessage

                    CaseOf 16

                    Inc end%
                    BREAK

                EndSelect

                Case end% : BREAK
                Casenote end% : 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#
            User Messages -16  Messages again Remove
            End