PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  
Pages: [1] 2

Author Topic: CWindow RC01 - Tab Control  (Read 6183 times)

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
CWindow RC01 - Tab Control
« on: April 03, 2016, 04:33:05 PM »

CWindow - Release candidate 01

I have made some small changes and added a new class, CTabPage, that derives from CWindow and deals with the pages for a Tab Control. The attached file contains the new CWindow.inc.

Tab Control example

This template demonstrates how to use the new CTabPage class:

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_TabCtrl_HDPI.fbtpl
' Contents: CWindow Tab Control template (High DPI)
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2015-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_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, 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

   FUNCTION = 0

   SELECT CASE AS CONST uMsg

      CASE WM_CREATE
         EXIT FUNCTION

      CASE WM_COMMAND
         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

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

   ' // Delete the tab pages
   Delete pTabPage3
   Delete pTabPage2
   Delete pTabPage1

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

' ========================================================================================
' Tab page 1 window procedure
' ========================================================================================
FUNCTION TabPage1_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   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
' ========================================================================================
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 = TRUE
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
' Tab page 3 window procedure
' ========================================================================================
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 = TRUE
         EXIT FUNCTION

   END SELECT

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

END FUNCTION
' ========================================================================================
« Last Edit: April 03, 2016, 08:42:43 PM by Jose Roca »
Logged

Paul Squires

  • Administrator
  • Guru Member
  • *****
  • Posts: 8865
  • Windows 10
    • PlanetSquires Software
Re: CWindow RC01 - Tab Control
« Reply #1 on: April 03, 2016, 05:48:33 PM »

I smile every time I see Jose Roca posting code!
 
Logged
Paul Squires
PlanetSquires Software
WinFBE Editor and Visual Designer

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Tab Control
« Reply #2 on: April 03, 2016, 06:19:02 PM »

I have to remove two declares:

Code: [Select]
DECLARE FUNCTION AfxWideCharToUtf8 (BYVAL lpWideCharStr AS LPCWCH) AS STRING
DECLARE FUNCTION AfxUtf8ToAnsi (BYVAL strUtf8 AS STRING) AS STRING

I was playing with some new functions that I have moved to AfxStr.inc

Code: [Select]
' ========================================================================================
' Converts an unicode string to an UTF8 encoded string.
' ========================================================================================
FUNCTION AfxWideCharToUtf8 (BYVAL lpWideCharStr AS LPCWCH) AS STRING
   DIM hr AS LONG, buffer AS STRING
   ' // Get the number of bytes required for the buffer for ANSI string
   hr = WideCharToMultiByte(CP_UTF8, 0, lpWideCharStr, lstrlenW(lpWideCharStr), NULL, 0, NULL, NULL)
   IF hr = 0 THEN EXIT FUNCTION
   ' // Allocate a string of the needed size
   buffer = SPACE(hr)
   ' // Convert to UTF8 and return the result
   hr = WideCharToMultiByte(CP_UTF8, 0, lpWideCharStr, lstrlenW(lpWideCharStr), STRPTR(buffer), LEN(buffer), NULL, NULL)
   IF hr = 0 THEN EXIT FUNCTION
   FUNCTION = buffer
END FUNCTION
' ========================================================================================

' ========================================================================================
' Converts an unicode string to an UTF8 encoded string.
' ========================================================================================
FUNCTION AfxUtf8ToAnsi (BYVAL strUtf8 AS STRING) AS STRING
   DIM hr AS LONG, buffer AS STRING
   ' // Get the number of bytes required for the buffer for WIDE string
   hr = MultiByteToWideChar(CP_UTF8, 0, STRPTR(strUtf8), LEN(strUtf8), NULL, 0)
   IF hr = 0 THEN EXIT FUNCTION
   ' // Convert to Unicode
   buffer = SPACE(hr * 2)
   DIM bstrHandle AS BSTR = SysAllocStringByteLen(STRPTR(buffer), LEN(buffer))
   hr = MultiByteToWideChar(CP_UTF8, 0, STRPTR(strUtf8), LEN(strUtf8), bstrHandle, hr * 2)
   ' // Convert to to ansi
   IF hr THEN
      buffer = SPACE(hr)
      hr = WideCharToMultiByte(CP_ACP, 0, bstrHandle, SysStringLen(bstrHandle), STRPTR(buffer), LEN(buffer), NULL, NULL)
   END IF
   IF bstrHandle THEN SysFreeString bstrHandle
   FUNCTION = buffer
