trating

trating

Postby Silvio.Falconi » Sun Feb 19, 2017 11:19 am

Last two year I build a class but now I lose that class

I have only a oldest test I made :
Code: Select all  Expand view

#include "Fivewin.ch"
#include "Image.ch"
#include "Constant.ch"

 STATIC count, pressed, aRate, nValue ,cRate
 STATIC Empty_Img,Full_Img,Half_Img,oSay1
 STATIC aClicked[5]
 STATIC img_name
 static aImages[5]


Function test()

  Local  nValore:= RatingBook("c:\work\fwh\bitmaps\007.bmp")


   Msginfo(nValore)

   return nil





Function RatingBook(cBook)
Local oDlg,oBook

Local oCursorBtn :=TCursor():New(,'HAND')
Local oFont,oReset
Local k

Local oBtnConfirm
Local img_name
Local  ncol := 60
Local  nRow := 140


       aRate:= {"10%","20%","30%","40%","50%",}
       pressed := 0

       count := 5

       Empty_Img:= ".\bitmaps\Emptyh.bmp"
       Full_Img:= ".\bitmaps\Fullh.bmp"
       Half_Img:=".\bitmaps\Halfh.bmp"
       nValue:= 0
       cRate := "0%"

       DEFINE FONT oFont NAME "Tahoma" SIZE 0, -12



define Dialog oDlg size 400,300  TITLE "Rating a Book"

@ 1,5 bitmap oBook filename cBook size 100,120 Noborder OF oDlg

@ nRow, 3 say "My Rating ("  SIZE 59, 10 OF oDlg  PIXEL
@ nRow, 55 say ")"  SIZE 2, 10 OF oDlg  PIXEL


        oReset := TUrlLink():New( nRow+0.2, 39, oDlg, .T., .F., oFont, "", "Reset" )
        oReset:SetColor(  oReset:nClrText, oDlg:nClrPane )
        oReset:nClrOver = CLR_RED
        oReset:bAction =  { || ( pressed := 5, Reset(pressed) ) }
        nCol:= 62



       @ nRow, nCol IMAGE aImages[1] SIZE 12, 12 OF oDlg  FILENAME Empty_Img PIXEL  NOBORDER  CURSOR oCursorBtn    ON CLICK ( pressed :=1,OnSelectRate(pressed,count,oSay1))
       nCol += 12
       @ nRow, nCol IMAGE aImages[2] SIZE 12, 12 OF oDlg  FILENAME Empty_Img PIXEL  NOBORDER  CURSOR oCursorBtn    ON CLICK ( pressed :=2,OnSelectRate(pressed,count,oSay1))
       nCol += 12
       @ nRow, nCol IMAGE aImages[3] SIZE 12, 12 OF oDlg  FILENAME Empty_Img PIXEL  NOBORDER  CURSOR oCursorBtn    ON CLICK ( pressed :=3,OnSelectRate(pressed,count,oSay1))
       nCol += 12
       @ nRow, nCol IMAGE aImages[4] SIZE 12, 12 OF oDlg  FILENAME Empty_Img PIXEL  NOBORDER  CURSOR oCursorBtn    ON CLICK ( pressed :=4,OnSelectRate(pressed,count,oSay1))
       nCol += 12
       @ nRow, nCol IMAGE aImages[5] SIZE 12, 12 OF oDlg  FILENAME Empty_Img PIXEL  NOBORDER  CURSOR oCursorBtn    ON CLICK ( pressed :=5,OnSelectRate(pressed,count,oSay1))


       @ nRow + 2, 135 SAY oSay1 PROMPT cRate OF oDlg SIZE 30, 12 COLOR CLR_RED PIXEL FONT oFont
                  oSay1:lTransparent := .T.


                      aImages[1]:bMMoved:= { ||( pressed :=1,OnHoverRate(pressed,count)) }
                      aImages[2]:bMMoved:= { ||( pressed :=2,OnHoverRate(pressed,count)) }
                      aImages[3]:bMMoved:= { ||( pressed :=3,OnHoverRate(pressed,count)) }
                      aImages[4]:bMMoved:= { ||( pressed :=4,OnHoverRate(pressed,count)) }
                      aImages[5]:bMMoved:= { ||( pressed :=5,OnHoverRate(pressed,count)) }

                      aImages[1]:bMLeave :={ ||( pressed :=1,OnLeaveRate(pressed,count)) }
                      aImages[2]:bMLeave :={ ||( pressed :=2,OnLeaveRate(pressed,count)) }
                      aImages[3]:bMLeave :={ ||( pressed :=3,OnLeaveRate(pressed,count)) }
                      aImages[4]:bMLeave :={ ||( pressed :=4,OnLeaveRate(pressed,count)) }
                      aImages[5]:bMLeave :={ ||( pressed :=5,OnLeaveRate(pressed,count)) }




      FOR k:=1 TO count
         * img_name := "Image_"+hb_ntos(k)
          aImages[k]:lTransparent := .T.
      NEXT


     @ 138, 160 button oBtnConfirm  Prompt "&Exit" SIZE 30, 10 OF oDlg PIXEL  action oDlg:end()


          Activate Dialog oDlg  center
          RETURN  nValue



