After I open the popup window, the program does not close when I click the cross on the main window.
This causes memory leaks.
I tried to send several messages to close it but it doesn't work, WM_CLOSE, WM_DESTROY etc.
it works fine if I close the pop up window first with the closing cross.
#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx
CONST IDC_POPUP = 1001
dim shared HWND_POPUP as hwnd
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
' // Forward declarations
DECLARE FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION PopupWindow (BYVAL hParent AS HWND) AS LONG
DECLARE FUNCTION PopupWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
AfxSetProcessDPIAware
' // Create the main window
DIM pWindow AS CWindow
pWindow.Create(NULL, "CWindow with a popup window", @WndProc)
pWindow.SetClientSize(500, 320)
pWindow.Center
pWindow.AddControl("Button", , IDC_POPUP, "&Popup", 350, 250, 75, 23)
' // Dispatch Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_COMMAND
SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
CASE IDC_POPUP
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
PopupWindow(hwnd)
EXIT FUNCTION
END IF
END SELECT
Case WM_CLOSE
' ? GetDlgItem( hwnd, ID)
' Sendmessage (HWND_POPUP, WM_Close , 0, 0 )
PostMessage(HWND_POPUP, WM_Close , 0, 0 )
CASE WM_DESTROY
' // Quit the application
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Popup window procedure
' ========================================================================================
FUNCTION PopupWindow (BYVAL hParent AS HWND) AS LONG
DIM pWindow AS CWindow
HWND_POPUP = pWindow.Create(hParent, "Popup", @PopupWndProc, , , 300 ,200 , _
WS_VISIBLE OR WS_CAPTION OR WS_SYSMENU or WS_THICKFRAME, _
WS_EX_TOOLWINDOW OR WS_EX_WINDOWEDGE OR WS_EX_CONTROLPARENT)
pWindow.Center(pWindow.hWindow, hParent)
' / Process Windows messages
FUNCTION = pWindow.DoEvents
END FUNCTION
' ========================================================================================
' ========================================================================================
' Popup window procedure
' ========================================================================================
FUNCTION PopupWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_CLOSE
? "WM_CLOSE"
' // Don't exit; let DefWindowProcW perform the default action
CASE WM_DESTROY
? "WM_DESTROY"
' // End the application by sending an WM_QUIT message
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
any idea how to solve this?
It looks like you are trying to create a modal popup because I see that you have a message pump right after the popup.
FUNCTION = pWindow.DoEvents
If you indeed want to have a modal popup, then the right approach would be to:
- disable the parent window before showing the popup
- show the popup and run the message pump
- re-enable the parent prior to the popup closing. I do this in WM_CLOSE of the popup becasue it helps in preserving the z-order of the windows.
The leak occurs because the message pump you created after the popup:
FUNCTION = pWindow.DoEvents
continues to run even after the main form's message pump has been exited.
It will not be a modal popup dialog, but a toolbox such as in winfbe is included.
Paul I've incorporated your suggestions into the code, but that doesn't help.
the strange thing is that I put the code below under a button it works, but not under Wndproc WM_CLOSE
SendMessage(HWND_POPUP, WM_COMMAND, MAKELONG(IDCANCEL, BN_CLICKED), NULL)
FUNCTION PopupWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
Case WM_CREATE
EnableWindow GetParent(hwnd), FALSE
CASE WM_COMMAND
SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
CASE IDCANCEL
' // If ESC key pressed, close the application by sending an WM_CLOSE message
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
? "pass IDCANCEL"
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_CLOSE
EnableWindow GetParent(hwnd), CTRUE
' DestroyWindow(hwnd)
? "WM_CLOSE"
CASE WM_DESTROY
? "WM_DESTROY"
' // End the application by sending an WM_QUIT message
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
Ah, well in that case, if you are implementing a modeless popup then you do not use the DoEvents in your PopupWindow function. That DoEvents is actually a second message pump. In this case, you should only have one message pump that controls the main form and any popup modeless popups. You only need another message pump if you implement a modal popup.
So, remove the DoEvents line at line 92.
Also, you have a PostQuitMessage(0) call in your PopupWndProc handler. For your example, you only need the PostQuitMessage(0) in the WndProc handler of your main form, not the popup.
thank you very much, the program close properly.
The adjustment did cause another problem.
I can no longer set the desired Font and Character size, It does go through WM_CREATE but doesn't seem to do anything with it.
FUNCTION PopupWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
STATIC hNewFont AS HFONT
SELECT CASE uMsg
CASE WM_CREATE
' // Get a pointer to the CWindow class from the CREATESTRUCT structure
DIM pWindow AS CWindow PTR = AfxcWindowPtr(lParam)
' // Create a new font scaled according the DPI ratio
IF pWindow->DPI <> 96 THEN hNewFont = pWindow->CreateFont("Tahoma", 9)
' Disable parent window to make popup window modal
EnableWindow GetParent(hwnd), FALSE
EXIT FUNCTION
After a long search, this is the solution
#define UNICODE
#include once "Afx/CWindow.inc"
USING Afx
CONST IDC_POPUP = 1001
Dim Shared as Hwnd HWND_WORKSPACEMAIN
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
' // Forward declarations
DECLARE FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION PopupWindow (BYVAL hParent AS HWND) AS CWindow PTR
DECLARE FUNCTION PopupWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
AfxSetProcessDPIAware
' // Create the main window
DIM pWindow AS CWindow
DIM hWndMain AS HWND = pWindow.Create(NULL, "Modeless popup window", @WndProc)
pWindow.SetClientSize(900, 500)
pWindow.Center
' // Add a button without position or size (it will be resized in the WM_SIZE message).
pWindow.AddControl("Button", , IDC_POPUP, "&Popup")
' // Display the window
ShowWindow(hWndMain, nCmdShow)
UpdateWindow(hWndMain)
' // Dispatch Windows messages
DIM uMsg AS MSG, hFocusWnd AS HWND
WHILE (GetMessageW(@uMsg, NULL, 0, 0) <> FALSE)
' // Check if a popup dialog is activated and get its handle
if HWND_WORKSPACEMAIN = GetFocus() then
hFocusWnd = HWND_WORKSPACEMAIN
else
hFocusWnd = hWndMain
end if
' // Process Windows messages
IF IsDialogMessageW(hFocusWnd, @uMsg) = 0 THEN
TranslateMessage(@uMsg)
DispatchMessageW(@uMsg)
END IF
WEND
FUNCTION = uMsg.wParam
END FUNCTION
' ========================================================================================
' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_COMMAND
' // If ESC key pressed, close the application sending an WM_CLOSE message
SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
CASE IDCANCEL
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_POPUP
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
PopupWindow(hwnd)
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
IF wParam <> SIZE_MINIMIZED THEN
' // Resize the button
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
pWindow->MoveWindow GetDlgItem(hwnd, IDC_POPUP), pWindow->ClientWidth - 140, pWindow->ClientHeight - 40, 75, 23, CTRUE
END IF
CASE WM_DESTROY
' // Quit the application
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' Popup main window
' ========================================================================================
FUNCTION PopupWindow (BYVAL hParent AS HWND) AS CWindow PTR
DIM pWindow AS CWindow PTR = NEW CWindow
pWindow->Create(hParent, "Popup window", @PopupWndProc, 0, 0, 0, 0, _
WS_POPUPWINDOW OR WS_CAPTION OR WS_CLIPSIBLINGS OR WS_CLIPCHILDREN OR WS_THICKFRAME, _
WS_EX_CONTROLPARENT OR WS_EX_WINDOWEDGE)
pWindow->Brush = GetStockObject(WHITE_BRUSH)
pWindow->SetClientSize(700, 400)
pWindow->Center(pWindow->hWindow, hParent)
' // Display the window
ShowWindow(pWindow->hWindow, SW_NORMAL)
UpdateWindow(pWindow->hWindow)
FUNCTION = pWindow
END FUNCTION
' ========================================================================================
' ========================================================================================
' Popup window procedure
' ========================================================================================
FUNCTION PopupWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_COMMAND
SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
CASE IDCANCEL
' // If ESC key pressed, close the application by sending an WM_CLOSE message
IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_DESTROY
' // Delete the popup CWindow class
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
IF pWindow THEN Delete pWindow
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
Awesome, nice to see that you figured it out and I bet you've learned a lot along the way. Nice to see that you are attempting this in somewhat traditional approach with a mixture of Win32 api and Jose's AFX. Using WinFBE visual designer would be easier but of course you would lose a bit of hardcore low level control from the extra level of abstraction.
I programmed vb5 & 6 for many years, until the programmer language slowly became obsolete.
As vb6 got older, we increasingly turned to weird tricks to keep up with the further developed programmer languages.
In the end it was more than usual to have many API calls and object definition language files to get a program look nice and working.
Probably this is my luck now.
After having programmed in DOS for many years, my first exposure to Windows programming was also through Visual Basic 3, 4, 5 & 6. Like you, I ended up resorted to a lot of tricks and hacks. When I finally took the full plunge into PowerBasic and Win32 api programming, that's when everything started to get easier (easier in the sense that the lower level gave you a lot more flexibility. Harder in the sense that the visual design freedom was lacking).