END FUNCTION
' ========================================================================================

' ========================================================================================
' Converts an UTF8 encoded string to an unicode string.
' ========================================================================================
FUNCTION AfxUtf8ToWideChar (BYVAL strUtf8 AS STRING) AS BSTR
   DIM hr AS LONG, buffer AS STRING
   ' // Get the number of bytes required for the buffer for WIDE string
   hr = MultiByteToWideChar(CP_UTF8, 0, STRPTR(strUtf8), LEN(strUtf8), NULL, 0)
   IF hr = 0 THEN EXIT FUNCTION
   ' // Convert to Unicode
   buffer = SPACE(hr * 2)
   DIM bstrHandle AS WSTRING PTR = SysAllocStringByteLen(STRPTR(buffer), LEN(buffer))
   hr = MultiByteToWideChar(CP_UTF8, 0, STRPTR(strUtf8), LEN(strUtf8), bstrHandle, hr * 2)
   FUNCTION = bstrHandle
'   // Alternate way
'   DIM pwBuffer AS WSTRING PTR
'   pwBuffer = CAllocate(hr * 2)
'   IF pwBuffer = NULL THEN EXIT FUNCTION
'   hr = MultiByteToWideChar(CP_UTF8, 0, STRPTR(strUtf8), LEN(strUtf8), pwBuffer, hr * 2)
'   FUNCTION = pwBuffer

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

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Tab Control
« Reply #3 on: April 05, 2016, 03:52:32 AM »

Upcoming changes:

Added support for Tri-state check buttons

I simply have added

Code: [Select]
      CASE "CHECK3STATE"
         ' Adds a 3 state checkbox to the window.
         wsClassName = "Button"
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR BS_AUTO3STATE OR BS_LEFT OR BS_VCENTER

to the CWindow.AddControl method.

Changed the class name of the GroupBox control from "Static" to "Button". The fact that PowerBASIC calls a "Frame" control to what it is a GroupBox control did confuse me.

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Tab Control
« Reply #4 on: April 06, 2016, 08:19:10 AM »

Added support for Rich Edit controls. Will work with XP+.

A couple of tricks:

CWindow will use by default as class names "FBWindowClass:xxx", where xxx is a count number. However, you can use your own class name very easily, e.g.

Code: [Select]
DIM pWindow AS CWindow = "MyClassName"

It also calculates the scaling ratio automatically according the DPI setting, but you can change it, e.g.

Code: [Select]
pWindow.DPI = 96   ' or any other value

With a value of 96 you disable scaling.

With any other value, it will scale according this value instead of the DPI setting, e.g.

Code: [Select]
pWindow.DPI = 150

Scale as if the DPI was 150.
« Last Edit: April 06, 2016, 08:20:52 AM by Jose Roca »
Logged

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Tab Control
« Reply #5 on: April 06, 2016, 08:25:39 AM »

The beauty (as Chris will say) of this class is that it is 100 SDK compatible.

