New Rating Class

[Silvio.Falconi]

Friends,

I made a new class : TRating class







It is a beta test but now it is working ...

It not need images or bitmap to build stars !!!

We can insert symbol and bitmaps

Sample:

@ 16 ,10 SAY "My Rating :" Of oWnd PIXEL
oRating := TRating():New( 10, 75, 80, 20, oWnd,oFont)
oRating:nType=1 // Stars


we can assign a Value for each symbols

simply with oRating:AssignValues( oRating:AssignValues(aValoracion))

where aValoracion is an array with values

you're seeing the number 50.... is the value it return on change action

[ukoenig]

Silvio,

do You remember the tool (visual design), I created 2012 ?



best regards
Uwe

[Antonio Linares]

Silvio,

Nice work

Do you plan to share its code ?

[Silvio.Falconi]

Uwe,
I Remember but I wish create a control because I wish insert it on my applications near to aother controls. as this
http://www.devcomponents.com/dotnetbar/RatingControl.aspx


Antonio,
No problem!!!
I remember you the class not make the Half colorize but only the full colorize

this is the Project TRating. I hope you help me to modify it
I Initiated from TAgCloud class.

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

//------------------------------------------------------------------------------------------//

CLASS TRating FROM TControl    // ( FROM TAGCLOUD.prg)

    CLASSDATA lRegistered AS LOGICAL

    DATA aItems

    DATA nClrTextOver
    DATA nClrPaneStar
    DATA nHLine AS NUMERIC INIT 25

    DATA aCoors

    DATA nOver
    DATA nClrBorder
    DATA nClrBackStar

    DATA bChange
    DATA lOverClose
    DATA nOption
    DATA nValor

    DATA nStarHeight
    DATA nStarWidth

    DATA nType
    DATA cFileBmp


    METHOD New( nTop, nLeft, nWidth, nHeight, oWnd ) CONSTRUCTOR

    METHOD Redefine( nId, oWnd, oFont, aItems ) CONSTRUCTOR

    METHOD AddItem( cText, nPeso )
    METHOD AssignValues()

    METHOD Paint()
    METHOD Display() INLINE ::BeginPaint(),::Paint(),::EndPaint(), 0
    METHOD GetItems()

    METHOD LButtonDown( nRow, nCol, nFlags )
    METHOD MouseMove  ( nRow, nCol, nFlags )
    METHOD LButtonUp  ( nRow, nCol, nFlags )
    METHOD Reset()
    METHOD EraseBkGnd( hDC ) INLINE 1


ENDCLASS

************************************************************************************************************************************
  METHOD New( nTop, nLeft, nWidth, nHeight, oWnd ,oFont) CLASS TRating
************************************************************************************************************************************

   local nClrText       := rgb(  0,102,227)
   local nClrTextOver   := 0 //rgb(255,102,  0)

   local nClrPane     := CLR_WHITE
   local nClrPaneStar := CLR_YELLOW
   local nClrBorder   :=  CLR_BLUE //rgb(192, 192, 192)
   local nClrBackStar  := rgb(192, 192, 192)



   DEFAULT nClrPane     := CLR_WHITE
   DEFAULT nClrPaneStar := rgb(255, 255,   0)
   DEFAULT nTop         := 0
   DEFAULT nLeft        := 0
   DEFAULT nWidth       := 0
   DEFAULT nHeight      := 0
   DEFAULT nClrBorder   := rgb(192, 192, 192)
   DEFAULT nClrBackStar  := rgb(192, 192, 192)


      ::nStyle       := nOR( WS_CHILD, WS_VISIBLE )

    ::nValor:= 0

   ::aCoors       := {}


   ::oWnd         := oWnd
   ::nTop         := nTop
   ::nLeft        := nLeft
   ::nBottom      := nTop + nHeight
   ::nRight       := nLeft + nWidth
   ::nId          := ::GetNewId()
   ::lCaptured    := .f.
   ::nClrPane     := nClrPane
   ::nClrText     := nClrText
   ::nClrPaneStar := nClrPaneStar
   ::nClrTextOver := nClrTextOver

   ::nStarHeight :=  nHeight
   ::nStarWidth:=   nWidth /4


   ::oFont        := oFont

   ::nOver        := -1
   ::nClrBorder   := nClrBorder
   ::nClrBackStar  := nClrBackStar
   ::lOverClose   := .f.
   ::nOption      := 1


   ::SetColor( nClrText, nClrPane )

   ::lVisible    := .t.

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )
   ::Create()


return Self

************************************************************************************************************************************
  METHOD Redefine( nId, oWnd, oFont, aItems, nClrBorder, nClrBackStar, nClrPane, nClrPaneStar ) CLASS TRating
