$ filename "SimpleMDI.exe"
uses rtl32
'uses rtl64
'winutil.inc
% InMessageLoop
sys hMDIClient=null 'must be declared before using the macro
sys hAccel 'must be declared before using the macro
macro InMessageLoop 'must be declared before including winutil.inc
'must use MSG structure of winutil.inc
if not TranslateMDISysAccel(hMDIClient, &wm) then
if TranslateAccelerator( hWnd, hAccel, @wm ) = 0 then
TranslateMessage(&wm)
DispatchMessage(&wm)
end if
end if
end macro
'% review 'Dialogs.inc, when using console
uses winutil
uses dialogs
'namespace
# autodim off
'additional constants
% COLOR_3DFACE = 15
% MDIS_ALLCHILDSTYLES = 1
% MDITILE_VERTICAL=0
% MDITILE_HORIZONTAL=1
% WM_MDICREATE = 544
% WM_MDIDESTROY=545
% WM_MDITILE = 550
% WM_MDICASCADE = 551
% WM_MDIICONARRANGE=552
% WM_MDIGETACTIVE = 553
type CLIENTCREATESTRUCT
sys hWindowMenu
uint idFirstChild
end type
type MDICREATESTRUCT
sys szClass
sys szTitle
sys hOwner
int x
int y
int cx
int cy
dword style
sys lParam
end type
'Menu IDs
#define IDM_NEW 1000
#define IDM_CLOSE 1001
#define IDM_EXIT 1002
#define IDM_CASCADE 1003
#define IDM_TILEHORZ 1004
#define IDM_TILEVERT 1005
#define IDM_ARRANGE 1006
% ID_MDI_FIRSTCHILD = 2000
string MDICHILDCLASS = "MdiChild"
declare sub SetupMenu(sys hWnd)
declare function SetUpMDIChildWindowClass() as bool
declare function CreateNewMDIChild(sys hMDIClient) as sys
sys hInstance=inst 'Winutil.inc
dyn::init_common_controls(0x00ff) 'Dialogs.inc, ICC_WIN95_CLASSES
'winutil.inc
MainWindow 480, 320,WS_OVERLAPPEDWINDOW
function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
select uMsg
case WM_CREATE
SetupMenu(hwnd)
SendMessage(hWnd, WM_SETTEXT, 0, "Simple MDI Demo")
'Register Child Window Class
if not SetUpMDIChildWindowClass() then
return 0
end if
CLIENTCREATESTRUCT ccs
' Create MDI Client
' Find window menu where children will be listed
ccs.hWindowMenu = GetSubMenu(GetMenu(hwnd), 1)
ccs.idFirstChild = ID_MDI_FIRSTCHILD
hMDIClient = CreateWindowEx(WS_EX_CLIENTEDGE, "mdiclient", null,
WS_CHILD or WS_VSCROLL or WS_HSCROLL or WS_VISIBLE,
0,0,0,0,
hwnd, 0, hInstance, &ccs)
if hMDIClient = null then
MessageBox(hwnd, "Could not create MDI client.", "Error", MB_OK or MB_ICONERROR)
end if
case WM_COMMAND
select loword(wParam)
case IDM_EXIT
PostMessage(hwnd, WM_CLOSE, 0, 0)
case IDM_NEW
CreateNewMDIChild(hMDIClient)
case IDM_CLOSE
sys hChild = SendMessage(hMDIClient, WM_MDIGETACTIVE,0,0)
if hChild then
SendMessage(hChild, WM_CLOSE, 0, 0)
SendMessage(hChild, WM_MDIDESTROY, 0, 0)
end if
case IDM_TILEHORZ
SendMessage(hMDIClient, WM_MDITILE, MDITILE_HORIZONTAL, 0)
case IDM_TILEVERT
SendMessage(hMDIClient, WM_MDITILE, MDITILE_VERTICAL, 0)
case IDM_CASCADE
SendMessage(hMDIClient, WM_MDICASCADE, 0, 0)
case IDM_ARRANGE
SendMessage(hMDIClient, WM_MDIICONARRANGE, 0, 0)
case else
if loword(wParam) >= ID_MDI_FIRSTCHILD then
DefFrameProc(hwnd, hMDIClient, WM_COMMAND, wParam, lParam)
else
sys hChild = SendMessage(hMDIClient, WM_MDIGETACTIVE,0,0)
if hChild then
SendMessage(hChild, WM_COMMAND, wParam, lParam)
end if
end if
end select
case WM_CLOSE
DestroyAcceleratorTable( hAccel )
DestroyWindow(hwnd)
case WM_DESTROY
PostQuitMessage(0)
case else
return DefFrameProc(hwnd, hMDIClient, uMsg, wParam, lParam)
end select
return 0
end function
function SetUpMDIChildWindowClass() as bool
'Register Child Window Class
WNDCLASSEX wc
'fill only necessary items
wc.cbSize = sizeof(WNDCLASSEX)
wc.lpfnWndProc = @MDIChildWndProc
wc.hbrBackground = COLOR_3DFACE+1
wc.lpszClassName = strptr "MdiChild" 'strptr(MDICHILDCLASS)
if not RegisterClassEx(&wc) then
MessageBox(0, "Could Not Register Child Window", "Oh Oh...",
MB_ICONEXCLAMATION or MB_OK)
return FALSE
else
return TRUE
end if
end function
function CreateNewMDIChild(sys hMDIClient) as sys
MDICREATESTRUCT mcs
sys hChild
string text, num
static int untitled
untitled+=1 : num=str(untitled) : if untitled<10 then num="0" & num
text="Untitled " & num
mcs.szTitle = strptr text
mcs.szClass = strptr"MdiChild"
mcs.hOwner = hInstance
mcs.x = mcs.cx = CW_USEDEFAULT
mcs.y = mcs.cy = CW_USEDEFAULT
mcs.style = MDIS_ALLCHILDSTYLES
hChild = SendMessage(hMDIClient, WM_MDICREATE, 0, &mcs)
if not hChild then
MessageBox(hMDIClient, "MDI Child creation failed.", "Oh Oh...",
MB_ICONEXCLAMATION or MB_OK)
end if
return hChild
end function
function MDIChildWndProc(sys hwnd, msg, wParam, lParam) as sys callback
return DefMDIChildProc(hwnd, msg, wParam, lParam)
end function
====================================
sub SetupMenu(sys hWnd)
sys hMenu
MENU(hMenu)
POPUP "&File"
BEGIN
MENUITEM "&New" tab "Ctrl-N", IDM_NEW
MENUITEM "&Close", IDM_CLOSE
MENUITEM "SEPARATOR"
MENUITEM "E&xit" tab "ALT-F4",IDM_EXIT
ENDMenu
POPUP "&Window"
BEGIN
MENUITEM "&Cascade", IDM_CASCADE
MENUITEM "Tile &horizontal", IDM_TILEHORZ
MENUITEM "Tile &vertical", IDM_TILEVERT
MENUITEM "&Arrange Icons", IDM_ARRANGE
ENDMenu
if SetMenu( hWnd, hMenu ) = 0 then
mbox "SetMenu hMenu failed!"
end if
'Accelerators
indexbase 0
ACCEL accl[0] = {
{FVIRTKEY | FCONTROL, asc("N"), IDM_NEW }
}
hAccel = CreateAcceleratorTable( @accl, 1 )
end sub