PowerBASIC Users Meeting Point
Very Simple Round Gauge 0-100% - Printable Version

+- PowerBASIC Users Meeting Point (http://pump.richheimer.de)
+-- Forum: User to User Discussions (http://pump.richheimer.de/forumdisplay.php?fid=3)
+--- Forum: Source Code Library (http://pump.richheimer.de/forumdisplay.php?fid=8)
+--- Thread: Very Simple Round Gauge 0-100% (/showthread.php?tid=84)

Very Simple Round Gauge 0-100% - Jules Marchildon - 24.09.2025

I needed a very simple round gauge for one of our in-house measuring dashboards.  I didn't use any double buffer or GDI+ as it is only intended to be a static needle most of the time.  

This one demo's percentage, but you can modify it to whatever; volts, amps, watts, temp, cats, dogs.   Big Grin
   

Code:
'
' Very simple round gauge, 0-100%
' Jules Marchildon, Sept. 24, 2025
'

#COMPILE EXE
#DIM ALL

#INCLUDE "WIN32API.INC"

GLOBAL gValue AS LONG
GLOBAL ghDlg AS DWORD

'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
FUNCTION PBMAIN()
    DIALOG NEW 0, "Round Gauge: 0-100%",,, 200, 200, %WS_SYSMENU TO ghDlg
    DIALOG SHOW MODAL ghDlg CALL DlgProc
END FUNCTION

'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
CALLBACK FUNCTION DlgProc()

    LOCAL ps AS PAINTSTRUCT
    LOCAL hDC, hMemDC, hBitmap, hOldBitmap AS DWORD
    LOCAL hGauge AS DWORD
    LOCAL rc AS RECT
    LOCAL cx AS LONG, cy AS LONG, radius AS LONG

    SELECT CASE CB.MSG

        CASE %WM_INITDIALOG
            '-simulate gauge updates with a timer
            SetTimer CB.HNDL, 1, 300, BYVAL %NULL

        CASE %WM_TIMER
            gValue = (gValue + 1) MOD 101
            InvalidateRect CB.HNDL, BYVAL %NULL, %TRUE

        CASE %WM_PAINT
            hDC = BeginPaint(CB.HNDL, ps)
                GetClientRect(CB.HNDL, rc)
                hMemDC = CreateCompatibleDC(hDC)
                hBitmap = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
                hOldBitmap = SelectObject(hMemDC, hBitmap)
                FillRect hMemDC, rc, GetSysColorBrush(%COLOR_BTNFACE)
                '-calc center and radius
                cx = (rc.nRight - rc.nLeft) \ 2
                cy = (rc.nBottom - rc.nTop) \ 2
                radius = MIN(cx, cy) - 10
                DrawGauge(hMemDC, cx, cy, radius, gValue)
                BitBlt hDC, 0, 0, rc.nRight, rc.nBottom, hMemDC, 0, 0, %SRCCOPY
                SelectObject hMemDC, hOldBitmap
                DeleteObject hBitmap
                DeleteDC hMemDC
            EndPaint(CB.HNDL, ps)

        CASE %WM_DESTROY
            KillTimer CB.HNDL, 1
            PostQuitMessage 0

    END SELECT
END FUNCTION

'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
SUB DrawGauge(hDC AS DWORD, cx AS LONG, cy AS LONG, radius AS LONG, value AS LONG)

    LOCAL angle, rad, offsetRad, aDeg, percent, needleWidth AS SINGLE
    LOCAL hPen, hOldPen, hFont, hOldFont, hBrush, hOldBrush AS DWORD
    LOCAL i, x1, y1, x2, y2, xTip, yTip, r, g, b AS LONG
    LOCAL xBase1, yBase1, xBase2, yBase2 AS LONG
    LOCAL sVal AS STRING, lsize AS SIZE, cherryPi AS EXT

    cherryPi = 4*ATN(1)

    '=== Arc background with green-yellow-red segments ===
    FOR aDeg = 225 TO -45 STEP -1
        rad = aDeg * cherryPi / 180
        x1 = cx + radius * 0.85 * COS(rad)
        y1 = cy - radius * 0.85 * SIN(rad)
        x2 = cx + radius * 0.95 * COS(rad)
        y2 = cy - radius * 0.95 * SIN(rad)
        '-calc perc% across arc 0 to 1
        percent = (225 - aDeg) / 270
        '-interpolate color
        IF percent <= 0.25 THEN
            '-green to Yellow
            r = percent / 0.25 * 255
            g = 255
            b = 0
        ELSEIF percent <= 0.75 THEN
            '-yellow to Red
            r = 255
            g = 255 - ((percent - 0.25) / 0.5 * 255)
            b = 0
        ELSE
            '-solid Red
            r = 255
            g = 0
            b = 0
        END IF
        hPen = CreatePen(%PS_SOLID, 1, RGB(r, g, b))
        hOldPen = SelectObject(hDC, hPen)
        MoveToEx hDC, x1, y1, BYVAL %NULL
        LineTo hDC, x2, y2
        SelectObject hDC, hOldPen
        DeleteObject hPen
    NEXT


    #IF 1 '=== Optional chintzy bezel ring ===
        hPen = CreatePen(%PS_SOLID, 4, RGB(190, 190, 190))
        hOldPen = SelectObject(hDC, hPen)
        LOCAL ltweak AS LONG
        ltweak = 1 '-tweak gap to your own taste
        ARC hDC, cx - radius - ltweak, cy - radius - ltweak, cx + radius + ltweak, cy + radius + ltweak, 0, 0, 0, 0
        SelectObject hDC, hOldPen
        DeleteObject hPen
    #ENDIF

    '=== tick marks and labels every 5 units ===
    FOR i = 0 TO 100 STEP 5
        angle = (225 - (i * 2.7!)) * cherryPi / 180
        '-major tick length for labels every 10 units, short for 5 units
        IF (i MOD 10) = 0 THEN
            x1 = cx + radius * 0.80 * COS(angle)
            y1 = cy - radius * 0.80 * SIN(angle)
        ELSE
            x1 = cx + radius * 0.84 * COS(angle)
            y1 = cy - radius * 0.84 * SIN(angle)
        END IF
        x2 = cx + radius * 0.92 * COS(angle)
        y2 = cy - radius * 0.92 * SIN(angle)
        MoveToEx hDC, x1, y1, BYVAL %NULL
        LineTo hDC, x2, y2
        '-label every 10 units only
        IF (i MOD 10) = 0 THEN
            LOCAL sText AS STRING
            sText = FORMAT$(i)
            SetBkMode hDC, %TRANSPARENT
            SetTextColor hDC, RGB(40, 140, 240)
            LOCAL tx AS LONG, ty AS LONG
            tx = cx + radius * 0.65 * COS(angle) - 10
            ty = cy - radius * 0.65 * SIN(angle) - 8
            TextOut hDC, tx, ty, BYVAL STRPTR(sText), LEN(sText)
        END IF
    NEXT

    '=== draw polygon needle ===
    angle = (225 - (gValue * 2.7!))  '<-map gValue (0-100) to 225 to -45
    rad = angle * cherryPi / 180
    '-tip of the needle
    xTip = cx + radius * 0.75 * COS(rad)
    yTip = cy - radius * 0.75 * SIN(rad)
    '-base width and angle offset for polygon
    needleWidth = 6.0  '<-adjust width here
    offsetRad = 90 * cherryPi / 180  '-perpendicular
    '-two base corners *perpendicular to needle angle
    xBase1 = cx + needleWidth * COS(rad + offsetRad)
    yBase1 = cy - needleWidth * SIN(rad + offsetRad)
    xBase2 = cx + needleWidth * COS(rad - offsetRad)
    yBase2 = cy - needleWidth * SIN(rad - offsetRad)
    '-define needle polygon points
    DIM pts(0 TO 2) AS POINTAPI
    pts(0).x = xTip : pts(0).y = yTip
    pts(1).x = xBase1 : pts(1).y = yBase1
    pts(2).x = xBase2 : pts(2).y = yBase2
    '-draw needle
    hBrush = CreateSolidBrush(RGB(255, 0, 0))    '-fill color
    hOldBrush = SelectObject(hDC, hBrush)
    hPen = CreatePen(%PS_SOLID, 1, RGB(0, 0, 0)) '-outline
    hOldPen = SelectObject(hDC, hPen)
    POLYGON hDC, pts(0), 3
    SelectObject hDC, hOldBrush
    DeleteObject hBrush
    SelectObject hDC, hOldPen
    DeleteObject hPen
    '-center cap
    ELLIPSE hDC, cx - 8, cy - 8, cx + 8, cy + 8
    '=== digital value display in the center ===
    sVal = FORMAT$(value) + "%"
    hFont = CreateFont(28, 0, 0, 0, %FW_BOLD, 0, 0, 0, _
                %ANSI_CHARSET, %OUT_DEFAULT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                %DEFAULT_QUALITY, %DEFAULT_PITCH OR %FF_DONTCARE, "Segoe UI")
    hOldFont = SelectObject(hDC, hFont)
    SetBkMode hDC, %TRANSPARENT
    SetTextColor hDC, RGB(0, 102, 204)
    '-measure text size to center it
    GetTextExtentPoint32 hDC, BYVAL STRPTR(sVal), LEN(sVal), lsize
    TextOut hDC, cx - lsize.cx \ 2, cy - lsize.cy \ 2 +60, BYVAL STRPTR(sVal), LEN(sVal)
    SelectObject hDC, hOldFont
    DeleteObject hFont

END SUB
                                         


RE: Simple -Very Simple Round Gauge 0-100% - Kevin Diggins - 24.09.2025

(24.09.2025, 06:01 PM)Jules Marchildon Wrote: I needed a very simple round gauge for one of our in-house measuring dashboards.  I didn't use any double buffer or GDI+ as it is only intended to be a static needle most of the time.  

This one demo's percentage, but you can modify it to whatever; volts, amps, watts, temp, cats, dogs.   Big Grin 

Thanks Jules -- Seems I can't control myself from converting your code to BCX.   Big Grin

I needed to make a few changes to make all the c/c++ compilers happy but this code compiles with all 6 compiler options shown in the screenshot.

[Image: GaugeScreenShot.jpg]

Code:
'-----------------------------------
' Very simple round gauge, 0-100%
' Jules Marchildon, Sept. 24, 2025
'-----------------------------------
'   Converted to BCX by MrBcx
'-----------------------------------
GLOBAL gValue AS LONG


'--------------------------------------------------------------------------------------------------
BCX_MDIALOG (GaugeProc, "Round Gauge: 0-100%", NULL, 6, 18, 90, 80, 0, 0, "Segoe UI", 22)
'--------------------------------------------------------------------------------------------------


BEGIN MODAL DIALOG AS GaugeProc
    LOCAL ps AS PAINTSTRUCT
    LOCAL AS HDC hDC, hMemDC
    LOCAL AS HBITMAP hNewBitmap, hOldBitmap
    LOCAL hGauge AS HWND
    LOCAL rc AS RECT
    LOCAL AS LONG cx, cy, radius

    SELECT CASE CBMSG
        CASE WM_INITDIALOG
        '-simulate gauge updates with a timer
        SetTimer (CBHNDL, 1, 300, NULL)
        HIDE CONWIN
        CENTER CBHWND

        CASE WM_TIMER
        gValue = (gValue + 1) MOD 101
        InvalidateRect (CBHNDL, NULL, FALSE)  ' Changed to FALSE - don't erase background

        CASE WM_ERASEBKGND
        ' Handle background erasing to prevent flicker
        FUNCTION = 1  ' Tell Windows we handled the erasing

        CASE WM_PAINT
        hDC = BeginPaint(CBHNDL, &ps)
        GetClientRect(CBHNDL, &rc)
        hMemDC = CreateCompatibleDC(hDC)
        hNewBitmap = CreateCompatibleBitmap(hDC, rc.right, rc.bottom)
        hOldBitmap = CAST(HBITMAP, SelectObject(hMemDC, hNewBitmap))
        FillRect (hMemDC, &rc, GetSysColorBrush(COLOR_BTNFACE))
        '-calc center and radius
        cx = (rc.right - rc.left) / 2
        cy = (rc.bottom - rc.top) / 2
        radius = MIN(cx, cy) - 10

        DrawGauge(hMemDC, cx, cy, radius, gValue)

        BitBlt (hDC, 0, 0, rc.right, rc.bottom, hMemDC, 0, 0, SRCCOPY)
        SelectObject (hMemDC, hOldBitmap)
        DeleteObject (hNewBitmap)
        DeleteDC (hMemDC)
        EndPaint(CBHNDL, &ps)

        CASE WM_DESTROY
        KillTimer (CBHNDL, 1)
        PostQuitMessage (0)
        CLOSEDIALOG

    END SELECT
END DIALOG

'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
SUB DrawGauge(hDC AS HDC, cx AS LONG, cy AS LONG, radius AS LONG, value AS LONG)
    LOCAL AS SINGLE angle, rad, offsetRad, aDeg, percent, needleWidth
    LOCAL AS HPEN hColorPen, hTickPen, hNeedlePen, hOldPen
    LOCAL AS HFONT hLabelFont, hValueFont, hOldFont
    LOCAL AS HBRUSH hNeedleBrush, hOldBrush
    LOCAL AS LONG i, x1, y1, x2, y2, xTip, yTip, r, g, b
    LOCAL AS LONG xBase1, yBase1, xBase2, yBase2
    LOCAL AS STRING sVal, sText
    LOCAL lsize AS SIZE

    ' === Draw colored arc background ===
    FOR i = 0 TO 100 STEP 1  ' Draw every degree for smoother arc
        aDeg = 225 - (i * 2.7)  ' Map 0-100 to 225 to -45 degrees
        rad = aDeg * PI / 180
        x1 = cx + radius * 0.85 * COS(rad)
        y1 = cy - radius * 0.85 * SIN(rad)
        x2 = cx + radius * 0.95 * COS(rad)
        y2 = cy - radius * 0.95 * SIN(rad)

        ' Calculate color based on position (0-100)
        IF i <= 33 THEN
            ' Green to yellow (0-33)
            r = INT(i * 255 / 33)
            g = 255
            b = 0
        ELSEIF i <= 67 THEN
            ' Yellow to red (33-67)
            r = 255
            g = INT(255 - ((i - 33) * 255 / 34))
            b = 0
        ELSE
            ' Red (67-100)
            r = 255
            g = 0
            b = 0
        END IF

        hColorPen = CreatePen(PS_SOLID, 3, RGB(r, g, b))
        hOldPen = CAST(HPEN, SelectObject(hDC, hColorPen))
        MoveToEx (hDC, x1, y1, NULL)
        LineTo (hDC, x2, y2)
        SelectObject (hDC, hOldPen)
        DeleteObject(hColorPen)
    NEXT

    ' === Draw bezel ring ===
    hTickPen = CreatePen(PS_SOLID, 4, RGB(190, 190, 190))
    hOldPen = CAST(HPEN, SelectObject(hDC, hTickPen))
    Arc (hDC, cx - radius - 4, cy - radius - 4, cx + radius + 4, cy + radius + 4, 0, 0, 0, 0)
    SelectObject (hDC, hOldPen)
    DeleteObject(hTickPen)

    ' === Draw tick marks and labels ===
    hTickPen = CreatePen(PS_SOLID, 1, RGB(0, 0, 0))
    hOldPen = CAST(HPEN, SelectObject(hDC, hTickPen))

    ' Create font for labels
    hLabelFont = CreateFont(24, 0, 0, 0, FW_BOLD, 0, 0, 0, _
    ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _
    DEFAULT_QUALITY, DEFAULT_PITCH BOR FF_DONTCARE, "Segoe UI")
    hOldFont = CAST(HFONT, SelectObject(hDC, hLabelFont))

    SetBkMode(hDC, TRANSPARENT)
    SetTextColor(hDC, RGB(40, 140, 240))

    FOR i = 0 TO 100 STEP 5
        angle = (225 - (i * 2.7)) * PI / 180

        ' Different tick lengths for major/minor
        IF (i MOD 10) = 0 THEN
            x1 = cx + radius * 0.78 * COS(angle)
            y1 = cy - radius * 0.78 * SIN(angle)
            x2 = cx + radius * 0.88 * COS(angle)
            y2 = cy - radius * 0.88 * SIN(angle)

            ' Draw label
            sText = STR$(i, 1)
            LOCAL tx AS LONG, ty AS LONG
            GetTextExtentPoint32(hDC, sText, LEN(sText), &lsize)
            tx = cx + radius * 0.65 * COS(angle) - lsize.cx / 2
            ty = cy - radius * 0.65 * SIN(angle) - lsize.cy / 2
            TextOut(hDC, tx, ty, sText, LEN(sText))
        ELSE
            x1 = cx + radius * 0.82 * COS(angle)
            y1 = cy - radius * 0.82 * SIN(angle)
            x2 = cx + radius * 0.88 * COS(angle)
            y2 = cy - radius * 0.88 * SIN(angle)
        END IF

        MoveToEx (hDC, x1, y1, NULL)
        LineTo (hDC, x2, y2)
    NEXT

    SelectObject(hDC, hOldFont)
    DeleteObject(hLabelFont)
    SelectObject (hDC, hOldPen)
    DeleteObject(hTickPen)

    ' === Draw needle ===
    angle = (225 - (gValue * 2.7)) * PI / 180

    ' Needle tip
    xTip = cx + radius * 0.75 * COS(angle)
    yTip = cy - radius * 0.75 * SIN(angle)

    ' Needle base
    needleWidth = 6.0
    offsetRad = 90 * PI / 180
    xBase1 = cx + needleWidth * COS(angle + offsetRad)
    yBase1 = cy - needleWidth * SIN(angle + offsetRad)
    xBase2 = cx + needleWidth * COS(angle - offsetRad)
    yBase2 = cy - needleWidth * SIN(angle - offsetRad)

    ' Draw needle polygon
    DIM pts[3] AS POINT
    pts[0].x = xTip : pts[0].y = yTip
    pts[1].x = xBase1 : pts[1].y = yBase1
    pts[2].x = xBase2 : pts[2].y = yBase2

    hNeedleBrush = CreateSolidBrush(RGB(255, 0, 0))
    hOldBrush = CAST(HBRUSH, SelectObject(hDC, hNeedleBrush))
    hNeedlePen = CreatePen(PS_SOLID, 1, RGB(0, 0, 0))
    hOldPen = CAST(HPEN, SelectObject(hDC, hNeedlePen))

    Polygon (hDC, pts, 3)
    SelectObject (hDC, hOldBrush)
    DeleteObject(hNeedleBrush)
    SelectObject (hDC, hOldPen)
    DeleteObject(hNeedlePen)

    ' Center cap
    hTickPen = CreatePen(PS_SOLID, 1, RGB(0, 0, 0))
    hOldPen = CAST(HPEN, SelectObject(hDC, hTickPen))
    Ellipse (hDC, cx - 8, cy - 8, cx + 8, cy + 8)
    SelectObject(hDC, hOldPen)
    DeleteObject(hTickPen)

    ' === Digital value display ===
    sVal = STR$(value, 1) + "%"
    hValueFont = CreateFont(28, 0, 0, 0, FW_BOLD, 0, 0, 0, _
    ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _
    DEFAULT_QUALITY, DEFAULT_PITCH OR FF_DONTCARE, "Segoe UI")
    hOldFont = CAST(HFONT, SelectObject(hDC, hValueFont))

    SetBkMode (hDC, TRANSPARENT)
    SetTextColor (hDC, RGB(0, 102, 204))
    '-measure text size to center it
    GetTextExtentPoint32 (hDC, sVal, LEN(sVal), &lsize)
    TextOut (hDC, cx - lsize.cx / 2, cy - lsize.cy / 2 +60, sVal, LEN(sVal))
    SelectObject (hDC, hOldFont)
    DeleteObject(hValueFont)

END SUB


RE: Simple -Very Simple Round Gauge 0-100% - Patrice Terrier - 24.09.2025

Jules

For your information. 

I just posted a new release of my 3D engine (OR version 4.02).
When you have time, give it a try, there is a demo that shall blow your socks off.

Now for your gauge, do you know the PlgBlt
Code:
PlgBlt
use:
  • Works with a source HDC that has a bitmap selected; fills a dest parallelogram from a source rect.
  • Great for rotation/scale/shear; pass the 3 destination points (TL, TR, BL).
  • No per-pixel alpha; for alpha use
    Code:
    AlphaBlend
    (msimg32) or GDI+ / layered windows.
  • Quality depends on the driver; try
    Code:
    SetStretchBltMode(hdcDest, HALFTONE)
    before calling.
  • Optional 1-bpp mask lets you punch holes (simple transparency).


RE: Very Simple Round Gauge 0-100% - Jules Marchildon - 30.09.2025

Kevin, I like your color ring better than mine.  Wink

Code:
'--------------------------------------------------------------------------------------------------
'  Kevin Diggins BCX translation to PowerBASIC, Kevin's color ring looks better than mine.
'--------------------------------------------------------------------------------------------------
SUB DrawGauge2(hDC AS DWORD, cx AS LONG, cy AS LONG, radius AS LONG, value AS LONG)

    LOCAL angle, rad, offsetRad, aDeg, percent, needleWidth AS SINGLE
    LOCAL hPen, hOldPen, hFont, hOldFont, hBrush, hOldBrush AS DWORD
    LOCAL i, x1, y1, x2, y2, xTip, yTip, r, g, b AS LONG
    LOCAL xBase1, yBase1, xBase2, yBase2 AS LONG
    LOCAL sVal AS STRING, lsize AS SIZE, cherryPi AS EXT

    cherryPi = 4*ATN(1)

    '=== Arc background with green-yellow-red segments ===
    FOR i = 0 TO 100 STEP 1    'draw every degree for smoother arc
        aDeg = 225 - (i * 2.7) 'map 0-100 as 225 to -45 degrees
        rad = aDeg * cherryPi / 180
        x1 = cx + radius * 0.85 * COS(rad)
        y1 = cy - radius * 0.85 * SIN(rad)
        x2 = cx + radius * 0.95 * COS(rad)
        y2 = cy - radius * 0.95 * SIN(rad)

        'calculate color based on position (0~100)
        IF i <= 33 THEN
            ' Green to yellow (0-33)
            r = INT(i * 255 / 33)
            g = 255
            b = 0
        ELSEIF i <= 67 THEN
            ' Yellow to red (33-67)
            r = 255
            g = INT(255 - ((i - 33) * 255 / 34))
            b = 0
        ELSE
            ' Red (67-100)
            r = 255
            g = 0
            b = 0
        END IF

        hPen = CreatePen(%PS_SOLID, 3, RGB(r, g, b))
        hOldPen = SelectObject(hDC, hPen)
        MoveToEx hDC, x1, y1, BYVAL %NULL
        LineTo hDC, x2, y2
        SelectObject hDC, hOldPen
        DeleteObject hPen
    NEXT


    #IF 1 '=== Optional chintzy bezel ring ===
        hPen = CreatePen(%PS_SOLID, 4, RGB(190, 190, 190))
        hOldPen = SelectObject(hDC, hPen)
        LOCAL ltweak AS LONG
        ltweak = -2 '-tweak gap to your own taste
        ARC hDC, cx - radius - ltweak, cy - radius - ltweak, cx + radius + ltweak, cy + radius + ltweak, 0, 0, 0, 0
        SelectObject hDC, hOldPen
        DeleteObject hPen
    #ENDIF

    '=== tick marks and labels every 5 units ===
     hPen = CreatePen(%PS_SOLID, 1, RGB(0, 0, 0))
     hOldPen = SelectObject(hDC, hPen)

    'create font for labels
    LOCAL hLabelFont AS DWORD
    hLabelFont = CreateFont(22, 0, 0, 0, %FW_BOLD, 0, 0, 0, _
    %ANSI_CHARSET, %OUT_DEFAULT_PRECIS, %CLIP_DEFAULT_PRECIS, _
    %DEFAULT_QUALITY, %DEFAULT_PITCH OR %FF_DONTCARE, "Segoe UI")
    hOldFont = selectObject(hDC, hLabelFont)

    SetBkMode(hDC, %TRANSPARENT)
    SetTextColor(hDC, RGB(40, 140, 240))


    FOR i = 0 TO 100 STEP 5
        angle = (225 - (i * 2.7!)) * cherryPi / 180
        '-major tick length for labels every 10 units, short for 5 untis
        IF (i MOD 10) = 0 THEN
            x1 = cx + radius * 0.78 * COS(angle)
            y1 = cy - radius * 0.78 * SIN(angle)
            x2 = cx + radius * 0.88 * COS(angle)
            y2 = cy - radius * 0.88 * SIN(angle)
            'draw label
            LOCAL stext AS STRING
            sText = FORMAT$(i)
            LOCAL tx AS LONG, ty AS LONG
            GetTextExtentPoint32(hDC, BYVAL STRPTR(sText), LEN(sText), lsize)
            tx = cx + radius * 0.65 * COS(angle) - lsize.cx / 2
            ty = cy - radius * 0.65 * SIN(angle) - lsize.cy / 2
            TextOut(hDC, tx, ty, BYVAL STRPTR(sText), LEN(sText))
        ELSE
            x1 = cx + radius * 0.82 * COS(angle)
            y1 = cy - radius * 0.82 * SIN(angle)
            x2 = cx + radius * 0.88 * COS(angle)
            y2 = cy - radius * 0.88 * SIN(angle)
        END IF

        MoveToEx (hDC, x1, y1, BYVAL %NULL)
        LineTo (hDC, x2, y2)
    NEXT

    SelectObject(hDC, hOldFont)
    DeleteObject(hLabelFont)
    SelectObject(hDC, hOldPen)
    DeleteObject(hPen)

    '=== draw polygon needle ===
    angle = (225 - (value * 2.7!)) * cherryPi / 180

    '-tip of the needle
    xTip = cx + radius * 0.75 * COS(angle)
    yTip = cy - radius * 0.75 * SIN(angle)

    '-base width and angle offset for polygon
    needleWidth = 6.0  '<-adjust width here
    offsetRad = 90 * cherryPi / 180  '-perpendicular

    '-two base corners *perpendicular to needle angle
    xBase1 = cx + needleWidth * COS(angle + offsetRad)
    yBase1 = cy - needleWidth * SIN(angle + offsetRad)
    xBase2 = cx + needleWidth * COS(angle - offsetRad)
    yBase2 = cy - needleWidth * SIN(angle - offsetRad)

    '-define needle polygon points
    DIM pts(0 TO 2) AS POINTAPI
    pts(0).x = xTip   : pts(0).y = yTip
    pts(1).x = xBase1 : pts(1).y = yBase1
    pts(2).x = xBase2 : pts(2).y = yBase2

    '-draw needle
    hBrush = CreateSolidBrush(RGB(255, 0, 0))    '-fill color
    hOldBrush = SelectObject(hDC, hBrush)
    hPen = CreatePen(%PS_SOLID, 1, RGB(0, 0, 0)) '-outline
    hOldPen = SelectObject(hDC, hPen)
    POLYGON hDC, pts(0), 3
    SelectObject hDC, hOldBrush
    DeleteObject hBrush
    SelectObject hDC, hOldPen
    DeleteObject hPen

    '-center cap
    hPen = CreatePen(%PS_SOLID, 1, RGB(0, 0, 0)) '-outline
    hOldPen = SelectObject(hDC, hPen)
    ELLIPSE hDC, cx - 8, cy - 8, cx + 8, cy + 8
    SelectObject hDC, hOldPen
    DeleteObject hPen

    '=== digital value display in the center ===
    sVal = FORMAT$(value) + "%"
    hFont = CreateFont(28, 0, 0, 0, %FW_BOLD, 0, 0, 0, _
                %ANSI_CHARSET, %OUT_DEFAULT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                %DEFAULT_QUALITY, %DEFAULT_PITCH OR %FF_DONTCARE, "Segoe UI")
    hOldFont = SelectObject(hDC, hFont)
    SetBkMode hDC, %TRANSPARENT
    SetTextColor hDC, RGB(0, 102, 204)
    '-measure text size to center it
    GetTextExtentPoint32 hDC, BYVAL STRPTR(sVal), LEN(sVal), lsize
    TextOut hDC, cx - lsize.cx \ 2, cy - lsize.cy \ 2 +60, BYVAL STRPTR(sVal), LEN(sVal)
    SelectObject hDC, hOldFont
    DeleteObject hFont

END SUB


                       


RE: Very Simple Round Gauge 0-100% - Kevin Diggins - 30.09.2025

Hi Jules,

I'm pleased to finally be able to return the favor, after all the useful code you've shared over the years.

RE: Very Simple Round Gauge 0-100% - Jules Marchildon - 03.10.2025

Using revised code, 4 gauges  on main dialog.  Gauge scales to client area of borderless child window.

   

Code:
'
' Small demo using 4 gauges, no subclassing used.
' It's simple enough for each gauge to have it's own callback
' Jules Marchildon, October 2nd, 2025
'

#COMPILE EXE
#DIM ALL

#INCLUDE "WIN32API.INC"

GLOBAL ghMain, ghChild1, ghChild2, ghChild3, ghChild4 AS DWORD
GLOBAL gValue1, gValue2, gValue3, gValue4 AS SINGLE

'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
  LOCAL uMsg AS tagMSG
  DIALOG NEW 0, "Gauge Demo:", 300, 100, 527, 135, %WS_OVERLAPPEDWINDOW OR %WS_CLIPCHILDREN TO ghMain
  DIALOG SHOW MODELESS ghMain CALL MainProc
  WHILE GetMessage(uMsg, BYVAL %NULL, 0, 0)
    Translatemessage uMsg
    Dispatchmessage uMsg
  WEND
END FUNCTION
'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
CALLBACK FUNCTION MainProc()
    LOCAL x, y, cx, cy AS LONG
    LOCAL rc AS RECT

    SELECT CASE CB.MSG
        CASE %WM_INITDIALOG
            GetClientRect CB.HNDL, rc
            x  = rc.nLeft :y  = rc.nTop
            cx = rc.nRight - rc.nLeft :cy = rc.nBottom - rc.nTop
            '-create 4 gauges
            DIALOG NEW ghMain, "Gauge 1",   5, 5, 125, 125, %WS_CHILD OR %WS_VISIBLE TO ghChild1
            DIALOG NEW ghMain, "Gauge 2", 135, 5, 125, 125, %WS_CHILD OR %WS_VISIBLE TO ghChild2
            DIALOG NEW ghMain, "Gauge 3", 265, 5, 125, 125, %WS_CHILD OR %WS_VISIBLE TO ghChild3
            DIALOG NEW ghMain, "Gauge 4", 395, 5, 125, 125, %WS_CHILD OR %WS_VISIBLE TO ghChild4
            DIALOG SHOW MODELESS ghChild1 CALL Child1Proc
            DIALOG SHOW MODELESS ghChild2 CALL Child2Proc
            DIALOG SHOW MODELESS ghChild3 CALL Child3Proc
            DIALOG SHOW MODELESS ghChild4 CALL Child4Proc
            '-gauge update with a one-shot timer 1.5 sec
            SetTimer CB.HNDL, 1, 1500, BYVAL %NULL

        CASE %WM_TIMER
            '-after warm up, display 1 reading
            gValue1 = 14.32  :InvalidateRect ghChild1, BYVAL %NULL, %TRUE
            gValue2 = 5.3    :InvalidateRect ghChild2, BYVAL %NULL, %TRUE
            gValue3 = 31.4   :InvalidateRect ghChild3, BYVAL %NULL, %TRUE
            gValue4 = 47.82  :InvalidateRect ghChild4, BYVAL %NULL, %TRUE
            KillTimer CB.HNDL, 1

        CASE %WM_DESTROY
            PostQuitMessage 0
    END SELECT
END FUNCTION
'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
CALLBACK FUNCTION Child1Proc()
    SELECT CASE CB.MSG
        CASE %WM_PAINT :OnWmPaint CB.HNDL, gValue1, "Batt" , " V"
    END SELECT
END FUNCTION
CALLBACK FUNCTION Child2Proc()
    SELECT CASE CB.MSG
        CASE %WM_PAINT :OnWmPaint CB.HNDL, gValue2, "Amps" , " A"
    END SELECT
END FUNCTION
CALLBACK FUNCTION Child3Proc()
    SELECT CASE CB.MSG
        CASE %WM_PAINT :OnWmPaint CB.HNDL, gValue3, "Temp" , " C"
    END SELECT
END FUNCTION
CALLBACK FUNCTION Child4Proc()
    SELECT CASE CB.MSG
        CASE %WM_PAINT :OnWmPaint CB.HNDL, gValue4, "Main" , " V"
    END SELECT
END FUNCTION

'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
SUB OnWmPaint( hDlg AS DWORD, value AS SINGLE, sname AS STRING ,slabel AS STRING )
    LOCAL ps AS PAINTSTRUCT
    LOCAL hDC, hMemDC, hBitmap, hOldBitmap AS DWORD
    LOCAL rc AS RECT
    LOCAL cx, cy, radius AS LONG
    '
    hDC = BeginPaint(hDlg, ps)
        GetClientRect hDlg, rc
        hMemDC = CreateCompatibleDC(hDC)
        hBitmap = CreateCompatibleBitmap(hDC, rc.nRight, rc.nBottom)
        hOldBitmap = SelectObject(hMemDC, hBitmap)
        FillRect hMemDC, rc, GetSysColorBrush(%COLOR_BTNFACE)
        '-calc center and radius
        cx = (rc.nRight - rc.nLeft) \ 2
        cy = (rc.nBottom - rc.nTop) \ 2
        radius = MIN(cx, cy) - 10
        DrawGauge hMemDC, cx, cy, radius, value, sname, slabel
        BitBlt hDC, 0, 0, rc.nRight, rc.nBottom, hMemDC, 0, 0, %SRCCOPY
        SelectObject hMemDC, hOldBitmap
        DeleteObject hBitmap
        DeleteDC hMemDC
    EndPaint hDlg, ps
END SUB


'--------------------------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------------------------
SUB DrawGauge(hDC AS DWORD, cx AS LONG, cy AS LONG, radius AS LONG, value AS SINGLE, sName AS STRING, sLabel AS STRING)
    LOCAL hPen, hOldPen, hFont, hOldFont, hBrush, hOldBrush, hTickFont, hOldTickFont AS DWORD
    LOCAL angle, rad, offsetRad, aDeg, percent, needleWidth, scaleFactor AS SINGLE
    LOCAL tickFontHeight, tx, ty, bezelWidth, capRadius AS LONG
    LOCAL i, x1, y1, x2, y2, xTip, yTip, r, g, b AS LONG
    LOCAL xBase1, yBase1, xBase2, yBase2 AS LONG
    LOCAL sVal, sText AS STRING
    LOCAL tsize, lsize AS SIZE
    LOCAL cherryPi AS EXT

    cherryPi = 4*ATN(1)

    '=== Calculate scale factor for elements below 150x150 (cy < 75) ===
    scaleFactor = MIN(1.0!, cy / 75.0!)
    needleWidth = 6.0 * scaleFactor
    bezelWidth  = 4   * scaleFactor
    capRadius   = 8   * scaleFactor

    '=== Arc background with green-yellow-red segments ===
    FOR aDeg = 225 TO -45 STEP -1
        rad = aDeg * cherryPi / 180
        x1 = cx + radius * 0.85 * COS(rad)
        y1 = cy - radius * 0.85 * SIN(rad)
        x2 = cx + radius * 0.95 * COS(rad)
        y2 = cy - radius * 0.95 * SIN(rad)
        '-calc perc% across arc 0 to 1
        percent = (225 - aDeg) / 270
        '-interpolate color
        IF percent <= 0.45 THEN
            '-green to Yellow
            r = percent / 0.45 * 255
            g = 255
            b = 0
        ELSEIF percent <= 0.80 THEN
            '-yellow to Red
            r = 255
            g = 255 - ((percent - 0.45) / 0.5 * 255)
            b = 0
        ELSE
            '-solid Red
            r = 255
            g = 0
            b = 0
        END IF
        hPen = CreatePen(%PS_SOLID, 1.7!, RGB(r, g, b))
        hOldPen = SelectObject(hDC, hPen)
        MoveToEx hDC, x1, y1, BYVAL %NULL
        LineTo hDC, x2, y2
        SelectObject hDC, hOldPen
        DeleteObject hPen
    NEXT


    #IF 0 '=== Optional chintzy bezel ring ===
        hPen = CreatePen(%PS_SOLID, bezelWidth, RGB(190, 190, 190))
        hOldPen = SelectObject(hDC, hPen)
        LOCAL ltweak AS LONG
        ltweak = 1 '-tweak gap to your own taste
        ARC hDC, cx - radius - ltweak, cy - radius - ltweak, cx + radius + ltweak, cy + radius + ltweak, 0, 0, 0, 0
        SelectObject hDC, hOldPen
        DeleteObject hPen
    #ENDIF

    '=== tick marks and labels every 5 units ===
    tickFontHeight = cy * 0.18 '-scale tick font height proportionally to client size
    hTickFont = CreateFont(tickFontHeight, 0, 0, 0, %FW_BOLD, 0, 0, 0, _
                %ANSI_CHARSET, %OUT_DEFAULT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                %DEFAULT_QUALITY, %DEFAULT_PITCH OR %FF_DONTCARE, "Segoe UI")
    hOldTickFont = SelectObject(hDC, hTickFont)
    FOR i = 0 TO 100 STEP 5
        angle = (225 - (i * 2.7!)) * cherryPi / 180
        '-major tick length for labels every 10 units, short for 5 units
        IF (i MOD 10) = 0 THEN
            x1 = cx + radius * 0.80 * COS(angle)
            y1 = cy - radius * 0.80 * SIN(angle)
        ELSE
            x1 = cx + radius * 0.84 * COS(angle)
            y1 = cy - radius * 0.84 * SIN(angle)
        END IF
        x2 = cx + radius * 0.92 * COS(angle)
        y2 = cy - radius * 0.92 * SIN(angle)
        MoveToEx hDC, x1, y1, BYVAL %NULL
        LineTo hDC, x2, y2
        '-label every 10 units only
        IF (i MOD 10) = 0 THEN
            sText = FORMAT$(i)
            SetBkMode hDC, %TRANSPARENT
            SetTextColor hDC, RGB(40, 140, 240)
            '-measure text size to center it
            GetTextExtentPoint32 hDC, BYVAL STRPTR(sText), LEN(sText), tsize
            tx = cx + radius * 0.65 * COS(angle) - tsize.cx \ 2
            ty = cy - radius * 0.65 * SIN(angle) - tsize.cy \ 2
            TextOut hDC, tx, ty, BYVAL STRPTR(sText), LEN(sText)
        END IF
    NEXT
    SelectObject hDC, hOldTickFont
    DeleteObject hTickFont

    '=== draw polygon needle ===
    angle = (225 - (Value * 2.7!))  '<-map gValue (0-100) to 225 to -45
    rad = angle * cherryPi / 180
    '-tip of the needle
    xTip = cx + radius * 0.75 * COS(rad)
    yTip = cy - radius * 0.75 * SIN(rad)
    '-base width and angle offset for polygon
    offsetRad = 90 * cherryPi / 180  '-perpendicular
    '-two base corners *perpendicular to needle angle
    xBase1 = cx + needleWidth * COS(rad + offsetRad)
    yBase1 = cy - needleWidth * SIN(rad + offsetRad)
    xBase2 = cx + needleWidth * COS(rad - offsetRad)
    yBase2 = cy - needleWidth * SIN(rad - offsetRad)
    '-define needle polygon points
    DIM pts(0 TO 2) AS POINTAPI
    pts(0).x = xTip : pts(0).y = yTip
    pts(1).x = xBase1 : pts(1).y = yBase1
    pts(2).x = xBase2 : pts(2).y = yBase2
    '-draw needle
    hBrush = CreateSolidBrush(RGB(255, 0, 0))    '-fill color
    hOldBrush = SelectObject(hDC, hBrush)
    hPen = CreatePen(%PS_SOLID, 1, RGB(0, 0, 0)) '-outline
    hOldPen = SelectObject(hDC, hPen)
    POLYGON hDC, pts(0), 3
    SelectObject hDC, hOldBrush
    DeleteObject hBrush
    SelectObject hDC, hOldPen
    DeleteObject hPen
    '-center cap (scaled)
    ELLIPSE hDC, cx - capRadius, cy - capRadius, cx + capRadius, cy + capRadius

    '=== digital value display in the center ===
    LOCAL fontHeight AS LONG
    fontHeight = cy * 0.22  '-scale font height proportionally to client size
    '-use a bold font for value
    hFont = CreateFont(fontHeight, 0, 0, 0, %FW_BOLD, 0, 0, 0, _
                %ANSI_CHARSET, %OUT_DEFAULT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                %DEFAULT_QUALITY, %DEFAULT_PITCH OR %FF_DONTCARE, "Segoe UI")
    hOldFont = SelectObject(hDC, hFont)
    SetBkMode hDC, %TRANSPARENT
    SetTextColor hDC, RGB(0, 102, 204)
    '-measure text size for sVal to center it
    sVal = FORMAT$(value) + sLabel
    GetTextExtentPoint32 hDC, BYVAL STRPTR(sVal), LEN(sVal), lsize
    LOCAL yOffset AS LONG
    yOffset = cy * 0.6  '-scale vertical offset proportionally to client size
    '-this is the reading 0-100
    LOCAL yVal AS LONG
    yVal = cy - lsize.cy \ 2 + yOffset
    TextOut hDC, cx - lsize.cx \ 2, yVal, BYVAL STRPTR(sVal), LEN(sVal)
    SelectObject hDC, hOldFont
    DeleteObject hFont
    '-use a normal font for label
    LOCAL hLabelFont AS DWORD, hOldLabelFont AS DWORD
    hLabelFont = CreateFont(fontHeight, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
                %ANSI_CHARSET, %OUT_DEFAULT_PRECIS, %CLIP_DEFAULT_PRECIS, _
                %DEFAULT_QUALITY, %DEFAULT_PITCH OR %FF_DONTCARE, "Segoe UI")
    hOldLabelFont = SelectObject(hDC, hLabelFont)
    SetBkMode hDC, %TRANSPARENT
    SetTextColor hDC, RGB(108, 108, 108)  '-light grey
    '-measure text size for sName
    LOCAL lsizeName AS SIZE
    GetTextExtentPoint32 hDC, BYVAL STRPTR(sName), LEN(sName), lsizeName
    LOCAL yName AS LONG
    yName = yVal - lsizeName.cy - 8  '-position above sVal
    TextOut hDC, cx - lsizeName.cx \ 2, yName, BYVAL STRPTR(sName), LEN(sName)
    SelectObject hDC, hOldLabelFont
    DeleteObject hLabelFont
    '-skidaddle
END SUB


RE: Very Simple Round Gauge 0-100% - Jules Marchildon - 18.10.2025

Updated demo and posted in pbusers.org forum.


Added Simulated updates every 2s.
Added Macro cherryPi   in place of  4*ATN(1)'.
Added user buttons to view border and bezel effects, toggle On/Off.
Added WM_ERASEBKGND to avoid flickering during updates.

https://pbusers.org/forum/viewtopic.php?p=132#p132