要创建一个弹出窗口,您只需创建一个新的CWindow类实例,并在Create方法中,使其成为主窗口的小孩并使用WS_POPUPWINDOW样式。
DIM pWindow AS CWindow
pWindow.Create(hParent, "Popup window", @PopupWndProc, , , , , _
WS_VISIBLE OR WS_CAPTION OR WS_POPUPWINDOW OR WS_THICKFRAME, WS_EX_WINDOWEDGE)
以这种方式创建的窗口是无模式的。 为了使其模态,我们需要禁用父窗口:
CASE WM_CREATE
EnableWindow GetParent(hwnd), FALSE
当弹出对话框关闭时,我们需要启用父窗口:
CASE WM_CLOSE
' // 启用父窗口保持父级的zorder
EnableWindow GetParent(hwnd), CTRUE
示例
' ########################################################################################
' Microsoft Windows
' File: CW_PopupWindow.fbtpl
' Contents: CWindow with a modal popup window
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx
CONST IDC_POPUP = 1001
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)
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
' // 设置处理DPI感知
AfxSetProcessDPIAware
DIM pWindow AS CWindow
pWindow.Create(NULL, "CWindow with a popup window", @WndProc)
pWindow.SetClientSize(500, 320)
pWindow.Center
' // 添加没有位置或大小的按钮(将在WM_SIZE消息中调整大小)。
pWindow.AddControl("Button", pWindow.hWindow, IDC_POPUP, "&Popup", 350, 250, 75, 23)
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ========================================================================================
' 窗口处理程序
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM hDC AS HDC
DIM pPaint AS PAINTSTRUCT
DIM rc AS RECT
DIM pWindow AS CWindow PTR
SELECT CASE uMsg
CASE WM_CREATE
EXIT FUNCTION
CASE WM_COMMAND
' // 按ESC键,关闭发送WM_CLOSE消息的应用程序
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_POPUP
IF HIWORD(wParam) = BN_CLICKED THEN
PopupWindow(hwnd)
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
IF wParam <> SIZE_MINIMIZED THEN
' // 调整按钮的大小
pWindow = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 120, pWindow->ClientHeight - 50, 75, 23, CTRUE
END IF
CASE WM_DESTROY
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Popup window procedure
' ========================================================================================
FUNCTION PopupWindow (BYVAL hParent AS HWND) AS LONG
DIM pWindow AS CWindow
pWindow.Create(hParent, "Popup window", @PopupWndProc, , , , , _
WS_VISIBLE OR WS_CAPTION OR WS_POPUPWINDOW OR WS_THICKFRAME, WS_EX_WINDOWEDGE)
pWindow.Brush = GetStockObject(WHITE_BRUSH)
pWindow.SetClientSize(300, 200)
pWindow.Center(pWindow.hWindow, hParent)
' / 处理Windows消息
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
DIM hOldFont AS HFONT
STATIC hNewFont AS HFONT
SELECT CASE uMsg
CASE WM_CREATE
' // 从CREATESTRUCT结构获取指向CWindow类的指针
DIM pCreateStruct AS CREATESTRUCT PTR = CAST(CREATESTRUCT PTR, lParam)
DIM pWindow AS CWindow PTR = CAST(CWindow PTR, pCreateStruct->lpCreateParams)
' // Create a new font scaled according the DPI ratio
IF pWindow->DPI <> 96 THEN hNewFont = pWindow->CreateFont("Tahoma", 9)
' 禁用父窗口使弹出窗口模态
EnableWindow GetParent(hwnd), FALSE
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
' // 按ESC键,关闭发送WM_CLOSE的应用程序 message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_PAINT
DIM rc AS RECT, ps AS PAINTSTRUCT, hDC AS HANDLE
hDC = BeginPaint(hWnd, @ps)
IF hNewFont THEN hOldFont = CAST(HFONT, SelectObject(hDC, CAST(HGDIOBJ, hNewFont)))
GetClientRect(hWnd, @rc)
DrawTextW(hDC, "Hello, World!", -1, @rc, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
IF hNewFont THEN SelectObject(hDC, CAST(HGDIOBJ, CAST(HFONT, hOldFont)))
EndPaint(hWnd, @ps)
EXIT FUNCTION
CASE WM_CLOSE
' // 启用父窗口保持父级的zorder
EnableWindow GetParent(hwnd), CTRUE
' // 不要退出 让DefWindowProcW执行默认操作
CASE WM_DESTROY
' // 销毁新的字体
IF hNewFont THEN DeleteObject(CAST(HGDIOBJ, hNewFont))
' // 通过发送WM_QUIT消息来结束应用程序
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================