New Rating Class

[Antonio Linares]

Silvio,

ok, the stars are getting painted not from the top, but from the next to the right.

These are the points that PolyForms() is returning:


So you have to use:
{ aPoints[ 9 ], aPoints[ 10 ], aPoints[ 1 ], aPoints[ 2 ], aPoints[ 3 ], aPoints[ 4 ], aPoints[ 9 ] }

[Silvio.Falconi]

ok but I not Know how do it .. I am off of head

[Antonio Linares]

Silvio,

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 = { aPoints[ 9 ], aPoints[ 10 ], aPoints[ 1 ], aPoints[ 2 ], aPoints[ 3 ], aPoints[ 4 ], aPoints[ 9 ] }
     PolyPolygon( ::hDc, aPoints )

[Silvio.Falconi]

Antonio,
I allready tried it
and I tried also
aPoints = { aPoints[ 9 ], aPoints[ 8 ], aPoints[ 7 ], aPoints[ 6 ], aPoints[ 5], aPoints[ 4 ], aPoints[ 9 ] }


for the ntype can be 1 , 2 or 3
I changed the ntype value on LButtonUp method but I not had success

[Silvio.Falconi]

antonio, I not found the solution

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

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

CLASS TRating FROM TControl    

    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       := {}

   ::nType = 3

   ::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.
loca  aPoints

//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 !lFirst
       nL := nL + nW + 8
    endif

    lFirst := .f.

    nW := 5

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

    nW := 5
    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 ) )
         PolyPolygon( ::hDc,  PolyForms( rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 ) )



 Do case
  case  ::nType = 2
      hOldBrush := SelectObject( ::hDC, if( n == ::nOver .or. n == ::nOption, hBrush1, hBrush ) )
     aPoints := PolyForms( rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 )
     aPoints := { aPoints[ 9 ], aPoints[ 10 ], aPoints[ 1 ], aPoints[ 2 ], aPoints[ 3 ], aPoints[ 4 ], aPoints[ 9 ] }
     PolyPolygon( ::hDc, aPoints )

    case ::nType = 1
         hOldBrush := SelectObject( ::hDC, if( n == ::nOver .or. n == ::nOption, hBrush1, hBrush ) )
        aPoints := PolyForms( rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 )
        aPoints :=  { aPoints[ 9 ], aPoints[ 8 ], aPoints[ 7 ], aPoints[6 ], aPoints[ 5 ], aPoints[ 4 ], aPoints[ 9 ] }
        PolyPolygon( ::hDc, aPoints )

     case ::nType = 3
         hOldBrush := SelectObject(hBrush)
         aPoints := PolyForms( rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 )
       && aPoints :=  { aPoints[ 9 ], aPoints[ 8 ], aPoints[ 7 ], aPoints[6 ], aPoints[ 5 ], aPoints[ 4 ], aPoints[ 9 ] }
        PolyPolygon( ::hDc, aPoints )


     Endcase


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



 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
       ::nType:= 1
       if nOver != n
                   ::nType:= 3
          ::Refresh(.f.)
       endif
       exit
    endif
next

if lFind
   if ::lOverClose
      CursorArrow()
   else
     CursorHand()
   endif
   ::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
       ::nType:= 2
      ::nOption := ::nOver
      if ::bChange != nil
         Eval( ::bChange,  ::nValor )
      endif
   endif

else


   ::Refresh()
endif

return 0

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



 //---------------------------------------------------------------------------------------//
 //---------------------------------------------------------------------------------------//
/*PolyForms( <nRow>, <nCol>, <nWidth>, <nHeight>, <nLados>, <nGiro>, <nPorCent> )

   Función que crea un ARRAY con las coordenadas de los vertices de un polígono
regular para dibujarlo con PolyPolygon(). El polígono puede ser normal
o en estrella.

<nRow>, <nCol>      Coordenadas de la esquina superior izquierda de la zona
                    cuadrángular en la que se va a inscribir el polígono.

<nWidth>, <nHeight> Dimesiones de la zona cuadrángular. Puede definirse como
                    un cuadrado o como un rectángulo, en cuyo caso el
                    polígono se deforma para adaptarse a la superficie.

<nLados>            Número de lados del polígono regular.

<nGiro>             Cantidad de grados que deseamos girar el polígono con
                    respecto a la horizontal (en sentido horario).
                    Por defecto '0'.

<nPorCent>          Para dibujarlos en forma de estrella. Si vale 100 el
                    polígono se dibuja normal. Por defecto vale 100. Con otro
                    valor se dibuja en forma de estrella. Este valor indica
                    el porcentaje del radio interior con respecto al radio
                    exterior. Cuanto menor sea ese valor, mayor será el efecto
                    estrella, las puntas saldrán más estrechas y profundas.
                                                                                               */
 //---------------------------------------------------------------------------------------//

#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
 

[Antonio Linares]

Silvio,

What drawing do you get with this code ?

aPoints = PolyForms( rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 )
aPoints = { aPoints[ 9 ], aPoints[ 10 ], aPoints[ 1 ], aPoints[ 2 ], aPoints[ 3 ], aPoints[ 4 ], aPoints[ 9 ] }
PolyPolygon( ::hDc, aPoints )

[Silvio.Falconi]

If I understood your suggestion

