CWindow RC08

[Paul Squires]

@Paul,

To make the use of AddAcelerator even easier, I have overloaded it to accept a wide string in the second parameter.

Instead of having to use

Code Select Expand


pWindow.AddAccelerator FVIRTKEY OR FCONTROL, ASC("S"), IDM_SAVE ' // Ctrl+S - Save


Code Select Expand


pWindow.AddAccelerator FVIRTKEY OR FCONTROL, "S", IDM_SAVE ' // Ctrl+S - Save


Not a big deal, but...

Thanks Jose, I assume in this case you would not use FVIRTKEY in your flags because you are passing ASCII character codes.

[José Roca]

I need to pass FVIRTKEY; otherwise, it does not work. Don't know why.

[José Roca]

BTW if you remember that I commented that, in this function

Code Select Expand


' ========================================================================================
' Adds a button to a toolbar.
' Minimum operating systems Windows NT 3.51, Windows 95
' ========================================================================================
PRIVATE FUNCTION AfxToolbar_AddButton (BYVAL hToolBar AS HWND, BYVAL idxBitmap AS LONG, BYVAL idCommand AS LONG, _
BYVAL fsState AS UBYTE = 0, BYVAL fsStyle AS UBYTE = 0, BYVAL dwData AS DWORD_PTR = 0, BYVAL pwszText AS WSTRING PTR = NULL) AS LRESULT
   IF fsState = 0 THEN fsState = TBSTATE_ENABLED
   DIM idxString AS INT_PTR
   IF pwszText <> NULL THEN idxString = IIF(LEN(*pwszText) = 0, -1, CAST(INT_PTR, pwszText))
#ifdef __FB_64BIT__
   DIM tbb AS TBBUTTON = (idxBitmap, idCommand, fsState, fsStyle, {0, 0, 0, 0, 0, 0}, dwData, idxString)
#else
   DIM tbb AS TBBUTTON = (idxBitmap, idCommand, fsState, fsStyle, {0, 0}, dwData, idxString)
#endif
   FUNCTION = SendMessageW(hToolBar, TB_ADDBUTTONSW, 1, CAST(LPARAM, @tbb))
END FUNCTION
' ========================================================================================


this worked

Code Select Expand


