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(faux)
moveWindow(hwnd,(maxx/2-d_hwndSizeX/2),(maxy*0.4-d_hwndSizeY/2),d_hwndSizeX,d_hwndSizeY,faux)
long tray.iconH=tray.init()
messages de l'utilisateur wm_close

do {

    sélectionner TrayIcon(msg,1)

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

        caseof WM_RBUTTONDOWN

        sélectionner tray.trackMenu()

            caseof m_tray_TrackMenu_exitApp : pause

        EndSelect

    EndSelect

    sélectionner uMessage

        caseof wm_close : hwnd.showWindow(faux)

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

}

hwnd.showWindow(int mode){

    ifnot hwnd.showMode==mode {

        showWindow(hWnd,mode)

    }

    si mode {

        setForeGroundWindow(hwnd)
        setActiveWindow(hwnd)

    }

    hwnd.showMode=mode
    return vrai

}

REM XProfan v11.0ß S8-NT
Def %MyMenu_InfoApp $1400
Def %MyMenu_ExitApp $1401
Def $DefTooltip (quoi cherchez car cet Programme ici?)
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
    Retour 1

ENDPROC

Proc Tray.Start

    Tray.Start(hAppWin&,{Icon$|Icon&|0},{Tooltip$|})
    Par 1 - hAppWin&
    Par 2 - IconName$ ou bien IconHandle& ou bien 0 (zéro) (ensuite auparavant: .SetIcon)
    Par 3 - ToolTip$ ou bien  (ensuite auparavant: .SetText)
    (cela IconHandle& wird interne über Tray.Stop entfernt.)
    Déclarer Typ$, AppWin&, ErrMsg$, erg% : Claire erg%  0 = faute, 1 = Ok
    ErrMsg$ = Tray.Start nécessaire trois (3) paramètre
    Tray.Start( hAppWin&, {Icon$|Icon&|0}, {Tooltip$|qq} )

    Si %PCount <> 3

        MessageBox(ErrMsg$,paramètre-faute (Anzahl),16 + 4096 + 262144)

    D'autre

        Typ$ = PType$(2)

        Select Left $(Typ$,1)

            CaseOf &  es wurde un IconHandle angegeben

            Paramètres p1a&,p2a&,p3a$
            AppWin& = p1a& : erg% = .SetIconAndText(p2a&,p3a$)

            CaseOf $  es wurde qui nom eines internen Icônes angegeben

            Paramètres p1b&,p2b$,p3b$
            AppWin& = p1b& : erg% = .SetIconAndText(p2b$,p3b$)
            Otherwise
            MessageBox(ErrMsg$,paramètre-faute (Typ),16 + 4096 + 262144)

        EndSelect

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

        Si erg%

            Casenote .hIcon& : .hIcon& = Créer(hIcon,A)
            Cas .Tooltip$ =  : .ToolTip$ = $DefTooltip
            TrayIcon(Ajouter,.hAppWin&,1,.hIcon&,.ToolTip$)

        EndIf

    EndIf

    Retour erg%

ENDPROC

