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(falso)
moveWindow(hwnd,(maxx/2-d_hwndSizeX/2),(maxy*0.4-d_hwndSizeY/2),d_hwndSizeX,d_hwndSizeY,falso)
long tray.iconH=tray.init()
mensajes de los usuarios wm_close

do {

    seleccionar TrayIcon(msg,1)

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

        caseof WM_RBUTTONDOWN

        seleccionar tray.trackMenu()

            caseof m_tray_TrackMenu_exitApp : romper

        EndSelect

    EndSelect

    seleccionar uMessage

        caseof wm_close : hwnd.showWindow(falso)

    EndSelect

    waitinput

}

tray.close(tray.iconH)
end

tray.init{

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

}

tray.close(long h){

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

}

tray.trackMenu{

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

}

hwnd.showWindow(int mode){

    ifnot hwnd.showMode==mode {

        showWindow(hWnd,mode)

    }

    if mode {

        setForeGroundWindow(hwnd)
        setActiveWindow(hwnd)

    }

    hwnd.showMode=mode
    volver true

}

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

Proc Tray.Tray

    Initialisiert el Datenbereich
    .ShowMode% = 1 : .hAppWin& = 0 : .hIcon& = 0 : .ToolTip$ = $DefTooltip
    Volver 1

ENDPROC

Proc Tray.Start

    Tray.Start(hAppWin&,{Icon$|Icon&|0},{Tooltip$|})
    Par 1 - hAppWin&
    Par 2 - IconName$ oder IconHandle& oder 0 (Null) (entonces vorher: .SetIcon)
    Par 3 - ToolTip$ oder  (entonces vorher: .SetText)
    (Das IconHandle& se intern über Tray.Stop lejos.)
    Declarar Typ$, AppWin&, ErrMsg$, erg% : Claro erg%  0 = Fehler, 1 = Ok
    ErrMsg$ = Tray.Start benötigt drei (3) Parámetro
    Tray.Start( hAppWin&, {Icon$|Icon&|0}, {Tooltip$|qq} )

    If %PCount <> 3

        MessageBox(ErrMsg$,Parámetro-Fehler (Anzahl),16 + 4096 + 262144)

    Más

        Typ$ = PType$(2)

        Select Left$(Typ$,1)

            CaseOf &  lo wurde una IconHandle angegeben

            Parámetros p1a&,p2a&,p3a$
            AppWin& = p1a& : erg% = .SetIconAndText(p2a&,p3a$)

            CaseOf $  lo wurde el Name uno internen Icons angegeben

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

        EndSelect

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

        If erg%

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

        EndIf

    EndIf

    Volver erg%

ENDPROC