DIM tbb AS TBBUTTON = (idxBitmap, idCommand, fsState, fsStyle, {0, 0, 0, 0, 0, 0}, dwData,


but this don't

Code Select Expand


DIM tbb AS TBBUTTON
tbb = (idxBitmap, idCommand, fsState, fsStyle, {0, 0, 0, 0, 0, 0}, dwData,


I have discovered the way to make it working

Code Select Expand


DIM tbb AS TBBUTTON
tbb = TYPE<TBBUTTON>(idxBitmap, idCommand, fsState, fsStyle, {0, 0, 0, 0, 0, 0}, dwData,


[José Roca]

I have made a very small change to the Create method of CWindow: I have changed the default values of the x, y, width and height parameters from 0 to CW_USEDEFAULT. This way, if the user does not specify screen coordinates and also does not call SetClientSize, a working window will still be created and displayed.

Just in case...

[José Roca]

I have added to AfxGdiplus.inc the following functions:

Code Select Expand


' ========================================================================================
' Loads an image from a file, converts it to an icon and adds it to specified image list.
' Parameters:
' - hIml        = A handle to the image list.
' - wszFileName = [in] Path of the image to load and convert.
' - dimPercent  = Percent of dimming (1-99)
' - bGrayScale  = TRUE or FALSE. Convert to gray scale.
' Return value:
'   Returns the index of the image if successful, or -1 otherwise.
' ========================================================================================
PRIVATE FUNCTION AfxGdipAddIconFromFile (BYVAL hIml AS HIMAGELIST, BYREF wszFileName AS WSTRING, _
   BYVAL dimPercent AS LONG = 0, BYVAL bGrayScale AS LONG = FALSE) AS LONG
   DIM hIcon AS HICON = AfxGdipImageFromFile(wszFileName, dimPercent, bGrayScale, IMAGE_ICON, 0)
   IF hIcon THEN FUNCTION = ImageList_ReplaceIcon(hIml, -1, hIcon)
   IF hIcon THEN DestroyIcon(hIcon)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Loads an image from a resource file, converts it to an icon and adds it to specified image list.
' Parameters:
' - hIml         = A handle to the image list.
' - hInstance    = [in] A handle to the module whose portable executable file or an accompanying
'                  MUI file contains the resource. If this parameter is NULL, the function searches
'                  the module used to create the current process.
' - wszImageName = [in] Name of the image in the resource file (.RES). If the image resource uses
'                  an integral identifier, wszImage should begin with a number symbol (#)
'                  followed by the identifier in an ASCII format, e.g., "#998". Otherwise,
'                  use the text identifier name for the image. Only images embedded as raw data
'                  (type RCDATA) are valid. These must be icons in format .png, .jpg, .gif, .tiff.
' - dimPercent   = Percent of dimming (1-99)
' - bGrayScale   = TRUE or FALSE. Convert to gray scale.
' Return value:
'   Returns the index of the image if successful, or -1 otherwise.
' ========================================================================================
PRIVATE FUNCTION AfxGdipAddIconFromRes (BYVAL hIml AS HIMAGELIST, BYVAL hInstance AS HINSTANCE, _
   BYREF wszImageName AS WSTRING, BYVAL dimPercent AS LONG = 0, BYVAL bGrayScale AS LONG = FALSE) AS LONG
   DIM hIcon AS HICON = AfxGdipImageFromRes(hInstance, wszImageName, dimPercent, bGrayScale, IMAGE_ICON, 0)
   IF hIcon THEN FUNCTION = ImageList_ReplaceIcon(hIml, -1, hIcon)
   IF hIcon THEN DestroyIcon(hIcon)
END FUNCTION
' ========================================================================================


[José Roca]

Working with the new resize class I realized that can't be used to resize the tab pages (modeless windows associated with the tabs), so I have added the following function (please note that can only be used with tab pages created with the CTabPage class).

Code Select Expand


' =====================================================================================
' Resize all the tab pages associated with a tab control
' =====================================================================================
PRIVATE FUNCTION AfxResizeTabPages (BYVAL hTab AS HWND) AS BOOLEAN
   IF hTab = NULL THEN EXIT FUNCTION
   DIM nCount AS LONG, i AS LONG, tci AS TCITEM, pTabPage AS CTabPage PTR
   ' // Get the number of items
   nCount = .SendMessageW(hTab, TCM_GETITEMCOUNT, 0, 0)
   IF nCount = 0 THEN EXIT FUNCTION
   ' // Ask to return the value of the lParam member
   tci.mask = TCIF_PARAM
   ' // Get information of the items
   FOR i = 0 TO nCount - 1
      IF .SendMessageW(hTab, TCM_GETITEMW, i, CAST(lParam, @tci)) THEN
         IF tci.lParam THEN
            pTabPage = CAST(CTabPage PTR, tci.lParam)
            ' // Retrieve the size of the tab control window
            DIM rcParent AS RECT
            .GetWindowRect(hTab, @rcParent)
            ' // Calculates the tab control's display area given its window rectangle
            .SendMessageW(hTab, TCM_ADJUSTRECT, FALSE, CAST(LPARAM, @rcParent))
            ' // Convert to window coordinates
            .MapWindowPoints(NULL, hTab, CAST(LPPOINT, @rcParent), 2)
            ' // Move the tab page
            .MoveWindow(pTabPage->hTabPage, rcParent.Left, rcParent.Top, _
               rcParent.Right - rcParent.Left, rcParent.Bottom - rcParent.Top, CTRUE)
         END IF
      END IF
   NEXT
   FUNCTION = TRUE
END FUNCTION
' ========================================================================================


[José Roca]

The following exmple demonstrates the use of the AfxResizeTabPages function:

Code Select Expand


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

#INCLUDE ONCE "Afx/CWindow.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 = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
         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 = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
         DIM hTab AS HWND = GetDlgItem(hwnd, IDC_TAB)
         ' // 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
         ' / Move the close button
         pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 85, pWindow->ClientHeight - 28, 75, 23, CTRUE
         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
                     nPage = SendMessage(ptnmhdr->hwndFrom, TCM_GETCURSEL, 0, 0)
                     tci.mask = TCIF_PARAM
                     IF SendMessageW(ptnmhdr->hwndFrom, TCM_GETITEMW, nPage, CAST(lParam, @tci)) THEN
                        IF tci.lParam THEN
                           pTabPage = CAST(CTabPage PTR, tci.lParam)
                           ShowWindow pTabPage->hTabPage, SW_SHOW
                        END IF
                     END IF
                  CASE TCN_SELCHANGING
                     ' // Hide the current page
                     nPage = SendMessage(ptnmhdr->hwndFrom, TCM_GETCURSEL, 0, 0)
                     tci.mask = TCIF_PARAM
                     IF SendMessageW(ptnmhdr->hwndFrom, TCM_GETITEMW, nPage, CAST(lParam, @tci)) THEN
                        IF tci.lParam THEN
                           pTabPage = CAST(CTabPage PTR, tci.lParam)
                           ShowWindow pTabPage->hTabPage, SW_HIDE
                        END IF
                     END IF
               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.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", pWindow.hWindow, 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, "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->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->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", pWindow.hWindow, 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)

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

   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

   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

   END SELECT

   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


As this example demonstrates, the CTabPage class, that inherits from CWindow, provides an easy solution for tab controls and tab pages. It should be not difficult for the Firefly Visual Designer to use it.

[José Roca]

An small change for the next release: I have made tha hParent parameter of the AddControl method optional. Therefore, besides

Code Select Expand


pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 250, 140, 75, 23)


we can also use

Code Select Expand


pWindow.AddControl("Button", , IDCANCEL, "&Close", 250, 140, 75, 23)


[José Roca]

I also have overloaded the AnchorControl method of the CLayout class, so now besides

Code Select Expand


pLayout.AnchorControl(GetDlgItem(pWindow.hWindow, IDC_EDIT1), AFX_ANCHOR_WIDTH)
pLayout.AnchorControl(GetDlgItem(pWindow.hWindow, IDC_EDIT2), AFX_ANCHOR_HEIGHT_WIDTH)
pLayout.AnchorControl(GetDlgItem(pWindow.hWindow, IDCANCEL), AFX_ANCHOR_BOTTOM_RIGHT)
pLayout.AnchorControl(GetDlgItem(pWindow.hWindow, IDC_GROUPBOX), AFX_ANCHOR_HEIGHT_RIGHT)
pLayout.AnchorControl(GetDlgItem(pWindow.hWindow, IDC_COMBOBOX), AFX_ANCHOR_RIGHT)


we can also use

Code Select Expand


pLayout.AnchorControl(IDC_EDIT1, AFX_ANCHOR_WIDTH)
pLayout.AnchorControl(IDC_EDIT2, AFX_ANCHOR_HEIGHT_WIDTH)
pLayout.AnchorControl(IDCANCEL, AFX_ANCHOR_BOTTOM_RIGHT)
pLayout.AnchorControl(IDC_GROUPBOX, AFX_ANCHOR_HEIGHT_RIGHT)
pLayout.AnchorControl(IDC_COMBOBOX, AFX_ANCHOR_RIGHT)


saving typing.

Of course, this only works if the parent window of the control is the main window. If the control is child of another control, such a group box, we have to pass the handle of the control, not only its idenifier.

[José Roca]

Added to CWindow.inc the following functions:

Code Select Expand


' ========================================================================================
' Returns a pointer to the CWindow class given the handle of the window created with it.
' ========================================================================================
PRIVATE FUNCTION AfxCWindowPtr OVERLOAD (BYVAL hwnd AS HWND) AS CWindow PTR
   FUNCTION = CAST(CWindow PTR, .GetWindowLongPtr(hwnd, 0))
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a pointer to the CWindow class given the a pointer to the CREATESTRUCT structure.
' ========================================================================================
PRIVATE FUNCTION AfxCWindowPtr OVERLOAD (BYVAL lParam AS LPARAM) AS CWindow PTR
   DIM pCreateStruct AS CREATESTRUCT PTR = CAST(CREATESTRUCT PTR, lParam)
   FUNCTION = CAST(CWindow PTR, pCreateStruct->lpCreateParams)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a pointer to the CWindow class given the a pointer to the CREATESTRUCT structure.
' ========================================================================================
PRIVATE FUNCTION AfxCWindowPtr OVERLOAD (BYVAL pCreateStruct AS CREATESTRUCT PTR) AS CWindow PTR
   FUNCTION = CAST(CWindow PTR, pCreateStruct->lpCreateParams)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a pointer to the CTabPage class given the handle of the tab control to which the
' tab page is associated and the zero-based tab index. If nTabIdx is ommited, the function
' will return the pointer of the selected tab, if any.
' ========================================================================================
PRIVATE FUNCTION AfxCTabPagePtr (BYVAL hTab AS HWND, BYVAL nTabIdx AS LONG = -1) AS CTabPage PTR
   IF hTab = NULL THEN EXIT FUNCTION
   IF nTabIdx = -1 THEN nTabIdx = SendMessageW(hTab, TCM_GETCURSEL, 0, 0)
   IF nTabIdx = -1 THEN EXIT FUNCTION   ' No tab selected
   ' // Ask to return the value of the lParam member
   DIM tci AS TCITEMW
   tci.mask = TCIF_PARAM
   IF .SendMessageW(hTab, TCM_GETITEMW, nTabIdx, CAST(LPARAM, @tci)) THEN
      IF tci.lParam THEN
         FUNCTION = CAST(CTabPage PTR, tci.lParam)
      END IF
   END IF
END FUNCTION
' ========================================================================================


Now, instead of

Code Select Expand


DIM pWindow AS CWindow PTR = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))