Proc Tray.SetIcon

    Tray.SetIcon( {Icon$|Icon&} )
    Par 1 - IconName$ ou bien IconHandle&
    Déclarer Typ$, ErrMsg$, erg% : Claire erg%  0 = faute, 1 = Ok
    ErrMsg$ = Tray.SetIcon nécessaire une (1) paramètre
    Tray.SetIcon( {Icon$ | Icon&} )

    Si %PCount <> 1

        MessageBox(ErrMsg$,paramètre-faute (Anzahl),16 + 4096 + 262144)

    D'autre

        Typ$ = PType$(1)

        Select Left $(Typ$,1)

            CaseOf &  es wurde un IconHandle angegeben

            Paramètres p1a&

            Si .hIcon& : Cas .hIcon& <> p1a& : DeleteObject .hIcon& : EndIf

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

                CaseOf $  es wurde qui nom eines internen Icônes angegeben

                Paramètres p1b$
                Cas .hIcon& : DeleteObject .hIcon&
                .hIcon& = Créer(hIcon,p1b$)
                Cas .hAppWin& : TrayIcon(SetIcon,.hAppWin&,1,.hIcon&)
                inc erg%
                Otherwise
                MessageBox(ErrMsg$,paramètre-faute (Typ),16 + 4096 + 262144)

            EndSelect

        EndIf

        Retour erg%

    ENDPROC

    Proc Tray.SetText

        Tray.SetText( Tooltip$ )
        Par 1 - ToolTip$
        Paramètres Txt$
        Déclarer ErrMsg$, erg% : Claire erg%  0 = faute, 1 = Ok
        ErrMsg$ = Tray.SetText nécessaire une (1) paramètre
        Tray.SetText( Tooltip$ )

        Si %PCount <> 1

            MessageBox(ErrMsg$,paramètre-faute (Anzahl),16 + 4096 + 262144)

        D'autre

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

        EndIf

        Retour erg%

    ENDPROC

    Proc Tray.SetIconAndText

        Tray.SetIcon( {Icon$|Icon&}, Tooltip$ )
        Par 1 - IconName$ ou bien IconHandle&
        Par 2 - ToolTip$
        Déclarer Typ$, ErrMsg$, erg% : Claire erg%  0 = faute, 1 = Ok
        ErrMsg$ = Tray.SetIconAndText nécessaire deux (2) paramètre
        Tray.SetIconAndText( {Icon$|Icon&}, Tooltip$ )

        Si %PCount <> 2

            MessageBox(ErrMsg$,paramètre-faute (Anzahl),16 + 4096 + 262144)

        D'autre

            Typ$ = PType$(1)

            Select Left $(Typ$,1)

                CaseOf &  es wurde un IconHandle angegeben

                Paramètres p1a&,p2a$
                erg% = .SetIcon(p1a&)
                Cas erg% : erg% = .SetText(p2a$)

                CaseOf $  es wurde qui nom eines internen Icônes angegeben

                Paramètres p1b$,p2b$
                erg% = .SetIcon(p1b$)
                Cas erg% : erg% = .SetText(p2b$)
                Otherwise
                MessageBox(ErrMsg$,paramètre-faute (Typ),16 + 4096 + 262144)

            EndSelect

        EndIf

        Retour erg%

    ENDPROC

    Proc Tray.Stop

        Déclarer erg%, h&
        Cas .hAppWin& : TrayIcon(Delete,.hAppWin&,1)
        Cas .hIcon& : DeleteObject .hIcon&
        .Tray()
        Retour 1

    ENDPROC

    Proc Tray.ShowWindow

        Paramètres mode%
        Casenote .ShowMode% = mode% : ShowWindow(.hAppWin&,mode%)

        Si mode%

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

        EndIf

        .ShowMode% = mode%
        Retour 1

    ENDPROC

    Proc Tray.SwitchWindow

        .ShowWindow( 1 - .ShowMode% )
        Retour 1

    ENDPROC

    Proc Tray.Menu

        Déclarer erg%
        CreateMenu
        AppendMenu %MyMenu_InfoApp,Info
        Séparateur
        AppendMenu %MyMenu_ExitApp,finissons
        SetActiveWindow(.hAppWin&)
        erg% = TrackMenu()
        SetMenuItem 0
        Retour erg%

    ENDPROC

    rem -----------------------------------------------------------------------
    rem ------- MAIN ----------------------------------------------------------
    rem -----------------------------------------------------------------------
    Déclarer appTitle$
    appTitle$ = Par$(0)
    Fenêtre Style 2 | 4 | 8 | 16 | 512 | 1024
    Titre de la fenêtre appTitle$ +  - XProfan v + $ProfVer
    Cls
    Imprimer qui linke Bouton de la souris ändert den Fensterstatus
    Imprimer qui rechte Bouton de la souris bringt un menu (Info=sans Hauptfenster)
    Imprimer
    Imprimer Pourquoi wird dans diesem Programme cela finissons pas fonctionnement (menu).
    Imprimer
    Imprimer si je cela la fenêtre schliesse, ensuite klappt es.
    Imprimer
    Imprimer wohin ist ici qui faute?
    Imprimer
    Imprimer
    Déclarer oTray#
    oTray# = New(Tray)
    Déclarer extIcon& : extIcon& = Créer(hIcon,c:\windows\system32\moricons.dll,14)

    Si non oTray#.Start( %hWnd, extIcon&, appTitle$ )  Aufruf avec Handle eines externe Icônes

        cela Icon wird par oTray#.Stop freigegeben

        Si non oTray#.Start( %hWnd, 0, appTitle$ )  sans Iconauswahl

            Si non oTray#.Start( %hWnd, EDITOR, appTitle$ )  nom eines internen Icônes

                MessageBox(Programme gestoppt, weil es pas correct arbeitet.,Programme-Abbruch,16 + 4096 + 262144)
                oTray#.Stop()
                Dispose oTray#
                FIN

            EndIf

            Utilisateur Messages 16  wm_close
            Déclarer ende% : Claire 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  à gauche

                    oTray#.SwitchWindow()

                    CaseOf $204  à droite

                    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

                Cas ende% : BREAK
                Casenote ende% : WaitInput
                Imprimer Key:;%Key,
                , MenuItem:;%MenuItem,
                , MWnd:;%MWnd,
                , Message:;%Message
                Imprimer wParam:;&wParam,($;Hex$(&wParam);),
                , lParam:;&lParam,($;Hex$(&lParam);)

            Endwhile

            oTray#.ShowWindow( 1 )
            oTray#.Stop()
            Dispose oTray#
            Utilisateur Messages -16  Messages wieder entfernen
            Fin