Modern UI Inspired Toggle Switch

[MrBcx]

I just copied the entire source code from the first post, compiled and ran it.

It runs perfectly for me.

[Quin]

MrBcx,
Thanks for your efforts here! Unfortunately I can't get your code to translate, I get told:

Missing AS TYPE at line 52 in Module: ToggleSwitch.bas

The line is:

Code Select Expand


Type TOGGLESTATEÃ,  Ã,  Ã,  Ã,  ' Structure to hold toggle switch state

I coppied it directly from the forum post and your previous version worked flawlessly. What am I missing?
Thanks,
Quin.

[MrBcx]

Thanks Robert,

Inside WM_CREATE, we can see the following:

SetWindowLongPtr(CBHWND, GWL_STYLE, GetWindowLongPtr(CBHWND, GWL_STYLE) OR WS_TABSTOP)

which basically supplements the default Windows Styles of the BCX_CONTROL with WS_TABSTOP.



What's the sound of a slow click ?

This works for me 

https://www.youtube.com/watch?v=ia3dJvydKY4

[Robert]

The code in the original post has been updated but the screenshot has not.

The ToggleSwitch control has a more refined behavior now. The control still looks
the same but there is a subtle animated transition between the on & off positions.

If you're interested in making your own custom controls, this might provide some clues.

It works with all the compilers.

Hi MrBCX:

Absolutely beautiful "subtle animated transition" from On to Off and back again.

Ray Chen has some ancients words on tabbing between user controls

Here is a link to his post 'Using the TAB key to navigate in non-dialogs"

https://devblogs.microsoft.com/oldnewthing/20031021-00/?p=42083

That "slow subtle animated transition" is the kind of code that makes the difference between "Top Shelf" and "Bottom of the Barrel"

What's the sound of a slow click ?

[MrBcx]

Quin,

Below is an updated callback function that mostly addresses your punch-list.

I'm not particularly crazy about the appearance of the focus rectangle but that can be disabled easily enough.

The tab / shift-tab key works and the spacebar key act like a toggle on the control that has focus.


Updated Later:  Added SetFocus() inside WM_LBUTTONUP handler

Code Select Expand



