Very Simple Round Gauge 0-100%
#2
(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
Reply


Messages In This Thread
RE: Simple -Very Simple Round Gauge 0-100% - by Kevin Diggins - 24.09.2025, 09:10 PM

Forum Jump:


Users browsing this thread: 1 Guest(s)