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()
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