************************************************************************************************************************************

   local nClrText       := rgb(  0,102,227)
   local nClrTextOver   := 0 //rgb(255,102,  0)
   DEFAULT nClrPane     := CLR_WHITE
   DEFAULT nClrPaneStar := rgb(221,221,221)
   DEFAULT nClrBorder   := rgb(204,214,197)
   DEFAULT nClrBackStar  := rgb(235,245,226)



   ::aCoors       := {}

   ::oWnd         := oWnd
   ::nId          := nId

   ::nId          := nId
   ::lCaptured    := .f.
   ::nClrPane     := nClrPane
   ::nClrText     := nClrText
   ::nClrPaneStar := nClrPaneStar
   ::nClrTextOver := nClrTextOver
   ::oFont        := oFont
   ::nOver        := -1
   ::nClrBorder   := nClrBorder
   ::nClrBackStar  := nClrBackStar
   ::lOverClose   := .f.
   ::nOption      := 1


   ::SetColor( nClrText, nClrPane )

   ::lVisible    := .t.

   ::Register()

   oWnd:DefControl( Self )


return Self

***************************************************************************************************************
    METHOD GetItems() CLASS TRating
***************************************************************************************************************
local n
local nLen := len(::aItems)
local aItems := {}

for n := 1 to nLen
    if ::aItems[n,2]
       aadd(aItems, ::aItems[n,1] )
    endif
next

return aItems





METHOD Reset()  CLASS TRating


    return  NIL

***************************************************************************************************************
    METHOD AssignValues( aItems ) CLASS TRating
***************************************************************************************************************

    local n
    local nLen

    if len(aItems) != 0

       ::aItems := {}

       for n := 1 to len(aItems)
           aadd(::aItems, {aItems[n], .f.,{0,0,0,0}, aItems[n][2]} )
       next

    endif

return 0

***************************************************************************************************************
   METHOD AddItem( cText ) CLASS TRating
***************************************************************************************************************

  // local oItem
  // local nLen := len(::aItems)+1

   if ::aItems == nil
      ::aItems := {}
   endif

   AAdd( ::aItems, {cText,.f.,{0,0,0,0}} )

return nil //oItem

***************************************************************************************************************
    METHOD Paint() CLASS TRating
***************************************************************************************************************
local aInfo := ::DispBegin()
local n
local nTop  := 3
local nT    := 0
local nL    := 0
local nLeft := 14
local nSep  := 11
local nH    := ::nHLine
local nLen
local nFont
local nW := 0
local hOldFont
local rc
local nMode := SetBkMode( ::hDC, 1 )
local nColor := SetTextColor(::hDC, ::nClrText )

local nT0, nL0, nB0, nR0
local hPen, hOldPen
local hBrush, hOldBrush
local hBrush1, hOldBrush1
local lFirst := .t.


//local nBkColor := SetBkColor(::hDC, CLR_GREEN )



hPen      := CreatePen( PS_SOLID, 1, ::nClrBorder )
hOldPen   := SelectObject(::hDC, hPen )

hBrush    := CreateSolidBrush( ::nClrBackStar )

hBrush1    := CreateSolidBrush( ::nClrPaneStar )

nLen := len( ::aItems )

::aCoors := array(nLen)
for n := 1 to nLen
    ::aCoors[n] :={0,0,0,0}
next
                     ::nClrPane :=CLR_BLUE

FillSolidRect(::hDC, GetClientRect(::hWnd), ::nClrPane )

nL := nLeft




for n := 1 to nLen

    if ::aItems[n,2] // oculto
       loop
    endif

   //if n == ::nOver
    SetTextColor(::hDC, nColor )
    nColor := SetTextColor(::hDC, if( n == ::nOver .or. n == ::nOption, ::nClrTextOver, ::nClrText) )
  // endif

    if !lFirst
       nL := nL + nW + 8
    endif

    lFirst := .f.

    nW := 5 + GetTextWidth(::hDC, ::aItems[n,1], ::oFont:hFont )

    if nL + nW + 5 + 5 > ::nWidth
       nTop += ( ::nHLine  ) +2
       nL := nLeft
    endif

    nW := 5 + GetTextWidth(::hDC, ::aItems[n,1], ::oFont:hFont )
    nT := nTop

    rc := { nT, nL-4, nT + nH, nL + nW }

    ::aCoors[n,1] := rc[1]
    ::aCoors[n,2] := rc[2]
    ::aCoors[n,3] := rc[3]
    ::aCoors[n,4] := rc[4]



    hOldBrush := SelectObject( ::hDC, if( n == ::nOver .or. n == ::nOption, hBrush1, hBrush ) )


