From this page:
https://social.msdn.microsoft.com/Forum ... =vcgeneral
Code: Select all
#Include "windows.bi"
Dim Shared As HINSTANCE hInst
Declare Function WndProc(hwnd_ As HWND ,uint_ As UINT ,wparam_ As WPARAM ,lparam_ As LPARAM ) As LRESULT
Declare Function ChildWndProc(hWnd_ As HWND , Msg_ As UINT , wParam_ As WPARAM , lParam_ As LPARAM) As LRESULT
Declare Function CreateNewMDIChildWindow(szTitle As LPTSTR , lpData As LPVOID ) As HWND
Dim Shared As HWND hWndMDIClient
Dim Shared As wstring Ptr wsChildClassName = StrPtr("ChildWindowClass")
#define IDM_FILE_NEWHELLO 100
Function WinMain(hInstance_ As HINSTANCE , hPrevInstance_ As HINSTANCE , lpCmdLine_ As LPTSTR , nCmdShow_ As Integer) As Integer
hInst = hInstance_
Dim As WNDCLASSEX wcex = Type _
( _
sizeof(WNDCLASSEX), 0, @WndProc, 0, 0, hInst, LoadIcon(NULL, IDI_APPLICATION), _
LoadCursor(NULL, IDC_ARROW), cast(HBRUSH,COLOR_WINDOW + 1), NULL, strptr("MDIFrameWindowClass"), NULL _
)
if RegisterClassEx(@wcex)=0 Then
return MessageBox(NULL, "Cannot register class !", "Error", MB_ICONERROR Or MB_OK)
EndIf
Dim As WNDCLASSEX wcexChild = Type _
( _
sizeof(WNDCLASSEX), 0, @ChildWndProc, 0, 0, hInst, LoadIcon(NULL, IDI_APPLICATION), _
LoadCursor(NULL, IDC_ARROW), cast(HBRUSH,COLOR_WINDOW + 1), NULL, wsChildClassName, NULL _
)
if RegisterClassEx(@wcexChild)=0 Then
return MessageBox(NULL, "Cannot register class !", "Error", MB_ICONERROR Or MB_OK)
EndIf
Dim As Integer nX = (GetSystemMetrics(SM_CXSCREEN) - 640) / 2, nY = (GetSystemMetrics(SM_CYSCREEN) - 400) / 2
Dim As HWND hWnd_ = CreateWindowEx( _
0, wcex.lpszClassName, strptr("Test"), WS_OVERLAPPEDWINDOW,_
nX, nY, 640, 400, NULL, NULL, hInst, NULL)
if hWnd_=0 Then
return MessageBox(NULL, "Cannot create window !", "Error", MB_ICONERROR Or MB_OK)
EndIf
ShowWindow(hWnd_, SW_SHOWNORMAL)
UpdateWindow(hWnd_)
Dim As MSG msg_
while (GetMessage(@msg_, NULL, 0, 0))
TranslateMessage(@msg_)
DispatchMessage(@msg_)
Wend
return CInt(msg_.wParam)
End Function
Function WndProc(hWnd_ As HWND , message_ As UINT , wParam_ As WPARAM , lParam_ As LPARAM) As LRESULT
Dim As HWND hWndChild
Select Case message_
Case WM_CREATE
Dim As HMENU hMenu = CreateMenu()
AppendMenu(hMenu, MF_STRING, IDM_FILE_NEWHELLO, "New")
Dim As HMENU hSubMenu = CreatePopupMenu()
AppendMenu(hMenu, MF_POPUP, cast(UINT,hSubMenu), "Window")
SetMenu(hWnd_, hMenu)
DrawMenuBar(hWnd_)
Dim As CLIENTCREATESTRUCT ccs
Dim As HMENU g = GetMenu(hWnd_)
ccs.hWindowMenu = GetSubMenu(GetMenu(hWnd_), 1)
ccs.idFirstChild = 1000
hWndMDIClient = CreateWindow( _
"MDICLIENT", NULL, WS_CHILD Or WS_CLIPCHILDREN Or WS_VISIBLE, _
0, 0, 0, 0, hWnd_, cast(HMENU,1), hInst, cast(PSTR,@ccs))
return 0
Case WM_COMMAND
Select Case (LOWORD(wParam_))
Case IDM_FILE_NEWHELLO
Dim As HWND hWndNew
hWndNew = CreateNewMDIChildWindow("Untitled", NULL)
SendMessage(hWndMDIClient, WM_MDIACTIVATE, cast(WPARAM,hWndNew), 0)
return 0
Case else
hWndChild = cast(HWND,SendMessage(hWndMDIClient, WM_MDIGETACTIVE, 0, 0) )
If (IsWindow(hWndChild)) Then
SendMessage(hWndChild, WM_COMMAND, wParam_, lParam_)
EndIf
End Select
Case WM_DESTROY
PostQuitMessage(0)
return 0
Case else
Return DefFrameProc(hWnd_, hWndMDIClient, message_, wParam_, lParam_)
End Select
return DefFrameProc(hWnd_, hWndMDIClient, message_, wParam_, lParam_)
End Function
Function CreateNewMDIChildWindow(szTitle As LPTSTR , lpData As lpVoid) As HWND
Dim As HWND hReturnWnd
hReturnWnd = CreateMDIWindow(wsChildClassName, szTitle, 0, CW_USEDEFAULT, CW_USEDEFAULT, 200, 200, hWndMDIClient, hInst, cast(LPARAM,lpData))
ShowWindow(hReturnWnd, SW_SHOW)
return hReturnWnd
End Function
Function ChildWndProc(hWnd_ As HWND , Msg_ As UINT , wParam_ As WPARAM , lParam_ As LPARAM) As LRESULT
Dim As HBRUSH hBrush_ = NULL
Select Case (Msg_)
Case WM_CREATE
hBrush_ = CreateSolidBrush(RGB(rand() * 255, rand() * 255, rand() * 255))
SetWindowLong(hWnd_, GWL_USERDATA, hBrush_ )
return 0
case WM_PAINT
Dim As HDC hDC
Dim As PAINTSTRUCT ps
hDC = BeginPaint(hWnd_, @ps)
Dim As RECT rc
GetClientRect(hWnd_, @rc)
Dim As HBRUSH hBrushStock = NULL
if ( (hBrushStock = cast(HBRUSH,GetWindowLong(hWnd_, GWL_USERDATA)) ) <> NULL) Then
FillRect(hDC, @rc, hBrushStock)
EndIf
EndPaint(hWnd_, @ps)
case WM_DESTROY
DeleteObject(hBrush_)
return 0
End Select
return DefMDIChildProc(hWnd_, Msg_, wParam_, lParam_)
End Function
' main loop
End WinMain( GetModuleHandle( NULL ), NULL, Command, SW_NORMAL )