CALLBACK FUNCTION ToggleSwitchProc
    LOCAL state AS TOGGLESTATE PTR
    LOCAL r AS RECT
    LOCAL hdc AS HDC
    LOCAL ps AS PAINTSTRUCT
    LOCAL hBrush AS HBRUSH
    LOCAL knobSize AS LONG
    LOCAL knobRect AS RECT     ' Rectangle for the sliding knob
    LOCAL hasFocus AS BOOL

    ' Get the state for this specific toggle instance
    state = CAST(TOGGLESTATE PTR, GetWindowLongPtr(CBHWND, GWLP_USERDATA))

    SELECT CASE CBMSG
        '*******************
        CASE WM_CREATE
        '*******************
        ' Create rounded corners for the control
        DIM Region AS HRGN
        DIM Rect AS RECT
        DIM w, h AS INT
        GetWindowRect(CBHWND, &Rect)
        w = Rect.right - Rect.left
        h = Rect.bottom - Rect.top
        Region = CreateRoundRectRgn(0, 0, w, h, h, h)
        SetWindowRgn(CBHWND, Region, TRUE)
        DeleteObject(Region)

        ' Initialize state for each toggle
        SetWindowLongPtr(CBHWND, GWLP_USERDATA, CAST(LONG_PTR, AllocateToggleState()))

        ' Initial paint request
        InvalidateRect(CBHWND, NULL, TRUE)

        ' Allow the control to receive keyboard focus
        SetWindowLongPtr(CBHWND, GWL_STYLE, GetWindowLongPtr(CBHWND, GWL_STYLE) OR WS_TABSTOP)
        EXIT FUNCTION


        '*******************
        CASE WM_TIMER
        '*******************
        IF state = NULL THEN EXIT FUNCTION
        IF state->isAnimating THEN
            IF (state->isOn AND state->knobPos < state->targetPos) OR (NOT state->isOn AND state->knobPos > state->targetPos) THEN
                state->knobPos = state->knobPos + IIF(state->isOn, 4, -4) ' Move smoothly
                InvalidateRect(CBHWND, NULL, TRUE)
            ELSE
                state->knobPos = state->targetPos
                KillTimer(CBHWND, 1)
                state->isAnimating = 0
            END IF
        END IF

        '*******************
        CASE WM_GETDLGCODE
        '*******************
        FUNCTION = DLGC_WANTARROWS OR DLGC_WANTTAB OR DLGC_WANTCHARS OR DLGC_WANTALLKEYS


        '*******************
        CASE WM_KEYDOWN
        '*******************
        SELECT CASE CBWPARAM
            CASE VK_SPACE
            ' Simulate a mouse click when Space bar is pressed
            SendMessage(CBHWND, WM_LBUTTONUP, 0, 0)

            CASE VK_TAB
            ' Move focus to the next control in the tab order
            IF GetKeyState(VK_SHIFT) < 0 THEN
                ' Shift+Tab moves focus backward
                SetFocus(GetNextDlgTabItem(GetParent(CBHWND), CBHWND, TRUE))
            ELSE
                ' Tab moves focus forward
                SetFocus(GetNextDlgTabItem(GetParent(CBHWND), CBHWND, FALSE))
            END IF
        END SELECT
        EXIT FUNCTION


        '*******************
        CASE WM_LBUTTONUP
        '*******************
        IF state = NULL THEN EXIT FUNCTION
        IF NOT state->isAnimating THEN
            state->isOn = NOT state->isOn
            GetClientRect(CBHWND, &r)
            state->targetPos = IIF(state->isOn, r.right - (r.bottom - r.top) - 2, r.left + 2)
            SetTimer(CBHWND, 1, 16, NULL) ' Start animation timer
            state->isAnimating = 1
            SendMessage(GetParent(CBHWND), WM_COMMAND, MAKELONG(GetWindowLongPtr(CBHWND, GWL_ID), BN_CLICKED), state->isOn)
            SetFocus(CBHWND)
            InvalidateRect(CBHWND, NULL, TRUE)
        END IF
        EXIT FUNCTION


        '*******************
        CASE WM_SETFOCUS
        '*******************
        InvalidateRect(CBHWND, NULL, TRUE)  ' Force a repaint to show the focus outline
        EXIT FUNCTION

        '*******************
        CASE WM_KILLFOCUS
        '*******************
        InvalidateRect(CBHWND, NULL, TRUE)  ' Repaint to remove focus outline
        EXIT FUNCTION

        '*******************
        CASE WM_PAINT
        '*******************
        IF state = NULL THEN EXIT FUNCTION
        GetClientRect(CBHWND, &r)
        hdc = BeginPaint(CBHWND, &ps)

        ' Draw background with rounded corners
        hBrush = (HBRUSH)CreateSolidBrush(IIF(state->isOn = 1, TOGGLE_ON_COLOR, TOGGLE_OFF_COLOR))
        FillRect(hdc, &r, hBrush)
        DeleteObject(hBrush)

        ' Calculate knob position and size
        knobSize = r.bottom - r.top - 5  ' Knob diameter is control height minus padding

        ' Draw knob
        hBrush = CreateSolidBrush(TOGGLE_KNOB_COLOR)
        SelectObject(hdc, hBrush)
        Ellipse(hdc, state->knobPos, r.top + 3, state->knobPos + knobSize, r.bottom - 3)
        DeleteObject(hBrush)


        ' Check if this control has focus
        IF CBHWND = GetFocus() THEN hasFocus = 1 ELSE hasFocus = 0

        ' Draw focus rectangle if the control has focus
        IF hasFocus THEN
            InflateRect(&r, -2, -2)  ' Shrink rectangle slightly to fit within the border
            DrawFocusRect(hdc, &r)   ' Draw the focus rectangle
        END IF

        EndPaint(CBHWND, &ps)
        EXIT FUNCTION

        '*******************
        CASE WM_DESTROY
        '*******************
        ' Clean up the state when the control is destroyed
        IF state <> NULL THEN
            FREE(state)
            SetWindowLongPtr(CBHWND, GWLP_USERDATA, 0)
        END IF
    END SELECT

    FUNCTION = DefWindowProc(CBHWND, CBMSG, CBWPARAM, CBLPARAM)
END FUNCTION



[MrBcx]

Quin,

Anything is possible but don't wait on me to implement everything that would make you happy.

You could probably paste my code into Chatgpt, Claude, or Deepseek and tell it what you
want added and get something back that might actually meet some of your requirements.

[Quin]

MrBcx,
Very cool stuff!
Do you think it would be possible to make this send proper accessibility events, and offer proper tab navigation? Currently, when I run this, I can only tab once and hear the text of the first toggle button, but that's it. I can't press space to toggle it like a normal toggle button, I don't know that it's a toggle button, I can't tab to the next one, etc. In other words, it's not an accessible control by default
Thanks,
Quin.

[MrBcx]

The code in the original post has been updated but the screenshot has not.

The ToggleSwitch control has a more refined behavior now. The control still looks
the same but there is a subtle animated transition between the on & off positions.

If you're interested in making your own custom controls, this might provide some clues.

It works with all the compilers.

[MrBcx]

Who needs dotnet when we have BCX?     

Screenshot attached.

Code Select Expand



'**************************************************************************
' Custom Toggle Switch Control -- Inspired by modern UI toggle switches
'                   by MrBcx February 2025  MIT License
'**************************************************************************