//-------------------------------------------------------------//
Function OnHoverRate(select,count)
   Local j,nValuePressed
    Local img_name
Reset(count)

FOR j:=1 TO select
   *   img_name := "Image_"+hb_ntos(j)
   *  &img_name:LoadBmp(Full_Img)
       aImages[j]:LoadBmp(Full_Img)
  NEXT

   SetHalf(count,  select, aClicked )


   IF select >1
      nValue:=  select-1
   endif




     nValuePressed:= val(aRate[select])  -5
     cRate := str(nValuePressed,2)+"%"
     oSay1:Refresh()


Return Nil

//------------------------------------------------------//
Function OnLeaveRate(pressed,count)

   IF pressed == 0
      Reset(count)
   ELSE
      OnSelectRate(pressed,count)
   ENDIF

   Return Nil

//-------------------------------------------------------//
Function OnSelectRate(pressed,count,oSay1)
Local k
Local img_name

IF pressed > 0

   Reset(count)

      FOR k:=1 TO pressed
       *  img_name := "Image_"+hb_ntos(k)
       * &img_name:LoadBmp(Full_Img)
          aImages[k]:LoadBmp(Full_Img)
     NEXT

     SetHalf(count, pressed, aClicked )


   ENDIF



  nValue:=val (aRate[pressed] )
    cRate := str(nValue,2)+"%"
     oSay1:Refresh()
   Return Nil

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

Static Function Reset(count)
   Local x
    Local img_name
  //

   FOR x:=1 TO count
  *  img_name := "Image_"+hb_ntos(x)
  *  &img_name:LoadBmp(Empty_Img)

    aImages[x]:LoadBmp(Empty_Img)
   NEXT

   Return Nil

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

Function SetHalf(select, nPos, aClicked)
Local j
Local img_name
FOR j:=1 TO select
  * img_name := "Image_" + hb_ntos(j)
   IF j = nPos // the RIGHT clicked full star
      aClicked[nPos] := 2 // clicked-status for the half star, 1 = full
     * &img_name:LoadBmp( Half_Img )
      aImages[j]:LoadBmp( Half_Img )
   ENDIF

NEXT

Return Nil
//-----------------------------------------------------//

 

we have 3 bitmaps
full.bmp when the star is selected
empty.bmp when the star is not selected
half.bmp when the star is selected middle

the control show a text
My Rating (Reset) with 5 stars

reset is the urlink with command to erase the stars function Reset()

Image

Someone can help me to build thie class trating ?

I wish create a control as http://www.devcomponents.com/dotnetbar/ ... ntrol.aspx


trying to build the class..
Code: Select all  Expand view


#include "Fivewin.ch"


#define COLOR_BTNFACE   15




Function Test()
Local oDlg,oRating
Local oFont
Local Empty_Img:= "Empty.bmp"
Local Full_Img:= "Full.bmp"
Local Half_Img:="Half.bmp"


DEFINE FONT oFont NAME "Tahoma" SIZE 0, -12


Define Dialog oDlg Size 400,300 Title "Test Rating"

oRating:=TRating():New(10,10,110,20,oDlg,Full_Img,Empty_Img,Half_Img)
oRating:oFont:= oFont

Activate Dialog oDlg center
return nil


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

CLASS TRating  From Tcontrol

   CLASSDATA lRegistered AS LOGICAL

  DATA  Full_Img
  DATA  Empty_Img
  DATA  Half_Img
  DATA  aClicked
  DATA  aImages
  DATA  lBorder
  DATA  cCaption
  DATA  oFont
  DATA  nClrBorder
  DATA  nClrText
  DATA  nClrReset
  DATA  oReset
  DATA  nCount
  DATA  nPressed
  DATA  nValue
  DATA  cRate



METHOD New(nTop,nLeft,nWidth, nHeight,oWnd,Full_Img,Empty_Img,Half_Img) CONSTRUCTOR

