This version is ready or very close to be published as version 1.0.
I have prepared a help file documenting the main classes and the wrapper functions, and I have more than 50 templates that could be used by an editor that, like CSED for PowerBASIC, has support for them. The templates are small compilable examples that demonstrate the use of each Windows control and several other things.
I would also add to the help file a tutorial, e.g.
- Creating an instance of CWindow.
- Overriding default DPI and Font settings before creating the main window.
- Creating the main window.
- Window styles.
- Callbacks.
- Adding controls.
- Menus.
- Toolbars.
- Statusbars.
- Resource files.
- Comparing a CWindow "Hello world" example with a straight SDK one.
- Modal and modeless popup windows.
- MDI.
This tutotial would be the hardest part of this project, since I'm much better at writing code than documentation or tutorials, so any help will be gratefully welcomed.
Those using Windows 7 with a DPI setting of 120 of less, won't notice much difference, but when using a DPI of more than 120 and the application is not DPI aware, Windows virtualizes it, i.e. renders the application window to an internal bitmal using 96 DPI and then scales up that bitmap to the DPI setting selected by the user before putting it on the screen, looking annoyingly blurry. There are other problems like drag and drop between a non DPI aware application and a DPI aware one, because each application gets different coordinates.
I have read that Windows 10 makes DPI virtualization permanent at all scaling levels, even when per-monitor scaling is disabled. Users running at 120 DPI or less, that were previously exempted, must therefore manually disable DPI virtualization for each individual application afflicted with blurry text.
One of the tools that I often use is DPI aware, but the programer has forgot to do scaling in one of the dialogs. See how the buttons look.
Excellent! Thanks Jose!
I have started writing an application to test the classes. The is the WinFBE editor application that I had started in Firefly. I am now coding it by hand using your class and wrappers. I will post my code in the WinFBE subforum for you and everyone to see as the project develops. I just finished the main window and topmenu with the accelerator table. Once I have the toolbar and status bar coded then I will post the code.
Creating the main window
To use CWindow you must first include "CWindow.inc" and allow all symbols of its namespace to be accessed adding USING Afx.CwindowClass.
#INCLUDE ONCE "CWindow.inc"
USING Afx.CWindowClass
The first step is to create an instance of the class:
DIM pWindow AS CWindow
The CWindow constructor registers a class for the window with the name "FBWindowClass:xxx", where xxx is a counter number. Alternatively, you can force the use of your own class name by specifying it, e.g.
DIM pWindow AS CWindow = "MyClassName"
The constructor also checks if the application is DPI aware and calculates de scaling ratios and the default font name and point size ("Tahoma", 8 pt, for Windows XP and below; "Segoe UI", 9 pt, for Windows 7 and above").
You can override it by setting your own DPI and/or font before creating the window, e.g.
DIM pWindow AS CWindow
pWindow. DPI = 96
pWindow.SetFont(pWindow.SetFont("Times New Roman", 10, FW_NORMAL, , , , DEFAULT_CHARSET)
By default, CWindow uses a standard COLOR_3DFACE + 1 brush. You can override it calling the Brush property:
DIM pWindow AS CWindow
pWindow.Brush = GetStockObject(WHITE_BRUSH)
This makes the background of the window white.
The window class uses CS_HREDRAW OR CS_VREDRAW as default window styles. Without them, the background is not repainted and the controls leave garbage in it when resized. With them, windows with many controls cause heavy flicker. To avoid flicker, you can change the windows style using e.g. pWindow.ClassStyle = CS_DBLCLKS and take care yourself of repainting.
The next step is to create the window.
The Create method has many parameters, all of which are optional:
hParent = Parent window handle
wszTitle = Window caption
lpfnWndProc = Address of the callback function
x = Horizontal position
y = Vertical position
nWidth = Window width
nHeight = Window height
dwStyle = Window style
dwExStyle = Extended style
The most verbose way to call it is:
DIM hwndMain AS HWND = pWindow.Create(NULL, "CWindow Test", @WndProc, 0, 0, 525, 395, _
WS_OVERLAPPEDWINDOW OR WS_CLIPCHILDREN OR WS_CLIPSIBLINGS, WS_EX_CONTROLPARENT OR WS_EX_WINDOWEDGE)
But just using
pWindow.Create
pWindow.SetClientSize(500, 320) ' The size may vary
a working window is created and sized.
Unless the window has to use all the available desktop space, I prefer to use the SetClientSize method to size the window because Windows UI elements such the caption and borders have different sizes depending of the Windows version and/or the styles used. Therefore, to make sure that you have enough room for your controls, sizing the window according the client size is more adequate.
We may need to process Windows messages, so we need to provide a callback function, e.g.
'========================================================================================
' 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)
CASE IDCANCEL
' // If ESC key pressed, close the application sending an WM_CLOSE message
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_DESTROY
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
and we have to pass the address of that callback function:
pWindow.Create(NULL, "CWindow Test", @WndProc)
pWindow.SetClientSize(500, 320) ' The size may vary
Optionally, we can automatically center the window in the destop calling the Center method, e.g.
pWindow.Create(NULL, "CWindow Test", @WndProc)
pWindow.SetClientSize(500, 320) ' The size may vary
pWindow.Center
To process Windows messages we need a message pump. CWindow provides a default one calling the DoEvents method:
FUNCTION = pWindow.DoEvents(nCmdShow)
This default message pump displays the window and processes the messages. It can be used with most applications, but, in case of need, you can replace it with your own, e.g.
' // Displays the window
DIM hwndMain AS HWND = pWindow.hWindow
ShowWindow(hwndMain, nCmdShow)
UpdateWindow(hwndMain)
' // Processes Windows messages
DIM uMsg AS MSG
WHILE (GetMessageW(@uMsg, NULL, 0, 0) <> FALSE)
IF IsDialogMessageW(hWndMain, @uMsg) = 0 THEN
TranslateMessage(@uMsg)
DispatchMessageW(@uMsg)
END IF
WEND
FUNCTION = uMsg.wParam
Each instance of the CWindow class has an user data area consisting in an array of 10 LONG_PTR values that you can use to store information that you find useful.
These values are set and retrieved using the UserData property and an index from 0 to 9.
I have also added to the help file the topics Windows Styles, Extended Window Styles and Common Control Styles, with tables detailing the styles and explanations.
Next topic will be Adding Controls.
Getting a pointer to the CWindow class
At any time, you can get a pointer to the CWindow class by using:
DIM pWindow AS CWindow PTR
pWindow = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
where hwnd is the handle of the main window.
An special case if the WM_CREATE message.
At the time in which this message is processed in the window callback, CWindow has not yet been able to store the pointer in the extra bytes of the window class.
To solve this problem, the Create method passes the pointer to the class in the lParam parameter when calling the API function CreateWindowEx to create the window.
This pointer can be retrieved in WM_CREATE using:
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)
Adding controls
To add controls to the window you can use the AddControl method. Alternatively, you can use the API function CreateWindowEx, but then you will need to do scaling by yourself.
Besides the registered class names for the controls, in many cases you can use easier to remember aliases. For example. you can use "STATUSBAR" instead of "MSCTLS_STATUSBAR32".
The AddControl method also provides default styles for all the Windows controls. Therefore, you can save typing unless you need to use different styles.
For example, to add a button you can use
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 350, 250, 75, 23)
instead of
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 350, 250, 75, 23, WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_PUSHBUTTON OR BS_CENTER OR BS_VCENTER
For a list of predefined class names and styles, see the documentation for the AddControl method.
If the application is DPI aware, controls created with the AddControl method are scaled according to the DPI setting.
AddControl also provides two ways for easily subclassing a control.
For the first way, used before Windows XP, you need to pass the address of the subclassed procedure, e.g.
pWindow.AddControl("Button", pWindow.hWindow, IDC_BUTTON, "Click me", 350, 250, 75, 23, , , , CAST(WNDPROC, @Button_SubclassProc))
and use a callback like this one:
' ========================================================================================
' Processes messages for the subclassed Button window.
' ========================================================================================
FUNCTION Button_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_LBUTTONDOWN
MessageBoxW(GetParent(hwnd), "Click", "FreeBasic", MB_OK)
EXIT FUNCTION
CASE WM_KEYDOWN
SELECT CASE LOWORD(wParam)
CASE VK_ESCAPE
SendMessageW(GetParent(hwnd), 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
' ========================================================================================
The second way uses under the hood the API function SetWindowSubclass. Besides passing the address of the callback procedure, it allows to pass the identifier of the control and a pointer to the CWindow class.
pWindow.AddControl("Button", pWindow.hWindow, IDC_BUTTON, "Click me", 350, 250, 75, 23, , , , _
CAST(WNDPROC, @Button_SubclassProc), IDC_BUTTON, CAST(DWORD_PTR, @pWindow))
The main advantage of this method is that we can use the same callback for all the subclassed controls and easily identify which one is firing the messages and also have a pointer to his parent CWindow class if we need to use it. SetWindowSubclass also eliminates the disadvantages of the old subclassing approach explained in this thread: Subclassing Controls
Example of a callback function for controls subclassed with this method:
' ========================================================================================
' Processes messages for the subclassed Button window.
' ========================================================================================
FUNCTION Button_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
BYVAL uIdSubclass AS UINT_PTR, _ ' // The subclass ID
BYVAL dwRefData AS DWORD_PTR _ ' // Pointer to reference data
) AS LRESULT
SELECT CASE uMsg
CASE WM_GETDLGCODE
' // All keyboard input
FUNCTION = DLGC_WANTALLKEYS
EXIT FUNCTION
CASE WM_LBUTTONDOWN
MessageBoxW(GetParent(hwnd), "Click", "FreeBasic", MB_OK)
EXIT FUNCTION
CASE WM_KEYDOWN
SELECT CASE LOWORD(wParam)
CASE VK_ESCAPE
SendMessageW(GetParent(hwnd), WM_CLOSE, 0, 0)
EXIT FUNCTION
END SELECT
CASE WM_DESTROY
' // REQUIRED: Remove control subclassing
RemoveWindowSubclass hwnd, @Button_SubclassProc, uIdSubclass
END SELECT
FUNCTION = DefSubclassProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
Both of these methods are optional. Therefore, you can use your own way to subclass controls.
Warning: You cannot use the subclassing helper functions to subclass a window across threads.
Popup windows
To create a popup window you simply create a new instance of the CWindow class and, in the Create method, you make it child of the main window and use the WS_POPUPWINDOW style.
DIM pWindow AS CWindow
pWindow.Create(hParent, "Popup window", @PopupWndProc, , , , , _
WS_VISIBLE OR WS_CAPTION OR WS_POPUPWINDOW OR WS_THICKFRAME, WS_EX_WINDOWEDGE)
The window created this way is modeless. To make it modal, we need to disable the parent window:
CASE WM_CREATE
EnableWindow GetParent(hwnd), FALSE
When the popup dialog is closed, we need to enable the parent window:
CASE WM_CLOSE
' // Enables parent window keeping parent's zorder
EnableWindow GetParent(hwnd), CTRUE
Example
' ########################################################################################
' Microsoft Windows
' File: CW_PopupWindow.fbtpl
' Contents: CWindow with a modal popup window
' 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 "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx.CWindowClass
CONST IDC_POPUP = 1001
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
DECLARE FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION PopupWindow (BYVAL hParent AS HWND) AS LONG
DECLARE FUNCTION PopupWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
AfxSetProcessDPIAware
DIM pWindow AS CWindow
pWindow.Create(NULL, "CWindow with a popup window", @WndProc)
pWindow.SetClientSize(500, 320)
pWindow.Center
' // Add a button without position or size (it will be resized in the WM_SIZE message).
pWindow.AddControl("Button", pWindow.hWindow, IDC_POPUP, "&Popup", 350, 250, 75, 23)
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
DIM hDC AS HDC
DIM pPaint AS PAINTSTRUCT
DIM rc AS RECT
DIM pWindow AS CWindow PTR
SELECT CASE uMsg
CASE WM_CREATE
EXIT FUNCTION
CASE WM_COMMAND
' // If ESC key pressed, close the application sending an WM_CLOSE message
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_POPUP
IF HIWORD(wParam) = BN_CLICKED THEN
PopupWindow(hwnd)
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
IF wParam <> SIZE_MINIMIZED THEN
' // Resize the buttons
pWindow = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 120, pWindow->ClientHeight - 50, 75, 23, CTRUE
END IF
CASE WM_DESTROY
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Popup window procedure
' ========================================================================================
FUNCTION PopupWindow (BYVAL hParent AS HWND) AS LONG
DIM pWindow AS CWindow
pWindow.Create(hParent, "Popup window", @PopupWndProc, , , , , _
WS_VISIBLE OR WS_CAPTION OR WS_POPUPWINDOW OR WS_THICKFRAME, WS_EX_WINDOWEDGE)
pWindow.Brush = GetStockObject(WHITE_BRUSH)
pWindow.SetClientSize(300, 200)
pWindow.Center(pWindow.hWindow, hParent)
' / Process Windows messages
FUNCTION = pWindow.DoEvents
END FUNCTION
' ========================================================================================
' ========================================================================================
' Popup window procedure
' ========================================================================================
FUNCTION PopupWndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM hOldFont AS HFONT
STATIC hNewFont AS HFONT
SELECT CASE uMsg
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)
' // Create a new font scaled according the DPI ratio
IF pWindow->DPI <> 96 THEN hNewFont = pWindow->CreateFont("Tahoma", 9)
' Disable parent window to make popup window modal
EnableWindow GetParent(hwnd), FALSE
EXIT FUNCTION
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_PAINT
DIM rc AS RECT, ps AS PAINTSTRUCT, hDC AS HANDLE
hDC = BeginPaint(hWnd, @ps)
IF hNewFont THEN hOldFont = CAST(HFONT, SelectObject(hDC, CAST(HGDIOBJ, hNewFont)))
GetClientRect(hWnd, @rc)
DrawTextW(hDC, "Hello, World!", -1, @rc, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
IF hNewFont THEN SelectObject(hDC, CAST(HGDIOBJ, CAST(HFONT, hOldFont)))
EndPaint(hWnd, @ps)
EXIT FUNCTION
CASE WM_CLOSE
' // Enables parent window keeping parent's zorder
EnableWindow GetParent(hwnd), CTRUE
' // Don't exit; let DefWindowProcW perform the default action
CASE WM_DESTROY
' // Destroy the new font
IF hNewFont THEN DeleteObject(CAST(HGDIOBJ, hNewFont))
' // End the application by sending an WM_QUIT message
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
Using PNG icons in toolbars
AfxGdiplus.inc provides functions that allow to use alphablended PNG icons in toolbars.
AfxGdipIconFromFile loads the images from disk and AfxGdipIconFromRes from a resource file embedded in the application.
We need to create an image list for the toolbar of the appropriate size. To calculate the size, I'm using the following formula: 16 * pWindow.DPI \ 96. Where 16 is the size of a normal icon (personally, for toolbars I prefer to use 20 to make them a bit bigger), pWindow.DPI the DPI being used by the computer and 96 the DPI used by applications that are not DPI aware.
' // Create an image list for the toolbar
DIM hImageList AS HIMAGELIST
DIM cx AS LONG = 16 * pWindow.DPI \ 96
hImageList = ImageList_Create(cx, cx, ILC_COLOR32 OR ILC_MASK, 4, 0)
IF hImageList THEN
ImageList_ReplaceIcon(hImageList, -1, AfxGdipIconFromRes(hInst, "IDI_ARROW_LEFT_48"))
ImageList_ReplaceIcon(hImageList, -1, AfxGdipIconFromRes(hInst, "IDI_ARROW_RIGHT_48"))
ImageList_ReplaceIcon(hImageList, -1, AfxGdipIconFromRes(hInst, "IDI_HOME_48"))
ImageList_ReplaceIcon(hImageList, -1, AfxGdipIconFromRes(hInst, "IDI_SAVE_48"))
END IF
SendMessageW hToolBar, TB_SETIMAGELIST, 0, CAST(LPARAM, hImageList)
I'm using 48 bit icons in this example, that resize well to adapt to different DPI settings. This way, we can use only a set of icons instead of several sets of icons of different sizes.
AfxGdipIconFromFile and AfxGdipIconFromRes also provide two optional parameters, dimPercent and bGrayScale. With dimPercent you can indicate a percentage of dimming, and bGrayScale is a boolean value (TRUE or FALSE) that tells these functions to convert the icon colors to shades of gray. This allows to create an image list for disabled items with the same icon set. The following code creates a disabled image using the same color PNG icons, but dimming them a 60% and converting them to gray:
' // Create a disabled image list for the toolbar
DIM hDisabledImageList AS HIMAGELIST
DIM cx AS LONG = 16 * pWindow.DPI \ 96
hDisabledImageList = ImageList_Create(cx, cx, ILC_COLOR32 OR ILC_MASK, 4, 0)
IF hDisabledImageList THEN
ImageList_ReplaceIcon(hDisabledImageList, -1, AfxGdipIconFromRes(hInst, "IDI_ARROW_LEFT_48", 60, TRUE))
ImageList_ReplaceIcon(hDisabledImageList, -1, AfxGdipIconFromRes(hInst, "IDI_ARROW_RIGHT_48", 60, TRUE))
ImageList_ReplaceIcon(hDisabledImageList, -1, AfxGdipIconFromRes(hInst, "IDI_HOME_48" 60, TRUE))
ImageList_ReplaceIcon(hDisabledImageList, -1, AfxGdipIconFromRes(hInst, "IDI_SAVE_48" 60, TRUE))
END IF
SendMessageW hToolBar, TB_SETDISABLEDIMAGELIST, 0, CAST(LPARAM, hDisabledImageList)
Not only can we use alphablended PNG icons, but we don't need to bloat the application with tons of icons of different sizes, both for normal and disabled image lists. And these same icons can also be used for menus. Gone are the times of 16 bit bitmap strips with a pink background.
Resource file:
//=============================================================================
// Manifest
//=============================================================================
1 24 "WThemes.xml"
//=============================================================================
// Toolbar icons
//=============================================================================
// Toolbar, normal
IDI_ARROW_LEFT_48 RCDATA "arrow_left_48.png"
IDI_ARROW_RIGHT_48 RCDATA "arrow_right_48.png"
IDI_HOME_48 RCDATA "home_48.png"
IDI_SAVE_48 RCDATA "save_48.png"
Manifest:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
<assemblyIdentity version="1.0.0.0"
processorArchitecture="*"
name="ApplicationName"
type="win32"/>
<description>Optional description of your application</description>
<asmv3:application>
<asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
<dpiAware>true</dpiAware>
</asmv3:windowsSettings>
</asmv3:application>
<!-- Compatibility section -->
<compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
<application>
<!--The ID below indicates application support for Windows Vista -->
<supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
<!--The ID below indicates application support for Windows 7 -->
<supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
<!--This Id value indicates the application supports Windows 8 functionality-->
<supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
<!--This Id value indicates the application supports Windows 8.1 functionality-->
<supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
</application>
</compatibility>
<!-- Trustinfo section -->
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
<security>
<requestedPrivileges>
<requestedExecutionLevel
level="asInvoker"
uiAccess="false"/>
</requestedPrivileges>
</security>
</trustInfo>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="*"
publicKeyToken="6595b64144ccf1df"
language="*" />
</dependentAssembly>
</dependency>
</assembly>
[code]
[b]Example[/b]
[code]
' ########################################################################################
' Microsoft Windows
' File: CW_Toolbar.fbtpl
' Contents: CWindow with a toolbar
' 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
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxGdiplus.inc"
USING Afx.CWindowClass
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)
' ========================================================================================
' 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
' ========================================================================================
' ========================================================================================
' Adds a separator to a toolbar.
' Minimum operating systems Windows NT 3.51, Windows 95
' ========================================================================================
PRIVATE FUNCTION AfxToolbar_AddSeparator (BYVAL hToolBar AS HWND, BYVAL nWidth AS LONG = 0) AS LRESULT
#ifdef __FB_64BIT__
DIM tbb AS TBBUTTON = (nWidth, 0, TBSTATE_ENABLED, TBSTYLE_SEP, {0, 0, 0, 0, 0, 0}, 0, -1)
#else
DIM tbb AS TBBUTTON = (nWidth, 0, TBSTATE_ENABLED, TBSTYLE_SEP, {0, 0}, 0, -1)
#endif
FUNCTION = SendMessageW(hToolBar, TB_ADDBUTTONSW, 1, CAST(LPARAM, @tbb))
END FUNCTION
' ========================================================================================
CONST IDC_TOOLBAR = 1001
enum
IDM_LEFTARROW = 28000
IDM_RIGHTARROW
IDM_HOME
IDM_SAVEFILE
end enum
' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM pWindow AS CWindow PTR
SELECT CASE uMsg
CASE WM_CREATE
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
' // If ESC key pressed, close the application sending an WM_CLOSE message
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' CASE IDM_CUT ' etc.
' MessageBoxW hwnd, "You have clicked the Cut button", "Toolbar", MB_OK
' EXIT FUNCTION
END SELECT
CASE WM_SIZE
IF wParam <> SIZE_MINIMIZED THEN
' // Update the size and position of the Toolbar control
SendMessageW GetDlgItem(hWnd, IDC_TOOLBAR), TB_AUTOSIZE, 0, 0
' // Resize the buttons
pWindow = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 95, pWindow->ClientHeight - 35, 75, 23, CTRUE
END IF
CASE WM_DESTROY
' // Destroy the image list
ImageList_Destroy CAST(HIMAGELIST, SendMessageW(GetDlgItem(hwnd, IDC_TOOLBAR), TB_SETIMAGELIST, 0, 0))
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 toolbar", @WndProc)
' // Disable background erasing
pWindow.ClassStyle = CS_DBLCLKS
' // Set the client size
pWindow.SetClientSize(600, 300)
' // Center the window
pWindow.Center
' // Add a button
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close")
' // Add a tooolbar
DIM hToolBar AS HWND = pWindow.AddControl("Toolbar", pWindow.hWindow, IDC_TOOLBAR)
' // Module instance handle
DIM hInst AS HINSTANCE = GetModuleHandle(NULL)
' // Create an image list for the toolbar
DIM hImageList AS HIMAGELIST
DIM cx AS LONG = 16 * pWindow.DPI \ 96
hImageList = ImageList_Create(cx, cx, ILC_COLOR32 OR ILC_MASK, 4, 0)
IF hImageList THEN
ImageList_ReplaceIcon(hImageList, -1, AfxGdipIconFromRes(hInst, "IDI_ARROW_LEFT_48"))
ImageList_ReplaceIcon(hImageList, -1, AfxGdipIconFromRes(hInst, "IDI_ARROW_RIGHT_48"))
ImageList_ReplaceIcon(hImageList, -1, AfxGdipIconFromRes(hInst, "IDI_HOME_48"))
ImageList_ReplaceIcon(hImageList, -1, AfxGdipIconFromRes(hInst, "IDI_SAVE_48"))
END IF
SendMessageW hToolBar, TB_SETIMAGELIST, 0, CAST(LPARAM, hImageList)
' // Add buttons to the toolbar
AfxToolbar_AddButton hToolBar, 0, IDM_LEFTARROW
AfxToolbar_AddButton hToolBar, 1, IDM_RIGHTARROW
AfxToolbar_AddButton hToolBar, 2, IDM_HOME
AfxToolbar_AddButton hToolBar, 3, IDM_SAVEFILE
' // Size the toolbar
SendMessageW hToolBar, TB_AUTOSIZE, 0, 0
' // Process event messages
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
Visual style menus
Windows Vista and posterior Windows versions provide menus that are part of the visual schema. These menus are rendered using visual styles, which can be added to existing applications. Adding code for new features to existing code must be done carefully to avoid breaking existing application behavior. Certain situations can cause visual styling to be disabled in an application. These situations include:
- Customizing menus using owner-draw menu items (MFT_OWNERDRAW)
- Using menu breaks (MFT_MENUBREAK or MFT_MENUBARBREAK)
- Using HBMMENU_CALLBACK to defer bitmap rendering
- Using a destroyed menu handle
These situations prevent visual style menus from being rendered. Owner-draw menus can be used in Windows Vista and posterior Windows versions, but the menus will not be visually styled. Windows Vista and posterior Windows versions provide alpha-blended bitmaps, which enables menu items to be shown without using owner-draw menu items.
Requirements:
- The bitmap is a 32bpp DIB section.
- The DIB section has BI_RGB compression.
- The bitmap contains pre-multiplied alpha pixels.
- The bitmap is stored in hbmpChecked, hbmpUnchecked, or hbmpItem fields.
Note: MFT_BITMAP items do not support PARGB32 bitmaps.
The AfxAddIconToMenuItem function included in AfxMenu.inc allows to use alphablended icons in visually styled menus.
DIM hSubMenu AS HMENU = GetSubMenu(hMenu, 1)
DIM hIcon AS HICON
hIcon = LoadImageW(NULL, "MyIcon.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE)
IF hIcon THEN AfxAddIconToMenuItem(hSubMenu, 0, TRUE, hIcon)
PNG icons can be used by converting them first to an icon with AfxGdipImageFromFile:
hIcon = AfxGdipImageFromFileEx("MyIcon.png")
IF hIcon THEN AfxAddIconToMenuItem(hSubMenu, 0, TRUE, hIcon)
But, in general, we are more interested in loading the icons from a resource file embedded in the application. We can achieve it using the AfxGdipIconFromRes function.
DIM hSubMenu AS HMENU = GetSubMenu(hMenu, 0)
AfxAddIconToMenuItem(hSubMenu, 0, TRUE, AfxGdipIconFromRes(hInst, "IDI_ARROW_LEFT_48"))
The following code uses the same resource file that the one for the "Using PNG icons in toolbars example" to demonstrate that we can use just one set of icons for both toolbars and menus.
' ########################################################################################
' Microsoft Windows
' File: CW_Menu.fbtpl
' Contents: CWindow with a menu
' 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 _WIN32_WINNT &h0602
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "win/uxtheme.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxGdiplus.inc"
#INCLUDE ONCE "Afx/AfxMenu.inc"
USING Afx.CWindowClass
' // Menu identifiers
#define IDM_UNDO 1001 ' Undo
#define IDM_REDO 1002 ' Redo
#define IDM_HOME 1003 ' Home
#define IDM_SAVE 1004 ' Save file
#define IDM_EXIT 1005 ' Exit
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)
' ========================================================================================
' Build the menu
' ========================================================================================
FUNCTION BuildMenu () AS HMENU
DIM hMenu AS HMENU
DIM hPopUpMenu AS HMENU
hMenu = CreateMenu
hPopUpMenu = CreatePopUpMenu
AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&File"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_UNDO, "&Undo" & CHR(9) & "Ctrl+U"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_REDO, "&Redo" & CHR(9) & "Ctrl+R"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_HOME, "&Home" & CHR(9) & "Ctrl+H"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVE, "&Save" & CHR(9) & "Ctrl+S"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_EXIT, "E&xit" & CHR(9) & "Alt+F4"
FUNCTION = hMenu
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)
CASE IDCANCEL
' // If ESC key pressed, close the application sending an WM_CLOSE message
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDM_UNDO
MessageBox hwnd, "Undo option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_REDO
MessageBox hwnd, "Redo option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_HOME
MessageBox hwnd, "Home option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_SAVE
MessageBox hwnd, "Save option clicked", "Menu", MB_OK
EXIT FUNCTION
END SELECT
CASE WM_DESTROY
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 menu", @WndProc)
pWindow.SetClientSize(400, 250)
pWindow.Center
' // Add a button
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 280, 180, 75, 23)
' // Module instance handle
DIM hInst AS HINSTANCE = GetModuleHandle(NULL)
' // Create the menu
DIM hMenu AS HMENU = BuildMenu
SetMenu pWindow.hWindow, hMenu
' // Add icons to the items of the File menu
DIM hSubMenu AS HMENU = GetSubMenu(hMenu, 0)
AfxAddIconToMenuItem(hSubMenu, 0, TRUE, AfxGdipIconFromRes(hInst, "IDI_ARROW_LEFT_48"))
AfxAddIconToMenuItem(hSubMenu, 1, TRUE, AfxGdipIconFromRes(hInst, "IDI_ARROW_RIGHT_48"))
AfxAddIconToMenuItem(hSubMenu, 2, TRUE, AfxGdipIconFromRes(hInst, "IDI_HOME_48"))
AfxAddIconToMenuItem(hSubMenu, 3, TRUE, AfxGdipIconFromRes(hInst, "IDI_SAVE_48"))
' // Process Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
Keyboard accelerators
Accelerators are closely related to menus â€" both provide the user with access to an application's command set. Typically, users rely on an application's menus to learn the command set and then switch over to using accelerators as they become more proficient with the application. Accelerators provide faster, more direct access to commands than menus do. At a minimum, an application should provide accelerators for the more commonly used commands. Although accelerators typically generate commands that exist as menu items, they can also generate commands that have no equivalent menu items.
Creating an accelerator table with CWindow is very simple. You only need to build the table with calls to the AddAccelerator method and then call the CreateAcceleratorTable method. The accelerator table will be destroyed automatically when the window is destroyed or the applications ends. If you need to change the accelerator table, you can first destroy it calling the DestroyAcceleratorTable method and build a new table with AddAccelerator and then call CreateAcceleratorTable.
' // Create a keyboard accelerator table
pWindow.AddAccelerator FVIRTKEY OR FCONTROL, "U", IDM_UNDO ' // Ctrl+U - Undo
pWindow.AddAccelerator FVIRTKEY OR FCONTROL, "R", IDM_REDO ' // Ctrl+R - Redo
pWindow.AddAccelerator FVIRTKEY OR FCONTROL, "H", IDM_HOME ' // Ctrl+H - Home
pWindow.AddAccelerator FVIRTKEY OR FCONTROL, "S", IDM_SAVE ' // Ctrl+S - Save
pWindow.CreateAcceleratorTable
Example
The following example creates a menu and an accelerator table.
' ########################################################################################
' Microsoft Windows
' File: CW_Menu.fbtpl
' Contents: CWindow with a menu
' 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 "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxMenu.inc"
' $FB_RESPATH = "FBTBRES.rc"
USING Afx.CWindowClass
' // Menu identifiers
#define IDM_UNDO 1001 ' Undo
#define IDM_REDO 1002 ' Redo
#define IDM_HOME 1003 ' Home
#define IDM_SAVE 1004 ' Save file
#define IDM_EXIT 1005 ' Exit
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)
' ========================================================================================
' Build the menu
' ========================================================================================
FUNCTION BuildMenu () AS HMENU
DIM hMenu AS HMENU
DIM hPopUpMenu AS HMENU
hMenu = CreateMenu
hPopUpMenu = CreatePopUpMenu
AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&File"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_UNDO, "&Undo" & CHR(9) & "Ctrl+U"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_REDO, "&Redo" & CHR(9) & "Ctrl+R"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_HOME, "&Home" & CHR(9) & "Ctrl+H"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVE, "&Save" & CHR(9) & "Ctrl+S"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_EXIT, "E&xit" & CHR(9) & "Alt+F4"
FUNCTION = hMenu
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)
CASE IDCANCEL
' // If ESC key pressed, close the application sending an WM_CLOSE message
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDM_UNDO
MessageBox hwnd, "Undo option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_REDO
MessageBox hwnd, "Redo option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_HOME
MessageBox hwnd, "Home option clicked", "Menu", MB_OK
EXIT FUNCTION
CASE IDM_SAVE
MessageBox hwnd, "Save option clicked", "Menu", MB_OK
EXIT FUNCTION
END SELECT
CASE WM_DESTROY
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 menu", @WndProc)
pWindow.SetClientSize(400, 250)
pWindow.Center
' // Add a button
DIM hButton AS HWND = pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 280, 180, 75, 23)
SetFocus hButton
' // Module instance handle
DIM hInst AS HINSTANCE = GetModuleHandle(NULL)
' // Create the menu
DIM hMenu AS HMENU = BuildMenu
SetMenu pWindow.hWindow, hMenu
' // Create a keyboard accelerator table
pWindow.AddAccelerator FVIRTKEY OR FCONTROL, "U", IDM_UNDO ' // Ctrl+U - Undo
pWindow.AddAccelerator FVIRTKEY OR FCONTROL, "R", IDM_REDO ' // Ctrl+R - Redo
pWindow.AddAccelerator FVIRTKEY OR FCONTROL, "H", IDM_HOME ' // Ctrl+H - Home
pWindow.AddAccelerator FVIRTKEY OR FCONTROL, "S", IDM_SAVE ' // Ctrl+S - Save
pWindow.CreateAcceleratorTable
' // Process Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
@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
pWindow.AddAccelerator FVIRTKEY OR FCONTROL, ASC("S"), IDM_SAVE ' // Ctrl+S - Save
pWindow.AddAccelerator FVIRTKEY OR FCONTROL, "S", IDM_SAVE ' // Ctrl+S - Save
Not a big deal, but...
Well, I think that I have documented the most important parts of the framework. This is a reference guide to use the classes and the wrappers, not a book to teach Windows API programming.
Together with the more than 50 templates that demonstrate the use of each Windows common control with CWindow, and other useful examples, it should be enough for anybody with some knowledge of SDK programming.
I'm one of the few that likes to code everything by hand (I'm a rare bird, I know) because it gives me total freedom and, above all, because it is the best way to learn how things work. Guess that the lurkers are waiting for Firefly to code with the mouse.
Most of the things, and much more, included in this framework, are available in my headers for PowerBASIC. Two of the best improvements are the new GDI+ wrappers that allow the use of icons and images without the problems of GDI+ locking the image or making b&w images more contrasty, and the new wrappers to allow the use of alphablended icons in visually styled menus.
Quote from: Jose Roca on May 27, 2016, 11:52:24 PM
@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
pWindow.AddAccelerator FVIRTKEY OR FCONTROL, ASC("S"), IDM_SAVE ' // Ctrl+S - Save
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. :)
I need to pass FVIRTKEY; otherwise, it does not work. Don't know why.
BTW if you remember that I commented that, in this function
' ========================================================================================
' 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
DIM tbb AS TBBUTTON = (idxBitmap, idCommand, fsState, fsStyle, {0, 0, 0, 0, 0, 0}, dwData,
but this don't
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
DIM tbb AS TBBUTTON
tbb = TYPE<TBBUTTON>(idxBitmap, idCommand, fsState, fsStyle, {0, 0, 0, 0, 0, 0}, dwData,
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...
I have added to AfxGdiplus.inc the following functions:
' ========================================================================================
' 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
' ========================================================================================
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).
' =====================================================================================
' 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
' ========================================================================================
The following exmple demonstrates the use of the AfxResizeTabPages function:
' ########################################################################################
' 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.
An small change for the next release: I have made tha hParent parameter of the AddControl method optional. Therefore, besides
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 250, 140, 75, 23)
we can also use
pWindow.AddControl("Button", , IDCANCEL, "&Close", 250, 140, 75, 23)
I also have overloaded the AnchorControl method of the CLayout class, so now besides
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
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.
Added to CWindow.inc the following functions:
' ========================================================================================
' 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
DIM pWindow AS CWindow PTR = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
we can use
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
instead of
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
CASE WM_CREATE
' // Get a pointer to the CWindow class from the CREATESTRUCT structure
DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
or
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
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
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.
Getting better every day! It is pretty cool the functionality and convenience that is gained by using overloading.
Better yet. I have modified the first overloaded function:
' ========================================================================================
' 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!
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.
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))
I have modified the AfxUcode and AfxAcode functions to work with UTF8 too.
' ========================================================================================
' 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
' ========================================================================================