Posts: 31
Threads: 5
Joined: 27.05.2024
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. 
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
Posts: 4
Threads: 0
Joined: 30.01.2025
24.09.2025, 09:10 PM
(This post was last modified: 24.09.2025, 09:13 PM by Kevin Diggins.)
(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.
Thanks Jules -- Seems I can't control myself from converting your code to BCX.
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]](https://bcxbasiccoders.com/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
Posts: 8
Threads: 1
Joined: 27.01.2025
24.09.2025, 09:46 PM
(This post was last modified: 24.09.2025, 10:02 PM by Patrice Terrier.)
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
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
(msimg32) or GDI+ / layered windows.
- Quality depends on the driver; try
Code: SetStretchBltMode(hdcDest, HALFTONE)
- Optional 1-bpp mask lets you punch holes (simple transparency).
www.objreader.com
GDImage.dll (graphics library), WinLIFT.dll (skin engine)
Posts: 31
Threads: 5
Joined: 27.05.2024
Kevin, I like your color ring better than mine. 
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
Posts: 4
Threads: 0
Joined: 30.01.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.
Posts: 31
Threads: 5
Joined: 27.05.2024
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
Posts: 31
Threads: 5
Joined: 27.05.2024
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
|