GUI "Form1", PIXELS

GLOBAL Form1 AS HWND
GLOBAL hToggle1 AS HWND
GLOBAL hToggle2 AS HWND
GLOBAL hLabel1 AS HWND
GLOBAL hLabel2 AS HWND


SUB FORMLOAD()
    CALL RegisterToggleSwitch      ' Register the "ToggleSwitch" custom control

    Form1 = BCX_FORM("Form1", 0, 0, 300, 200)
    hToggle1 = BCX_CONTROL("ToggleSwitch", Form1, "Toggle 1", 1, 50, 50, 60, 30)
    hLabel1  = BCX_LABEL("OFF", Form1, 0, 120, 55, 40, 20)
    hToggle2 = BCX_CONTROL("ToggleSwitch", Form1, "Toggle 2", 2, 50, 100, 60, 30)
    hLabel2  = BCX_LABEL("OFF", Form1, 0, 120, 105, 40, 20)

    CENTER Form1
    SHOW   Form1
END SUB


BEGIN EVENTS
    SELECT CASE CBMSG
        CASE WM_COMMAND
        SELECT CASE CBCTL
            CASE 1
            IF CBLPARAM = 1 THEN BCX_SET_TEXT(hLabel1, "ON") ELSE BCX_SET_TEXT(hLabel1, "OFF")
            CASE 2
            IF CBLPARAM = 1 THEN BCX_SET_TEXT(hLabel2, "ON") ELSE BCX_SET_TEXT(hLabel2, "OFF")
        END SELECT
    END SELECT
END EVENTS



'**********************************************************
'              Custom Control Starts Here
'**********************************************************

MACRO TOGGLE_ON_COLOR   = RGB(0,   255,  64) ' Bright green for ON state
MACRO TOGGLE_OFF_COLOR  = RGB(200, 200, 200) ' Gray for OFF state
MACRO TOGGLE_KNOB_COLOR = RGB(255, 255, 255) ' White for the sliding knob


TYPE TOGGLESTATE        ' Structure to hold toggle switch state
    isOn AS LONG        ' Current state (0 = Off, 1 = On)
    knobPos AS LONG     ' Knob position for animation
    targetPos AS LONG   ' Target position for animation
    isAnimating AS LONG ' Animation flag
END TYPE


FUNCTION AllocateToggleState() AS TOGGLESTATE PTR
    LOCAL state AS TOGGLESTATE PTR
    state = (TOGGLESTATE PTR)malloc(SIZEOF(TOGGLESTATE))
    state->isOn = 0
    state->knobPos = 2  ' Initial position at left
    state->targetPos = 2
    state->isAnimating = 0
    FUNCTION = state
END FUNCTION


FUNCTION RegisterToggleSwitch
    LOCAL ClassName$
    LOCAL wc AS WNDCLASS
    ClassName = "ToggleSwitch"
    wc.style = CS_HREDRAW OR CS_VREDRAW
    wc.lpfnWndProc = ToggleSwitchProc
    wc.hIcon = NULL
    wc.hCursor = LoadCursor(NULL, IDC_HAND)
    wc.hbrBackground = (HBRUSH)GetStockObject(GRAY_BRUSH)  ' Set default background
    wc.lpszMenuName = NULL
    wc.lpszClassName = ClassName
    FUNCTION = RegisterClass(&wc)
END FUNCTION


