XProfan

 {$cleq}
Declarar WndClass#
Declarar FrameClass#
Declarar ClientCreateStruct#
Declarar Msg#
Declarar hWndFrame&
Declarar hWndClient&
Declarar hMenu&
Declarar hPopupMenu&
Declarar mdiChild&
Struct TWindowClass = ~WNDCLASS
Struct TMsg = ~MSG
Struct TClientCreateStruct = ~CLIENTCREATESTRUCT
Dim Msg#,TMsg
Var FrameClass$      = "MDIFRAME"
Var FrameName$       = "MDI-Anwendung"
Var MDIClientClass$  = "MDICLIENT"
Var MDIChildClass$   = "MDICHILD"
Var MDIChildName$    = "CHILD"
Var ChildUp&         = 2000
Var Expediente$           = "&Datei"
Var Neu$             = "&Neu"
var Beenden$         = "&Beenden"
'****************************************************************************************

Proc Menu

    hMenu&      =  ~CreateMenu()
    hPopupMenu& = ~CreateMenu()
    ~AppendMenu(hPopupMenu&,~MF_POPUP,101,Addr(Neu$))
    ~AppendMenu(hPopupMenu&,~MF_POPUP,102,Addr(Beenden$))
    ~AppendMenu(hMenu&,~MF_POPUP, hPopupMenu&, Addr(Expediente$))

ENDPROC

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

Proc WinMain

    Dim 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#)
    Disponer FrameClass#
    Dim 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#)
    Disponer 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&)
    Dim 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#)

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

        ~TranslateMessage(Msg#)

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

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

        endif

        ~DispatchMessage(Msg#)

    EndWhile

    Volver 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

    Parámetros Wnd&, Message&, wParam&, lParam&
    global hWndClient&

    If Message& = ~WM_COMMAND

        If 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

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

ENDPROC

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

nProc MDIChildProc

    Parámetros Wnd&,Message&, wParam&, lParam&
    global hWndClient&

    If Message& = ~WM_CLOSE

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

    Más

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

    EndIf

ENDPROC

'****************************************************************************************
WinMain
Disponer Msg#
Disponer ClientCreateStruct#