Dear Daniel,
would you be so kind to help me to get a windows 8 like YES/NO button.
I thought maybe we could adopt your selector class.
Thanks in advance
Otto
@ 260, 40 SELEX oSelex VAR nOption SIZE 40, 15 OF oDlgChild PIXEL ;
GRADIENT OUTTRACK { { 0.5, 16770250, 16312263 }, ;
{ 0.5, 16312263, 16770250 } } ;
GRADIENT INTRACK { { 1, 1789, 1789 } } ;
ITEMS "", "" ;
THUMBSIZE 15, 26 ROUNDSIZE 5 ;
COLOR THUMB 16770250
@ 260, 100 BUTTON "No" ACTION ( oSelex:SetOption( 1 ), ;
oSelex:aGradIn := { { 1, 1789, 1789 } }, ;
oSelex:Refresh() ) SIZE 20, 20 PIXEL FONT oFont
@ 260, 125 BUTTON "Yes" ACTION ( oSelex:SetOption( 2 ), ;
oSelex:aGradIn := { { 1, 2143051, 2143051 } }, ;
oSelex:Refresh() ) SIZE 20, 20 PIXEL FONT oFont
#include "FiveWin.ch"
#include "xbrowse.ch"
#include "tselex.ch"
#include "constant.ch"
static oSay
function Main()
local oWnd, oFont, oBrw, oFont2, oFont3, oFont4, oFont5
local aItems := { "Personalize", "Users", "Wireless", "Notifications", "Privacy", "General", "Search" }
local oSelex
local nOption1 := 2
local cSay := "On"
local oChk
local lChk := .t.
DEFINE FONT oFont NAME "Segoe UI Light" SIZE 0, -52
DEFINE FONT oFont2 NAME "Segoe UI Light" SIZE 0, -32
DEFINE FONT oFont3 NAME "Segoe UI Light" SIZE 0, -16
DEFINE FONT oFont4 NAME "Segoe UI Light" SIZE 0, -18
DEFINE FONT oFont5 NAME "Segoe UI Light" SIZE 0, -18 BOLD
DEFINE WINDOW oWnd STYLE nOr( WS_POPUP, WS_VISIBLE ) ;
COLOR RGB( 170, 170, 170 ), CLR_WHITE
@ 2, 10 SAY "Chefzahlen" FONT oFont SIZE 300, 100
@ 2, 80 SAY "Personalize" FONT oFont SIZE 300, 100
@ 9, 7 XBROWSE oBrw ARRAY aItems COLSIZES 800 CELL ;
FONT oFont2 SIZE 400, 700 NOBORDER OF oWnd
oBrw:nDataLines = 2
oBrw:lRecordSelector = .F.
oBrw:lHeader = .F.
oBrw:lHScroll = .F.
oBrw:lVScroll = .t.
oBrw:nStretchCol = 1
oBrw:bClrStd = { || { CLR_BLACK, CLR_WHITE } }
oBrw:bClrSel := ;
oBrw:bClrSelFocus := { || { CLR_WHITE, RGB( 34, 177, 76 ) } }
oBrw:SetColor( "B/W*" )
oBrw:CreateFromCode()
oBrw:aCols[ 1 ]:bPaintText = { | oCol, hDC, cText, aCoors, aColors, lHighlight | DrawRow( oCol, hDC, cText, aCoors, oFont3 ) }
oBrw:SetFocus()
@ 140, 500 SAY "Play notification sounds" FONT oFont4 PIXEL SIZE 500, 100
@ 170, 500 SAY oSay PROMPT cSay FONT oFont5 PIXEL SIZE 300, 100
@ 170, 850 SELEX oSelex VAR nOption1 OF oWnd PIXEL SIZE 60, 36;
ITEMS " ", " ";
THUMBSIZE 30, 30 ROUNDSIZE 0 ;
ACTION ChangeYesNo( oSelex )
@ 300, 500 CHECKBOX oChk VAR lChk PROMPT "Show app notifications old Windows 7 style";
PIXEL SIZE 350, 20 OF oWnd
oChk:SetFont( oFont4 )
ACTIVATE WINDOW oWNd MAXIMIZED ;
ON CLICK oWnd:End()
return nil
FUNCTION ChangeYesNo( oSelex )
if oSelex:nOption = 2
oSay:SetText("On")
else
oSay:SetText("Off")
endif
return nil
//----------------------------------------------------------------------------//
function DrawRow( oCol, hDC, cText, aCoors, oFont )
local hOldFont
local aItems := { "Customize your lock screen and user tile",;
"Change your account or add new ones",;
"Turn wireless and airplane mode on or off",;
"Choose if apps notify you",;
"Control how apps use your personal info",;
"Change time zone and keyboard settings",;
"Pick what/where you want to search" }
DrawText( hDC, cText, aCoors )
aCoors[ 1 ] += 45
hOldFont = SelectObject( hDC, oFont:hFont )
DrawText( hDC, aItems[ oCol:oBrw:KeyNo ], aCoors )
SelectObject( hDC, hOldFont )
return nil
//-Klasse---------------------------------------------------------------------------//
#define DT_VCENTER 4
#define DEFAULT_GUI_FONT 17
#define COLOR_3DHIGHLIGHT 20
#define COLOR_3DSHADOW 16
#define TME_LEAVE 2
#define WM_MOUSELEAVE 675
#define RECHTS 2
#define LINKS 4
CLASS TSelex FROM TControl
CLASSDATA lRegistered AS LOGICAL
DATA aOptions // Array with options text
DATA aGradOut // Gradient of outside area track
DATA aGradIn // Gradient of inside area track
DATA bOnSelect // Codebock for launch action for option selected
DATA bOption // Option selected (bSETGET)
DATA nClrThumb // Thumb color
DATA nClrOptSel // Color option selected
DATA nColDown // Use Internally to check event "Mouse Down"
DATA nClrBoxIn // Color internal border to 3d effect
DATA nClrBoxOut // Color external border to 3d effect
DATA nRound // Round corner size
DATA nWidthThumb // Thumb width
DATA nHeightThumb // Thumb Height
DATA nOffSetCol // Use internally
DATA nOption
DATA nOldOption
DATA nTitleHeight
DATA lCaptured // Use internally
DATA nPosition
METHOD New()
METHOD Redefine()
METHOD Default()
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD EraseBkGnd( hDC ) INLINE 0
METHOD GoNext()
METHOD GoPrev()
METHOD HandleEvent( nMsg, nWParam, nLParam )
METHOD Initiate( hDlg )
METHOD KeyDown( nKey, nFlags )
METHOD Line( hDC, nTop, nLeft, nBottom, nRight, nColor )
METHOD LButtonDown( nRow, nCol )
METHOD LButtonUp( nRow, nCol )
METHOD MouseLeave( nRow, nCol, nFlags )
METHOD MouseMove( nRow, nCol )
METHOD Paint()
METHOD ProcessOption() HIDDEN
METHOD SetOption( nOpt )
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, lPixel, aOptions, bOnSelect, ;
lUpdate, aGradOut, aGradIn, nClrBoxIn, nClrBoxOut, nClrThumb, ;
nClrText, bOption, nClrOptSel,;
nWidthThumb, nHeightThumb, nRound ) CLASS TSelex
local hRgnWnd, aFontInfo, nOpt := 1
DEFAULT nTop := 10,;
nLeft := 10,;
nWidth := 200,;
nHeight := 40,;
oWnd := GetWndDefault(),;
aOptions := { {"&One", "&Two", "T&hree", "&Four"} },;
aGradOut := { { 1, CLR_BLACK, CLR_BLACK } },;
aGradIn := { { 1, nRGB( 195, 195, 195 ), nRGB( 195, 195, 195 ) } },;
nClrThumb := nRGB( 45, 70, 200 ),;
nClrText := GetSysColor( COLOR_3DHIGHLIGHT ),;
nClrOptSel := nRGB( 240, 240, 0 ),;
nClrBoxIn := nRGB( 142, 142, 142 ),;
nClrBoxOut := nRGB( 65, 65, 65 ),;
bOption := bSETGET( nOpt ),;
nRound := 0,;
nWidthThumb := 21,;
nHeightThumb := 55,;
lPixel := .F.,;
bOnSelect := {|| NIL }
::nTop = If( lPixel, nTop, nTop * SAY_CHARPIX_H )
::nLeft = If( lPixel, nLeft, nLeft * SAY_CHARPIX_W )
::nBottom = nTop + nHeight - 19
::nRight = nLeft + nWidth - 1
::oWnd = oWnd
::nId = ::GetNewId()
::lDrag = .F.
::aGradOut = aGradOut
::aGradIn = aGradIn
::aOptions = CheckArray( aOptions )
::nClrThumb = nClrThumb
::nClrText = nClrText
::nClrOptSel = nClrOptSel
::nStyle = nOR( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN, WS_TABSTOP )
::nClrBoxIn = nClrBoxIn
::nClrBoxOut = nClrBoxOut
::nOption = Eval( bOption )
::bOption = bOption
::nOldOption = ::nOption
::bOnSelect = bOnSelect
::nOffSetCol = 0
::nRound = nRound
::nWidthThumb = nWidthThumb
::nHeightThumb = nHeightThumb
::lCaptured = .F.
::Register()
if ! Empty( oWnd:hWnd )
::Create()
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
endif
if ::hWnd != NIL
// hRgnWnd := CreateRoundRectRgn( GetClientRect( ::hWnd ), ::nRound, ::nRound )
hRgnWnd := CreateRoundRectRgn( GetClientRect( ::hWnd ), 0, 0 )
SetWindowRgn( ::hWnd, hRgnWnd )
DeleteObject( hRgnWnd )
endif
RETURN Self
//----------------------------------------------------------------------------//
METHOD Redefine( nID, oWnd, aOptions, bOnSelect, ;
lUpdate, aGradOut, aGradIn, nClrBoxIn, nClrBoxOut, nClrThumb, ;
nClrText, bOption, nClrOptSel,;
nWidthThumb, nHeightThumb, nRound ) CLASS TSelex
local aFontInfo, nOpt := 1
DEFAULT oWnd := GetWndDefault(),;
aOptions := { {"&One", "&Two", "T&hree", "&Four"} },;
aGradOut := { { 1/2 , nRGB( 195, 195, 195 ), nRGB( 195, 195, 195 ) },;
{ 1/2 , nRGB( 195, 195, 195 ), nRGB( 195, 195, 195 ) } },;
aGradIn := { { 1, nRGB( 195, 195, 195 ), nRGB( 195, 195, 195 ) } },;
nClrThumb := nRGB(45, 70, 200 ),;
nClrText := GetSysColor( COLOR_3DHIGHLIGHT ),;
nClrOptSel := nRGB( 240, 240, 0 ),;
nClrBoxIn := nRGB( 142, 142, 142 ),;
nClrBoxOut := nRGB( 65, 65, 65 ),;
bOption := bSETGET( nOpt ),;
nRound := 0,;
nWidthThumb := 21,;
nHeightThumb := 25,;
bOnSelect := {|| NIL }
::oWnd = oWnd
::nID = nID
::lDrag = .F.
::aGradOut = aGradOut
::aGradIn = aGradIn
::aOptions = CheckArray( aOptions )
::nClrThumb = nClrThumb
::nClrText = nClrText
::nClrOptSel = nClrOptSel
::nStyle = nOR( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN, WS_TABSTOP )
::nClrBoxIn = nClrBoxIn
::nClrBoxOut = nClrBoxOut
::nOption = Eval( bOption )
::bOption = bOption
::nOldOption = ::nOption
::bOnSelect = bOnSelect
::nDlgCode = DLGC_WANTALLKEYS
::nOffSetCol = 0
::nRound = 0// nRound
::nWidthThumb = nWidthThumb
::nHeightThumb = nHeightThumb
::lCaptured = .F.
#ifdef __XPP__
DEFAULT ::lRegistered := .f.
#endif
::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )
if oWnd != nil
oWnd:DefControl( Self )
endif
RETURN Self
//----------------------------------------------------------------------------//
METHOD Default() CLASS TSelex
local hOld
if ValType( Eval( ::bOption ) ) == "U"
::nOption = 1
Eval( ::bOption, ::nOption )
endif
::GetDC()
return nil
//----------------------------------------------------------------------------//
METHOD GoNext( lRefresh ) CLASS TSelex
local nOld := ::nOption
DEFAULT lRefresh := .T.
::nOption := Min( ++::nOption, Len( ::aOptions ) )
Eval( ::bOption, ::nOption )
if lRefresh
Eval( ::bOnSelect, ::nOption, nOld )
::Refresh()
endif
return nil
//----------------------------------------------------------------------------//
METHOD GoPrev( lRefresh ) CLASS TSelex
local nOld := ::nOption
DEFAULT lRefresh := .T.
::nOption := Max( --::nOption, 1 )
Eval( ::bOption, ::nOption )
if lRefresh
Eval( ::bOnSelect, ::nOption, nOld )
::Refresh()
endif
return nil
//----------------------------------------------------------------------------//
METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TSelex
do case
case nMsg == WM_MOUSELEAVE
return ::MouseLeave( nHiWord( nLParam ), nLoWord( nLParam ), nWParam )
endcase
return Super:HandleEvent( nMsg, nWParam, nLParam )
//----------------------------------------------------------------------------//
METHOD Initiate( hDlg ) CLASS TSelex
LOCAL aRect, hRgnWnd
Super:Initiate( hDlg )
aRect := GetClientRect( ::hWnd )
hRgnWnd := CreateRectRgn( aRect)
SetWindowRgn( ::hWnd, hRgnWnd )
DeleteObject( hRgnWnd )
::Default()
RETURN NIL
//----------------------------------------------------------------------------//
METHOD KeyDown( nKey, nFlags ) CLASS TSelex
do case
case nKey == VK_UP .or. nKey == VK_LEFT
::GoPrev()
case nKey == VK_DOWN .or. nKey == VK_RIGHT
::GoNext()
endcase
return Super:KeyDown( nKey, nFlags )
//----------------------------------------------------------------------------//
METHOD LButtonDown( nRow, nCol ) CLASS TSelex
local aRect := GetClientRect( ::hWnd )
local nAdj := 5
local aRectIn := Array( 4 )
local nTrackWidth
local nTotOption := Len( ::aOptions )
local nBlockWidth
local nModBlock
local nLeftPos
aRectIn[ 1 ] = aRect[ 1 ] + nAdj
aRectIn[ RECHTS ] = aRect[ RECHTS ] + nAdj
aRectIn[ 3 ] = ::nHeightThumb
aRectIn[ LINKS ] = aRect[ LINKS ] - nAdj
nTrackWidth := aRectIn[ LINKS ] - aRectIn[ RECHTS ]
nBlockWidth := Int( nTrackWidth / nTotOption )
nModBlock := nTrackWidth % nTotOption
nLeftPos := aRectIn[ RECHTS ] + ( ( nBlockWidth * ( ::nOption - 1 ) ) + ( nBlockWidth / 2 ) ) ;
- ::nWidthThumb / 2 + If( ::nOption == nTotOption, nModBlock, 0 )
::SetFocus()
if nCol > nLeftPos .and. nCol < nLeftPos + ::nWidthThumb .and.;
nRow > aRectIn[ 1 ] .and. nRow < aRectIn[ 3 ]
::lCaptured = .T.
::nColDown = nCol
::nOffSetCol = nLeftPos
::nOldOption = ::nOption
else //elseif nRow > aRectIn[ 3 ]
::SetOption( Min( Int( nCol / nBlockWidth ) + 1, nTotOption ) )
endif
RETURN nil
//----------------------------------------------------------------------------//
METHOD LButtonUp( nRow, nCol ) CLASS TSelex
::ProcessOption()
RETURN Super:LButtonUp( nRow, nCol )
//----------------------------------------------------------------------------//
METHOD MouseLeave( nRow, nCol, nFlags ) CLASS TSelex
::ProcessOption()
return nil
//----------------------------------------------------------------------------//
METHOD MouseMove( nRow, nCol ) CLASS TSelex
local nTemp
local nNextOpt
local nPrevOpt
local nTotOption
local nBlockWidth
local nModBlock
local nTrackWidth
if ::lCaptured
nTrackWidth := ::nWidth - 10
nTotOption := Len( ::aOptions )
nBlockWidth := Int( nTrackWidth / nTotOption )
nModBlock := nTrackWidth % nTotOption
if ::nOption > 1
nPrevOpt = 5 + ( ( nBlockWidth * ( ::nOption - 2 ) ) + ( nBlockWidth / 2 ) ) - ::nWidthThumb / 2
if ::nOption < nTotOption
nNextOpt = 5 + ( ( nBlockWidth * ( ::nOption ) ) + ( nBlockWidth / 2 ) ) - ::nWidthThumb / 2
else
nNextOpt = 5 + ( ( nBlockWidth * ( ::nOption - 1 ) ) + ( nBlockWidth / 2 ) ) ;
- ::nWidthThumb / 2 + If( ::nOption == nTotOption, nModBlock, 0 )
endif
else
nPrevOpt = 5 + ( ( nBlockWidth * ( ::nOption - 1 ) ) + ( nBlockWidth / 2 ) ) - ::nWidthThumb / 2
nNextOpt = 5 + ( ( nBlockWidth * ( ::nOption ) ) + ( nBlockWidth / 2 ) ) - ::nWidthThumb / 2
endif
nTemp = ::nOffSetCol
nTemp += nCol - ::nColDown
if nTemp > 5
if nTemp > ::nWidth - ::nWidthThumb - 5
nTemp = ::nWidth - ::nWidthThumb - 5
Endif
if nTemp > nNextOpt - ::nWidthThumb / 2
::GoNext( .F. )
elseif nTemp < nPrevOpt + ::nWidthThumb / 2
::GoPrev( .F. )
endif
else
nTemp = 5
endif
::nOffSetCol = nTemp
::nColDown = nCol
::Refresh()
endif
TrackMouseEvent( ::hWnd, TME_LEAVE )
RETURN Super:MouseMove( nRow, nCol )
//----------------------------------------------------------------------------//
METHOD Line( hDC, nTop, nLeft, nBottom, nRight, nColor ) CLASS TSelex
local hPen, hOldPen
hPen = CreatePen( PS_SOLID, 1, nColor )
hOldPen = SelectObject( hDC, hPen )
MoveTo( hDC, nLeft, nTop )
LineTo( hDC, nRight, nBottom )
SelectObject( hDC, hOldPen )
DeleteObject( hPen )
return nil
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TSelex
local aInfo := ::DispBegin()
local aRect := GetClientRect( ::hWnd )
local hDC := ::hDC
local nAdj := 5
// local hBrushIn := GradientBrush( hDC, 0, 0, aRect[ LINKS ] - nAdj, aRect[ 3 ] - nAdj, ::aGradIn, .F. )
local hBrushSel := CreateSolidBrush( ::nClrThumb )
local hOld, nOldClr
local nRound := ::nRound
local aRectIn := Array( 4 )
local nTrackWidth
local nTotOption := Len( ::aOptions )
local nBlockWidth
local nModBlock
local n, nOffset, nTopText, nBottomText
local nBckColor := GetSysColor( COLOR_3DSHADOW )
local aRectTh := Array( 4 ), nMidThumb
local aGrdBack := { { 1, CLR_GREEN, CLR_GREEN } }
aRectIn[ 1 ] = aRect[ 1 ] + nAdj
aRectIn[ RECHTS ] = aRect[ RECHTS ] + nAdj
aRectIn[ 3 ] = ::nHeightThumb
aRectIn[ LINKS ] = aRect[ LINKS ] - nAdj
nTrackWidth := aRectIn[ LINKS ] - aRectIn[ RECHTS ]
nBlockWidth := Int( nTrackWidth / nTotOption )
nModBlock := nTrackWidth % nTotOption
if ::nOffSetCol > 0
aRectTh[ RECHTS ] = ::nOffSetCol
aRectTh[ LINKS ] = ::nOffSetCol + ::nWidthThumb
else
aRectTh[ RECHTS ] := aRectIn[ RECHTS ] + ( ( nBlockWidth * ( ::nOption - 1 ) ) + ( nBlockWidth / 2 ) ) ;
- ::nWidthThumb / 2 + If( ::nOption == nTotOption, ( nModBlock + 10 ), -10 )
aRectTh[ LINKS ] := aRectTh[ RECHTS ] + ::nWidthThumb
endif
aRectTh[ 1 ] = aRectIn[ 1 ] + 2
aRectTh[ 3 ] = aRectIn[ 3 ] - 2
if ::nOption = 2
GradientFill( hDC, aRect[ 1 ]+3, aRect[ RECHTS ]+3, aRect[ 3 ]-3, aRect[ LINKS ]-3, aGrdBack )
else
GradientFill( hDC, aRect[ 1 ]+3, aRect[ RECHTS ]+3, aRect[ 3 ]-3, aRect[ LINKS ]-3, ::aGradIn )
endif
SelectObject( hDC, hOld )
//Paint thumb
hOld = SelectObject( hDC, hBrushSel )
// oben rechts unten links
GradientFill( hDC, aRectTh[ 1 ] - 5, aRectTh[ RECHTS ] , aRectTh[ 3 ] + 5 , aRectTh[ 4], ::aGradOut )
// WndBox2007( hDC, aRectTh[ 1 ] - 5, aRectTh[ RECHTS ] , aRectTh[ 3 ], aRectTh[ 4] )
SelectObject( hDC, hOld )
::DispEnd( aInfo )
return 0
//----------------------------------------------------------------------------//
METHOD ProcessOption() CLASS TSelex
local nOldOption := ::nOldOption
::lCaptured = .F.
::nColDown = 0
::nOffSetCol = 0
if ::nOption != nOldOption
::nOldOption = ::nOption
Eval( ::bOnSelect, ::nOption, nOldOption )
endif
::Refresh()
RETURN nil
//----------------------------------------------------------------------------//
METHod SetOption( nOption ) CLASS TSelex
local nOldOpt := ::nOption
if nOption != nOldOpt
::nOption = nOption
::ProcessOption()
Eval( ::bOption, ::nOption )
endif
RETURN nOldOpt
//----------------------------------------------------------------------------//
static function CheckArray( aArray )
if ValType( aArray ) == 'A' .and. ;
Len( aArray ) == 1 .and. ;
ValType( aArray[ 1 ] ) == 'A'
aArray := aArray[ 1 ]
endif
return aArray
//----------------------------------------------------------------------------//
nageswaragunupudi wrote:Mr Otto
New control is included in FWH 11.10
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: cmsoft, Google [Bot] and 73 guests