Hello, here is a snippet someone might find useful!
It is a mouse-controlled GUI item for choosing a rating, based on the CanvasGadget. Typically you would use it with star icons (1 through 5), but you can customize the active and non-active icons, background color, and you can optionally allow right-clicking to clear (zero) the rating.
I finally got around to embedding two star icons in the code, so I could easily post it here. Enjoy, let me know if you find it useful!
EDIT: Tested on Windows, PB 5.11+. Should be cross-platform. EnableExplicit-friendly.
Code: Select all
; +--------------+----------+
; | RatingGadget | by kenmo |
; +--------------+----------+
; | 8.01.2013 . Creation (PB 5.11)
; | .02. . Fixed Hover below 1 bug
; | 10.15. . Embedded star icons in code
; | .16. . Cleaned up demo code
; | .26. . Minor optimization to SetRatingGadget()
;-
;EnableExplicit
;- Constants - Public
; Attribute constants
Enumeration
#RG_OnImageID
#RG_OffImageID
#RG_Background
#RG_State
#RG_AllowZero
#RG_Maximum
EndEnumeration
;- Structures - Private
Structure RATINGGADGET
State.i
Max.i
Hover.i
OnImageID.i
OffImageID.i
Background.i
AllowZero.i
EndStructure
;-
;- Procedures - Private
Procedure.i xRatingGadgetDefault(Attribute.i)
CompilerIf (#PB_Compiler_OS = #PB_OS_Windows)
Select (Attribute)
Case #RG_Background
ProcedureReturn (GetSysColor_(#COLOR_BTNFACE))
EndSelect
CompilerElse
Select (Attribute)
Case #RG_Background
ProcedureReturn ($EAEAEA)
EndSelect
CompilerEndIf
EndProcedure
Procedure xRatingGadgetRedraw(Gadget.i, *RG.RATINGGADGET, Empty.i = #False)
Protected i.i, w.i, h.i
If (IsGadget(Gadget) And *RG)
If (*RG\Max < 1)
*RG\Max = 1
EndIf
If (*RG\State > *RG\Max)
*RG\State = *RG\Max
Else
If (*RG\AllowZero And (*RG\State < 0))
*RG\State = 0
ElseIf ((Not *RG\AllowZero) And (*RG\State < 1))
*RG\State = 1
EndIf
EndIf
If (StartDrawing(CanvasOutput(Gadget)))
w = OutputWidth()
h = OutputHeight()
Box(0, 0, w, h, *RG\Background)
DrawingMode(#PB_2DDrawing_AlphaBlend)
If (*RG\OnImageID)
For i = 0 To *RG\Max - 1
If ((Not Empty) And ((*RG\Hover And (i < *RG\Hover)) Or ((Not *RG\Hover) And (i < *RG\State))))
DrawImage(*RG\OnImageID, i * w / *RG\Max, 0)
ElseIf (*RG\OffImageID)
DrawImage(*RG\OffImageID, i * w / *RG\Max, 0)
EndIf
Next i
EndIf
StopDrawing()
EndIf
EndIf
EndProcedure
;-
;- Procedures - Public
Procedure ResizeRatingGadget(Gadget.i, x.i, y.i, Width.i, Height.i)
ResizeGadget(Gadget, x, y, Width, Height)
xRatingGadgetRedraw(Gadget, GetGadgetData(Gadget))
EndProcedure
Procedure.i FreeRatingGadget(Gadget.i)
Protected *RG.RATINGGADGET
If (IsGadget(Gadget))
*RG = GetGadgetData(Gadget)
If (*RG)
ClearStructure(*RG, RATINGGADGET)
FreeMemory(*RG)
EndIf
FreeGadget(Gadget)
EndIf
ProcedureReturn (#Null)
EndProcedure
Procedure SetRatingGadget(Gadget.i, Attribute.i, Value.i)
Protected *RG.RATINGGADGET
If (IsGadget(Gadget))
*RG = GetGadgetData(Gadget)
If (*RG)
Select (Attribute)
Case #RG_OnImageID
*RG\OnImageID = Value
Case #RG_OffImageID
*RG\OffImageID = Value
Case #RG_Background
*RG\Background = Value
Case #RG_State
If (Value < 0)
Value = 0
EndIf
If (Value > *RG\Max)
Value = *RG\Max
EndIf
*RG\State = Value
Case #RG_AllowZero
*RG\AllowZero = Bool(Value)
Case #RG_Maximum
*RG\Max = Value
EndSelect
xRatingGadgetRedraw(Gadget, *RG)
EndIf
EndIf
EndProcedure
Procedure.i GetRatingGadget(Gadget.i, Attribute.i)
Protected Result = #Null
Protected *RG.RATINGGADGET
If (IsGadget(Gadget))
*RG = GetGadgetData(Gadget)
If (*RG)
Select (Attribute)
Case #RG_OnImageID
Result = *RG\OnImageID
Case #RG_OffImageID
Result = *RG\OffImageID
Case #RG_Background
Result = *RG\Background
Case #RG_State
Result = *RG\State
Case #RG_AllowZero
Result = Bool(*RG\AllowZero)
Case #RG_Maximum
Result = *RG\Max
EndSelect
EndIf
EndIf
ProcedureReturn (Result)
EndProcedure
Procedure.i RatingGadgetEvent(Gadget.i, Type.i)
Protected Result.i = #Null
Protected *RG.RATINGGADGET
Protected Hover.i
If (IsGadget(Gadget))
*RG = GetGadgetData(Gadget)
If (*RG)
Hover = *RG\Hover
Select (Type)
Case #PB_EventType_LeftClick
If (*RG\Hover)
*RG\State = *RG\Hover
Result = #PB_EventType_Change
xRatingGadgetRedraw(Gadget, *RG)
EndIf
Case #PB_EventType_RightClick
If (*RG\AllowZero)
*RG\State = 0
xRatingGadgetRedraw(Gadget, *RG, #True)
Result = #PB_EventType_Change
EndIf
Case #PB_EventType_MouseEnter, #PB_EventType_MouseMove
Hover = 1 + *RG\Max * GetGadgetAttribute(Gadget, #PB_Canvas_MouseX) / GadgetWidth(Gadget)
If (Hover < 1)
Hover = 1
ElseIf (Hover > *RG\Max)
Hover = *RG\Max
EndIf
Case #PB_EventType_MouseLeave
Hover = 0
EndSelect
If (Hover <> *RG\Hover)
*RG\Hover = Hover
xRatingGadgetRedraw(Gadget, *RG)
EndIf
EndIf
EndIf
ProcedureReturn (Result)
EndProcedure
Procedure.i RatingGadget(Gadget.i, x.i, y.i, Width.i, Height.i, Max.i, OnImageID.i, OffImageID.i = #Null)
Protected Result.i = #Null
Protected Canvas.i
Protected *RG.RATINGGADGET
Canvas = CanvasGadget(Gadget, x, y, Width, Height)
If (Canvas)
If (Gadget = #PB_Any)
Gadget = Canvas
EndIf
*RG = AllocateMemory(SizeOf(RATINGGADGET))
If (*RG)
InitializeStructure(*RG, RATINGGADGET)
*RG\State = 0
*RG\Max = Max
*RG\Hover = 0
*RG\OnImageID = OnImageID
*RG\OffImageID = OffImageID
*RG\Background = xRatingGadgetDefault(#RG_Background)
*RG\AllowZero = #True
SetGadgetData(Gadget, *RG)
xRatingGadgetRedraw(Gadget, *RG)
Result = Gadget
Else
FreeGadget(Gadget)
EndIf
EndIf
ProcedureReturn (Result)
EndProcedure
;-
;- Demo Program
CompilerIf ((#True) And (#PB_Compiler_IsMainFile))
DisableExplicit
If (OpenWindow(0, 0, 0, 320, 110, "RatingGadget", #PB_Window_ScreenCentered|#PB_Window_SystemMenu))
UsePNGImageDecoder()
CatchImage(0, ?GrayStart, ?GrayEnd - ?GrayStart)
CatchImage(1, ?StarStart, ?StarEnd - ?StarStart)
RatingGadget(0, 30, 10 + 0*26, 160, 16, 10, ImageID(1), ImageID(0))
SetRatingGadget(0, #RG_State, 5)
TextGadget(0+3, 210, 10 + 0*26, 110, 20, "Right-click to clear")
RatingGadget(1, 30, 10 + 1*26, 160, 16, 10, ImageID(1), ImageID(0))
SetRatingGadget(1, #RG_State, 5)
SetRatingGadget(1, #RG_AllowZero, #False)
TextGadget(1+3, 210, 10 + 1*26, 110, 20, "No clearing allowed")
RatingGadget(2, 30, 10 + 2*26, 160, 16, 10, ImageID(1))
SetRatingGadget(2, #RG_State, 5)
SetRatingGadget(2, #RG_Background, $FFE0D0)
TextGadget(2+3, 210, 10 + 2*26, 110, 20, "Color, no 'off' image")
TextGadget(6, 0, WindowHeight(0)-22, WindowWidth(0), 22, "", #PB_Text_Center)
While (#True)
Event = WaitWindowEvent()
If (Event = #PB_Event_Gadget)
Select (RatingGadgetEvent(EventGadget(), EventType()))
Case #PB_EventType_Change
Rated = GetRatingGadget(EventGadget(), #RG_State)
Max = GetRatingGadget(EventGadget(), #RG_Maximum)
If (Rated > 0)
SetGadgetText(6, "Gadget " + Str(EventGadget()) + " set to " + Str(Rated) + " / " + Str(Max))
Else
SetGadgetText(6, "Gadget " + Str(EventGadget()) + " cleared!")
EndIf
EndSelect
ElseIf (Event = #PB_Event_CloseWindow)
Break
EndIf
Wend
EndIf
DataSection
StarStart:
Data.a 137,80,78,71,13,10,26,10,0,0,0,13,73,72,68,82,0,0,0,16
Data.a 0,0,0,16,8,6,0,0,0,31,243,255,97,0,0,0,25,116,69,88
Data.a 116,83,111,102,116,119,97,114,101,0,65,100,111,98,101,32,73,109,97,103
Data.a 101,82,101,97,100,121,113,201,101,60,0,0,2,5,73,68,65,84,120,218
Data.a 164,83,207,75,84,81,20,254,238,125,211,115,28,25,13,108,108,176,169,8
Data.a 154,33,93,100,49,105,131,66,32,73,180,16,137,150,45,134,8,134,126,64
Data.a 127,128,27,161,63,161,93,38,82,89,180,104,213,198,141,45,90,20,12,36
Data.a 129,99,82,84,26,161,146,76,47,181,134,153,166,177,251,206,237,220,231,12
Data.a 168,205,19,162,11,223,123,223,189,247,59,223,61,247,156,247,160,181,134,223
Data.a 248,122,191,247,42,227,182,223,190,23,187,155,65,41,123,221,45,190,204,232
Data.a 221,12,164,223,102,126,60,121,203,142,157,151,13,135,7,61,238,167,147,245
Data.a 83,79,133,100,99,235,72,96,127,59,12,12,255,39,3,87,169,59,161,206
Data.a 11,160,181,103,30,12,207,143,159,122,80,79,27,48,15,103,162,111,66,187
Data.a 234,184,38,213,5,114,121,53,8,59,26,5,253,124,227,137,236,232,49,192
Data.a 10,166,243,99,39,211,144,22,132,12,228,132,101,205,242,86,218,51,32,162
Data.a 139,45,125,87,154,26,142,36,193,70,156,87,43,104,229,17,72,209,102,154
Data.a 149,28,34,151,238,177,112,21,2,21,252,90,120,222,85,152,158,58,106,12
Data.a 132,169,164,16,226,196,242,88,247,212,222,206,67,17,123,95,11,52,113,160
Data.a 230,219,9,171,90,110,206,74,16,79,37,54,156,2,126,188,93,116,14,100
Data.a 94,157,227,216,153,90,13,102,98,153,233,129,249,236,167,73,35,144,141,9
Data.a 110,145,203,70,106,19,204,101,40,129,202,202,58,230,179,11,147,28,60,96
Data.a 98,118,22,113,246,244,112,238,38,253,230,91,89,205,124,40,109,135,104,2
Data.a 149,45,24,141,209,214,237,194,210,104,119,106,79,91,28,170,240,142,79,118
Data.a 77,117,60,24,78,197,15,8,68,226,88,186,219,147,242,109,99,73,161,95
Data.a 134,130,208,27,14,7,148,81,154,91,244,96,56,85,28,88,97,27,197,178
Data.a 234,247,53,8,183,199,134,168,248,25,149,229,117,56,115,95,222,31,188,252
Data.a 162,199,192,112,179,166,213,119,132,35,109,67,127,255,16,213,177,246,116,80
Data.a 59,15,123,221,209,107,137,27,60,237,216,34,235,48,107,223,30,159,113,87
Data.a 159,156,213,91,99,107,109,172,173,37,171,239,143,140,194,142,143,174,153,17
Data.a 175,242,215,219,12,254,103,252,17,96,0,49,255,2,185,111,125,142,173,0
Data.a 0,0,0,73,69,78,68,174,66,96,130
StarEnd:
GrayStart:
Data.a 137,80,78,71,13,10,26,10,0,0,0,13,73,72,68,82,0,0,0,16
Data.a 0,0,0,16,8,6,0,0,0,31,243,255,97,0,0,0,6,98,75,71
Data.a 68,0,255,0,255,0,255,160,189,167,147,0,0,0,9,112,72,89,115,0
Data.a 0,11,19,0,0,11,19,1,0,154,156,24,0,0,0,7,116,73,77,69
Data.a 7,221,10,16,0,17,55,147,185,108,112,0,0,2,10,73,68,65,84,56
Data.a 203,149,147,193,75,27,81,16,198,127,111,221,69,220,64,23,97,151,156,114
Data.a 145,22,65,72,45,20,36,87,65,60,10,246,232,33,215,30,68,26,136,185
Data.a 10,66,142,201,66,34,148,94,219,255,193,75,239,57,73,193,120,16,36,171
Data.a 7,241,178,174,32,148,77,12,89,223,188,30,106,74,43,174,212,15,134,247
Data.a 134,153,247,49,51,223,27,140,49,228,161,219,237,126,236,118,187,157,188,184
Data.a 49,6,155,103,80,42,149,62,107,173,45,224,83,94,142,149,23,8,195,112
Data.a 127,113,113,209,90,90,90,34,12,195,253,23,17,116,58,29,215,117,221,61
Data.a 207,243,240,60,15,215,117,247,94,68,112,127,127,255,165,92,46,19,69,17
Data.a 81,20,81,46,151,9,195,240,235,83,185,54,192,193,193,193,55,173,245,91
Data.a 17,89,22,17,28,199,193,243,60,46,46,46,0,88,88,88,192,182,237,106
Data.a 187,221,174,42,165,152,153,153,233,91,150,117,2,84,109,0,17,249,80,169
Data.a 84,10,165,82,9,17,97,110,110,142,126,191,143,136,0,16,199,49,91,91
Data.a 91,220,221,221,161,181,102,48,24,44,159,158,158,190,6,170,202,24,131,82
Data.a 234,93,171,213,250,94,44,22,131,66,161,128,136,160,148,194,178,126,119,40
Data.a 34,24,99,176,44,139,209,104,68,28,199,73,189,94,95,55,198,28,79,103
Data.a 112,188,187,187,187,118,126,126,126,56,26,141,240,125,31,17,65,107,141,214
Data.a 26,17,193,247,125,210,52,37,138,162,195,122,189,190,6,28,63,30,226,73
Data.a 179,217,220,81,74,49,59,59,139,49,230,31,115,28,7,128,102,179,185,3
Data.a 156,60,169,66,171,213,170,4,65,192,245,245,245,159,178,141,49,136,8,55
Data.a 55,55,4,65,64,187,221,174,228,202,152,101,217,170,227,56,12,135,67,38
Data.a 147,9,73,146,144,36,9,147,201,132,225,112,136,109,219,140,199,227,213,92
Data.a 2,223,247,55,110,111,111,73,211,148,56,142,207,106,181,218,74,173,86,91
Data.a 137,227,248,44,77,83,198,227,49,243,243,243,27,185,4,34,82,188,186,186
Data.a 146,94,175,183,221,104,52,54,179,44,59,202,178,236,168,209,104,108,246,122
Data.a 189,237,203,203,75,17,145,226,223,111,166,50,78,253,247,15,231,0,248,249
Data.a 232,211,189,2,222,60,220,127,76,183,81,61,183,206,255,131,95,222,246,11
Data.a 2,206,203,196,96,0,0,0,0,73,69,78,68,174,66,96,130
GrayEnd:
EndDataSection
CompilerEndIf
;-