Trick: Multiple Child Windows Into Parent

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Trick: Multiple Child Windows Into Parent

Post by jepalza »

I have needed for a specific case, to create several child windows inside the main parent, and searching the net, I have found an example that I have converted and I share it with anyone who may need it.


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 )

Ed Davis
Posts: 37
Joined: Jul 28, 2008 23:24

Re: Trick: Multiple Child Windows Into Parent

Post by Ed Davis »

When I compile this with v1.09, I get:

fbc -s gui multiwin2.bas
multiwin2.bas(10) warning 4(2): Suspicious pointer assignment
multiwin2.bas(29) warning 4(2): Suspicious pointer assignment
multiwin2.bas(65) error 20: Type mismatch, before ')' in 'AppendMenu(hMenu, MF_POPUP, cast(UINT,hSubMenu), "Window")'
multiwin2.bas(108) warning 3(2): Passing different pointer types, at parameter 1 of CREATEMDIWINDOW()
multiwin2.bas(119) error 42: Variable not declared, GWL_USERDATA in 'SetWindowLong(hWnd_, GWL_USERDATA, hBrush_ )'
multiwin2.bas(131) error 1: Argument count mismatch, found 'GWL_USERDATA' in 'if ( (hBrushStock = cast(HBRUSH,GetWindowLong(hWnd_, GWL_USERDATA)) ) <> NULL) Then'

Do you have specific compile instructions and/or version requirements in order for this to compile?
srvaldez
Posts: 3373
Joined: Sep 25, 2005 21:54

Re: Trick: Multiple Child Windows Into Parent

Post by srvaldez »

I made some cast and a change or two, it now compiles and runs in both 32 and 64-bit
but I am not an expert in windows programming, so even though it compiles and runs ok, I am not confident that all variables or functions are correct
reference https://stackoverflow.com/questions/181 ... of-windows

Code: Select all


#Include "windows.bi"
#Include "win\winuser.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 LPCSTR wsChildClassName = cast(LPCSTR ,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, cast(LPCSTR ,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, wstr("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(uinteger,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)) 
			'SetWindowLongPtr(hWnd_, GWL_USERDATA, hBrush_ ) 
			SetWindowLongPtr(hWnd_, GWLP_USERDATA, cast(integer,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,GetWindowLongPtr(hWnd_, GWLP_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 )
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Trick: Multiple Child Windows Into Parent

Post by jepalza »

Another solution for "wsChildClassName " is:

Code: Select all

Dim Shared As ZString Ptr wsChildClassName 
wsChildClassName = Allocate( 17 * Len(ZString) )
*wsChildClassName = "ChildWindowClass"
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Trick: Multiple Child Windows Into Parent

Post by deltarho[1859] »

Ed Davis wrote:When I compile this with v1.09, I get:
As I do in 64-bit. GWL_USERDATA is subject to '#undef' in winuser.bi and 64-bit. In 32-bit I just get four warnings and no errors. It compiles and appears to run OK despite the warnings.

This compiles and runs.

Code: Select all

Const David = 99
Print David
'#undef David
'Print David
Sleep
Remove the comments and we find that 'David' is not declared.

Anyway, well done srvaldez for his modifications resulting in 'Errors 0 Warnings 0' for both 32 and 64-bit. :wink:

Added:

From the manual: Const Non-modifiable variable declaration.

Here is a Const being modified.

Code: Select all

Const David = 99
Print David
#undef David
Const David = 33
Print David
Sleep
That is not for the feint hearted. :) Remove the '#undef David' and we get a duplicated definition error.
Post Reply