24.09.2025, 06:01 PM
(This post was last modified: 24.09.2025, 11:39 PM by Jules Marchildon.)
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.
This one demo's percentage, but you can modify it to whatever; volts, amps, watts, temp, cats, dogs.
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