CWindow Release Candidate 11.
Besides some additional wrapper functions, the main change is the addition of scrollable windows support.
The way to get it working is to design your main window or popup dialog as if it was not scrollable, e.g.
DIM pWindow AS CWindow
DIM hwndMain AS HWND = pWindow.Create(NULL, "Scrollable window", @WndProc)
pWindow.ClassStyle = CS_DBLCLKS ' // Change the window style to avoid flicker
' // Set a client size big enough to display all the controls
pWindow.SetClientSize(320, 335)
Add controls, e.g.
' // Add a listbox
DIM hListBox AS HWND
hListBox = pWindow.AddControl("ListBox", , IDC_LISTBOX)
pWindow.SetWindowPos hListBox, NULL, 8, 8, 300, 280, SWP_NOZORDER
Attach the window to an instance of the CScrollWindow class:
' // Create an instance of the CScrollWindow class and attach the main window to it
DIM pScrollWindow AS CScrollWindow PTR = NEW CScrollWindow(hwndMain)
' // Store the pointer in the class of the parent window for later deletion
pWindow.ScrollWindowPtr = pScrollWindow
and shrink the client size of the window:
' // Shrink the client size
pWindow.SetClientSize(250, 260)
In the callback function, process the WM_SIZE, WM_VSCROLL and WM_VSCROLL messages:
CASE WM_SIZE
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
IF pScrollWindow THEN pScrollWindow->OnSize(wParam, lParam)
EXIT FUNCTION
CASE WM_VSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
IF pScrollWindow THEN pScrollWindow->OnVScroll(wParam, lParam)
EXIT FUNCTION
CASE WM_HSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
IF pScrollWindow THEN pScrollWindow->OnHScroll(wParam, lParam)
EXIT FUNCTION
Full example code:
' ########################################################################################
' Microsoft Windows
' File: CW_ScrollWindow.fbtpl
' Contents: Scrollable window
' Compiler: Free Basic
' Copyright (c) 2016 Jose 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.
' ########################################################################################
#define unicode
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxCtl.inc"
#INCLUDE ONCE "Afx/CScrollWindow.inc"
USING Afx.CWindowClass
#define IDC_LISTBOX 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
' ========================================================================================
' 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
DIM pWindow AS CWindow
DIM hwndMain AS HWND = pWindow.Create(NULL, "Scrollable window", @WndProc)
pWindow.ClassStyle = CS_DBLCLKS ' // Change the window style to avoid flicker
' // Set a client size big enough to display all the controls
pWindow.SetClientSize(320, 335)
' // Add a listbox
DIM hListBox AS HWND
hListBox = pWindow.AddControl("ListBox", , IDC_LISTBOX)
pWindow.SetWindowPos hListBox, NULL, 8, 8, 300, 280, SWP_NOZORDER
' // Fill the list box
DIM i AS LONG, wszText AS WSTRING * 260
FOR i = 1 TO 50
wszText = "Item " & RIGHT("00" & STR(i), 2)
ListBox_AddString(hListBox, @wszText)
NEXT
' // Select the first item
ListBox_SetCursel(hListBox, 0)
' // Add a cancel button
pWindow.AddControl("Button", , IDCANCEL, "&Cancel", 233, 298, 75, 23)
' // Create an instance of the CScrollWindow class and attach the main window to it
DIM pScrollWindow AS CScrollWindow PTR = NEW CScrollWindow(hwndMain)
' // Store the pointer in the class of the parent window for later deletion
pWindow.ScrollWindowPtr = pScrollWindow
' // Shrink the client size
pWindow.SetClientSize(250, 260)
' // Center the window
pWindow.Center
' // Message pump
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Window procedure
' ================================================================e========================
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 LOWORD(wParam)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_LISTBOX
SELECT CASE HIWORD(wParam)
CASE LBN_DBLCLK
' // Get the handle of the Listbox
DIM hListBox AS HWND = GetDlgItem(hwnd, IDC_LISTBOX)
' // Get the current selection
DIM curSel AS LONG = ListBox_GetCursel(hListBox)
' // Get the length of the ListBox item text
DIM nLen AS LONG = ListBox_GetTextLen(hListBox, curSel)
' // Allocate memory for the buffer
DIM pwszText AS WSTRING PTR = CAllocate(nLen + 1, 2)
' // Get the text and display it
ListBox_GetText(hListBox, curSel, pwszText)
MessageBoxW(hwnd, pwszText, "ListBox test", MB_OK)
' // Deallocate the memory used by the buffer
DeAllocate pwszText
pwszText = NULL
EXIT FUNCTION
END SELECT
END SELECT
CASE WM_SIZE
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
IF pScrollWindow THEN pScrollWindow->OnSize(wParam, lParam)
EXIT FUNCTION
CASE WM_VSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
IF pScrollWindow THEN pScrollWindow->OnVScroll(wParam, lParam)
EXIT FUNCTION
CASE WM_HSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
IF pScrollWindow THEN pScrollWindow->OnHScroll(wParam, lParam)
EXIT FUNCTION
CASE WM_DESTROY
' // End the application
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Pass unprocessed messages to DefWindowProc
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
Tab pages created with the CTabPage class, that extends CWindow, are containers whose size is adjusted automatically to fit the client area of the tab. To make them scrollable, we have to increase its client size, attach them to an instance of the CScrollWindow, and restore its original client size, e.g.
' // Get the client size of the first page and make it greater
DIM nWidth AS LONG = pTabPage1->ClientWidth
DIM nHeight AS LONG = pTabPage1->ClientHeight
pTabPage1->SetClientSize(nWidth + 150, nHeight + 150)
' // Create an instance of the CScrollWindow class and attach the tab page handle to it
DIM pScrollWindow AS CScrollWindow PTR = NEW CScrollWindow(pTabPage1->hTabPage)
' // Store the pointer in the tab page for later deletion
pTabPage1->ScrollWindowPtr = pScrollWindow
' // Shrink the client size back to original
pTabPage1->SetClientSize(nWidth, nHeight)
We don't need to make scrollable all the tab pages, just the one(s) we want.
In the callback function of each tab page made scrollable, we have to process the WM_SIZE, WM_VSCROLL and WM_VSCROLL messages:
CASE WM_SIZE
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 0)
IF pScrollWindow THEN pScrollWindow->OnSize(wParam, lParam)
EXIT FUNCTION
CASE WM_VSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 0)
IF pScrollWindow THEN pScrollWindow->OnVScroll(wParam, lParam)
EXIT FUNCTION
CASE WM_HSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 0)
IF pScrollWindow THEN pScrollWindow->OnHScroll(wParam, lParam)
EXIT FUNCTION
As the pointers are stored in the structure for the tabs (not in the tab page), we have to pass the handle of the tab control with GetParent(hwnd) and the zero-based index of the tab (0 for the first tab, 1 for the second tab, etc.).
Full example code:
' ########################################################################################
' Microsoft Windows
' File: CW_ScrollTabPage.fbtpl
' Contents: Tab control with scrollable pages
' Compiler: Free Basic
' Copyright (c) 2016 Jose 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 "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/CScrollWindow.inc"
USING Afx.CWindowClass
CONST IDC_TAB = 1001
CONST IDC_EDIT1 = 1002
CONST IDC_EDIT2 = 1003
CONST IDC_BTNSUBMIT = 1004
CONST IDC_COMBO = 1005
CONST IDC_LISTBOX = 1006
' // Forward declarations
DECLARE FUNCTION TabPage1_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION TabPage2_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION TabPage3_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
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)
' ========================================================================================
' 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_CREATE
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
' // If ESC key pressed, close the application sending an 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_GETMINMAXINFO
' Set the pointer to the address of the MINMAXINFO structure
DIM ptmmi AS MINMAXINFO PTR = CAST(MINMAXINFO PTR, lParam)
' Set the minimum and maximum sizes that can be produced by dragging the borders of the window
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
IF pWindow THEN
ptmmi->ptMinTrackSize.x = 460 * pWindow->rxRatio
ptmmi->ptMinTrackSize.y = 320 * pWindow->ryRatio
END IF
EXIT FUNCTION
CASE WM_SIZE
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
DIM hTab AS HWND = GetDlgItem(hwnd, IDC_TAB)
' / Move the close button
IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 85, pWindow->ClientHeight - 28, 75, 23, CTRUE
' // Resize the tab control
IF pWindow THEN pWindow->MoveWindow(hTab, 10, 10, pWindow->ClientWidth - 20, pWindow->ClientHeight - 42, CTRUE)
' // Resize the tab pages
AfxResizeTabPages hTab
EXIT FUNCTION
CASE WM_NOTIFY
DIM nPage AS DWORD ' // Page number
DIM pTabPage AS CTabPage PTR ' // Tab page object reference
DIM tci AS TCITEMW ' // TCITEMW structure
DIM ptnmhdr AS NMHDR PTR ' // Information about a notification message
ptnmhdr = CAST(NMHDR PTR, lParam)
SELECT CASE ptnmhdr->idFrom
CASE IDC_TAB
SELECT CASE ptnmhdr->code
CASE TCN_SELCHANGE
' // Show the selected page
pTabPage = AfxCTabPagePtr(ptnmhdr->hwndFrom, -1)
IF pTabPage THEN ShowWindow pTabPage->hTabPage, SW_SHOW
CASE TCN_SELCHANGING
' // Hide the current page
pTabPage = AfxCTabPagePtr(ptnmhdr->hwndFrom, -1)
IF pTabPage THEN ShowWindow pTabPage->hTabPage, SW_HIDE
END SELECT
END SELECT
CASE WM_DESTROY
' // Destroy the tab pages
AfxDestroyAllTabPages(GetDlgItem(hwnd, IDC_TAB))
' // Quit the application
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' 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
DIM pWindow AS CWindow
' pWindow.DPI = 144 ' for testing purposes; not usully needed
pWindow.Create(NULL, "CWindow with a Tab Control", @WndProc)
pWindow.SetClientSize(500, 320)
pWindow.Center
' // Add a tab control
DIM hTab AS HWND = pWindow.AddControl("Tab", , IDC_TAB, "", 10, 10, pWindow.ClientWidth - 20, pWindow.ClientHeight - 42)
' // Create the first tab page
DIM pTabPage1 AS CTabPage PTR = NEW CTabPage
pTabPage1->DPI = pWindow.DPI ' --> for testing purposes; not usully needed
pTabPage1->InsertPage(hTab, 0, "Tab 1", -1, @TabPage1_WndProc)
' // Add controls to the first page
pTabPage1->AddControl("Label", pTabPage1->hTabPage, -1, "First name", 15, 15, 121, 21)
pTabPage1->AddControl("Label", pTabPage1->hTabPage, -1, "Last name", 15, 50, 121, 21)
pTabPage1->AddControl("Edit", pTabPage1->hTabPage, IDC_EDIT1, "", 165, 15, 186, 21)
pTabPage1->AddControl("Edit", pTabPage1->hTabPage, IDC_EDIT2, "", 165, 50, 186, 21)
pTabPage1->AddControl("Button", pTabPage1->hTabPage, IDC_BTNSUBMIT, "Submit", 340, 185, 76, 26, BS_DEFPUSHBUTTON)
' // Create the second tab page
DIM pTabPage2 AS CTabPage PTR = NEW CTabPage
pTabPage2->DPI = pWindow.DPI ' --> for testing purposes; not usully needed
pTabPage2->InsertPage(hTab, 1, "Tab 2", -1, @TabPage2_WndProc)
' // Add controls to the second page
DIM hComboBox AS HWND = pTabPage2->AddControl("ComboBox", pTabPage2->hTabPage, IDC_COMBO, "", 20, 20, 191, 105)
' // Create the third tab page
DIM pTabPage3 AS CTabPage PTR = NEW CTabPage
pTabPage3->DPI = pWindow.DPI ' --> for testing purposes; not usully needed
pTabPage3->InsertPage(hTab, 2, "Tab 3", -1, @TabPage3_WndProc)
' // Add controls to the third page
' DIM hListBox AS HWND = pTabPage3->AddControl("ListBox", pTabPage3->hTabPage, IDC_LISTBOX, "", 15, 20, 161, 120)
DIM hListBox AS HWND = pTabPage3->AddControl("ListBox", pTabPage3->hTabPage, IDC_LISTBOX)
pTabPage3->SetWindowPos hListBox, NULL, 15, 20, 161, 120, SWP_NOZORDER
' // Fill the controls with some data
DIM i AS LONG = 1, wszText AS WSTRING * 260
FOR i = 1 TO 9
wszText = "Item " & RIGHT("00" & STR(i), 2)
SendMessageW(hComboBox, CB_ADDSTRING, 0, CAST(LPARAM, @wszText))
SendMessageW(hListBox, LB_ADDSTRING, 0, CAST(LPARAM, @wszText))
NEXT
' // Select the first item in the combo box and the list box
SendMessageW(hComboBox, CB_SETCURSEL, 0, 0)
SendMessageW(hListBox, LB_SETCURSEL, 0, 0)
' // Add a button
pWindow.AddControl("Button", , IDCANCEL, "&Close", 415, 292, 75, 23)
' // Get the client size of the first page and make it greater
DIM nWidth AS LONG = pTabPage1->ClientWidth
DIM nHeight AS LONG = pTabPage1->ClientHeight
pTabPage1->SetClientSize(nWidth + 150, nHeight + 150)
' // Create an instance of the CScrollWindow class and attach the tab page handle to it
DIM pScrollWindow AS CScrollWindow PTR = NEW CScrollWindow(pTabPage1->hTabPage)
' // Store the pointer in the tab page for later deletion
pTabPage1->ScrollWindowPtr = pScrollWindow
' // Shrink the client size back to original
pTabPage1->SetClientSize(nWidth, nHeight)
' // Get the client size of the second page and make it greater
nWidth = pTabPage2->ClientWidth
nHeight = pTabPage2->ClientHeight
pTabPage2->SetClientSize(nWidth + 150, nHeight + 150)
' // Create an instance of the CScrollWindow class and attach the tab page handle to it
pScrollWindow = NEW CScrollWindow(pTabPage2->hTabPage)
' // Store the pointer in the tab page for later deletion
pTabPage2->ScrollWindowPtr = pScrollWindow
' // Shrink the client size back to original
pTabPage2->SetClientSize(nWidth, nHeight)
' // Get the client size of the second page and make it greater
nWidth = pTabPage3->ClientWidth
nHeight = pTabPage3->ClientHeight
pTabPage3->SetClientSize(nWidth + 150, nHeight + 150)
' // Create an instance of the CScrollWindow class and attach the tab page handle to it
pScrollWindow = NEW CScrollWindow(pTabPage3->hTabPage)
' // Store the pointer in the tab page for later deletion
pTabPage3->ScrollWindowPtr = pScrollWindow
' // Shrink the client size back to original
pTabPage3->SetClientSize(nWidth, nHeight)
' // Display the first tab page
ShowWindow pTabPage1->hTabPage, SW_SHOW
' // Set the focus to the first tab
SendMessageW hTab, TCM_SETCURFOCUS, 0, 0
' // Dispatch messages
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 1 window procedure
' To get a pointer to the CTabPage interface:
' DIM pTabPage AS CTabPage PTR = CAST(CTabPage PTR, GetWindowLongPtr(hwnd, 0))
' ========================================================================================
FUNCTION TabPage1_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 LOWORD(wParam)
CASE IDC_BTNSUBMIT
IF HIWORD(wParam) = BN_CLICKED THEN
MessageBoxW(hWnd, "Submit", "Tab 1", MB_OK)
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 0)
IF pScrollWindow THEN pScrollWindow->OnSize(wParam, lParam)
EXIT FUNCTION
CASE WM_VSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 0)
IF pScrollWindow THEN pScrollWindow->OnVScroll(wParam, lParam)
EXIT FUNCTION
CASE WM_HSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 0)
IF pScrollWindow THEN pScrollWindow->OnHScroll(wParam, lParam)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 2 window procedure
' To get a pointer to the CTabPage interface:
' DIM pTabPage AS CTabPage PTR = CAST(CTabPage PTR, GetWindowLongPtr(hwnd, 0))
' ========================================================================================
FUNCTION TabPage2_WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM hBrush AS HBRUSH, rc AS RECT, tlb AS LOGBRUSH
SELECT CASE uMsg
CASE WM_ERASEBKGND
GetClientRect hWnd, @rc
' Create custom brush
tlb.lbStyle = BS_SOLID
tlb.lbColor = &H00CB8734
tlb.lbHatch = 0
hBrush = CreateBrushIndirect(@tlb)
' Erase background
FillRect CAST(HDC, wParam), @rc, hBrush
DeleteObject hBrush
FUNCTION = CTRUE
EXIT FUNCTION
CASE WM_SIZE
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 1)
IF pScrollWindow THEN pScrollWindow->OnSize(wParam, lParam)
EXIT FUNCTION
CASE WM_VSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 1)
IF pScrollWindow THEN pScrollWindow->OnVScroll(wParam, lParam)
EXIT FUNCTION
CASE WM_HSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 1)
IF pScrollWindow THEN pScrollWindow->OnHScroll(wParam, lParam)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 3 window procedure
' To get a pointer to the CTabPage interface:
' DIM pTabPage AS CTabPage PTR = CAST(CTabPage PTR, GetWindowLongPtr(hwnd, 0))
' ========================================================================================
FUNCTION TabPage3_WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM hBrush AS HBRUSH, rc AS RECT, tlb AS LOGBRUSH
SELECT CASE uMsg
CASE WM_ERASEBKGND
GetClientRect hWnd, @rc
' Create custom brush
tlb.lbStyle = BS_SOLID
tlb.lbColor = &H0000FF00
tlb.lbHatch = 0
hBrush = CreateBrushIndirect(@tlb)
' Erase background
FillRect CAST(HDC, wParam), @rc, hBrush
DeleteObject hBrush
FUNCTION = CTRUE
EXIT FUNCTION
CASE WM_SIZE
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 2)
IF pScrollWindow THEN pScrollWindow->OnSize(wParam, lParam)
EXIT FUNCTION
CASE WM_VSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 2)
IF pScrollWindow THEN pScrollWindow->OnVScroll(wParam, lParam)
EXIT FUNCTION
CASE WM_HSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollTabPagePtr(GetParent(hwnd), 2)
IF pScrollWindow THEN pScrollWindow->OnHScroll(wParam, lParam)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
What about a scrollable and resizable child window as a container of other controls?
' ########################################################################################
' Microsoft Windows
' File: CW_ScrollableChildWindow.fbtpl
' Contents: Demonstrates the use of an scrollable child CWindow as container of child controls.
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose 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 "Afx/CWindow.inc"
USING Afx.CWindowClass
#INCLUDE ONCE "Afx/CLayout.inc"
USING Afx.CLayoutClass
ENUM AFX_USERDATA
AFX_LAYOUTPTRIDX = 0
END ENUM
ENUM
IDC_EDIT1 = 1001
IDC_EDIT2 = 1002
IDC_GROUPBOX = 1003
IDC_COMBOBOX = 1004
IDC_OPTION1 = 1005
IDC_OPTION2 = 1006
IDC_OPTION3 = 1007
IDC_DTPICKER = 1008
END ENUM
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 ChildDlg_WndProc (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
DIM pWindow AS CWindow
pWindow.Create(NULL, "Scrollable Child CWindow Example", @WndProc)
pWindow.SetClientSize 455, 180
pWindow.Center
' // Add controls
pWindow.AddControl("GroupBox", , IDC_GROUPBOX, "GroupBox", 340, 8, 100, 155)
pWindow.AddControl("Button", , IDCANCEL, "&Close", 250, 140, 76, 23)
' // Add a combobox control
DIM hCombobox AS HWND = pWindow.AddControl("ComboBox", , IDC_COMBOBOX, "", 350, 30, 80, 100)
' // Fill the control with some data
DIM i AS LONG = 1, wszText AS WSTRING * 260
FOR i = 1 TO 9
wszText = "Item " & RIGHT("00" & STR(i), 2)
SendMessageW(hComboBox, CB_ADDSTRING, 0, CAST(LPARAM, @wszText))
NEXT
' ***************************************************************************************
' // Child dialog
DIM pChildDlg AS CWindow
pChildDlg.Create(pWindow.hWindow, "", @ChildDlg_WndProc, 15, 15, , , _
WS_VISIBLE OR WS_CHILD OR WS_CLIPSIBLINGS OR WS_CLIPCHILDREN OR WS_BORDER, WS_EX_CONTROLPARENT)
pChildDlg.ClassStyle = CS_DBLCLKS
' // Set a client size big enough to display all the controls
' 310, 115
pChildDlg.SetClientSize(310, 180)
' // Add an Edit control
DIM hEdit AS HWND = pChildDlg.AddControl("Edit", , IDC_EDIT1, "", 10, 15, 275, 23)
' // Add three radio buttons (the first one should have the WS_GROUP style)
pChildDlg.AddControl("RadioButton", , IDC_OPTION1, "Option 1", 10, 50, 75, 23, WS_GROUP)
pChildDlg.AddControl("RadioButton", , IDC_OPTION2, "Option 2", 10, 70, 75, 23)
pChildDlg.AddControl("RadioButton", , IDC_OPTION3, "Option 3", 10, 90, 75, 23)
' // Add a date time picker control
pChilddlg.AddControl("SysDateTimePick32", , IDC_DTPICKER, "", 135, 55, 150, 23)
' // Add a button
pChildDlg.AddControl("Button", , IDOK, "&Ok", 205, 140, 76, 23)
' // Create an instance of the CScrollWindow class and attach the main window to it
DIM pScrollChildDlg AS CScrollWindow PTR = NEW CScrollWindow(pChildDlg.hWindow)
' // Store the pointer in the class of the parent window for later deletion
pChildDlg.ScrollWindowPtr = pScrollChildDlg
' // Shrink the client size
pChildDlg.SetClientSize(310, 110)
' // Set the focus in the first edit control
SetFocus hEdit
' ***************************************************************************************
' // Anchor the controls
DIM pLayout AS CLayout = pWindow.hWindow
pWindow.UserData(AFX_LAYOUTPTRIDX) = CAST(LONG_PTR, @pLayout)
pLayout.AnchorControl(IDCANCEL, AFX_ANCHOR_BOTTOM_RIGHT)
pLayout.AnchorControl(IDC_GROUPBOX, AFX_ANCHOR_HEIGHT_RIGHT)
pLayout.AnchorControl(IDC_COMBOBOX, AFX_ANCHOR_RIGHT)
' // Anchor the child CWindow
pLayout.AnchorControl(pChildDlg.hWindow, AFX_ANCHOR_HEIGHT_WIDTH)
' // We could also make the child controls of this window with
' // DIM pChildLayout AS CLayout = pChildDlg.hWindow
' // pChildLayout.AnchorControl(IDC_EDIT1, AFX_ANCHOR_WIDTH)
' // etc.
' // Process 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 LOWORD(wParam)
' // If ESC key pressed, close the application sending an 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_GETMINMAXINFO
' Set the pointer to the address of the MINMAXINFO structure
DIM ptmmi AS MINMAXINFO PTR = CAST(MINMAXINFO PTR, lParam)
' Set the minimum and maximum sizes that can be produced by dragging the borders of the window
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
IF pWindow THEN
ptmmi->ptMinTrackSize.x = 300 * pWindow->rxRatio
ptmmi->ptMinTrackSize.y = 180 * pWindow->ryRatio
END IF
EXIT FUNCTION
CASE WM_SIZE
' // Adjusts the controls
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
IF pWindow THEN
DIM pLayout AS CLayout PTR = CAST(CLayout PTR, pWindow->UserData(AFX_LAYOUTPTRIDX))
IF pLayout THEN pLayout->AdjustControls
END IF
EXIT FUNCTION
CASE WM_DESTROY
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Child dialog window procedure
' ========================================================================================
FUNCTION ChildDlg_WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
' // We can't use AfxCWindowPtr because, being a child dialog, this function
' // will return the pointer of the owner window.nd)->ScrollWindowPtr
' // I will modify the AfxScrollWindowPtr function to allow its use with CWindow child windows, i.e.
' // DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
CASE WM_SIZE
' DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
DIM pScrollWindow AS CScrollWindow PTR = cast(CWindow PTR, GetWindowLongPtr(hwnd, 0))->ScrollWindowPtr
IF pScrollWindow THEN pScrollWindow->OnSize(wParam, lParam)
EXIT FUNCTION
CASE WM_VSCROLL
' DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
DIM pScrollWindow AS CScrollWindow PTR = cast(CWindow PTR, GetWindowLongPtr(hwnd, 0))->ScrollWindowPtr
IF pScrollWindow THEN pScrollWindow->OnVScroll(wParam, lParam)
EXIT FUNCTION
CASE WM_HSCROLL
' DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
DIM pScrollWindow AS CScrollWindow PTR = cast(CWindow PTR, GetWindowLongPtr(hwnd, 0))->ScrollWindowPtr
IF pScrollWindow THEN pScrollWindow->OnHScroll(wParam, lParam)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
There is a problem with multiline and rich edit controls. For some unknown reason to me, if the ESC key is pressed when the control has the focus, it closes the child dialog! The only workaround that I have found is to subclass these controls.
' ########################################################################################
' Microsoft Windows
' File: CW_ScrollableChildWindow2.fbtpl
' Contents: Demonstrates the use of an scrollable child CWindow as container of child controls.
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose 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 "Afx/CWindow.inc"
USING Afx.CWindowClass
#INCLUDE ONCE "Afx/CLayout.inc"
USING Afx.CLayoutClass
ENUM AFX_USERDATA
AFX_LAYOUTPTRIDX = 0
END ENUM
ENUM
IDC_EDIT1 = 1001
IDC_EDIT2 = 1002
IDC_GROUPBOX = 1003
IDC_COMBOBOX = 1004
IDC_OPTION1 = 1005
IDC_OPTION2 = 1006
IDC_OPTION3 = 1007
IDC_DTPICKER = 1008
END ENUM
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 ChildDlg_WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION Edit_SubclassProc ( _
BYVAL hwnd AS HWND, _ ' // Control window handle
BYVAL uMsg AS UINT, _ ' // Type of message
BYVAL wParam AS WPARAM, _ ' // First message parameter
BYVAL lParam AS LPARAM _ ' // Second message parameter
) 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
DIM pWindow AS CWindow
pWindow.Create(NULL, "Scrollable Child CWindow Example", @WndProc)
pWindow.SetClientSize 455, 180
pWindow.Center
' // Add controls
pWindow.AddControl("GroupBox", , IDC_GROUPBOX, "GroupBox", 340, 8, 100, 155)
pWindow.AddControl("Button", , IDCANCEL, "&Close", 250, 140, 76, 23)
' // Add a combobox control
DIM hCombobox AS HWND = pWindow.AddControl("ComboBox", , IDC_COMBOBOX, "", 350, 30, 80, 100)
' // Fill the control with some data
DIM i AS LONG = 1, wszText AS WSTRING * 260
FOR i = 1 TO 9
wszText = "Item " & RIGHT("00" & STR(i), 2)
SendMessageW(hComboBox, CB_ADDSTRING, 0, CAST(LPARAM, @wszText))
NEXT
' ***************************************************************************************
' // Child dialog
DIM pChildDlg AS CWindow
pChildDlg.Create(pWindow.hWindow, "", @ChildDlg_WndProc, 15, 15, , , _
WS_VISIBLE OR WS_CHILD OR WS_CLIPSIBLINGS OR WS_CLIPCHILDREN OR WS_BORDER, WS_EX_CONTROLPARENT)
pChildDlg.ClassStyle = CS_DBLCLKS
' // Set a client size big enough to display all the controls
' 310, 115
pChildDlg.SetClientSize(310, 180)
' // Add an Edit control
DIM hEdit AS HWND = pChildDlg.AddControl("Edit", , IDC_EDIT1, "", 10, 15, 275, 23)
' // Add a multiline Edit control
' // There is a problem with multiline and rich edit controls: if the ESC key is
' // pressed when the control has the focus, it closes the child dialog!
' // One solution is to subclass the control and process the VK_ESCAPE message.
pChildDlg.AddControl("EditMultiline", , IDC_EDIT2, "", 10, 45, 275, 80, , , , CAST(WNDPROC, @Edit_SubclassProc))
' // Add a button
pChildDlg.AddControl("Button", , IDOK, "&Ok", 208, 140, 76, 23)
' // Create an instance of the CScrollWindow class and attach the main window to it
DIM pScrollChildDlg AS CScrollWindow PTR = NEW CScrollWindow(pChildDlg.hWindow)
' // Store the pointer in the class of the parent window for later deletion
pChildDlg.ScrollWindowPtr = pScrollChildDlg
' // Shrink the client size
pChildDlg.SetClientSize(310, 110)
' // Set the focus in the first edit control
SetFocus hEdit
' ***************************************************************************************
' // Anchor the controls
DIM pLayout AS CLayout = pWindow.hWindow
pWindow.UserData(AFX_LAYOUTPTRIDX) = CAST(LONG_PTR, @pLayout)
pLayout.AnchorControl(IDCANCEL, AFX_ANCHOR_BOTTOM_RIGHT)
pLayout.AnchorControl(IDC_GROUPBOX, AFX_ANCHOR_HEIGHT_RIGHT)
pLayout.AnchorControl(IDC_COMBOBOX, AFX_ANCHOR_RIGHT)
' // Anchor the child CWindow
pLayout.AnchorControl(pChildDlg.hWindow, AFX_ANCHOR_HEIGHT_WIDTH)
' // We could also make the child controls of this window with
' // DIM pChildLayout AS CLayout = pChildDlg.hWindow
' // pChildLayout.AnchorControl(IDC_EDIT1, AFX_ANCHOR_WIDTH)
' // etc.
' // Process 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 LOWORD(wParam)
' // If ESC key pressed, close the application sending an 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_GETMINMAXINFO
' Set the pointer to the address of the MINMAXINFO structure
DIM ptmmi AS MINMAXINFO PTR = CAST(MINMAXINFO PTR, lParam)
' Set the minimum and maximum sizes that can be produced by dragging the borders of the window
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
IF pWindow THEN
ptmmi->ptMinTrackSize.x = 300 * pWindow->rxRatio
ptmmi->ptMinTrackSize.y = 180 * pWindow->ryRatio
END IF
EXIT FUNCTION
CASE WM_SIZE
' // Adjusts the controls
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
IF pWindow THEN
DIM pLayout AS CLayout PTR = CAST(CLayout PTR, pWindow->UserData(AFX_LAYOUTPTRIDX))
IF pLayout THEN pLayout->AdjustControls
END IF
EXIT FUNCTION
CASE WM_DESTROY
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Child dialog window procedure
' ========================================================================================
FUNCTION ChildDlg_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 LOWORD(wParam)
CASE IDOK
IF HIWORD(wParam) = BN_CLICKED THEN
MessageBoxW hwnd, "Ok button clicked", "", MB_OK
EXIT FUNCTION
END IF
CASE IDC_OPTION1, IDC_OPTION2, IDC_OPTION3
IF HIWORD(wParam) = BN_CLICKED THEN
MessageBoxW hwnd, "Option button clicked", "", MB_OK
EXIT FUNCTION
END IF
END SELECT
' // We can't use AfxCWindowPtr because, being a child dialog, this function
' // will return the pointer of the owner window.nd)->ScrollWindowPtr
' // I will modify the AfxScrollWindowPtr function to allow its use with CWindow child windows, i.e.
' // DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
CASE WM_SIZE
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
' DIM pScrollWindow AS CScrollWindow PTR = cast(CWindow PTR, GetWindowLongPtr(hwnd, 0))->ScrollWindowPtr
IF pScrollWindow THEN pScrollWindow->OnSize(wParam, lParam)
EXIT FUNCTION
CASE WM_VSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
' DIM pScrollWindow AS CScrollWindow PTR = cast(CWindow PTR, GetWindowLongPtr(hwnd, 0))->ScrollWindowPtr
IF pScrollWindow THEN pScrollWindow->OnVScroll(wParam, lParam)
EXIT FUNCTION
CASE WM_HSCROLL
DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
' DIM pScrollWindow AS CScrollWindow PTR = cast(CWindow PTR, GetWindowLongPtr(hwnd, 0))->ScrollWindowPtr
IF pScrollWindow THEN pScrollWindow->OnHScroll(wParam, lParam)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Processes messages for the subclassed Button window.
' ========================================================================================
FUNCTION Edit_SubclassProc ( _
BYVAL hwnd AS HWND, _ ' // Control window handle
BYVAL uMsg AS UINT, _ ' // Type of message
BYVAL wParam AS WPARAM, _ ' // First message parameter
BYVAL lParam AS LPARAM _ ' // Second message parameter
) AS LRESULT
SELECT CASE uMsg
CASE WM_GETDLGCODE
' // All keyboard input
FUNCTION = DLGC_WANTALLKEYS
EXIT FUNCTION
CASE WM_KEYDOWN
SELECT CASE LOWORD(wParam)
CASE VK_ESCAPE
' // Do nothing or forward the message to the ancestor
SendMessageW(GetAncestor(hwnd, GA_ROOTOWNER), WM_CLOSE, 0, 0)
EXIT FUNCTION
END SELECT
CASE WM_DESTROY
' // REQUIRED: Remove control subclassing
SetWindowLongPtrW hwnd, GWLP_WNDPROC, CAST(LONG_PTR, RemovePropW(hwnd, "OLDWNDPROC"))
END SELECT
FUNCTION = CallWindowProcW(GetPropW(hwnd, "OLDWNDPROC"), hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
Quote from: Jose Roca on June 24, 2016, 12:50:00 PM
There is a problem with multiline and rich edit controls. For some unknown reason to me, if the ESC key is pressed when the control has the focus, it closes the child dialog! The only workaround that I have found is to subclass these controls.
I know exactly how you feel. When building Firefly's code generator I also had to deal with the mysterious ESC closing the window (I also decided to handle the case of allowing the TAB key to move out of a mulitline edit control). Here is the code that is built into all Firefly generated message loops:
' Handle the strange situation where pressing ESCAPE in a multiline
' textbox causes the application to receive a WM_CLOSE that could
' cause an application to terminate. also allow the TAB key to move
' in and out of a multiline textbox.
GetClassName GetFocus, zTempString, SizeOf(zTempString)
Select Case Ucase(zTempString)
Case "EDIT", Ucase(gFLY_RichEditClass)
IF (GetWindowLongPtr(GetFocus, GWL_STYLE) AND ES_MULTILINE) = ES_MULTILINE THEN
If (msg.message = WM_KEYDOWN) And (Msg.wParam = VK_ESCAPE) Then
msg.message = WM_COMMAND
msg.wParam = MakeLong(IDCANCEL, 0)
msg.lParam = 0
ElseIf (Msg.message = WM_CHAR) And (Msg.wParam = 9) Then
' allow the Tab key to tab out of a multiline textbox
If (GetAsyncKeyState(VK_SHIFT) And &H8000) = 0 Then
SetFocus GetNextDlgTabItem( GetParent(Msg.hWnd), Msg.hWnd, FALSE )
Else
SetFocus GetNextDlgTabItem( GetParent(Msg.hWnd), Msg.hWnd, TRUE )
End If
msg.message = WM_NULL
End If
End If
End Select
I have looked at the source code of Wine's implementation and it posts a WM_CLOSE message to his parent:
case VK_ESCAPE:
if ((es->style & ES_MULTILINE) && EDIT_IsInsideDialog(es))
PostMessageW(es->hwndParent, WM_CLOSE, 0, 0);
break;
case VK_TAB:
if ((es->style & ES_MULTILINE) && EDIT_IsInsideDialog(es))
SendMessageW(es->hwndParent, WM_NEXTDLGCTL, shift, 0);
break;
See: https://github.com/wine-mirror/wine/blob/master/dlls/user32/edit.c
I have managed to embed the Explorer Browser in a Tab Page. Next step will be to retrieve the paths of the selected item or items.
' ########################################################################################
' Microsoft Windows
' File: CW_COMMCTRL_TabControlDemo.fbtpl - Template
' Contents: CWindow Tab Control template
' Remarks: Demonstrates the use of the CTabPage class
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose 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.
' ########################################################################################
#define UNICODE
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxCtl.inc"
#INCLUDE ONCE "win/shlobj.bi"
USING Afx.CWindowClass
' $FB_RESPATH = "FBRES.rc"
CONST IDC_TAB = 1001
CONST IDC_EDIT1 = 1002
CONST IDC_EDIT2 = 1003
CONST IDC_BTNSUBMIT = 1004
CONST IDC_COMBO = 1005
CONST IDC_LISTBOX = 1006
' // 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 TabPage1_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION TabPage2_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
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)
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Initialize the COM library
OleInitialize(NULL)
' // Set process DPI aware
AfxSetProcessDPIAware
DIM pWindow AS CWindow
pWindow.Create(NULL, "Explorer Browser in a Tab Control", @WndProc)
pWindow.SetClientSize(550, 370)
pWindow.Center
' // Add a tab control
DIM hTab AS HWND = pWindow.AddControl("Tab", , IDC_TAB, "", 10, 10, pWindow.ClientWidth - 20, pWindow.ClientHeight - 42)
' // Create the first tab page
DIM pTabPage1 AS CTabPage PTR = NEW CTabPage
pTabPage1->InsertPage(hTab, 0, "Explorer Browser", -1, @TabPage1_WndProc)
' // Create the second tab page
DIM pTabPage2 AS CTabPage PTR = NEW CTabPage
pTabPage2->InsertPage(hTab, 1, "Items Selected", -1, @TabPage2_WndProc)
' // Add a button
pWindow.AddControl("Button", , IDCANCEL, "&Close", 415, 292, 75, 23)
' // Display the first tab page
ShowWindow pTabPage1->hTabPage, SW_SHOW
' // Set the focus to the first tab
SendMessageW hTab, TCM_SETCURFOCUS, 0, 0
' // Dispatch messages
FUNCTION = pWindow.DoEvents(nCmdShow)
' // Uninitialize the COM library
CoUninitialize
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_CREATE
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
' // If ESC key pressed, close the application sending an 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_GETMINMAXINFO
' Set the pointer to the address of the MINMAXINFO structure
DIM ptmmi AS MINMAXINFO PTR = CAST(MINMAXINFO PTR, lParam)
' Set the minimum and maximum sizes that can be produced by dragging the borders of the window
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
IF pWindow THEN
ptmmi->ptMinTrackSize.x = 460 * pWindow->rxRatio
ptmmi->ptMinTrackSize.y = 320 * pWindow->ryRatio
END IF
EXIT FUNCTION
CASE WM_SIZE
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
DIM hTab AS HWND = GetDlgItem(hwnd, IDC_TAB)
' / Move the close button
IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 85, pWindow->ClientHeight - 28, 75, 23, CTRUE
' // Resize the tab control
IF pWindow THEN pWindow->MoveWindow(hTab, 10, 10, pWindow->ClientWidth - 20, pWindow->ClientHeight - 42, CTRUE)
' // Resize the tab pages
AfxResizeTabPages hTab
EXIT FUNCTION
CASE WM_NOTIFY
DIM nPage AS DWORD ' // Page number
DIM pTabPage AS CTabPage PTR ' // Tab page object reference
DIM tci AS TCITEMW ' // TCITEMW structure
DIM ptnmhdr AS NMHDR PTR ' // Information about a notification message
ptnmhdr = CAST(NMHDR PTR, lParam)
SELECT CASE ptnmhdr->idFrom
CASE IDC_TAB
SELECT CASE ptnmhdr->code
CASE TCN_SELCHANGE
' // Show the selected page
pTabPage = AfxCTabPagePtr(ptnmhdr->hwndFrom, -1)
IF pTabPage THEN ShowWindow pTabPage->hTabPage, SW_SHOW
CASE TCN_SELCHANGING
' // Hide the current page
pTabPage = AfxCTabPagePtr(ptnmhdr->hwndFrom, -1)
IF pTabPage THEN ShowWindow pTabPage->hTabPage, SW_HIDE
END SELECT
END SELECT
CASE WM_DESTROY
' // Destroy the tab pages
AfxDestroyAllTabPages(GetDlgItem(hwnd, IDC_TAB))
' // Quit the application
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 1 window procedure
' ========================================================================================
FUNCTION TabPage1_WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
STATIC peb AS IExplorerBrowser PTR
SELECT CASE uMsg
CASE WM_CREATE
' // Get a pointer to the TabPage class
DIM pTabPage AS CTabPage PTR = AfxCTabPagePtr(GetParent(hwnd), 0)
' // Create an instance of IExplorerBrowser
CoCreateInstance(@CLSID_ExplorerBrowser, NULL, CLSCTX_INPROC_SERVER, @IID_IExplorerBrowser, @peb)
IF peb = NULL THEN EXIT FUNCTION
peb->lpVtbl->SetOptions(peb, EBO_SHOWFRAMES)
DIM fs AS FOLDERSETTINGS
fs.ViewMode = FVM_DETAILS
DIM rc AS RECT
GetClientRect hwnd, @rc
peb->lpVtbl->Initialize(peb, hwnd, @rc, @fs)
' // Navigate to the Profile folder
DIM pidlBrowse AS LPITEMIDLIST
' IF SUCCEEDED(SHGetFolderLocation(NULL, CSIDL_PROFILE, NULL, 0, @pidlBrowse)) THEN
' peb->lpVtbl->BrowseToIDList(peb, pidlBrowse, 0)
' ILFree(pidlBrowse)
' END IF
DIM wszPath AS WSTRING * MAX_PATH
wszPath = "C:\Users\Pepe\FreeBasic64" ' --> change me
IF SUCCEEDED(SHParseDisplayName(wszPath, NULL, @pidlBrowse, 0, NULL)) THEN
peb->lpVtbl->BrowseToIDList(peb, pidlBrowse, 0)
ILFree(pidlBrowse)
END IF
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDC_BTNSUBMIT
IF HIWORD(wParam) = BN_CLICKED THEN
MessageBoxW(hWnd, "Submit", "Tab 1", MB_OK)
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
' // Resize the Explorer control
DIM rc AS RECT
GetClientRect hwnd, @rc
IF peb THEN peb->lpVtbl->SetRect(peb, NULL, rc)
EXIT FUNCTION
CASE WM_DESTROY
' // Destroy the browser and release the interface
IF peb THEN
peb->lpVtbl->Destroy(peb)
peb->lpVtbl->Release(peb)
END IF
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 2 window procedure
' ========================================================================================
FUNCTION TabPage2_WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM hBrush AS HBRUSH, rc AS RECT, tlb AS LOGBRUSH
SELECT CASE uMsg
CASE WM_CREATE
' // Get a pointer to the TabPage class
DIM pTabPage AS CTabPage PTR = AfxCTabPagePtr(GetParent(hwnd), 1)
' // Add a combobox to the second page
DIM hListBox AS HWND = pTabPage->AddControl("ListBox", hwnd, IDC_LISTBOX, "", 20, 20, 485, 270)
' // Fill the listbox with some data
DIM i AS LONG = 1, wszText AS WSTRING * 260
FOR i = 1 TO 9
wszText = "Item " & RIGHT("00" & STR(i), 2)
ListBox_AddString(hListBox, @wszText)
NEXT
' // Select the first item in the combo box
ListBox_SetCursel(hListBox, 0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
Note that I'm using OleInitialize instead of CoInitialize to allow drag and drop.
The Explorer browser also maintains a travel log of all the folders visited. It is possible to programmatically navigate back or forward. This can be done using the BrowseToIDList function as shown below:
peb->BrowseToIDList(NULL, SBSP_NAVIGATEBACK)
peb->BrowseToIDList(NULL, SBSP_NAVIGATEFORWARD)
So an enhancement would be to add a couple of arrow icons and perform forward or backwards navigation if clicked.
See this article in CodeProject:
http://www.codeproject.com/Articles/17809/Host-Windows-Explorer-in-your-applications-using-t
Skip all the part of "Preparing the Build Environment".
This example retrievs the paths of the selected files and displays its names in the listbox of the second tab page.
' ########################################################################################
' Microsoft Windows
' File: CW_COMMCTRL_TabControlDemo.fbtpl - Template
' Contents: CWindow Tab Control template
' Remarks: Demonstrates the use of the CTabPage class
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose 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.
' ########################################################################################
#define UNICODE
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxCtl.inc"
#INCLUDE ONCE "win/shlobj.bi"
USING Afx.CWindowClass
' $FB_RESPATH = "FBRES.rc"
CONST IDC_TAB = 1001
CONST IDC_BTNSUBMIT = 1002
CONST IDC_LISTBOX = 1003
CONST IDC_SELECTION = 1004
' // 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 TabPage1_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION TabPage2_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
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)
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Initialize the COM library
OleInitialize(NULL)
' // Set process DPI aware
AfxSetProcessDPIAware
DIM pWindow AS CWindow
pWindow.Create(NULL, "Explorer Browser in a Tab Control", @WndProc)
pWindow.SetClientSize(550, 370)
pWindow.Center
' // Add a tab control
DIM hTab AS HWND = pWindow.AddControl("Tab", , IDC_TAB, "", 10, 10, pWindow.ClientWidth - 20, pWindow.ClientHeight - 42)
' // Create the first tab page
DIM pTabPage1 AS CTabPage PTR = NEW CTabPage
pTabPage1->InsertPage(hTab, 0, "Explorer Browser", -1, @TabPage1_WndProc)
' // Create the second tab page
DIM pTabPage2 AS CTabPage PTR = NEW CTabPage
pTabPage2->InsertPage(hTab, 1, "Selected Items", -1, @TabPage2_WndProc)
' // Add buttons
pWindow.AddControl("Button", , IDC_SELECTION, "&Selection")
pWindow.AddControl("Button", , IDCANCEL, "&Close")
' // Display the first tab page
ShowWindow pTabPage1->hTabPage, SW_SHOW
' // Set the focus to the first tab
SendMessageW hTab, TCM_SETCURFOCUS, 0, 0
' // Dispatch messages
FUNCTION = pWindow.DoEvents(nCmdShow)
' // Uninitialize the COM library
CoUninitialize
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_CREATE
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_SELECTION
IF HIWORD(wParam) = BN_CLICKED THEN
' // Get a reference to the 2nd tab page
DIM pTabPage AS CTabPage PTR = AfxCTabPagePtr(GetDlgItem(hwnd, IDC_TAB), 1)
' // Get the handle of the listbox control
DIM hListBox AS HWND = GetDlgItem(pTabPage->hTabPage, IDC_LISTBOX)
' // Get the number of items in the listbox
DIM nItems AS LONG = ListBox_GetCount(hListBox)
' // Delete all items
DIM i AS LONG
FOR i = 0 TO nItems - 1
ListBox_DeleteString(hListBox, 0)
NEXT
' // Get a reference to the CWindow class
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
IF pWindow = NULL THEN EXIT FUNCTION
' // Get the pointer to IExplorerBrowser previously stored in the user data
DIM peb AS IExplorerBrowser PTR = cast(IExplorerBrowser PTR, pWindow->UserData(0))
IF peb = NULL THEN EXIT FUNCTION
' // Get a reference to the IShellView interface for the current view
DIM psv AS IShellView PTR
DIM hr AS HRESULT = peb->lpvtbl->GetCurrentView(peb, @IID_IShellView, @psv)
IF psv THEN
' // Get a reference to the IDataObject interface
DIM pDataObject AS IDataObject PTR
psv->lpvtbl->GetItemObject(psv, SVGIO_SELECTION, @IID_IDataObject, @pDataObject)
If pDataObject = NULL THEN MessageBox hwnd, "No files selected", "", MB_OK
IF pDataObject THEN
DIM fmt AS FORMATETC = (CF_HDROP, NULL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL)
DIM stg AS STGMEDIUM
stg.tymed = TYMED_HGLOBAL
' // Get the kind of data specified in FORMATETC
IF SUCCEEDED(pDataObject->lpvtbl->GetData(pDataObject, @fmt, @stg)) THEN
' // Lock the global memory handle
DIM hDrop AS HDROP = GlobalLock(stg.hGlobal)
' // Get the number of selected files
DIM uNumFiles AS UINT = DragQueryFile(hDrop, &hFFFFFFFF, NULL, 0)
DIM hr AS HRESULT, i AS LONG
DIM wszPath AS WSTRING * MAX_PATH
FOR i = 0 TO uNumFiles - 1
wszPath = ""
' // Get the path of the file
DragQueryFile(hDrop, i, @wszPath, MAX_PATH)
' // Add it to the listbox
ListBox_AddString(hListbox, @wszPath)
NEXT
' // Unlock the global memry handle
GlobalUnlock(stg.hGlobal)
' // Release the STGMEDIUM structure
ReleaseStgMedium(@stg)
' // Set the focus in the Items tab
DIM hTab AS HWND = GetDlgItem(hwnd, IDC_TAB)
TabCtrl_SetCurFocus(hTab, 1)
END IF
' // Release the IDataObject interface
pDataObject->lpVtbl->Release(pDataObject)
END IF
END IF
' // Release the IShellView interface
IF psv THEN psv->lpVtbl->Release(psv)
EXIT FUNCTION
END IF
END SELECT
CASE WM_GETMINMAXINFO
' Set the pointer to the address of the MINMAXINFO structure
DIM ptmmi AS MINMAXINFO PTR = CAST(MINMAXINFO PTR, lParam)
' Set the minimum and maximum sizes that can be produced by dragging the borders of the window
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
IF pWindow THEN
ptmmi->ptMinTrackSize.x = 460 * pWindow->rxRatio
ptmmi->ptMinTrackSize.y = 320 * pWindow->ryRatio
END IF
EXIT FUNCTION
CASE WM_SIZE
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
DIM hTab AS HWND = GetDlgItem(hwnd, IDC_TAB)
' / Move the buttons
IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_SELECTION), pWindow->ClientWidth - 170, pWindow->ClientHeight - 28, 75, 23, CTRUE
IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 85, pWindow->ClientHeight - 28, 75, 23, CTRUE
' // Resize the tab control
IF pWindow THEN pWindow->MoveWindow(hTab, 10, 10, pWindow->ClientWidth - 20, pWindow->ClientHeight - 42, CTRUE)
' // Resize the tab pages
AfxResizeTabPages hTab
EXIT FUNCTION
CASE WM_NOTIFY
DIM nPage AS DWORD ' // Page number
DIM pTabPage AS CTabPage PTR ' // Tab page object reference
DIM tci AS TCITEMW ' // TCITEMW structure
DIM ptnmhdr AS NMHDR PTR ' // Information about a notification message
ptnmhdr = CAST(NMHDR PTR, lParam)
SELECT CASE ptnmhdr->idFrom
CASE IDC_TAB
SELECT CASE ptnmhdr->code
CASE TCN_SELCHANGE
' // Show the selected page
pTabPage = AfxCTabPagePtr(ptnmhdr->hwndFrom, -1)
IF pTabPage THEN ShowWindow pTabPage->hTabPage, SW_SHOW
CASE TCN_SELCHANGING
' // Hide the current page
pTabPage = AfxCTabPagePtr(ptnmhdr->hwndFrom, -1)
IF pTabPage THEN ShowWindow pTabPage->hTabPage, SW_HIDE
END SELECT
END SELECT
CASE WM_DESTROY
' // Destroy the tab pages
AfxDestroyAllTabPages(GetDlgItem(hwnd, IDC_TAB))
' // Quit the application
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 1 window procedure
' ========================================================================================
FUNCTION TabPage1_WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
STATIC peb AS IExplorerBrowser PTR
SELECT CASE uMsg
CASE WM_CREATE
' // Get a pointer to the TabPage class
DIM pTabPage AS CTabPage PTR = AfxCTabPagePtr(GetParent(hwnd), 0)
' // Create an instance of IExplorerBrowser
CoCreateInstance(@CLSID_ExplorerBrowser, NULL, CLSCTX_INPROC_SERVER, @IID_IExplorerBrowser, @peb)
IF peb = NULL THEN EXIT FUNCTION
peb->lpVtbl->SetOptions(peb, EBO_SHOWFRAMES)
DIM fs AS FOLDERSETTINGS
fs.ViewMode = FVM_DETAILS
DIM rc AS RECT
GetClientRect hwnd, @rc
peb->lpVtbl->Initialize(peb, hwnd, @rc, @fs)
' // Navigate to the Profile folder
DIM pidlBrowse AS LPITEMIDLIST
' IF SUCCEEDED(SHGetFolderLocation(NULL, CSIDL_PROFILE, NULL, 0, @pidlBrowse)) THEN
' peb->lpVtbl->BrowseToIDList(peb, pidlBrowse, 0)
' ILFree(pidlBrowse)
' END IF
DIM wszPath AS WSTRING * MAX_PATH
' wszPath = "C:\Users\Pepe\FreeBasic64" ' --> change me
wszPath = "C:\Users" ' --> change me
IF SUCCEEDED(SHParseDisplayName(wszPath, NULL, @pidlBrowse, 0, NULL)) THEN
peb->lpVtbl->BrowseToIDList(peb, pidlBrowse, 0)
ILFree(pidlBrowse)
END IF
' // Store the IExplorerBrowser pointer in the user data of the main window
DIM pWindow AS CWindow PTR = AfxCWindowPtr(GetAncestor(hwnd, GA_ROOTOWNER))
pWindow->UserData(0) = cast(LONG_PTR, peb)
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDC_BTNSUBMIT
IF HIWORD(wParam) = BN_CLICKED THEN
MessageBoxW(hWnd, "Submit", "Tab 1", MB_OK)
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
' // Resize the Explorer control
DIM rc AS RECT
GetClientRect hwnd, @rc
IF peb THEN peb->lpVtbl->SetRect(peb, NULL, rc)
EXIT FUNCTION
CASE WM_DESTROY
' // Destroy the browser and release the interface
IF peb THEN
peb->lpVtbl->Destroy(peb)
peb->lpVtbl->Release(peb)
END IF
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 2 window procedure
' ========================================================================================
FUNCTION TabPage2_WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM hBrush AS HBRUSH, rc AS RECT, tlb AS LOGBRUSH
SELECT CASE uMsg
CASE WM_CREATE
' // Get a pointer to the TabPage class
DIM pTabPage AS CTabPage PTR = AfxCTabPagePtr(GetParent(hwnd), 1)
' // Add a combobox to the second page
DIM hListBox AS HWND = pTabPage->AddControl("ListBox", hwnd, IDC_LISTBOX, "", 20, 20, 485, 270)
' // Fill the listbox with some data
DIM i AS LONG = 1, wszText AS WSTRING * 260
FOR i = 1 TO 9
wszText = "Item " & RIGHT("00" & STR(i), 2)
ListBox_AddString(hListBox, @wszText)
NEXT
' // Select the first item in the combo box
ListBox_SetCursel(hListBox, 0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
Not for the faint of heart :)