METHOD SetHalf(select, nPos)
METHOD Reset(count)
METHOD OnSelectRate(pressed,count)
METHOD OnLeaveRate(pressed,count)
METHOD OnHoverRate(select,count)

METHOD Paint()
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD EraseBkGnd( hDC ) INLINE 1
METHOD PaintReset( aRect)
METHOD LoadImage( cImage )
    METHOD LButtonDown( nRow, nCol, nFlags )
    METHOD MouseMove  ( nRow, nCol, nFlags )
    METHOD LButtonUp  ( nRow, nCol, nFlags )
    METHOD MouseLeave( nRow, nCol, nFlags )

EndClass
//-------------------------------------------------------------------------------------------------//

   METHOD New(nTop,nLeft,nWidth, nHeight,oWnd,cFull_Img,cEmpty_Img,cHalf_Img,nClrBorder,nClrText,nClrPane,lPixel,cCaption,oFont,lBorder,nClrReset) CLASS TRating

   DEFAULT oWnd   := GetWndDefault()
   DEFAULT nClrBorder   := rgb(192, 192, 192)
   DEFAULT nClrText     := CLR_BLACK
   DEFAULT nClrPane     := GetSysColor( COLOR_BTNFACE )
   DEFAULT lPixel       := .T.
   DEFAULT cCaption     := "My Rating"
   DEFAULT lBorder      := .f.
   DEFAULT nClrReset    := CLR_RED

   ::nTop    = nTop
   ::nLeft   = nLeft
   ::nBottom = nHeight
   ::nRight  = nWidth
   ::oWnd    = oWnd

   ::cCaption   = cCaption


   ::nId  := ::GetNewId()
   ::nStyle  = nOr( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN )
   ::nClrPane = GetSysColor( COLOR_BTNFACE )

   ::SetColor( nClrText, nClrPane )



   ::nClrBorder = nClrBorder
   ::nClrReset  = nClrReset
   ::nClrText   = nClrText


   ::lBorder    = .t. // lBorder
   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   ::Full_Img  =  cFull_Img
   ::Empty_Img =  cEmpty_Img
   ::Half_Img  =  cHalf_Img

   ::aImages := array(5)



   if oWnd:lVisible
      ::Create()
      ::Default()
      ::lVisible = .t.
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
      ::lVisible  = .F.
   endif

   return self

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


METHOD PaintReset( aRect)   CLASS TRating
      Local  bAction := { || ( pressed := ::nCount, ::Reset(pressed) ) }
      Local nWidthCaption := 5 + GetTextWidth(::hDC, ::cCaption, ::oFont:hFont )

     ::oReset := TUrlLink():New( aRect[1]+2, aRect[2]+nWidthCaption+3, Self, .T., .F., ::oFont, "", "Reset" )  // ::cCaption
     ::oReset:SetColor( ::oReset:nClrText, ::oWnd:nClrPane )
     ::oReset:nClrOver = ::nClrReset
     ::oReset:bAction = bAction

     return 0

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

   METHOD Paint() CLASS TRating

   local aInfo := ::DispBegin()
   local aRect := GetClientRect(::hWnd)
   local hbrushBorder
   Local nWidthCaption  := 45 + GetTextWidth(::hDC, ::cCaption, ::oFont:hFont )
   Local  nRow := 10,nCol:= 120
   local hBmpEmpty := 0
   local nWBmpEmpty := 0
   local nHBmpEmpty := 0

    hBmpEmpty := ::LoadImage( ::Empty_Img )

if hBmpEmpty != 0
   nWBmpEmpty := nBmpWidth( hBmpEmpty )
   nHBmpEmpty := nBmpHeight( hBmpEmpty )
endif


FillSolidRect(::hDC, aRect, ::nClrPane )


     // show the border
     IF ::lBorder
        hBrushBorder      := CreateSolidBrush( ::nClrBorder )
        RoundRect( ::hDC, aRect[1], aRect[2], aRect[4], aRect[3]-1, 9, 9 )
        DeleteObject( hBrushBorder )
     Endif


     // show the Urlink
    SetTextColor (::hDC, ::nClrText)
    SetBkMode( ::hDC, 1 )
    SelectObject( ::hDC, ::oFont:hFont )
    DrawTextEx( ::hDC, ::cCaption+" ( ", {aRect[1]+2,aRect[2],aRect[3]+40,aRect[4]}, 0)
    ::PaintReset( aRect)
    DrawTextEx( ::hDC, ")", {aRect[1],aRect[2]+nWidthCaption-3,aRect[3],aRect[4]}, 0)

    nCol:= aRect[2]+nWidthCaption+8
    nRow := aRect[1]+1



    // show the stars

    FOR i = 1 TO 5
          ::aImages[i] := ::LoadImage( ::Empty_Img )
             DrawTransBmp( ::hDC, ::aImages[i], nRow, nCol, nWBmpEmpty,nHBmpEmpty )
             nCol += 16

                 *  ::aImages[i]:bRClicked := { || (npressed := 1, ::OnSelectRate(npressed,5) ) }
                 *  ::aImages[i]:bMMoved:= { ||( npressed := 1, ::OnHoverRate(npressed,5) ) }

       Next

   ::DispEnd( aInfo )

   return 0

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


  METHOD LoadImage( cImage )  CLASS TRating

  local hImage := 0

  hImage := LoadBitmap( GetResources(), cImage )

  if hImage == 0
    hImage := ReadBitmap( 0, cImage )
  endif