Proc Tray.SetIcon

    Tray.SetIcon( {Icon$|Icon&} )
    Par 1 - IconName$ oder IconHandle&
    Declarar Typ$, ErrMsg$, erg% : Claro erg%  0 = Fehler, 1 = Ok
    ErrMsg$ = Tray.SetIcon benötigt una (1) Parámetro
    Tray.SetIcon( {Icon$ | Icon&} )

    If %PCount <> 1

        MessageBox(ErrMsg$,Parámetro-Fehler (Anzahl),16 + 4096 + 262144)

    Más

        Typ$ = PType$(1)

        Select Left$(Typ$,1)

            CaseOf &  lo wurde una IconHandle angegeben

            Parámetros p1a&

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

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

                CaseOf $  lo wurde el Name uno internen Icons angegeben

                Parámetros p1b$
                Case .hIcon& : DeleteObject .hIcon&
                .hIcon& = Crear(hIcon,p1b$)
                Case .hAppWin& : TrayIcon(SetIcon,.hAppWin&,1,.hIcon&)
                inc erg%
                Otherwise
                MessageBox(ErrMsg$,Parámetro-Fehler (Typ),16 + 4096 + 262144)

            EndSelect

        EndIf

        Volver erg%

    ENDPROC

    Proc Tray.SetText

        Tray.SetText( Tooltip$ )
        Par 1 - ToolTip$
        Parámetros Txt$
        Declarar ErrMsg$, erg% : Claro erg%  0 = Fehler, 1 = Ok
        ErrMsg$ = Tray.SetText benötigt una (1) Parámetro
        Tray.SetText( Tooltip$ )

        If %PCount <> 1

            MessageBox(ErrMsg$,Parámetro-Fehler (Anzahl),16 + 4096 + 262144)

        Más

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

        EndIf

        Volver erg%

    ENDPROC

    Proc Tray.SetIconAndText

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

        If %PCount <> 2

            MessageBox(ErrMsg$,Parámetro-Fehler (Anzahl),16 + 4096 + 262144)

        Más

            Typ$ = PType$(1)

            Select Left$(Typ$,1)

                CaseOf &  lo wurde una IconHandle angegeben

                Parámetros p1a&,p2a$
                erg% = .SetIcon(p1a&)
                Case erg% : erg% = .SetText(p2a$)

                CaseOf $  lo wurde el Name uno internen Icons angegeben

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

            EndSelect

        EndIf

        Volver erg%

    ENDPROC

    Proc Tray.Stop

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

    ENDPROC

    Proc Tray.ShowWindow

        Parámetros mode%
        Casenote .ShowMode% = mode% : ShowWindow(.hAppWin&,mode%)

        If mode%

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

        EndIf

        .ShowMode% = mode%
        Volver 1

    ENDPROC

    Proc Tray.SwitchWindow

        .ShowWindow( 1 - .ShowMode% )
        Volver 1

    ENDPROC

    Proc Tray.Menu

        Declarar erg%
        CreateMenu
        AppendMenu %MyMenu_InfoApp,Info
        Separador
        AppendMenu %MyMenu_ExitApp,Beenden
        SetActiveWindow(.hAppWin&)
        erg% = TrackMenu()
        SetMenuItem 0
        Volver erg%

    ENDPROC

    rem -----------------------------------------------------------------------
    rem ------- MAIN ----------------------------------------------------------
    rem -----------------------------------------------------------------------
    Declarar appTitle$
    appTitle$ = Par$(0)
    Ventana de Estilo 2 | 4 | 8 | 16 | 512 | 1024
    Título de la ventana appTitle$ +  - XProfan v + $ProfVer
    Cls
    Imprimir el linke Botón del ratón ändert el Fensterstatus
    Imprimir el rechte Botón del ratón bringt una Menü (Info=sin Ventana principal)
    Imprimir
    Imprimir ¿Por qué se en diesem Programa el Beenden no ausgeführt (Menü).
    Imprimir
    Imprimir Wenn Yo el Ventana schliesse, entonces klappt lo.
    Imprimir
    Imprimir Wo es hier el Fehler?
    Imprimir
    Imprimir
    Declarar oTray#
    oTray# = New(Tray)
    Declarar extIcon& : extIcon& = Crear(hIcon,c:\windows\system32\moricons.dll,14)

    Caso negativo oTray#.Start( %hWnd, extIcon&, appTitle$ )  Aufruf con Handle uno externo Icons

        Das Icon se por oTray#.Stop freigegeben

        Caso negativo oTray#.Start( %hWnd, 0, appTitle$ )  sin Iconauswahl

            Caso negativo oTray#.Start( %hWnd, EDITOR, appTitle$ )  Name uno internen Icons

                MessageBox(Programa gestoppt, porque lo no fehlerfrei arbeitet.,Programa-Abbruch,16 + 4096 + 262144)
                oTray#.Stop()
                Disponer oTray#
                FIN

            EndIf

            Mensajes del usuario 16  wm_close
            Declarar ende% : Claro ende%

            Sinestar encargado 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
                Casenote ende% : WaitInput
                Imprimir Key:;%Key,
                , MenuItem:;%MenuItem,
                , MWnd:;%MWnd,
                , Message:;%Message
                Imprimir wParam:;&wParam,($;Hex$(&wParam);),
                , lParam:;&lParam,($;Hex$(&lParam);)

            EndWhile

            oTray#.ShowWindow( 1 )
            oTray#.Stop()
            Disponer oTray#
            Mensajes del usuario -16  Messages otra vez entfernen
            End