CALLBACK FUNCTION ToggleSwitchProc
    LOCAL state AS TOGGLESTATE PTR
    LOCAL r AS RECT
    LOCAL hdc AS HDC
    LOCAL ps AS PAINTSTRUCT
    LOCAL hBrush AS HBRUSH
    LOCAL knobSize AS LONG
    LOCAL knobRect AS RECT     ' Rectangle for the sliding knob
    LOCAL hasFocus AS BOOL

    ' Get the state for this specific toggle instance
    state = CAST(TOGGLESTATE PTR, GetWindowLongPtr(CBHWND, GWLP_USERDATA))

    SELECT CASE CBMSG
        '*******************
        CASE WM_CREATE
        '*******************
        ' Create rounded corners for the control
        DIM Region AS HRGN
        DIM Rect AS RECT
        DIM w, h AS INT
        GetWindowRect(CBHWND, &Rect)
        w = Rect.right - Rect.left
        h = Rect.bottom - Rect.top
        Region = CreateRoundRectRgn(0, 0, w, h, h, h)
        SetWindowRgn(CBHWND, Region, TRUE)
        DeleteObject(Region)

        ' Initialize state for each toggle
        SetWindowLongPtr(CBHWND, GWLP_USERDATA, CAST(LONG_PTR, AllocateToggleState()))

        ' Initial paint request
        InvalidateRect(CBHWND, NULL, TRUE)

        ' Allow the control to receive keyboard focus
        SetWindowLongPtr(CBHWND, GWL_STYLE, GetWindowLongPtr(CBHWND, GWL_STYLE) OR WS_TABSTOP)
        EXIT FUNCTION


        '*******************
        CASE WM_TIMER
        '*******************
        IF state = NULL THEN EXIT FUNCTION
        IF state->isAnimating THEN
            IF (state->isOn AND state->knobPos < state->targetPos) OR (NOT state->isOn AND state->knobPos > state->targetPos) THEN
                state->knobPos = state->knobPos + IIF(state->isOn, 4, -4) ' Move smoothly
                InvalidateRect(CBHWND, NULL, TRUE)
            ELSE
                state->knobPos = state->targetPos
                KillTimer(CBHWND, 1)
                state->isAnimating = 0
            END IF
        END IF

        '*******************
        CASE WM_GETDLGCODE
        '*******************
        FUNCTION = DLGC_WANTARROWS OR DLGC_WANTTAB OR DLGC_WANTCHARS OR DLGC_WANTALLKEYS


        '*******************
        CASE WM_KEYDOWN
        '*******************
        SELECT CASE CBWPARAM
            CASE VK_SPACE
            ' Simulate a mouse click when Space bar is pressed
            SendMessage(CBHWND, WM_LBUTTONUP, 0, 0)

            CASE VK_TAB
            ' Move focus to the next control in the tab order
            IF GetKeyState(VK_SHIFT) < 0 THEN
                ' Shift+Tab moves focus backward
                SetFocus(GetNextDlgTabItem(GetParent(CBHWND), CBHWND, TRUE))
            ELSE
                ' Tab moves focus forward
                SetFocus(GetNextDlgTabItem(GetParent(CBHWND), CBHWND, FALSE))
            END IF
        END SELECT
        EXIT FUNCTION


        '*******************
        CASE WM_LBUTTONUP
        '*******************
        IF state = NULL THEN EXIT FUNCTION
        IF NOT state->isAnimating THEN
            state->isOn = NOT state->isOn
            GetClientRect(CBHWND, &r)
            state->targetPos = IIF(state->isOn, r.right - (r.bottom - r.top) - 2, r.left + 2)
            SetTimer(CBHWND, 1, 16, NULL) ' Start animation timer
            state->isAnimating = 1
            SendMessage(GetParent(CBHWND), WM_COMMAND, MAKELONG(GetWindowLongPtr(CBHWND, GWL_ID), BN_CLICKED), state->isOn)
            SetFocus(CBHWND)
            InvalidateRect(CBHWND, NULL, TRUE)
        END IF
        EXIT FUNCTION


        '*******************
        CASE WM_SETFOCUS
        '*******************
        InvalidateRect(CBHWND, NULL, TRUE)  ' Force a repaint to show the focus outline
        EXIT FUNCTION

        '*******************
        CASE WM_KILLFOCUS
        '*******************
        InvalidateRect(CBHWND, NULL, TRUE)  ' Repaint to remove focus outline
        EXIT FUNCTION

        '*******************
        CASE WM_PAINT
        '*******************
        IF state = NULL THEN EXIT FUNCTION
        GetClientRect(CBHWND, &r)
        hdc = BeginPaint(CBHWND, &ps)

        ' Draw background with rounded corners
        hBrush = (HBRUSH)CreateSolidBrush(IIF(state->isOn = 1, TOGGLE_ON_COLOR, TOGGLE_OFF_COLOR))
        FillRect(hdc, &r, hBrush)
        DeleteObject(hBrush)

        ' Calculate knob position and size
        knobSize = r.bottom - r.top - 5  ' Knob diameter is control height minus padding

        ' Draw knob
        hBrush = CreateSolidBrush(TOGGLE_KNOB_COLOR)
        SelectObject(hdc, hBrush)
        Ellipse(hdc, state->knobPos, r.top + 3, state->knobPos + knobSize, r.bottom - 3)
        DeleteObject(hBrush)


        ' Check if this control has focus
        IF CBHWND = GetFocus() THEN hasFocus = 1 ELSE hasFocus = 0

        ' Draw focus rectangle if the control has focus
        IF hasFocus THEN
            InflateRect(&r, -2, -2)  ' Shrink rectangle slightly to fit within the border
            DrawFocusRect(hdc, &r)   ' Draw the focus rectangle
        END IF

        EndPaint(CBHWND, &ps)
        EXIT FUNCTION

        '*******************
        CASE WM_DESTROY
        '*******************
        ' Clean up the state when the control is destroyed
        IF state <> NULL THEN
            FREE(state)
            SetWindowLongPtr(CBHWND, GWLP_USERDATA, 0)
        END IF
    END SELECT

    FUNCTION = DefWindowProc(CBHWND, CBMSG, CBWPARAM, CBLPARAM)
END FUNCTION