The following example embeds a progress bar into a status bar:

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_SBwithPB.fbtpl - Template
' Contents: Demonstrates the use of the StatusBar and ProgressBar controls.
' Comments: In this example, the progress bar has been made child of the status bar.
' 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_START = 1001
CONST IDC_STATUSBAR = 1002
CONST IDC_PROGRESSBAR = 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_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE IDC_START
               ' // Retrieve the handle to the progress bar
               DIM hProgressBar AS HWND = GetDlgItem(GetDlgItem(hwnd, IDC_STATUSBAR), IDC_PROGRESSBAR)
               ' *** Test code ***
               ' // Sets the step increment
               SendMessageW(hProgressBar, PBM_SETSTEP, 1, 0)
               ' // Draws the bar
               DIM i AS LONG
               FOR i = 1 TO 100
                  ' // Advances the current position for a progress bar by the step
                  ' // increment and redraws the bar to reflect the new position
                  SendMessageW(hProgressBar, PBM_STEPIT, 0, 0)
                  SLEEP 10
               NEXT
               ' // Clears the bar by reseting its position to 0
               SendMessageW(hProgressBar, PBM_SETPOS, 0, 0)
         END SELECT

      CASE WM_SIZE
         ' // Resizes the status bar
         DIM hStatusBar AS HWND = GetDlgItem(hwnd, IDC_STATUSBAR)
         SendMessageW hStatusBar, WM_SIZE, wParam, lParam
         ' // Redraws it
         InvalidateRect hStatusBar, NULL, TRUE
         EXIT FUNCTION

    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, "Status bar with progress bar", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
   pWindow.Center

   ' // Add a button
   pWindow.AddControl("Button", pWindow.hWindow, IDC_START, "&Start", 20, 20, 75, 23)

   ' // Add a status bar
   DIM hStatusbar AS HWND = pWindow.AddControl("Statusbar", pWindow.hWindow, IDC_STATUSBAR)
   ' // Set the parts
   DIM rgParts(1 TO 2) AS LONG
   rgParts(1) = pWindow.ScaleX(160)
   rgParts(2) = -1
   IF SendMessageW(hStatusBar, SB_SETPARTS, 2, CAST(LPARAM, @rgParts(1))) <> 0 THEN
      SendMessageW(hStatusBar, SB_SIMPLE, FALSE, 0)
   END IF

   ' // Add a progress bar to the status bar
   DIM hProgressBar AS HWND = pWindow.AddControl("ProgressBar", hStatusbar, IDC_PROGRESSBAR, "", 0, 2, 160, 18)
   ' // Set the range
   SendMessageW(hProgressBar, PBM_SETRANGE32, 0, 100)
   ' // Set the initial position
   SendMessageW(hProgressBar, PBM_SETPOS, 0, 0)

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

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

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Tab Control
« Reply #6 on: April 06, 2016, 08:31:03 AM »

Although the main windows and the controls are Unicode aware, you can use ansi strings with them, e.g. using SendMessageA instead of SendMessageW. Windows checks if the target window is Unicode and does the conversion. Therefore, there is no need to have both ansi and unicode support in the class.

The opposite is not true, i.e. you can't use Unicode with an ansi control.

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Tab Control
« Reply #7 on: April 06, 2016, 10:51:34 AM »

I just have learned that instead of

Code: [Select]
DIM rgParts(1 TO 2) AS LONG
rgParts(1) = pWindow.ScaleX(160)
rgParts(2) = -1

we can use

Code: [Select]
DIM rgParts(1 TO 2) AS LONG = {pWindow.ScaleX(160), -1}

I like these nice shortcuts.

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Tab Control
« Reply #8 on: April 08, 2016, 07:50:55 AM »

Continuing my monologue, I'm writing small tests to check for errors in the AddControl method.

There was an small one in the UpDown control, in which this line

Code: [Select]
' // Correct for Windows using a default size for the updown control
SetWindowPos hCtl, NULL, x, y, nWidth, nHeight, SWP_NOZORDER

should be

Code: [Select]
' // Correct for Windows using a default size for the updown control
this.SetWindowPos hCtl, NULL, x, y, nWidth, nHeight, SWP_NOZORDER

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Tab Control
« Reply #9 on: April 08, 2016, 07:52:44 AM »

This example has some interest, showing how to create, resize and processing notifications for an Header control.

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_HeaderCtrl.fbtpl - Template
' Contents: Demonstrates the use of the Header 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
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"

USING Afx.CWindowClass

CONST IDC_HEADER = 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)

' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_NOTIFY
         DIM ptnmhdr AS NMHDR PTR = CAST(NMHDR PTR, lParam)
         SELECT CASE ptnmhdr->idFrom
            CASE IDC_HEADER
               SELECT CASE ptnmhdr->code
                  CASE HDN_ITEMCLICKW
                     DIM ptnmh AS NMHEADERW PTR = CAST(NMHEADERW PTR, lParam)
                     MessageBoxW hwnd, "You have clicked item " & WSTR$(ptnmh->iItem + 1), "", MB_OK
                     EXIT FUNCTION
'                  CASE HDN_ITEMDBLCLICK
'                     DIM ptnmh AS NMHEADERW PTR = CAST(NMHEADERW PTR, lParam)
'                     MessageBoxW hwnd, "You have clicked item " & WSTR$(ptnmh->iItem + 1), "", MB_OK
'                     EXIT FUNCTION
               END SELECT
         END SELECT

      CASE WM_SIZE
         ' // Resize the header control
         DIM hHeader AS HWND = GetDlgItem(hwnd, IDC_HEADER)
         DIM thdl AS HDLAYOUT, twp AS WINDOWPOS, trc AS RECT
         GetClientRect hwnd, @trc
         thdl.prc = @trc
         thdl.pwpos = @twp
         SendMessageW hHeader, HDM_LAYOUT, 0, CAST(LPARAM, @thdl)
         SetWindowPos hHeader, NULL, twp.x, twp.y, twp.cx, twp.cy, SWP_NOZORDER OR SWP_NOACTIVATE
         EXIT FUNCTION

    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, "Header control", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
   pWindow.Center

   DIM hHeader AS HWND = pWindow.AddControl("Header", pWindow.hWindow, IDC_HEADER, "", 0, 0, pWindow.ClientWidth, 23)

   DIM thdi AS HDITEM
   DIM wszItem AS WSTRING * 260
   ' Insert items
   wszItem       = "Item 1"
   thdi.Mask     = HDI_WIDTH OR HDI_FORMAT OR HDI_TEXT
   thdi.fmt      = HDF_LEFT OR HDF_STRING
   thdi.cxy      = pWindow.ScaleX(80)
   thdi.pszText  = @wszItem
   SendMessage hHeader, HDM_INSERTITEM, 1, CAST(LPARAM, @thdi)
   wszItem       = "Item 2"
   SendMessage hHeader, HDM_INSERTITEM, 2, CAST(LPARAM, @thdi)
   wszItem       = "Item 3"
   SendMessage hHeader, HDM_INSERTITEM, 3, CAST(LPARAM, @thdi)
   wszItem       = "Item 4"
   SendMessage hHeader, HDM_INSERTITEM, 4, CAST(LPARAM, @thdi)

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

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

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Month Calendar
« Reply #10 on: April 08, 2016, 08:43:59 AM »

Month Calendar control example.

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_MonthCal.fbtpl - Template
' Contents: Demonstrates the use of the Month Calendar 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
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"

USING Afx.CWindowClass

CONST IDC_MONTHCAL = 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)

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

        CASE WM_NOTIFY
            ' // Process notification messages
            DIM ptnmsc AS NMSELCHANGE PTR = CAST(NMSELCHANGE PTR, lParam)
            ' // Get selected date
            IF ptnmsc->nmhdr.code = MCN_SELCHANGE THEN
               DIM wszDate AS WSTRING * 260
               wszDate = "Day: " & WSTR$(ptnmsc->stSelStart.wDay) & " " & _
                         "Month: " & WSTR$(ptnmsc->stSelStart.wMonth) & " " & _
                         "Year: " & WSTR$(ptnmsc->stSelStart.wYear)
               SendMessageW hwnd, WM_SETTEXT, 0, CAST(LPARAM, @wszDate)
               ' Note: Don't use MessageBox here or you will get non-stop messages!
               EXIT FUNCTION
            END IF

      CASE WM_SIZE
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Resize the buttons
            pWindow = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
            pWindow->MoveWindow GetDlgItem(hwnd, IDC_MONTHCAL), 10, 10, pWindow->ClientWidth - 20, pWindow->ClientHeight - 20, TRUE
         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 month calendar", @WndProc)
   pWindow.SetClientSize(400, 220)
   pWindow.Center

   ' // Add a button
   pWindow.AddControl("SysMonthCal32", pWindow.hWindow, IDC_MONTHCAL, "", _
      10, 10, pWindow.ClientWidth - 20, pWindow.CLientHeight - 20)

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

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

