Page 1 of 2

RatingGadget (stars) via CanvasGadget

Posted: Wed Oct 16, 2013 1:31 am
by kenmo
2016.01.10 EDIT: Did a rewrite of this gadget for newer versions of PureBasic: http://www.purebasic.fr/english/viewtop ... 91#p479691




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

;-

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Wed Oct 16, 2013 1:56 am
by skywalk
Nice. 8) Works on v5.20 :wink:

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Wed Oct 16, 2013 3:40 am
by idle
works on linux, thanks

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Wed Oct 16, 2013 3:50 am
by flaith
Really nice indeed :D
I will use it for my current application :wink:
Thanks kenmo

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Wed Oct 16, 2013 6:23 am
by ts-soft
Image

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Wed Oct 16, 2013 7:09 am
by Karellen
Nice one, thanks a lot! :D

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Wed Oct 16, 2013 9:03 am
by Kwai chang caine
Nice idea and works very well
Thanks for sharing 8)

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Wed Oct 16, 2013 9:25 am
by davido
******
Thanks for sharing.:D

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Wed Oct 16, 2013 10:32 pm
by kenmo
Glad it's useful. I actually never ended up using it for its original purpose!

PS. I changed the demo program a bit. It's smaller, cleaner, easier to read now. :)

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Wed Oct 16, 2013 11:54 pm
by IdeasVacuum
Image 8)

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Sat Oct 19, 2013 11:19 pm
by said
Very nice, thanks for sharing!

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Sat Oct 26, 2013 12:09 pm
by StarBootics
Hello everyone,

Nice gadget but few optimisation can be done to the code like this procedure :

Code: Select all

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
Thanks for sharing, a gadget like this there will be very useful to raise the appreciation of a program by the users.

Best regards
StarBootics

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Sat Oct 26, 2013 8:03 pm
by kenmo
Thanks for the tip, I updated the code in the top post.

I guess I didn't notice that I was redrawing the gadget for every Case!

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Sat Oct 26, 2013 8:23 pm
by Andre
Very nice and useful, thanks! :D

Runs on MacOS 10.5.8 with PB5.20 too.

Re: RatingGadget (ie. stars) via CanvasGadget

Posted: Sat Oct 26, 2013 8:32 pm
by infratec
Hi,

I just tried it: nice :!:

One thing:

It is always possible to rate 0 of something.
In your Gadget that's only possible by a 'right click'.
Is there no hint about that, the user can not do it.

My idea:
'draw' one invisible star in front of the others.
So if the mouse goes in front the first visible star, you have 0 stars.
I hope it is clear what I mean.

Bernd