XProfan

 {$cleq}
Déclarer WndClass#
Déclarer FrameClass#
Déclarer ClientCreateStruct#
Déclarer Msg#
Déclarer hWndFrame&
Déclarer hWndClient&
Déclarer hMenu&
Déclarer hPopupMenu&
Déclarer mdiChild&
Struct TWindowClass = ~WNDCLASS
Struct TMsg = ~MSG
Struct TClientCreateStruct = ~CLIENTCREATESTRUCT
Faible Msg#,TMsg
Var FrameClass$      = "MDIFRAME"
Var FrameName$       = "MDI-Anwendung"
Var MDIClientClass$  = "MDICLIENT"
Var MDIChildClass$   = "MDICHILD"
Var MDIChildName$    = "CHILD"
Var ChildUp&         = 2000
Var Dossier$           = "&Datei"
Var récente$             = "&Neu"
var finissons$         = "& Quitter"
'****************************************************************************************

Proc Menu

    hMenu&      =  ~CreateMenu()
    hPopupMenu& = ~CreateMenu()
    ~AppendMenu(hPopupMenu&,~MF_POPUP,101,Addr(récente$))
    ~AppendMenu(hPopupMenu&,~MF_POPUP,102,Addr(finissons$))
    ~AppendMenu(hMenu&,~MF_POPUP, hPopupMenu&, Addr(Dossier$))

ENDPROC

'****************************************************************************************

Proc WinMain

    Faible FrameClass#,TWindowClass

    With FrameClass#

        .style&          = ~CS_HREDRAW | ~CS_VREDRAW
        .lpfnWndProc&    = ProcAddr(FrameWndProc,4)
        .cbClsExtra&     = 0
        .cbWndExtra&     = 0
        .hInstance&      = %hInstance
        .hIcon&          = ~LoadIcon(0,~IDI_Winlogo)
        .hCursor&        = ~LoadCursor(0, ~IDC_ARROW)
        .hbrBackground&  = ~createsolidbrush(~getSysColor(4))
        .lpszMenuName&   = 0
        .lpszClassName&  = Addr(FrameClass$)

    EndWith

    ~RegisterClass(FrameClass#)
    Dispose FrameClass#
    Faible WndClass#,TWindowClass

    With WndClass#

        .style&          = ~CS_HREDRAW | ~CS_VREDRAW
        .lpfnWndProc&    = ProcAddr(MDIChildProc,4)
        .cbClsExtra&     = 0
        .cbWndExtra&     = 0
        .hInstance&      = %hInstance
        .hIcon&          = 0
        .hCursor&        = ~LoadCursor(0, ~IDC_ARROW)
        .hbrBackground&  = ~createsolidbrush(~getSysColor(0))
        .lpszMenuName&   = 0
        .lpszClassName&  = Addr(MDIChildClass$)

    EndWith

    ~RegisterClass(WndClass#)
    Dispose WndClass#
    hWndFrame& = ~CreateWindowEx(                                                         \
    0,                                                                    \
    Addr(FrameClass$),                                                    \
    Addr(FrameName$),                                                     \
    ~WS_CAPTION | ~WS_MINIMIZEBOX | ~WS_SYSMENU | ~WS_CLIPCHILDREN |      \
    ~WS_VISIBLE,      \
    200,                                                                  \
    100,                                                                  \
    698,                                                                  \
    542,                                                                  \
    0,                                                                    \
    0,                                                                    \
    %hInstance,                                                           \
    0)
    Menu
    ~SetMenu(hWndFrame&,hMenu&)
    Faible ClientCreateStruct#,TClientCreateStruct

    With ClientCreateStruct#

        .hWindowMenu&   = ~GetSubMenu(~GetMenu(hWndFrame&),1)
        .idFirstChild&  = ChildUp&

    EndWith

    hWndClient& = ~CreateWindowEx(                                                        \
    ~WS_EX_CLIENTEDGE,                                                   \
    Addr(MDIClientClass$),                                               \
    0,                                                                   \
    ~WS_CHILD | ~WS_CLIPCHILDREN | ~WS_CLIPSIBLINGS | ~WS_VISIBLE |      \
    ~MDIS_ALLCHILDSTYLES,      \
    0,                                                                   \
    0,                                                                   \
    700,                                                                 \
    500,                                                                 \
    hWndFrame&,                                                          \
    0,                                                                   \
    %hInstance,                                                          \
    ClientCreateStruct#)

    Tandis que ~GetMessage(Msg#, 0, 0, 0) > 0

        ~TranslateMessage(Msg#)

        si (long(msg#,4)=wm_user+1)

            cas (long(msg#,12)=1) : newWindow()

        endif

        ~DispatchMessage(Msg#)

    Endwhile

    Retour Msg#.wParam&

ENDPROC

'****************************************************************************************

Proc NewWindow

    mdiChild& = ~CreateMDIWindow(                                                         \
    Addr(MDIChildClass$),                                                  \
    Addr(MDIChildname$),                                                   \
    ~WS_CAPTION | ~WS_MINIMIZEBOX | ~WS_SYSMENU | ~WS_VISIBLE,             \
    40,                                                                    \
    40,                                                                    \
    300,                                                                   \
    200,                                                                   \
    hwndclient&,                                                           \
    %HINSTANCE,                                                            \
    0)

ENDPROC

'****************************************************************************************

nProc FrameWndProc

    Paramètres Wnd&, Message&, wParam&, lParam&
    global hWndClient&

    Si Message& = ~WM_COMMAND

        Si wParam& = 101

            postMessage(Wnd&,wm_user+1,0,1)

        ElseIf wParam& = 102

            SendMessage(hWndClient&,~WM_MDIGETACTIVE,0,0)
            SendMessage(Wnd&,~WM_CLOSE,0,0)

        EndIf

    ElseIf Message& = ~WM_CLOSE

    ElseIf Message& = ~WM_DESTROY

        ~PostQuitMessage(0)

    EndIf

    Retour ~DefFrameProc(Wnd&, hWndClient&, Message&, wParam&, lParam&)

ENDPROC

'****************************************************************************************

nProc MDIChildProc

    Paramètres Wnd&,Message&, wParam&, lParam&
    global hWndClient&

    Si Message& = ~WM_CLOSE

        SendMessage(hWndClient&,~WM_MDIDESTROY,Wnd&,0)

    D'autre

        Retour ~DefMDIChildProc(Wnd&, Message&, wParam&, lParam&)

    EndIf

ENDPROC

'****************************************************************************************
WinMain
Dispose Msg#
Dispose ClientCreateStruct#