Print

Please login or register.
1 Hour 1 Day 1 Week 1 Month Forever
Login with username, password and session length

[José Roca]

I have modified CWindow, CXpButton and CPgBar3D to store the pointer to the class in the window extra bytes instead of as a property.

Therefore, instead of using something like

Code: [Select]

pWindow = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))

that had the inconvenience of having to remember the name of the property ("CWINDOWPTR", etc.), we now will always use something line

Code: [Select]

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


[José Roca]

And these are the modified OOP versions of the progress bar sample programs.

[José Roca]

A split button is a button with a drop down arrow. It is available with Windows Vista+ and needs the use of a manifest because we need to use version 6 of the Windows Common Controls. It also supports the use of an imagelist to display icons.

To make the size of the icon DPI aware, I have used this formula:

Code: [Select]

   ' // Calculate an appropriate icon size
   DIM cx AS LONG = 16 * pWindow.DPI \ 96

based in that 16 pixels is the normal icon size for 96 DPI.

Remember to link a resource file that includes a manifest and remember also to change the path and name of the icon.

Code: [Select]

' ########################################################################################
' Microsoft Windows
' File: CW_SplitButton.fbtpl
' Contents: CWindow with a split button
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define unicode
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxGdiplus.inc"
' // You must link a resource file that includes a manifest
' $FB_RESPATH = "FBRES.rc"

USING Afx.CWindowClass
USING Afx.Gdiplus

