CWindow RC02

[José Roca]

CWindow class, release candidate nº 2.

[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_Rebar.fbtpl
' Contents: CWindow with a rebar control
' 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"

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, COMMAND(), SW_NORMAL)

CONST IDC_TOOLBAR = 1001
CONST IDC_CBBOX = 1002
CONST IDC_REBAR = 1003
enum
   IDM_CUT = 28000
   IDM_COPY, IDM_PASTE, IDM_UNDO, IDM_REDOW, IDM_DELETE, IDM_FILENEW, IDM_FILEOPEN
   IDM_FILESAVE, IDM_PRINTPRE, IDM_PROPERTIES, IDM_HELP, IDM_FIND, IDM_REPLACE, IDM_PRINT
end enum

' ========================================================================================
' Adds a button to the toolbar
' ========================================================================================
FUNCTION ToolBar_AddButtonW (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 LONG
   DIM tb AS TBBUTTON, idxString AS INT_PTR
   IF fsState = 0 THEN fsState = TBSTATE_ENABLED
   IF pwszText <> NULL THEN
      IF LEN(*pwszText) = 0 THEN idxString = -1 ELSE idxString = CAST(INT_PTR, pwszText)
   END IF
   tb.iBitmap = idxBitmap : tb.idCommand = idCommand : tb.fsState = fsState
   tb.fsStyle = fsStyle : tb.dwData = dwData : tb.iString = idxString
   FUNCTION = SendMessageW(hToolBar, TB_ADDBUTTONSW, 1, CAST(WPARAM, @tb))
END FUNCTION
' ========================================================================================

' ========================================================================================
' Adds a separator to the toolbar
' ========================================================================================
FUNCTION ToolBar_AddSeparatorW (BYVAL hToolBar AS HWND, BYVAL nWidth AS LONG = 0) AS LONG
   DIM tb AS TBBUTTON
   tb.iBitmap = nWidth : tb.idCommand = 0 : tb.fsState = TBSTATE_ENABLED
   tb.fsStyle = TBSTYLE_SEP : tb.dwData = 0 : tb.iString = -1
   FUNCTION = SendMessageW(hToolBar, TB_ADDBUTTONSW, 1, CAST(LPARAM, @tb))
END FUNCTION
' ========================================================================================

' ========================================================================================
' Create the toolbar
' ========================================================================================
FUNCTION CreateToolbar (BYVAL pWindow AS CWindow PTR) AS HWND

   ' // Add a tooolbar
   DIM hToolBar AS HWND = pWindow->AddControl("Toolbar", pWindow->hWindow, IDC_TOOLBAR, "", 0, 0, 0, 0, _
      WS_CHILD OR WS_VISIBLE OR TBSTYLE_TOOLTIPS OR TBSTYLE_FLAT OR CCS_NODIVIDER OR CCS_NORESIZE OR CCS_NOPARENTALIGN)
   ' // Allow drop down arrows
   SendMessageW hToolBar, TB_SETEXTENDEDSTYLE, 0, TBSTYLE_EX_DRAWDDARROWS
   ' // Add a bitmap with the button images
   DIM ttbab AS TBADDBITMAP
   ttbab.hInst = HINST_COMMCTRL
   IF AfxIsProcessDPIAware THEN
      ttbab.nId = IDB_STD_LARGE_COLOR
   ELSE
      ttbab.nId = IDB_STD_SMALL_COLOR
   END IF
   SendMessageW(hToolBar, TB_ADDBITMAP, 0, CAST(LPARAM, @ttbab))
   ' // Add buttons to the toolbar
   Toolbar_AddButtonW hToolBar, STD_CUT, IDM_CUT
   Toolbar_AddButtonW hToolBar, STD_COPY, IDM_COPY
   Toolbar_AddButtonW hToolBar, STD_PASTE, IDM_PASTE
   Toolbar_AddButtonW hToolBar, STD_DELETE, IDM_DELETE
   ToolBar_AddSeparatorW hToolBar
   Toolbar_AddButtonW hToolBar, STD_UNDO, IDM_UNDO
   Toolbar_AddButtonW hToolBar, STD_REDOW, IDM_REDOW
   ToolBar_AddSeparatorW hToolBar
   Toolbar_AddButtonW hToolBar, STD_FILENEW, IDM_FILENEW, 0, BTNS_DROPDOWN
   Toolbar_AddButtonW hToolBar, STD_FILEOPEN, IDM_FILEOPEN
   Toolbar_AddButtonW hToolBar, STD_FILESAVE, IDM_FILESAVE
   Toolbar_AddButtonW hToolBar, STD_PRINTPRE, IDM_PRINTPRE
   ToolBar_AddSeparatorW hToolBar
   Toolbar_AddButtonW hToolBar, STD_FIND, IDM_FIND
   Toolbar_AddButtonW hToolBar, STD_REPLACE, IDM_REPLACE
   ToolBar_AddSeparatorW hToolBar
   Toolbar_AddButtonW hToolBar, STD_PROPERTIES, IDM_PROPERTIES
   Toolbar_AddButtonW hToolBar, STD_PRINT, IDM_PRINT
   ToolBar_AddSeparatorW hToolBar
   Toolbar_AddButtonW hToolBar, STD_HELP, IDM_HELP
   ' // Size the toolbar
   SendMessageW hToolBar, TB_AUTOSIZE, 0, 0
   ' // Return the toolbar handle
   FUNCTION = hToolbar

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 pWindow AS CWindow PTR
   DIM rc AS RECT

   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_NOTIFY
         ' -------------------------------------------------------
         ' Notification messages are handled here.
         ' The TTN_GETDISPINFO message is sent by a ToolTip control
         ' to retrieve information needed to display a ToolTip window.
         ' ------------------------------------------------------
         DIM ptnmhdr AS NMHDR PTR              ' // Information about a notification message
         DIM ptttdi AS NMTTDISPINFO PTR       ' // Tooltip notification message information
         DIM wszTooltipText AS WSTRING * 260   ' // Tooltip text

         ptnmhdr = CAST(NMHDR PTR, lParam)
         SELECT CASE ptnmhdr->code
            ' // The height of the rebar has changed
            CASE RBN_HEIGHTCHANGE
               ' // Get the coordinates of the client area
               GetClientRect hwnd, @rc
               ' // Send a WM_SIZE message to resize the controls
               SendMessageW hwnd, WM_SIZE, SIZE_RESTORED, MAKELONG(rc.Right - rc.Left, rc.Bottom - rc.Top)
            ' // Toolbar tooltips
            CASE TTN_GETDISPINFO
               ptttdi = CAST(NMTTDISPINFO PTR, lParam)
               ptttdi->hinst = NULL
               wszTooltipText = ""
               SELECT CASE ptttdi->hdr.hwndFrom
                  CASE SendMessageW(GetDlgItem(GetDlgItem(hwnd, IDC_REBAR), IDC_TOOLBAR), TB_GETTOOLTIPS, 0, 0)
                     SELECT CASE ptttdi->hdr.idFrom
                        CASE IDM_CUT        : wszTooltipText = "Cut"
                        CASE IDM_COPY       : wszTooltipText = "Copy"
                        CASE IDM_PASTE      : wszTooltipText = "Paste"
                        CASE IDM_UNDO       : wszTooltipText = "Undo"
                        CASE IDM_REDOW      : wszTooltipText = "Redo"
                        CASE IDM_DELETE     : wszTooltipText = "Delete"
                        CASE IDM_FILENEW    : wszTooltipText = "File New"
                        CASE IDM_FILEOPEN   : wszTooltipText = "File Open"
                        CASE IDM_FILESAVE   : wszTooltipText = "File Save"
                        CASE IDM_PRINTPRE   : wszTooltipText = "Print Preview"
                        CASE IDM_PROPERTIES : wszTooltipText = "Properties"
                        CASE IDM_HELP       : wszTooltipText = "Help"
                        CASE IDM_FIND       : wszTooltipText = "Find"
                        CASE IDM_REPLACE    : wszTooltipText = "Replace"
                        CASE IDM_PRINT      : wszTooltipText = "Print"
                     END SELECT
                     IF LEN(wszTooltipText) THEN ptttdi->lpszText = @wszTooltipText
               END SELECT

         CASE TBN_DROPDOWN
            DIM ptbn AS TBNOTIFY PTR = CAST(TBNOTIFY PTR, lParam)
            SELECT CASE ptbn->iItem
               CASE IDM_FILENEW
                  DIM rc AS RECT
                  SendMessageW(ptbn->hdr.hwndFrom, TB_GETRECT, ptbn->iItem, CAST(LPARAM, @rc))
                  MapWindowPoints(ptbn->hdr.hwndFrom, HWND_DESKTOP, CAsT(LPPOINT, @rc), 2)
                  DIM hPopupMenu AS HMENU = CreatePopUpMenu
                  AppendMenuW hPopupMenu, MF_ENABLED, 10001, "Option 1"
                  AppendMenuW hPopupMenu, MF_ENABLED, 10002, "Option 2"
                  AppendMenuW hPopupMenu, MF_ENABLED, 10003, "Option 3"
                  AppendMenuW hPopupMenu, MF_ENABLED, 10004, "Option 4"
                  AppendMenuW hPopupMenu, MF_ENABLED, 10005, "Option 5"
                  TrackPopupMenu(hPopupMenu, 0, rc.Left, rc.Bottom, 0, hwnd, NULL)
                  DestroyMenu hPopupMenu
            END SELECT

         END SELECT

      CASE WM_SIZE
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Update the size and position of the Rebar control
            SendMessageW GetDlgItem(hwnd, IDC_REBAR), WM_SIZE, wParam, lParam
            ' // Resize the button
            pWindow = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
            pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 95, pWindow->ClientHeight - 35, 75, 23, CTRUE
            EXIT FUNCTION
         END IF

    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 rebar", @WndProc)
   ' // Disable background erasing
   pWindow.ClassStyle = CS_DBLCLKS
   ' // Set the client size
   pWindow.SetClientSize(600, 250)
   ' // Center the window
   pWindow.Center

   ' // Add a button
   DIM hButton AS HWND = pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close")

   ' // Create a rebar control
   DIM hRebar AS HWND = pWindow.AddControl("Rebar", pWindow.hWindow, IDC_REBAR)

   ' Create the toolbar
   DIM hToolbar AS HWND = CreateToolbar(@pWindow)

   ' // Add the band containing the toolbar control to the rebar
   ' // The size of the REBARBANDINFO is different in Vista/Windows 7
   DIM rc AS RECT, wszText AS WSTRING * 260
   DIM rbbi AS REBARBANDINFO
   IF AfxWindowsVersion >= 600 AND AfxComCtlVersion >= 600 THEN
      rbbi.cbSize  = REBARBANDINFO_V6_SIZE
   ELSE
      rbbi.cbSize  = REBARBANDINFO_V3_SIZE
   END IF

   ' // Insert the toolbar in the rebar control
   rbbi.fMask      = RBBIM_STYLE OR RBBIM_CHILD OR RBBIM_CHILDSIZE OR _
                     RBBIM_SIZE OR RBBIM_ID OR RBBIM_IDEALSIZE OR RBBIM_TEXT
   rbbi.fStyle     = RBBS_CHILDEDGE
   rbbi.hwndChild  = hToolbar
   rbbi.cxMinChild = 250 * pWindow.rxRatio
   rbbi.cyMinChild = HIWORD(SendMessageW(hToolBar, TB_GETBUTTONSIZE, 0, 0))
   rbbi.cx         = 250 * pWindow.rxRatio
   rbbi.cxIdeal    = 250 * pWindow.rxRatio
   wszText = "Toolbar"
   rbbi.lpText = @wszText
   '// Insert band into rebar
   SendMessageW hRebar, RB_INSERTBAND, -1, CAST(LPARAM, @rbbi)

   ' // Insert a combobox in the rebar control
   DIM hCbBox AS HWND = pWindow.AddControl("ComboBox", pWindow.hWindow, IDC_CBBOX, "", 0, 0, 0, 50 * pWindow.rxRatio)
   GetWindowRect hCbBox, @rc
   rbbi.fMask      = RBBIM_STYLE OR RBBIM_CHILD OR RBBIM_CHILDSIZE OR _
                     RBBIM_SIZE OR RBBIM_ID OR RBBIM_IDEALSIZE OR RBBIM_TEXT
   rbbi.fStyle     = RBBS_FIXEDSIZE OR RBBS_CHILDEDGE
   rbbi.hwndChild  = hCbBox
   rbbi.cxMinChild = 200 * pWindow.rxRatio
   rbbi.cyMinChild = rc.Bottom - rc.Top
   rbbi.cx         = 200 * pWindow.rxRatio
   rbbi.cxIdeal    = 200 * pWindow.rxRatio
   wszText = "Combobox"
   rbbi.lpText = @wszText
   '// Insert band into rebar
   SendMessageW hRebar, RB_INSERTBAND, -1, CAST(LPARAM, @rbbi)

   

   ' // Process event messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

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


[José Roca]

I have adapted my XpButton control to FreeBasic using a class. This technique makes it somewhat easier to use the control and will allow me to extend the functionality of CWindow without adding bloat to that class.

[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_XpButton.fbtpl
' Contents: CWindow XpButton example
' 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/CXpButton.inc"

USING Afx.CWindowClass
USING Afx.CXpButtonClass

CONST IDC_BUTTON1 = 1001
CONST IDC_BUTTON2 = 1002
CONST IDC_BUTTON3 = 1003

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

   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
         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, "XpButton example", @WndProc)
   pWindow.SetClientSize(215, 142)
   pWindow.Center

   DIM pXpButton1 AS CXpButton = CXpButton(@pWindow, IDC_BUTTON1, "&Ok", 50, 20, 114, 26)
   pXpButton1.SetIconFromFile ExePath & "\16_OK.ICO", XPBI_NORMAL
   pXpButton1.SetIconFromFile ExePath & "\16_OKHOT.ICO", XPBI_HOT
   pXpButton1.SetToggle CTRUE
   pXpButton1.SetCursor LoadCursor(NULL, IDC_CROSS)
   pXpButton1.SetImageMargin 10

   DIM pXpButton2 AS CXpButton = CXpButton(@pWindow, IDC_BUTTON2, "&Cancel", 50, 55, 114, 26)
   pXpButton2.SetIconFromFile ExePath & "\16_CANCEL.ICO", XPBI_NORMAL
   pXpButton2.SetIconFromFile ExePath & "\16_CANCELDISABLED.ICO", XPBI_DISABLED
   pXpButton2.SetImagePos XPBI_RIGHT OR XPBI_VCENTER
   pXpButton2.SetTextFormat DT_RIGHT OR DT_VCENTER OR DT_SINGLELINE
   EnableWindow pXpButton2.hWindow, FALSE   ' Disable the button

   DIM pXpButton3 AS CXpButton = CXpButton(@pWindow, IDC_BUTTON3, "&Classic Button", 50, 90, 114, 26)
   
   SetFocus pXpButton1.hWindow

   FUNCTION = pWindow.DoEvents(nCmdShow)

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