we can use

Code Select Expand


DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)


instead of

Code Select Expand


CASE WM_CREATE
   ' // Get a pointer to the CWindow class from the CREATESTRUCT structure
   DIM pCreateStruct AS CREATESTRUCT PTR = CAST(CREATESTRUCT PTR, lParam)
   DIM pWindow AS CWindow PTR = CAST(CWindow PTR, pCreateStruct->lpCreateParams)


we can use

Code Select Expand


CASE WM_CREATE
   ' // Get a pointer to the CWindow class from the CREATESTRUCT structure
   DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)


or

Code Select Expand


CASE WM_CREATE
   ' // Get a pointer to the CWindow class from the CREATESTRUCT structure
   DIM pWindow AS CWindow PTR = AfxCWindowPtr(CAST(CREATESTRUCT PTR, lParam))


and instead of

Code Select Expand


CASE TCN_SELCHANGE
    // Show the selected page
   nPage = SendMessageW(ptnmhdr->hwndFrom, TCM_GETCURSEL, 0, 0)
   tci.mask = TCIF_PARAM
   IF SendMessageW(ptnmhdr->hwndFrom, TCM_GETITEMW, nPage, CAST(lParam, @tci)) THEN
      IF tci.lParam THEN
         pTabPage = CAST(CTabPage PTR, tci.lParam)
         ShowWindow pTabPage->hTabPage, SW_SHOW
      END IF
   END IF
