Trond's code bug-fixed to work with PureBasic v6.00.
Code: Select all
; Original code by Trond.
Procedure.d MaxD(A.d, B.d)
If A > B
ProcedureReturn A
EndIf
ProcedureReturn B
EndProcedure
Procedure MinI(A, B)
If A < B
ProcedureReturn A
EndIf
ProcedureReturn B
EndProcedure
Procedure DrawTextCentered(x, y, T.s, FrontColor, BackColor)
x = x - TextWidth(T)/2
y = y - TextHeight("Wg")/2
DrawText(x, y, T, FrontColor, BackColor)
EndProcedure
Macro GaugeValueType
i
EndMacro
Prototype SGauge_PaintProto(*Gauge, Image)
Structure SGauge
X.i
Y.i
W.i
H.i
Min.GaugeValueType
Max.GaugeValueType
BigStep.GaugeValueType ; A text is drawn for every BigStep
SmallStep.GaugeValueType ; A nub is drawn for every SmallStep
Value.i
Text.s
SubText.s
Gadget.i
; Style:
SectorDegrees.i
InnerCircleRadius.i
BgColor.i
WheelColor.i
WheelBgColor.i
TextColor.i
SubTextColor.i
HandColor.i
WheelFont.i
TextFont.i
SubTextFont.i
; Style override:
PaintBackground.SGauge_PaintProto
PaintWheel.SGauge_PaintProto
PaintDescription.SGauge_PaintProto
PaintHand.SGauge_PaintProto
; Repaint cache (set to 1 after changing style override)
; (The hand is always repainted)
BgNeedRepaint.i
WheelNeedRepaint.i
DescriptionNeedRepaint.i
; Image cache (don't touch)
BgImg.i
WheelImg.i
DescriptionImg.i
ComposedImg.i
EndStructure
; Default paint functions
Procedure SGauge_PaintBackground(*G.SGauge, Image)
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0, 0, *G\w, *g\H, *G\BgColor)
DrawingMode(#PB_2DDrawing_AllChannels | #PB_2DDrawing_Outlined)
Box(0, 0, *G\w, *g\H, RGBA(0, 0, 0, 32))
EndProcedure
Procedure SGauge_PaintWheel(*G.SGauge, Image)
With *G
StartDegree.i = 0 + ((360-\SectorDegrees)/2)
wpx = \W / 33
wpx2 = wpx/4.*3-1
centerX = \w/2
centerY = \H/2
r = MinI(centerX, centerY) - TextWidth("12345")
SmallStepDegrees.d = \SmallStep / \Max * \SectorDegrees
BigStepDegrees.d = \BigStep / \Max * \SectorDegrees
DrawingMode(#PB_2DDrawing_AllChannels)
For I = 0 To \SectorDegrees
x = centerX + Sin(Radian(StartDegree+I))*r
y = centerY + Cos(Radian(StartDegree+I))*r
Circle(x, y, wpx, \WheelColor)
Next
DrawingMode(#PB_2DDrawing_AllChannels)
For I = 0 To \SectorDegrees
x = centerX + Sin(Radian(StartDegree+I))*r
y = centerY + Cos(Radian(StartDegree+I))*r
Circle(x, y, wpx2, \WheelBgColor)
Next
dI.d = 0
While dI <= \SectorDegrees
x1 = centerX + Sin(Radian(StartDegree+dI))*(r-wpx2)
y1 = centerY + Cos(Radian(StartDegree+dI))*(r-wpx2)
x2 = centerX + Sin(Radian(StartDegree+dI))*(r-wpx2/2)
y2 = centerY + Cos(Radian(StartDegree+dI))*(r-wpx2/2)
LineXY(x1, y1, x2, y2, \WheelColor)
dI + SmallStepDegrees
Wend
dI = 0
While dI <= \SectorDegrees + 1 ;?!
x1 = centerX + Sin(Radian(StartDegree+dI))*(r-wpx)
y1 = centerY + Cos(Radian(StartDegree+dI))*(r-wpx)
x2 = centerX + Sin(Radian(StartDegree+dI))*(r+wpx)
y2 = centerY + Cos(Radian(StartDegree+dI))*(r+wpx)
LineXY(x1, y1, x2, y2, \WheelColor)
dI + BigStepDegrees
Wend
DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
DrawingFont(FontID(\WheelFont))
dI = 0
I = 0
While dI <= \SectorDegrees+1 ; not sure why that is needed
T.s = Str(\Max-I)
x = centerX + Sin(Radian(StartDegree+dI))*(r+wpx*3)
y = centerY + Cos(Radian(StartDegree+dI))*(r+wpx*3)
DrawTextCentered(x, y, T, RGBA(0, 0, 0, 255), RGBA(0, 0, 0, 0))
dI + BigStepDegrees
I + \BigStep
Wend
EndWith
EndProcedure
Procedure SGauge_PaintDescription(*G.SGauge, Image)
With *G
DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
DrawingFont(FontID(\TextFont))
x = 0.5 * \w
y = 0.8 * \h
DrawTextCentered(x, y, \Text, \TextColor, 0)
y + TextHeight("Wg")
DrawingFont(FontID(\SubTextFont))
DrawTextCentered(x, y, \SubText, \SubTextColor, 0)
EndWith
EndProcedure
Procedure SGauge_PaintHand(*G.SGauge, Image)
With *G
StartDegree.i = 0 + ((360-\SectorDegrees)/2)
DrawVal = \Max - \Value
DirDegrees.d = StartDegree + DrawVal / \Max * \SectorDegrees
centerX = \W / 2
centerY = \H / 2
DrawingFont(\WheelFont)
r = MinI(centerX, centerY) - TextWidth("12345")
tipX = centerX + Sin(Radian(DirDegrees)) * r
tipY = centerY + Cos(Radian(DirDegrees)) * r
innerx = centerX + Sin(Radian(DirDegrees)) * \InnerCircleRadius
innery = centerY + Cos(Radian(DirDegrees)) * \InnerCircleRadius
LineXY(innerx, innery, tipx, tipy, RGBA(255, 0, 0, 255))
Circle(innerx, innery, 2, RGBA(255, 0, 0, 255))
EndWith
EndProcedure
Procedure SoftFreeImage(Image)
If Image
FreeImage(Image)
EndIf
EndProcedure
Procedure SoftFreeFont(Font)
If Font
FreeFont(Font)
EndIf
EndProcedure
; Set sane default settings for a gauge
; (except x and y which must be set manually unless already done)
; Better call this first, or your gauge won't show up
Procedure Gauge_InitDefaults(*G.SGauge, X = #PB_Ignore, Y = #PB_Ignore, W = #PB_Ignore, H = #PB_Ignore)
With *G
If X <> #PB_Ignore
\X = X
EndIf
If Y <> #PB_Ignore
\Y = Y
EndIf
If W <> #PB_Ignore
\W = W
EndIf
If H <> #PB_Ignore
\H = H
EndIf
\Min = 0
\Max = 100
\BigStep = 10
\SmallStep = 5
\Value = 0
\Text = "Value"
\SubText = "in percent"
\Gadget = -1
\SectorDegrees = 270
\InnerCircleRadius = 0
\BgColor = RGBA(0, 0, 0, 0)
\WheelColor = RGBA(62, 62, 128, 192)
\WheelBgColor = RGBA(64, 64, 0, 32)
\TextColor = RGBA(0, 0, 0, 255)
\SubTextColor = RGBA(92, 92, 92, 255)
\HandColor = RGBA(255, 255, 192, 255)
SoftFreeFont(\WheelFont)
SoftFreeFont(\TextFont)
SoftFreeFont(\SubTextFont)
\WheelFont.i = LoadFont(#PB_Any, "Tahoma", MaxD(7, 0.04*\W))
\TextFont.i = LoadFont(#PB_Any, "Tahoma", MaxD(8, 0.056*\W), #PB_Font_Bold)
\SubTextFont.i = LoadFont(#PB_Any, "Tahoma", MaxD(7, 0.04*\W))
\PaintBackground = @SGauge_PaintBackground()
\PaintWheel = @SGauge_PaintWheel()
\PaintDescription = @SGauge_PaintDescription()
\PaintHand = @SGauge_PaintHand()
\BgNeedRepaint.i = 1
\WheelNeedRepaint.i = 1
\DescriptionNeedRepaint.i = 1
\BgImg = SoftFreeImage(\BgImg)
\WheelImg = SoftFreeImage(\WheelImg)
\DescriptionImg = SoftFreeImage(\DescriptionImg)
\ComposedImg = SoftFreeImage(\ComposedImg)
EndWith
EndProcedure
; Called to redraw gauge
Procedure Gauge_UpdateDisplay(*G.SGauge)
With *G
If \BgNeedRepaint
SoftFreeImage(\BgImg)
\BgImg = CreateImage(#PB_Any, \w, \H, 32, #PB_Image_Transparent)
StartDrawing(ImageOutput(\BgImg))
\PaintBackground(*G, \BgImg)
StopDrawing()
EndIf
If \WheelNeedRepaint
SoftFreeImage(\WheelImg)
\WheelImg= CreateImage(#PB_Any, \w, \h, 32 , #PB_Image_Transparent)
StartDrawing(ImageOutput(\WheelImg))
\PaintWheel(*G, \WheelImg)
StopDrawing()
EndIf
If \DescriptionNeedRepaint
SoftFreeImage(\DescriptionImg)
\DescriptionImg= CreateImage(#PB_Any, \w, \h, 32 , #PB_Image_Transparent)
StartDrawing(ImageOutput(\DescriptionImg))
\PaintDescription(*G, \DescriptionImg)
StopDrawing()
EndIf
SoftFreeImage(\ComposedImg)
\ComposedImg = CreateImage(#PB_Any, \w, \h, 32 , #PB_Image_Transparent)
StartDrawing(ImageOutput(\ComposedImg))
DrawingMode(#PB_2DDrawing_AlphaBlend)
DrawImage(ImageID(\BgImg), 0, 0)
DrawImage(ImageID(\WheelImg), 0, 0)
DrawImage(ImageID(\DescriptionImg), 0, 0)
\PaintHand(*G, \ComposedImg)
StopDrawing()
If \Gadget = -1
\Gadget = ImageGadget(#PB_Any, \x, \y, \w, \h, ImageID(\ComposedImg))
Else
ResizeGadget(\Gadget, \x, \y, #PB_Ignore, #PB_Ignore)
SetGadgetState(\Gadget, ImageID(\ComposedImg))
EndIf
EndWith
EndProcedure
; If changing some other setting than value, call this
; before Gauge_UpdateDisplay() or it won't be redrawn properly
Procedure Gauge_SettingsChanged(*G.SGauge)
With *G
\BgNeedRepaint.i = 1
\WheelNeedRepaint.i = 1
\DescriptionNeedRepaint.i = 1
EndWith
EndProcedure
;- Example
#W = 640
#H = 384
OpenWindow(0, 0, 0, #W, #H, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
; SpinGadget(0, 300, 10, 100, 22, 0, 100, #PB_Spin_Numeric)
TrackBarGadget(0, 220, 10, 200, 22, 0, 100)
SetGadgetState(0, 0)
; SpinGadget(1, 300, 40, 100, 22, 1, 360, #PB_Spin_Numeric)
TrackBarGadget(1, 220, 40, 360, 22, 1, 360)
SetGadgetState(1, 270)
;SpinGadget(2, 300, 70, 100, 22, 0, 80, #PB_Spin_Numeric)
TrackBarGadget(2, 220, 70, 200, 22, 0, 40)
SetGadgetState(2, 0)
g.SGauge
Gauge_InitDefaults(@G, 10, 10, 200, 200)
Gauge_UpdateDisplay(@G)
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case 0: ; Change value
g\Value = GetGadgetState(0)
Gauge_UpdateDisplay(@g)
Case 1: ; Change size in degrees
g\SectorDegrees = GetGadgetState(1)
Gauge_SettingsChanged(@G)
Gauge_UpdateDisplay(@g)
Case 2: ; Change hand origin radius
g\InnerCircleRadius = GetGadgetState(2)
Gauge_SettingsChanged(@G)
Gauge_UpdateDisplay(@g)
EndSelect
Case #PB_Event_CloseWindow
Break
EndSelect
ForEver