Re: RatingGadget (ie. stars) via CanvasGadget
Posted: Sat Oct 26, 2013 9:12 pm
Hello everyone,
A little change I made to kenmo original code but this modification will only work with PureBasic version supporting BindGadgetEvent().
The events are now managed in background and the program main event loop become more simple.
Best regards
StarBootics
A little change I made to kenmo original code but this modification will only work with PureBasic version supporting BindGadgetEvent().
The events are now managed in background and the program main event loop become more simple.
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
Procedure xRatingGadgetEvent()
Protected *RG.RATINGGADGET
Protected Hover.i, Gadget.i
Gadget = EventGadget()
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_Canvas
*RG = GetGadgetData(Gadget)
If (*RG)
Hover = *RG\Hover
Select EventType()
Case #PB_EventType_LeftClick
If (*RG\Hover)
*RG\State = *RG\Hover
xRatingGadgetRedraw(Gadget, *RG)
PostEvent(#PB_Event_Gadget, -1, Gadget, #PB_EventType_Change)
EndIf
Case #PB_EventType_RightClick
If (*RG\AllowZero)
*RG\State = 0
xRatingGadgetRedraw(Gadget, *RG, #True)
PostEvent(#PB_Event_Gadget, -1, Gadget, #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
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)
UnbindGadgetEvent(Gadget, @xRatingGadgetEvent())
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 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)
BindGadgetEvent(Gadget, @xRatingGadgetEvent())
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)
Repeat
EventID = WaitWindowEvent()
Select EventID
Case #PB_Event_Menu
Select EventMenu()
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case 0,1,2
If EventType() = #PB_EventType_Change
Rated = GetRatingGadget(EventGadget(), #RG_State)
If (Rated > 0)
SetGadgetText(6, "Gadget " + Str(EventGadget()) + " set to " + Str(Rated) + " / " + Str(GetRatingGadget(EventGadget(), #RG_Maximum)))
Else
SetGadgetText(6, "Gadget " + Str(EventGadget()) + " cleared!")
EndIf
EndIf
EndSelect
EndSelect
Until EventID = #PB_Event_CloseWindow
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
StarBootics