Perhaps Somebody can Help to build a running mdi example with my example . I have Mixed two examples for it. Main Part based on petzolds mdi example... You can Compile example. The Window frame Works. Not more. The menu I have included but Menu Files are still without function..
Code: Select all
.' test mdi demo, part one, loewenherz, 30-10-2024
' freebasic, petzold mdi example as basis
' mixing two mdi examples, but how does petzold example works correct?
'
#Include "windows.bi"
#include once "crt.bi"
Const FILE_EXIT = 1001
type HELLODATA
as UINT iColor
as COLORREF clrText
end type
type PHELLODATA as HELLODATA ptr
'' structure for storing data unique to each Rect child window
type RECTDATA
as short cxClient
as short cyClient
end type
type PRECTDATA as RECTDATA ptr
'' global variables
dim shared as string szAppName
szAppName = "MDIDemo"
dim shared as string szFrameClass
szFrameClass = "MdiFrame"
dim shared as string szHelloClass
szHelloClass = "MdiHelloChild"
dim shared as string szRectClass
szRectClass = "MdiRectChild"
dim shared as HINSTANCE hInst
dim shared as HMENU hMenuInit, hMenuHello, hMenuRect
dim shared as HMENU hMenuInitWindow, hMenuHelloWindow, hMenuRectWindow
#define IDM_FILE_NEWHELLO 40001
#define IDM_FILE_NEWRECT 40002
#define IDM_APP_EXIT 40003
#define IDM_FILE_CLOSE 40004
#define IDM_COLOR_BLACK 40005
#define IDM_COLOR_RED 40006
#define IDM_COLOR_GREEN 40007
#define IDM_COLOR_BLUE 40008
#define IDM_COLOR_WHITE 40009
#define IDM_WINDOW_CASCADE 40010
#define IDM_WINDOW_TILE 40011
#define IDM_WINDOW_ARRANGE 40012
#define IDM_WINDOW_CLOSEALL 40013
Const FILE_EXIT = 1001
Dim As MSG msg
Dim shared As HWND hWnd, hMDIClient, hwMDI
Dim wc As wndclassex
#define INIT_MENU_POS 0
#define HELLO_MENU_POS 2
#define RECT_MENU_POS 1
#define IDM_FIRSTCHILD 50000
Declare function WndProc(hDlg as hwnd,Msg as uint,wparam as wparam,lparam as lparam) as Integer
Declare function ChildWndProc(hDlg as hwnd,Msg as uint,wparam as wparam,lparam as lparam) as Integer
declare function HelloWndProc (byval hwnd as HWND, byval message as UINT, _
byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
Declare function CloseEnumProc (byval hwnd as HWND, byval lParam as LPARAM) as BOOL
Declare function RectWndProc (byval hwnd as HWND, byval message as UINT, _
byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
With wc
.cbSize = SIZEOF( WNDCLASSEX )
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = NULL
.cbWndExtra = NULL
.hInstance =GetModuleHandle(0)
.hbrBackground =Cast(HBRUSH,28)
.lpszMenuName = NULL
.lpszClassName = @"Simple"
.hIcon = LoadIcon( NULL,IDI_APPLICATION )
.hIconSm = .hIcon
.hCursor = LoadCursor( NULL,IDC_ARROW)
end With
if(RegisterClassEx(@wc) = FALSE) then
MessageBox(0,"Can not register window class","Error",0)
end 1
end If
With wc
.cbSize = SIZEOF( WNDCLASSEX )
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = @ChildWndProc
.cbClsExtra = NULL
.cbWndExtra = NULL
.hInstance =GetModuleHandle(0)
.hbrBackground =Cast(HBRUSH,28)
.lpszMenuName = NULL
.lpszClassName = @"SimpleChild"
.hIcon = LoadIcon( NULL,IDI_APPLICATION )
.hIconSm = .hIcon
.hCursor = LoadCursor( NULL,IDC_ARROW)
end With
With wc
.cbSize = SIZEOF( WNDCLASSEX )
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = @HelloWndProc
.cbClsExtra = NULL
.cbWndExtra = NULL
.hInstance =GetModuleHandle(0)
.hbrBackground =Cast(HBRUSH,28)
.lpszMenuName = NULL
.lpszClassName = @"szHelloClass"
.hIcon = LoadIcon( NULL,IDI_APPLICATION )
.hIconSm = .hIcon
.hCursor = LoadCursor( NULL,IDC_ARROW)
end With
With wc
.cbSize = SIZEOF( WNDCLASSEX )
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = @RectWndProc
.cbClsExtra = NULL
.cbWndExtra = NULL
.hInstance =GetModuleHandle(0)
.hbrBackground =Cast(HBRUSH,28)
.lpszMenuName = NULL
.lpszClassName = @"szRectClass"
.hIcon = LoadIcon( NULL,IDI_APPLICATION )
.hIconSm = .hIcon
.hCursor = LoadCursor( NULL,IDC_ARROW)
end With
if(RegisterClassEx(@wc) = FALSE) then
MessageBox(0,"Can not register window class","Error",0)
end 1
end If
' not petzold
Function WndProc(hDlg as hwnd,Msg as uint,wparam as wparam,lparam as lparam) as integer
select case msg
case wm_create
Dim as HMENU Menu = CreateMenu
Dim as HMENU subWindows = CreatePopupMenu 'subMenu
'AppendMenu Menu, MF_POPUP OR MF_ENABLED, subWindows, "&File"
Menu = CreateMenu
AppendMenu(subWindows,MF_STRING,100,"Cascade")
AppendMenu(subWindows,MF_STRING,100,"Tile")
AppendMenu(subWindows,MF_STRING,100,"Arrange")
AppendMenu(subWindows,MF_STRING,FILE_EXIT,"Exit")
AppendMenu(Menu,MF_POPUP,Cint(subWindows),"Windows")
DrawMenuBar(hDlg)
SetMenu(hDlg,Menu)
Dim as HMENU hMenuWindow = CreatePopUpMenu
AppendMenu(hMenuWindow,MF_STRING,101,"NewHello")
AppendMenu(hMenuWindow,MF_STRING,101,"NewRectangle")
AppendMenu(hMenuWindow, MF_SEPARATOR, 0, "") 'hSubMenu
'AppendMenu(subWindows,MF_STRING,FILE_EXIT,"Exit")
AppendMenu(Menu,MF_POPUP,CInt(hMenuWindow),"File")
DrawMenuBar(hDlg)
SetMenu(hDlg,Menu)
Dim as HMENU hMenuCol = CreatePopUpMenu
AppendMenu(hMenuCol,MF_STRING,102,"Black")
AppendMenu(hMenuCol,MF_STRING,102,"Red")
AppendMenu(hMenuCol,MF_STRING,102,"Green")
AppendMenu(hMenuCol,MF_STRING,102,"Blue")
AppendMenu(hMenuCol,MF_STRING,102,"White")
AppendMenu(Menu,MF_POPUP,CInt(hMenuCol),"Colors")
'AppendMenu(hMenuCol, MF_SEPARATOR, 0, "") 'hSubMenu
DrawMenuBar(hDlg)
SetMenu(hDlg,Menu)
Dim As CLIENTCREATESTRUCT ccs
ccs.hWindowMenu = subWindows
ccs.idFirstChild = &HFF000
hMDIClient = CreateWindow("MDICLIENT", "",WS_CHILD Or WS_CLIPCHILDREN Or WS_CLIPSIBLINGS Or WS_VISIBLE Or WS_VSCROLL Or WS_HSCROLL,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,hDlg,Cast(HMENU,&HCAC),GetModuleHandle(0),@ccs)
hwMDI = CreateWindowEx(WS_EX_MDICHILD, "SimpleChild", "", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, CW_USEDEFAULT,CW_USEDEFAULT,300,200,hMDIClient, 0, GetModuleHandle(0),0)
Return false
case FILE_EXIT
PostMessage( hWnd, WM_CLOSE, 0, 0 )
exit function
' end select
case wm_close
PostQuitMessage(0)
end select
return DefFrameProc(hDlg, hMDIClient, Msg, wParam, lParam)
End function
' not petzold
function ChildWndProc(hDlg as hwnd,Msg as uint,wparam as wparam,lparam as lparam) as integer
select case msg
case wm_close
select case MessageBox(hDlg,"Close ?","MDIChild",mb_iconquestion or mb_yesno)
case idno
return true
end select
end select
return DefMDIChildProc(hDlg, Msg, wParam, lParam)
End function
hWnd = CreateWindowEx( 0, "Simple", "Hello MDI Example", WS_OVERLAPPEDWINDOW Or WS_VISIBLE Or WS_CLIPCHILDREN Or WS_CLIPSIBLINGS, 100, 100, 500, 300, 0, 0, GetModuleHandle(0), 0 )
While GetMessage( @msg, 0, 0, 0 )
TranslateMessage( @msg )
DispatchMessage( @msg )
Wend
' petzold
function CloseEnumProc (byval hwnd as HWND, byval lParam as LPARAM) as BOOL
if (GetWindow (hwnd, GW_OWNER) <> 0) then '' Check for icon title
return TRUE
end if
SendMessage (GetParent (hwnd), WM_MDIRESTORE, cast(WPARAM, hwnd), 0)
if (SendMessage (hwnd, WM_QUERYENDSESSION, 0, 0) = 0) then return TRUE
SendMessage (GetParent (hwnd), WM_MDIDESTROY, cast(WPARAM, hwnd), 0)
return TRUE
end function
' petzold
function HelloWndProc (byval hwnd as HWND, byval message as UINT, _
byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
static as COLORREF clrTextArray(0 to 4) => _
{ rgb (0, 0, 0), _
rgb (0, 0, 255), _
rgb (0, 255, 0), _
rgb (255, 0, 0), _
rgb (255, 255, 255) }
static as HWND hwndClient, hwndFrame
dim as HDC hdc
dim as HMENU hMenu
dim as PHELLODATA pHelloData
dim as PAINTSTRUCT ps
dim as RECT rect
select case (message)
case WM_CREATE:
'' Allocate memory for window private data
pHelloData = cast(PHELLODATA, HeapAlloc (GetProcessHeap (), _
HEAP_ZERO_MEMORY, sizeof (HELLODATA)))
pHelloData->iColor = IDM_COLOR_BLACK
pHelloData->clrText = rgb (0, 0, 0)
SetWindowLong (hwnd, 0, cast(long, pHelloData))
'' Save some window handles
hwndClient = GetParent (hwnd)
hwndFrame = GetParent (hwndClient)
return 0
case WM_COMMAND
select case (LOWORD (wParam))
case IDM_COLOR_BLACK, IDM_COLOR_RED, IDM_COLOR_GREEN, IDM_COLOR_BLUE, IDM_COLOR_WHITE
'' Change the text color
pHelloData = cast(PHELLODATA, GetWindowLong (hwnd, 0))
hMenu = GetMenu (hwndFrame)
CheckMenuItem (hMenu, pHelloData->iColor, MF_UNCHECKED)
pHelloData->iColor = wParam
CheckMenuItem (hMenu, pHelloData->iColor, MF_CHECKED)
pHelloData->clrText = clrTextArray(wParam - IDM_COLOR_BLACK)
InvalidateRect (hwnd, NULL, FALSE)
end select
return 0
case WM_PAINT
'' Paint the window
hdc = BeginPaint (hwnd, @ps)
pHelloData = cast(PHELLODATA, GetWindowLong (hwnd, 0))
SetTextColor (hdc, pHelloData->clrText)
GetClientRect (hwnd, @rect)
DrawText (hdc, "Hello, World!", -1, @rect, _
DT_SINGLELINE or DT_CENTER or DT_VCENTER)
EndPaint (hwnd, @ps)
return 0
case WM_MDIACTIVATE
'' Set the Hello menu if gaining focus
if (lParam = cast(LPARAM, hwnd)) then
SendMessage (hwndClient, WM_MDISETMENU, _
cast(WPARAM, hMenuHello), cast(LPARAM, hMenuHelloWindow))
end if
'' Check or uncheck menu item
pHelloData = cast(PHELLODATA, GetWindowLong (hwnd, 0))
CheckMenuItem (hMenuHello, pHelloData->iColor, _
(iif(lParam = cast(LPARAM, hwnd), MF_CHECKED, MF_UNCHECKED)))
'' Set the Init menu if losing focus
if (lParam <> cast(LPARAM, hwnd)) then
SendMessage (hwndClient, WM_MDISETMENU, cast(WPARAM, hMenuInit), _
cast(LPARAM, hMenuInitWindow))
end if
DrawMenuBar (hwndFrame)
return 0
case WM_QUERYENDSESSION, WM_CLOSE
if (IDOK <> MessageBox (hwnd, "OK to close window?", _
"Hello", _
MB_ICONQUESTION or MB_OKCANCEL)) then return 0
''else process by DefMDIChildProc
case WM_DESTROY
pHelloData = cast(PHELLODATA, GetWindowLong (hwnd, 0))
HeapFree (GetProcessHeap (), 0, pHelloData)
return 0
end select
'' Pass unprocessed message to DefMDIChildProc
return DefMDIChildProc (hwnd, message, wParam, lParam)
end function
' petzold
function RectWndProc (byval hwnd as HWND, byval message as UINT, _
byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
static as HWND hwndClient, hwndFrame
dim as HBRUSH hBrush
dim as HDC hdc
dim as PRECTDATA pRectData
dim as PAINTSTRUCT ps
dim as integer xLeft, xRight, yTop, yBottom
dim as short nRed, nGreen, nBlue
select case message
case WM_CREATE
'' Allocate memory for window private data
pRectData = cast(PRECTDATA, HeapAlloc (GetProcessHeap (), _
HEAP_ZERO_MEMORY, sizeof (RECTDATA)))
SetWindowLong (hwnd, 0, cast(long, pRectData))
'' Start the timer going
SetTimer (hwnd, 1, 250, NULL)
'' Save some window handles
hwndClient = GetParent (hwnd)
hwndFrame = GetParent (hwndClient)
return 0
case WM_SIZE '' If not minimized, save the window size
if (wParam <> SIZE_MINIMIZED) then
pRectData = cast(PRECTDATA, GetWindowLong (hwnd, 0))
pRectData->cxClient = LOWORD (lParam)
pRectData->cyClient = hiword (lParam)
end if
'' WM_SIZE must be processed by DefMDIChildProc (no return 0)
case WM_TIMER '' Display a random rectangle
pRectData = cast(PRECTDATA, GetWindowLong (hwnd, 0))
xLeft = rand () mod pRectData->cxClient
xRight = rand () mod pRectData->cxClient
yTop = rand () mod pRectData->cyClient
yBottom = rand () mod pRectData->cyClient
nRed = rand () and 255
nGreen = rand () and 255
nBlue = rand () and 255
hdc = GetDC (hwnd)
hBrush = CreateSolidBrush (rgb (nRed, nGreen, nBlue))
SelectObject (hdc, hBrush)
Rectangle (hdc, min (xLeft, xRight), min (yTop, yBottom), _
max (xLeft, xRight), max (yTop, yBottom))
ReleaseDC (hwnd, hdc)
DeleteObject (hBrush)
return 0
case WM_PAINT '' Clear the window
InvalidateRect (hwnd, NULL, TRUE)
hdc = BeginPaint (hwnd, @ps)
EndPaint (hwnd, @ps)
return 0
case WM_MDIACTIVATE '' Set the appropriate menu
if (lParam = cast(LPARAM, hwnd)) then
SendMessage (hwndClient, WM_MDISETMENU, cast(WPARAM, hMenuRect), _
cast(LPARAM, hMenuRectWindow))
else
SendMessage (hwndClient, WM_MDISETMENU, cast(WPARAM, hMenuInit), _
cast(LPARAM, hMenuInitWindow))
end if
DrawMenuBar (hwndFrame)
return 0
case WM_DESTROY
pRectData = cast(PRECTDATA, GetWindowLong (hwnd, 0))
HeapFree (GetProcessHeap (), 0, pRectData)
KillTimer (hwnd, 1)
return 0
end select
'' Pass unprocessed message to DefMDIChildProc
return DefMDIChildProc (hwnd, message, wParam, lParam)
end function
'ends