Paul Squires

  • Administrator
  • Guru Member
  • *****
  • Posts: 8865
  • Windows 10
    • PlanetSquires Software
Re: CWindow RC01 - Tab Control
« Reply #11 on: April 08, 2016, 08:45:17 AM »

The beauty (as Chris will say) of this class is that it is 100 SDK compatible.

The following example embeds a progress bar into a status bar:

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_SBwithPB.fbtpl - Template
' Contents: Demonstrates the use of the StatusBar and ProgressBar controls.
' Comments: In this example, the progress bar has been made child of the status bar.
' 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_START = 1001
CONST IDC_STATUSBAR = 1002
CONST IDC_PROGRESSBAR = 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_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE IDC_START
               ' // Retrieve the handle to the progress bar
               DIM hProgressBar AS HWND = GetDlgItem(GetDlgItem(hwnd, IDC_STATUSBAR), IDC_PROGRESSBAR)
               ' *** Test code ***
               ' // Sets the step increment
               SendMessageW(hProgressBar, PBM_SETSTEP, 1, 0)
               ' // Draws the bar
               DIM i AS LONG
               FOR i = 1 TO 100
                  ' // Advances the current position for a progress bar by the step
                  ' // increment and redraws the bar to reflect the new position
                  SendMessageW(hProgressBar, PBM_STEPIT, 0, 0)
                  SLEEP 10
               NEXT
               ' // Clears the bar by reseting its position to 0
               SendMessageW(hProgressBar, PBM_SETPOS, 0, 0)
         END SELECT

      CASE WM_SIZE
         ' // Resizes the status bar
         DIM hStatusBar AS HWND = GetDlgItem(hwnd, IDC_STATUSBAR)
         SendMessageW hStatusBar, WM_SIZE, wParam, lParam
         ' // Redraws it
         InvalidateRect hStatusBar, NULL, TRUE
         EXIT FUNCTION

    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, "Status bar with progress bar", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
   pWindow.Center

   ' // Add a button
   pWindow.AddControl("Button", pWindow.hWindow, IDC_START, "&Start", 20, 20, 75, 23)

   ' // Add a status bar
   DIM hStatusbar AS HWND = pWindow.AddControl("Statusbar", pWindow.hWindow, IDC_STATUSBAR)
   ' // Set the parts
   DIM rgParts(1 TO 2) AS LONG
   rgParts(1) = pWindow.ScaleX(160)
   rgParts(2) = -1
   IF SendMessageW(hStatusBar, SB_SETPARTS, 2, CAST(LPARAM, @rgParts(1))) <> 0 THEN
      SendMessageW(hStatusBar, SB_SIMPLE, FALSE, 0)
   END IF

   ' // Add a progress bar to the status bar
   DIM hProgressBar AS HWND = pWindow.AddControl("ProgressBar", hStatusbar, IDC_PROGRESSBAR, "", 0, 2, 160, 18)
   ' // Set the range
   SendMessageW(hProgressBar, PBM_SETRANGE32, 0, 100)
   ' // Set the initial position
   SendMessageW(hProgressBar, PBM_SETPOS, 0, 0)

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

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


Hi Jose,

This example did not "work" for me when I ran it. It actually does work but the ProgressBar is not initially visible. I used Spy.exe to confirm that it existed but did not have the WS_VISIBLE style set. I looked at your code for cWindow and I see that you are not defining a default dwStyle for the ProgressBar (other than the WS_CHILD that gets added afterwards).