The part at right of the star ( ntype 1)
aPoints := { aPoints[ 9 ], aPoints[ 10 ], aPoints[ 1 ], aPoints[ 2 ], aPoints[ 3 ], aPoints[ 4 ], aPoints[ 9 ] }

the part at left of the star ( ntype 2)
aPoints := { aPoints[ 9 ], aPoints[ 8 ], aPoints[ 7 ], aPoints[ 6 ], aPoints[ 5], aPoints[ 4 ], aPoints[ 9 ] }

the full star ( ntype 3) ( default)
aPoints := PolyForms( rc[1]-2, rc[2]-8,::nStarWidth,::nStarHeight,5,-18,31 )

[Antonio Linares]

Try it

[Silvio.Falconi]

Antonio,

if I insert ntype 1 or nType 2 erase the picture and draw only the part Left or Right

Perhaps it can run ok if the procedure not erase the picture but refill only the part left ( ntype 1) and right ( ntype 2)





Take This last source fro the release please :

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)

   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

Trating class

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

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

CLASS TRating FROM TControl    

    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,nClrPane,nClrPaneStar,nClrBorder,nClrBackStar ) CLASS TRating
************************************************************************************************************************************

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



   DEFAULT nClrPane     := CLR_WHITE
   DEFAULT nClrPaneStar := CLR_YELLOW//rgb(255, 255,   0)
   DEFAULT nClrBorder   := CLR_RED //rgb(192, 192, 192)
   DEFAULT nClrBackStar := rgb(192, 192, 192)

   DEFAULT nTop         := 0
   DEFAULT nLeft        := 0
   DEFAULT nWidth       := 0
   DEFAULT nHeight      := 0

   ::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
   ::nType = 3

   ::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.
loca  aPoints

//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 !lFirst
       nL := nL + nW + 8
    endif

    lFirst := .f.

    nW := 5

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

    nW := 5
    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 ) )


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





 Do case
 case  ::nType = 1   // Right
        aPoints := { aPoints[ 9 ], aPoints[ 10 ], aPoints[ 1 ], aPoints[ 2 ], aPoints[ 3 ], aPoints[ 4 ], aPoints[ 9 ] }
        aPoints :=AADD(aPoints,aPoints )


    case ::nType = 2 // Left
        aPoints := { aPoints[ 9 ], aPoints[ 8 ], aPoints[ 7 ], aPoints[ 6 ], aPoints[ 5], aPoints[ 4 ], aPoints[ 9 ] }
        aPoints :=AADD(aPoints,aPoints )


    case ::nType = 3

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

     Endcase



      PolyPolygon( ::hDc, aPoints )

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



 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.
       ::nType = 1
          ::nOver := n
          if nOver != n
         ::Refresh(.f.)
         endif
       exit
    endif
next

if lFind

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


   ::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

else


   ::Refresh()
endif

return 0

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



 //---------------------------------------------------------------------------------------//
 //---------------------------------------------------------------------------------------//
/*PolyForms( <nRow>, <nCol>, <nWidth>, <nHeight>, <nLados>, <nGiro>, <nPorCent> )

   Función que crea un ARRAY con las coordenadas de los vertices de un polígono
regular para dibujarlo con PolyPolygon(). El polígono puede ser normal
o en estrella.

<nRow>, <nCol>      Coordenadas de la esquina superior izquierda de la zona
                    cuadrángular en la que se va a inscribir el polígono.

<nWidth>, <nHeight> Dimesiones de la zona cuadrángular. Puede definirse como
                    un cuadrado o como un rectángulo, en cuyo caso el
                    polígono se deforma para adaptarse a la superficie.

<nLados>            Número de lados del polígono regular.

<nGiro>             Cantidad de grados que deseamos girar el polígono con
                    respecto a la horizontal (en sentido horario).
                    Por defecto '0'.

<nPorCent>          Para dibujarlos en forma de estrella. Si vale 100 el
                    polígono se dibuja normal. Por defecto vale 100. Con otro
                    valor se dibuja en forma de estrella. Este valor indica
                    el porcentaje del radio interior con respecto al radio
                    exterior. Cuanto menor sea ese valor, mayor será el efecto
                    estrella, las puntas saldrán más estrechas y profundas.
                                                                                               */
 //---------------------------------------------------------------------------------------//

#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
 

[Antonio Linares]

Silvio,

Half star is just another painting mode of a star. So it is just another case of your do case in Method Paint().

[Silvio.Falconi]

yes but if I draw half star for sample left it erase the right of all stars and for that star

[Antonio Linares]

Silvio,

You paint the star with white background (o the color you want), then you paint half star on top of it with another color

[ukoenig]

I'm working on a different solution using 2 images :
It would be possible as well using a image, showing a quarter of an star.
Only 1 empty star-image is used.
The 2. star-image could have a different style.

Maybe still better, counting empty and full stars next to each other.
1 full empty star
1 half empty star
1 full colored star
1 half colored star



how it works :

3 images used :

1. I display the empty star-image with the calculated width ( 50 % )
2. I display the startpos. of the 2. star-image 75 % ( with the half star ) using the empty star-endpos.
3. I calculate the needed image-width of the used 2. image ( half star + 2 full stars. )



best regards
Uwe

[Silvio.Falconi]

Uew,
do you converte it on a class ( control ) ?

[ukoenig]

Silvio,

only the calculation for the moment.
Maybe You can include the logic inside Your class.

best regards
Uwe