03.10.2025, 03:13 AM
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