Code: [Select]
      CASE "PROGRESSBAR", "MSCTLS_PROGRESS32"
         ' Adds a progress bar to the window.
         wsClassName = "msctls_progress32"
         bSetFont = FALSE

Probably should be....

Code: [Select]
      CASE "PROGRESSBAR", "MSCTLS_PROGRESS32"
         ' Adds a progress bar to the window.
         wsClassName = "msctls_progress32"
         bSetFont = FALSE
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE



Logged
Paul Squires
PlanetSquires Software
WinFBE Editor and Visual Designer

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Tab Control
« Reply #12 on: April 08, 2016, 09:20:52 AM »

Yes. I did notice it when I wrote the example (I'm writing these tests to see if there are bugs) and changed the code to:

Code: [Select]
      CASE "PROGRESSBAR", "MSCTLS_PROGRESS32"
         ' Adds a progress bar to the window.
         IF dwStyle = 0 THEN dwStyle = WS_VISIBLE
         wsClassName = "msctls_progress32"
         bSetFont = FALSE

but forgot to point it here.

Thanks very much.
« Last Edit: April 08, 2016, 09:23:24 AM by Jose Roca »
Logged

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Tab Control
« Reply #13 on: April 08, 2016, 09:23:10 AM »

Size Box control example.

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_SizeBox.fbtpl - Template
' Contents: Demonstrates the use of the SizeBox 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
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"

USING Afx.CWindowClass

CONST IDC_SIZEBOX = 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)

' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         IF wParam <> SIZE_MINIMIZED THEN
            DIM hSizeBox AS HWND = GetDlgItem(hWnd, IDC_SIZEBOX)
            ' // Reposition the sizebox
            ' Hide the sizebox if the window is maximized
            IF wParam = SIZE_MAXIMIZED THEN
               ShowWindow hSizeBox, SW_HIDE
            ' Reposition and show the sizebox
            ELSE
               DIM cx AS LONG = GetSystemMetrics(SM_CXVSCROLL)
               DIM cy AS LONG = GetSystemMetrics(SM_CYHSCROLL)
               SetWindowPos hSizeBox, NULL, LOWORD(lParam) - cx, HIWORD(lParam) - cy, cx, cy, SWP_NOZORDER OR SWP_SHOWWINDOW
            END IF
         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

   ' // Create the main window with default coordinates
   DIM pWindow AS CWindow
   pWindow.Create(NULL, "Size box", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
   pWindow.Center

   ' // Add a size box control (it will be positioned and displayed in the WM_SIZE message)
   pWindow.AddControl("SizeBox", pWindow.hWindow, IDC_SIZEBOX)

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

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

Josť Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3205
Re: CWindow RC01 - Toolbar
« Reply #14 on: April 08, 2016, 01:47:18 PM »

Toolbar example.

Code: [Select]
' ########################################################################################
' 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"

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
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 a tool bar
' ========================================================================================
SUB AddToolbarButtons (BYVAL hToolBar AS HWND)

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

END SUB
' ========================================================================================

' ========================================================================================
' 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, GetPropW(hwnd, "CWINDOWPTR"))
            pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 95, pWindow->ClientHeight - 35, 75, 23, TRUE
         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 toolbar", @WndProc)
   ' // Disable background erasing
   pWindow.ClassStyle = CS_DBLCLKS
   ' // Set the client size
   pWindow.SetClientSize(300, 150)
   ' // 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)
   ' // Flat toolbar
'   DIM hToolBar AS HWND = pWindow.AddControl("Toolbar", pWindow.hWindow, IDC_TOOLBAR, "", 0, 0, 0, 0, _
'              WS_VISIBLE OR WS_CLIPCHILDREN OR WS_CLIPSIBLINGS OR CCS_TOP OR TBSTYLE_FLAT)
   ' // Add the toolbar buttons
   AddToolbarButtons hToolBar
   ' // Size the toolbar
   SendMessageW hToolBar, TB_AUTOSIZE, 0, 0

   

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

END FUNCTION
' ========================================================================================
Pages: [1] 2