DO CASE
       CASE ::nType=1

    //Create stars
    //---------------------------------------------------------------------------------
     PolyPolygon( ::hDc, PolyForms(rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 ) )

  CASE  ::nType=2

      // Boxes
      RoundRect( ::hDC, rc[2]-4, rc[1], rc[4], rc[3]-10, 6, 6 )

  CASE  ::nType=3
          //balls
       PolyPolygon( ::hDc, PolyForms(rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,50,-18,31 ) )

     //BItmaps ?
       
  CASE  ::nType=4
      hBmp := ReadBitmap( 0, ::cFileBMP)

       if hBmp != 0
                 nWBmp := nBmpWidth( hBmp )
                 nHBmp := nBmpHeight( hBmp )
              endif

             if hBmp != 0 //.and. ( n == ::nOver .or. n == ::nOption)



             DrawMasked( ::hDC, hBmp, rc[1]-1, rc[2]-6)
          endif
   ENDCASE








    hOldFont := SelectObject( ::hDC, ::oFont:hFont )

  //  DrawText(::hDC, ::aItems[n,1], {rc[1],rc[2]-6,rc[3]-2,rc[4]}, 32+4 )

    SelectObject( ::hDC, hOldFont )

    /*
    if n == ::nOver
       SetTextColor(::hDC, nColor )
       nColor := SetTextColor(::hDC, ::nClrText )
    endif
       */
next n

SetBkMode( ::hDC, nMode )
SetTextColor(::hDC, nColor )



SelectObject( ::hDC, hOldPen )
SelectObject( ::hDC, hOldBrush )

DeleteObject( hPen )
DeleteObject( hBrush )
DeleteObject( hBrush1 )


::DispEnd( aInfo )

return 0

***************************************************************************************************************
    METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TRating
***************************************************************************************************************

return 0

***************************************************************************************************************
    METHOD MouseMove  ( nRow, nCol, nFlags ) CLASS TRating
***************************************************************************************************************


 local nOver := ::nOver
local n
local nLen := len(::aCoors)
local lFind := .f.


for n := 1 to nLen
    if PtInRect( nRow, nCol, ::aCoors[n] )
       lFind := .t.
       ::nOver := n
       if nOver != n
          ::Refresh(.f.)
       endif
       exit
    endif
next

if lFind
   if ::lOverClose
      CursorArrow()
   else
     CursorHand()
   endif

  // msginfo( ::aItems[::nOver,1] )
  // msginfo(::aItems[::nOver,2])
   //   msginfo(::aItems[::nOver,4])


   //return the value
   ::nValor:= ::aItems[::nOver,4]


else

   ::nOver := -1
   CursorArrow()
endif

if nOver != ::nOver
   ::Refresh(.f.)
endif


return 0

***************************************************************************************************************
    METHOD LButtonUp  ( nRow, nCol, nFlags ) CLASS TRating
***************************************************************************************************************

if ::nOver > 0
   if ::lOverClose
      ::aItems[::nOver,2] := .t.
   else
      ::nOption := ::nOver
      if ::bChange != nil
         Eval( ::bChange,  ::nValor )
      endif
   endif
   ::Refresh()
endif

return 0

***************************************************************************************************************



 //---------------------------------------------------------------------------------------//
 //---------------------------------------------------------------------------------------//
 //---------------------------------------------------------------------------------------//

#Define PI   3.141592653589

 FUNCTION PolyForms(nX,nY,nWidth,nHeight,nLados,nGiro,nPorC)
   LOCAL aVert
   LOCAL nRadV := nHeight/2
   LOCAL nRadH := nWidth/2
   LOCAL nAngl := (2*PI)/nLados
   LOCAL nAngu,nOAng
   LOCAL nCount,nStep

   DEFAULT nGiro := 0 , ;
           nPorC := 100

   nPorc := Max(0,Min(100,nPorC))
   nAngu := (nGiro*PI)/180
   IF nPorC = 100
      aVert := Array(nLados+1,2)
      nStep := 1
   ELSE
      aVert := Array((nLados*2)+1,2)
      nStep := 2
      nOAng := nAngl/2
      nLados:= nLados*2
      nPorC := 9.9+(nPorC*0.9)
   ENDIF

   FOR nCount = 1 TO nLados STEP nStep
       aVert[nCount] := { nY+nRadH+(nRadH*Cos(nAngu)), nX+nRadV+(nRadV*Sin(nAngu)) }
       IF nPorC < 100
      aVert[nCount+1] := { nY+nRadH+(nRadH*(nPorC/100)*Cos(nAngu+nOAng)), ;
                           nX+nRadV+(nRadV*(nPorC/100)*Sin(nAngu+nOAng))  }
       ENDIF
       nAngu += nAngl
   NEXT
   aVert[nLados+1] := aVert[1]
RETURN aVert
 

Test.prg