CONST IDC_MENUCOMMAND1 = 28000
CONST IDC_MENUCOMMAND2 = 28001

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, 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

   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
         END SELECT

      CASE WM_NOTIFY
         ' // Processs notify messages sent by the split button
         DIM pNmh AS NMHDR PTR = CAST(NMHDR PTR, lParam)
         IF pNmh->idFrom = IDCANCEL AND pNmh->code = BCN_DROPDOWN THEN
            DIM pDropDown AS NMBCDROPDOWN PTR = CAST(NMBCDROPDOWN PTR, lParam)
            ' // Get screen coordinates of the button
            DIM pt AS POINT = (pDropdown->rcButton.left, pDropDown->rcButton.bottom)
            ClientToScreen(pNmh->hwndFrom, @pt)
            ' // Create a menu and add items
            DIM hSplitMenu AS HMENU = CreatePopupMenu
            AppendMenuW(hSplitMenu, MF_BYPOSITION, IDC_MENUCOMMAND1, "Menu item 1")
            AppendMenuW(hSplitMenu, MF_BYPOSITION, IDC_MENUCOMMAND2, "Menu item 2")
            ' // Display the menu
            TrackPopupMenu(hSplitMenu, TPM_LEFTALIGN OR TPM_TOPALIGN, pt.x, pt.y, 0, hwnd, NULL)
            FUNCTION = CTRUE
            EXIT FUNCTION
         END IF

      CASE WM_SIZE
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Resize the button
            pWindow = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
            pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 200, pWindow->ClientHeight - 90, 110, 23, CTRUE
         END IF

    CASE WM_DESTROY
         ImageList_Destroy CAST(HIMAGELIST, SendMessageW(GetDlgItem(hwnd, IDCANCEL), 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 split button", @WndProc)
   pWindow.SetClientSize(300, 150)
   pWindow.Center

   ' // Add a button without position or size (it will be resized in the WM_SIZE message).
   DIM hSplitButton AS HWND = pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, _
      "&Shutdown", , , , , WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR BS_CENTER OR BS_VCENTER OR BS_SPLITBUTTON)

   ' // Calculate an appropriate icon size
   DIM cx AS LONG = 16 * pWindow.DPI \ 96
   ' // Create an image list for the button
   DIM hImageList AS HIMAGELIST = ImageList_Create(cx, cx, ILC_COLOR32 OR ILC_MASK, 1, 0)
   ' // Remember to change the path and name of the icon
   IF hImageList THEN ImageList_ReplaceIcon(hImageList, -1, AfxGdipImageFromFile(ExePath & "\Shutdown_48.png"))
   ' // Fill a BUTTON_IMAGELIST structure and set the image list
   DIM bi AS BUTTON_IMAGELIST = (hImageList, (3, 3, 3, 3), BUTTON_IMAGELIST_ALIGN_LEFT)
   SendMessageW hSplitButton, BCM_SETIMAGELIST, 0, CAST(LPARAM, @bi)

   ' // Process windows events
   FUNCTION = pWindow.DoEvents(nCmdShow)

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


[José Roca]

Thanks to the functions included in AfxGdiplus.inc, we don't need to have a set of different icon sizes for each DPI setting. We can have a 48 or 64 icon and create the image list with the appropriate width and height using the formula: DIM cx AS LONG = 16 * pWindow.DPI \ 96.

Note that, unlike LoadImage, you don't have to specify the wanted dimensions of the icon when using the AfxGdipxxx functions that create the icon from a .png file, only when calling ImageList_Create.

By using a manifest, the alpha channel is preserved; otherwise, it is lost, because versions of the common controls library below 6 don't support the alpha channel.

[José Roca]

I also like this FreeBasic shortcut to fill structures:

Code: [Select]

DIM bi AS BUTTON_IMAGELIST = (hImageList, (3, 3, 3, 3), BUTTON_IMAGELIST_ALIGN_LEFT)

The structure is as follows:

Code: [Select]

type BUTTON_IMAGELIST
himl as HIMAGELIST
margin as RECT
uAlign as UINT
end type

The (3, 3, 3, 3) in the assignment allows to fill the embedded RECT structure. Nice.

[Paul Squires]

The new cWindow class is looking awesome! Finally a great new Windows based framework for FreeBASIC.

I am just thinking out loud at this point, but I can see new users having no trouble creating windows and adding controls, however, I can see users having trouble dealing with the notifications/events from those windows/controls. Just as PowerBASIC users do not take the time to learn the meanings of wParam and lParam values for notifications, I can see FreeBASIC users having the same lack of interest. I wonder if eventually you might want to consider creating message crackers similar to how the old style C programmers used to deal with the WinAPI. It would also ensure that messages are cracked correctly between 32 and 64 bit.

Basically, maybe start creating examples using the handlers found in windowsx.bi

Then have separate functions setup to respond to those macros: like, OnCreate, OnSize, OnDestroy, etc...

It would help hide all of the messy CAST, LOWORD, HIWORD, stuff, and make the code much more "approachable" and structured for newbies.

Just a thought.

[José Roca]

I never have liked to use message crackers. But the main reason is that, since FB doesn't remove dead code, I want to keep the class as lightweight as possible. Even some of the auxiliary code will eventually end in separate include files.

But these classes are not like PB classes. You can simply extend it and do wathever you like.

MyClsWindow EXTENDS CWindow

and pass to it a pointer to your new window procedure, and replace the DoEvents procedure with your own, and/or override methods, etc.

This way, CWindow will provide the basic stuff and you can add all the bloat you like.

BTW many of these messy CAST, LOWORD, HIWORD, stuff can be solved with defines or macros. windowsx.bi already has many of them, such GET_X_LPARAM, GET_Y_LPARAM, etc. I will try to learn more about FB macros. Until now I have mainly written test code.

I think that the last version of CWindow can already be used for production code. It does a lot of things with little overhead. DPI and Unicode aware, MDI support, works with 32 and 64 bit without changes, etc. And see how easily I have extended it in the CTabPage class to provide support for tab pages.

[José Roca]

There are convenient defines in windowsx.bi that I will begin to use, such DeleteFont or SelectFont.

Therefore, instead of

DeleteObject(CAST(HGDIOBJ, hNewFont))

I will use

DeleteFont(hNewFont)

or instead of

SelectObject(hDC, CAST(HGDIOBJ, CAST(HFONT, hOldFont)))

I will use

SelectFont(hDC, hOldFont)

They're convenient because they hide these nasty casts.

But using defines for Windows messages can be more problematic, because the MSDN documentation talks about HIWORD of wParam, not about GET_WM_COMMAND_CMD or something like that.

[José Roca]

Don't undestand.

If I try to replace

IF hNewFont THEN DeleteObject(CAST(HGDIOBJ, hNewFont))

with

IF hNewFont THEN DeleteFont(hNewFont)

I get a syntax error.

Error 17: Syntax error. Found 'hNewFont' in 'IF hNewFont THEN DeleteFont(hNewFont)'.

DeleteFont is defined as

#define DeleteFont(hfont) DeleteObject(cast(HGDIOBJ, cast(HFONT, (hfont))))

in windowsx.bi

[James Fuller]

Jose,
  It probably isn't this but I NEVER use single line IF THEN statements.

James

[José Roca]

If doesn't matter if I use one line or

Code: [Select]

         IF hNewFont NULL THEN
            DeleteFont(hNewFont)
         END IF

or

Code: [Select]

         IF hNewFont <> NULL THEN
            DeleteFont(hNewFont)
         END IF

Where is the syntax error?

[José Roca]

The easier way to avoid that casting mess would be, of course, to remove that irritant strict type checking from the compiler. It is impossible to write a couple of lines of API code without having to use CAST. I wonder if the writers of the compiler use it to write applications. Probably they use C++.

[Paul Squires]

I think it has to do with the #define using the hfont variable as part of the expansion. Maybe because hfont is a defined structure in FB.

I changed the declare to the following and it worked:
#Define DeleteFont(_hfont) DeleteObject(Cast(HGDIOBJ, Cast(HFONT, (_hfont)) ))

If this is the case then I can post on the FB forum to get a more definitive answer.

[José Roca]

Something frequently asked. How to make a modal popup window?

Code: [Select]

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

#define unicode
#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, 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
' ========================================================================================



[José Roca]

I think it has to do with the #define using the hfont variable as part of the expansion. Maybe because hfont is a defined structure in FB.

I changed the declare to the following and it worked:
#Define DeleteFont(_hfont) DeleteObject(Cast(HGDIOBJ, Cast(HFONT, (_hfont)) ))

If this is the case then I can post on the FB forum to get a more definitive answer.

That is. As always, macros are a can of worms.