CASE TCN_SELCHANGING
    // Hide the current page
   nPage = SendMessageW(ptnmhdr->hwndFrom, TCM_GETCURSEL, 0, 0)
   tci.mask = TCIF_PARAM
   IF SendMessageW(ptnmhdr->hwndFrom, TCM_GETITEMW, nPage, CAST(lParam, @tci)) THEN
      IF tci.lParam THEN
         pTabPage = CAST(CTabPage PTR, tci.lParam)
         ShowWindow pTabPage->hTabPage, SW_HIDE
      END IF
   END IF


we can use

Code Select Expand


CASE TCN_SELCHANGE
    // Show the selected page
   pTabPage = AfxCTabPagePtr(ptnmhdr->hwndFrom)
   IF pTabPage THEN ShowWindow pTabPage->hTabPage, SW_SHOW
CASE TCN_SELCHANGING
    // Hide the current page
   pTabPage = AfxCTabPagePtr(ptnmhdr->hwndFrom)
   IF pTabPage THEN ShowWindow pTabPage->hTabPage, SW_HIDE


Overloading and default parameter values are invaluable features.

[Paul Squires]

Getting better every day! It is pretty cool the functionality and convenience that is gained by using overloading.

[José Roca]

Better yet. I have modified the first overloaded function:

Code Select Expand


' ========================================================================================
' Returns a pointer to the CWindow class given the handle of the window created with it
' or the handle of any of the window's child controls.
' ========================================================================================
PRIVATE FUNCTION AfxCWindowPtr OVERLOAD (BYVAL hwnd AS HWND) AS CWindow PTR
   IF hwnd = NULL THEN EXIT FUNCTION
   DIM hRootOwner AS .HWND = .GetAncestor(hwnd, GA_ROOTOWNER)
   IF hRootOwner = NULL THEN EXIT FUNCTION
   FUNCTION = CAST(CWindow PTR, .GetWindowLongPtr(hRootOwner, 0))