return (hImage)


//---------------------------------------------------------------------------------//
   METHOD OnSelectRate(pressed,count)  CLASS TRating
Local k
*Local img_name

IF pressed > 0

   ::Reset(count)

      FOR k:=1 TO pressed
          ::aImages[k]:LoadBmp(::Full_Img)
     NEXT

     ::SetHalf(count, pressed)


   ENDIF



 * nValue:=val (aRate[pressed] )
 *   cRate := str(nValue,2)+"%"
 *    oSay1:Refresh()
   Return Nil

//------------------------------------------------------------------------------------//
 METHOD Reset(count)  CLASS TRating
   Local x
  *  Local img_name
  //

   FOR x:=1 TO count
     ::aImages[x]:LoadBmp(::Empty_Img)
   NEXT

   Return Nil

 //--------------------------------------------------------------------------------//
    METHOD SetHalf(select, nPos)  CLASS TRating
Local j

FOR j:=1 TO select

   IF j = nPos // the RIGHT clicked full star
      ::aClicked[nPos] := 2 // clicked-status for the half star, 1 = full
      ::aImages[j]:LoadBmp( ::Half_Img )
   ENDIF

NEXT

Return Nil

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

 METHOD OnLeaveRate(pressed,count) CLASS TRating

   IF pressed == 0
      ::Reset(count)
   ELSE
      ::OnSelectRate(pressed,count)
   ENDIF

   Return Nil
//--------------------------------------------------------------------------------//

  METHOD OnHoverRate(select,count) CLASS TRating
   Local j

::Reset(count)

FOR j:=1 TO select

      ::aImages[j]:LoadBmp(::Full_Img)
  NEXT


  ::SetHalf(count,  select)

 /*  IF select >1
      nValue:=  select-1
   endif

     nValuePressed:= val(aRate[select])-5
     cRate := str(nValuePressed,2)+"%"
     oSay1:Refresh()
     */


     Return Nil



METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TRating

   return Super:LButtonDown( nRow, nCol, nFlags )
//--------------------------------------------------------------------------------//
METHOD MouseMove  ( nRow, nCol, nFlags ) CLASS TRating




 RETURN 0 // (Super:MouseMove( nRow, nCol, nKeyFlags ))
//--------------------------------------------------------------------------------//
METHOD LButtonUp  ( nRow, nCol, nFlags ) CLASS TRating

   return 0
//--------------------------------------------------------------------------------//

METHOD MouseLeave( nRow, nCol, nFlags )    CLASS TRating

    return 0
















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

  static function DrawTransBmp( hDC, hBmp, nRow, nCol, nWidth, nHeight )

   local hDCMem, hBmpOld, nOldClr, nZeroZeroClr

   DEFAULT nWidth := nBmpWidth( hBmp ), nHeight := nBmpHeight( hBmp )

   hDCMem = CreateCompatibleDC( hDC )

   // we can not get nZeroZeroClr from hDC is possible hDC are locked by other SelectObject
   // An application cannot select a bitmap into more than one device context at a time.
   hBmpOld      = SelectObject( hDCMem, hBmp )
   nZeroZeroClr = GetPixel( hDCMem, 0, 0 )

   SelectObject( hDCMem, hBmpOld )
   DeleteDC( hDCMem )

   nOldClr = SetBkColor( hDC, nRGB( 255, 255, 255 ) )
   TransBmp( hBmp, nBmpWidth( hBmp ), nBmpHeight( hBmp ), nZeroZeroClr, hDC, ;
             nCol, nRow, nWidth, nHeight )
   SetBkColor( hDC, nOldClr )

return nil

 
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 6716
Joined: Thu Oct 18, 2012 7:17 pm

Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot], nageswaragunupudi and 11 guests