CWindow RC11

Started by José Roca, June 22, 2016, 02:13:03 PM

Previous topic - Next topic
Print
Go Down Pages1
User actions

José Roca

June 22, 2016, 02:13:03 PM Last Edit: September 01, 2016, 12:12:58 AM by Jose Roca
CWindow Release Candidate 11.

Besides some additional wrapper functions, the main change is the addition of scrollable windows support.

José Roca

#1
June 22, 2016, 02:21:56 PM
The way to get it working is to design your main window or popup dialog as if it was not scrollable, e.g.

Code Select

   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.

Code Select

   ' // 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:

Code Select

   ' // 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:

Code Select

   ' // Shrink the client size
   pWindow.SetClientSize(250, 260)


In the callback function, process the WM_SIZE, WM_VSCROLL and WM_VSCROLL messages:

Code 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

José Roca

#2
June 22, 2016, 02:22:54 PM
Full example code:

Code Select

' ########################################################################################
' 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
' ========================================================================================

José Roca

#3
June 22, 2016, 02:34:49 PM Last Edit: June 22, 2016, 02:50:17 PM by Jose Roca
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.

Code Select

   ' // 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:

Code 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


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.).

José Roca

#4
June 22, 2016, 02:35:19 PM Last Edit: June 22, 2016, 02:48:09 PM by Jose Roca
Full example code:

Code Select

' ########################################################################################
' 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
' ========================================================================================

José Roca

#5
June 24, 2016, 12:45:15 PM
What about a scrollable and resizable child window as a container of other controls?

Code Select

' ########################################################################################
' 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
' ========================================================================================

José Roca

#6
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.

Code Select

' ########################################################################################
' 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
' ========================================================================================

Paul Squires

#7
June 24, 2016, 01:59:42 PM
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:

Code Select

                ' 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

Paul Squires
PlanetSquires Software

José Roca

#8
June 24, 2016, 02:28:36 PM
I have looked at the source code of Wine's implementation and it posts a WM_CLOSE message to his parent:

Code Select

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

José Roca

#9
June 28, 2016, 10:36:07 PM Last Edit: June 28, 2016, 10:38:41 PM by Jose Roca
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.

Code Select

' ########################################################################################
' 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.

José Roca

#10
June 28, 2016, 10:46:07 PM Last Edit: June 28, 2016, 10:48:18 PM by Jose Roca
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:

Code Select

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".

José Roca

#11
June 29, 2016, 02:20:34 AM Last Edit: June 29, 2016, 02:22:50 AM by Jose Roca
This example retrievs the paths of the selected files and displays its names in the listbox of the second tab page.

Code Select

' ########################################################################################
' 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 :)
Print
Go Up Pages1
User actions