Code: Select all  Expand view  RUN

#include "FiveWin.ch"





function Main()

   local oWnd, oRating
   local oFont
   local aValoracion :=  { { "1" ,  10 },;
                           { "2" ,  20 },;
                           { "3" ,  30 },;
                           { "4" ,  40 },;
                           { "5" ,  50 }}
    loca oSay := 1

   DEFINE FONT oFont NAME "Segoe UI" SIZE 0,-10
   DEFINE FONT oFont2 NAME "Segoe UI" SIZE 0,-20
   DEFINE WINDOW oWnd TITLE "Rating"

   @ 16 ,10 SAY "My Rating :" Of oWnd  PIXEL

   oRating := TRating():New( 10, 75, 80, 20, oWnd,oFont)



   oRating:nType=1
  // oRating:cFileBmp :="Hearth.bmp"

   for n := 1 to len( aValoracion )
       oRating:AddItem( aValoracion[n,1], aValoracion[n,2] )
   next

   oRating:AssignValues(aValoracion)

   @ 60 ,220 SAY oSay  PROMPT  oRating:nValor  Of oWnd  PIXEL   FONT oFont2  SIZE 30,50

    oRating:bChange := {|| oSay:refresh() }

   ACTIVATE WINDOW oWnd

   return 0

 

I insert this line on Paint method only for trace to see the width and the height of control rating

::nClrPane :=CLR_BLUE ( Line 316) you must rem it

i explain you
the class created symbols ..you can click on each symbol / stars,balls,roundrect....)

NOTE : it not created the half colorize but only the full colorize ..I not found the solution for this problem

to call the class
oRating := TRating():New( 10, 75, 80, 20, oWnd,oFont)

oRating:nType=1

1 = stars
2 = boxes round
3= balls
4= bitmap

you must add itelms and assign the values

for n := 1 to len( aValoracion )
oRating:AddItem( aValoracion[n,1], aValoracion[n,2] )
next

oRating:AssignValues(aValoracion)


I mean the first parameter to create a tooltip the The mouse is over on symbols

the second parameter is the value sample "10% 20% 30%..." of return


then to show the value of return

@ 60 ,220 SAY oSay PROMPT oRating:nValor Of oWnd PIXEL FONT oFont2 SIZE 30,50

oRating:bChange := {|| oSay:refresh() }


here the Size of Symbols

::nStarHeight
::nStarWidth


the colors
nClrBackStar when the symbol is empty
nClrPaneStar when the symbol is full
nClrBorder the boder color of symbols


I need ::aCoors to have the right coordinates to use Ptinrect and click on symbols

[Antonio Linares]

Silvio,

Look at Uwe's so nice screenshot. Look at a star that is half painted with two colors.

Each half star can be painted as a poligon. So thats the solution

The half of a star is also a poligon

[Silvio.Falconi]

Uwe use 3 bitmaps Full, Half, Empty

Also a big friend (Paco) sad me I must use bitmaps...

Perhaps it is good solution but I 'll modify all source class

for the ploygon I think Not it can be done (I mean to build a half star)

[Antonio Linares]

Silvio,

Who coded function PolyForms() ?

[Silvio.Falconi]

Antolin of course I found this function on forum
I tried to contact him but I did not answer

[Antonio Linares]

Silvio,

Please try this code and let me know what value you get:

Code: Select all  Expand view  RUN

DO CASE
       CASE ::nType=1

    //Create stars
    //---------------------------------------------------------------------------------
     MsgInfo( Len( PolyForms(rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 ) ) ) // new
     PolyPolygon( ::hDc, PolyForms(rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 ) )

[Antonio Linares]

Please try this:

Code: Select all  Expand view  RUN

DO CASE
       CASE ::nType=1

    //Create stars
    //---------------------------------------------------------------------------------
     aPoints = PolyForms( rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 )
     aPoints = AAdd( ASize( aPoints, Len( aPoints ) / 2 ), aPoints[ 1 ] )  
     PolyPolygon( ::hDc, aPoints )
 

[Silvio.Falconi]

not draw any stars

the msg return 11

[Antonio Linares]

Silvio,

What do you get here ?

MsgInfo( Len( PolyForms(rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 ) ) )

I guess that if a star has 5 points, then it should return 10

[Antonio Linares]

This should be the right code:

aPoints = AAdd( ASize( aPoints, 6 ), aPoints[ 1 ] )

[Silvio.Falconi]

I insert 11 instead of 6 and return the stars

[Silvio.Falconi]

MsgInfo( Len( PolyForms(rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,4.5,-18,31 ) ) )

return 10

MsgInfo( Len( PolyForms(rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 ) ) )

return 11


the polyforms func is here viewtopic.php?f=17&t=18780