END FUNCTION
' ========================================================================================


Now we can get the CWindow pointer passing the handle of the main window or the handle of any of its child controls without having to use GetParent!

[José Roca]

Now that we can retrieve the CWindow pointer very easily from any part of the application, I have increased the user data from 0-9 to 0-99. It is a good way to avoid the use of globals.

We can use an enumeration in our application, e.g.

Code Select Expand


ENUM AFX_USERDATA
   AFX_LAYOUTPTRIDX = 0
   ...
   ...
END ENUM

' // Set the pointer
pWindow.UserData(AFX_LAYOUTPTRIDX) = CAST(LONG_PTR, @pLayout)

' // Get the pointer
DIM pLayout AS CLayout PTR = CAST(CLayout PTR, pWindow->UserData(AFX_LAYOUTPTRIDX))


[José Roca]

I have modified the AfxUcode and AfxAcode functions to work with UTF8 too.

Code Select Expand


' ========================================================================================
' Translates ansi bytes to unicode bytes.
' Parameters:
' - ansiStr = A ansi or UTF8 string.
' - nCodePage = The code page used in the conversion, e.g. 1251 for Russian.
'   If you specify CP_UTF8, the returned string will be UTF8 encoded.
'   If you don't pass an unicode page, the function will use CP_ACP (0), which is the
'   system default Windows ANSI code page.
' Return value:
'   An unicode BSTR. You must free this handle with SysFreeString when no longer needed.
' ========================================================================================
PRIVATE FUNCTION AfxUcode (BYREF ansiStr AS CONST STRING, BYVAL nCodePage AS LONG = 0) AS BSTR
   DIM pbstr AS BSTR
   IF nCodePage = CP_UTF8 THEN
      DIM dwLen AS DWORD = MultiByteToWideChar(CP_UTF8, 0, STRPTR(ansiStr), LEN(ansiStr), NULL, 0)
      IF dwLen THEN
         pbstr = SysAllocString(WSTR(SPACE(dwLen)))
         dwLen = MultiByteToWideChar(CP_UTF8, 0, STRPTR(ansiStr), LEN(ansiStr), pbstr, dwLen * 2)
      END IF
   ELSE
      pbstr = SysAllocString(WSTR(SPACE(LEN(ansiStr))))
      MultiByteToWideChar(nCodePage, MB_PRECOMPOSED, STRPTR(ansiStr), LEN(ansiStr), pbstr, LEN(ansiStr) * 2)
   END IF
   FUNCTION = pbstr
END FUNCTION
' ========================================================================================

' ========================================================================================
' Translates unicode bytes to ansi bytes.
' Parameters:
' - pbstr = The unicode BSTR to convert
' - nCodePage = The code page used in the conversion, e.g. 1251 for Russian.
'   If you specify CP_UT8, it is assumed that ansiStr contains an UTF8 encoded string.
'   If you don't pass an unicode page, the function will use CP_ACP (0), which is the
'   system default Windows ANSI code page.
' Return value:
'   The converted string.
' ========================================================================================
PRIVATE FUNCTION AfxAcode (BYVAL pbstr AS BSTR, BYVAL nCodePage AS LONG = 0) AS STRING
   DIM ansiStr AS STRING
   IF nCodePage = CP_UTF8 THEN
      DIM dwLen As DWORD = WideCharToMultiByte(CP_UTF8, 0, pbstr, SysStringLen(pbstr), NULL, 0, NULL, NULL)
      IF dwLen THEN
         ansiStr = SPACE(dwLen)
         dwLen = WideCharToMultiByte(CP_UTF8, 0, pbstr, SysStringLen(pbstr), STRPTR(ansiStr), LEN(ansiStr), NULL, NULL)
      END IF
   ELSE
      ansiStr = SPACE(SysStringLen(pbstr))
      WideCharToMultiByte(nCodePage, 0, pbstr, SysStringLen(pbstr), STRPTR(ansiStr), LEN(ansiStr), NULL, NULL)
   ENDIF
   FUNCTION = ansiStr
END FUNCTION
' ========================================================================================