/*-------------------------------------------------------------------------------------------------*/
/*incluye fichero cabezera de fivewin y otros*/
#include "fivewin.ch"
#include "constant.ch"
#include "wcolors.ch"
/*-------------------------------------------------------------------------------------------------*/
/*constantes*/
#define COLOR_WINDOW 5
#define COLOR_WINDOWTEXT 8
#define COLOR_BTNFACE 15
/*-------------------------------------------------------------------------------------------------*/
/*valores de colores para degradado*/
#define DARKBLUE nRGB( 003, 056, 147 )
#define DARKCYAN nRGB( 125, 165, 224 )
#define LIGHTBLUE nRGB( 089, 135, 214 )
#define LIGHTCYAN nRGB( 203, 225, 252 )
#define DARKORANGE1 nRGB( 238, 152, 025 )
#define DARKORANGE2 nRGB( 247, 192, 091 )
#define LIGHTORANGE1 nRGB( 250, 227, 143 )
#define LIGHTORANGE2 nRGB( 255, 255, 220 )
/*-------------------------------------------------------------------------------------------------*/
/*definicion de clase visual TMyTitle*/
CLASS TMyTitle FROM TControl
CLASSDATA lRegistered AS LOGICAL
/*datas*/
DATA cTitle
DATA nClrBegin
DATA nClrEnd
DATA lVertical
DATA lBorder
DATA lGlass
DATA oBitmap
DATA oFontTitle
DATA aRect
/*methods*/
METHOD New( oWnd, nTop, nLeft, nHeight, nWidth, cTitle, nClrFore, nClrBegin, nClrEnd, nStyle, oFontTitle, lVertical, lBorder, lGlass, cBitmap ) CONSTRUCTOR
METHOD ReDefine( nId, oWnd, cTitle, nClrFore, nClrBegin, nClrEnd, lVertical, lBorder, lGlass, cBitmap, oFontTitle ) CONSTRUCTOR
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD Paint()
METHOD EraseBkGnd( hDC ) INLINE 1
METHOD Default()
METHOD Initiate( hDlg )
METHOD CoorsUpdate()
METHOD SetBitmap( cBitmap )
METHOD SetTitle( cTitle )
METHOD SetFont( oFontTitle ) INLINE ( ::oFontTitle := oFontTitle )
METHOD End() INLINE IF( ::hWnd == 0, ::Destroy(), Super:End() )
METHOD Destroy()
ENDCLASS
/*-------------------------------------------------------------------------------------------------*/
/*metodo para crear un objeto ttitle*/
METHOD TMyTitle:New( oWnd, nTop, nLeft, nHeight, nWidth, cTitle, nClrFore, nClrBegin, nClrEnd, nStyle, oFontTitle, lVertical, lBorder, lGlass, cBitmap )
DEFAULT oWnd := GetWndDefault(),;
nStyle := nOr( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN ),;
nWidth := 100, nHeight := 50,;
cTitle := "TTitle Con Fivewin",;
nClrFore := GetSysColor(COLOR_BTNFACE), ;
nClrBegin := LIGHTBLUE,;
nClrEnd := DARKBLUE,;
lVertical := .F.,;
lBorder := .T.,;
lGlass := .F.
IF oFontTitle == NIL
DEFINE FONT oFontTitle NAME "TAHOMA" SIZE 0,-18 BOLD
ENDIF
::nId := ::GetNewId()
::oWnd := oWnd
::nStyle := nStyle
::nTop := nTop
::nLeft := nLeft
::nBottom := ::nTop + nHeight - 1
::nRight := ::nLeft + nWidth - 1
::oFontTitle := oFontTitle
::cTitle := cTitle
::nClrText := nClrFore
::nClrBegin := nClrBegin
::nClrEnd := nClrEnd
::lVertical := lVertical
::lBorder := lBorder
::lGlass := lGlass
IF !Empty( cBitmap )
::SetBitmap( cBitmap )
ENDIF
::Register( CS_VREDRAW, CS_HREDRAW )
IF !Empty( oWnd:hWnd )
::Create()
::Default()
oWnd:AddControl( Self )
ELSE
oWnd:DefControl( Self )
ENDIF
RETURN Self
/*-------------------------------------------------------------------------------------------------*/
/*metodo para redefinir clase*/
METHOD TMyTitle:ReDefine( nId, oWnd, cTitle, nClrFore, nClrBegin, nClrEnd, lVertical, lBorder, lGlass, cBitmap, oFontTitle )
DEFAULT oWnd := GetWndDefault(),;
cTitle := "Prueba de TTitle",;
nClrFore := GetSysColor(COLOR_BTNFACE), ;
nClrBegin := LIGHTBLUE,;
nClrEnd := DARKBLUE,;
lVertical := .F.,;
lBorder := .T.,;
lGlass := .F.
IF oFontTitle == NIL
DEFINE FONT oFontTitle NAME "TAHOMA" SIZE 0,-18 BOLD
ENDIF
::nId := nId
::cTitle := cTitle
::oWnd := oWnd
::hWnd := 0
::nStyle := nOr( WS_CHILD, WS_VISIBLE ) //, WS_CLIPCHILDREN )
::cTitle := cTitle
::nClrText := nClrFore
::nClrBegin := nClrBegin
::nClrEnd := nClrEnd
::lVertical := lVertical
::lBorder := lBorder
::lGlass := lGlass
::oFontTitle := oFontTitle
IF !Empty( cBitmap )
::SetBitmap( cBitmap )
ENDIF
::Register( CS_VREDRAW, CS_HREDRAW )
oWnd:DefControl( Self )
RETURN Self
/*-------------------------------------------------------------------------------------------------*/
/*m,etodo para cambiar el bitmap de ttitle*/
METHOD TMyTitle:SetBitmap( cBitmap )
/*si existe destruye el bitmap*/
IF ValType( ::oBitmap ) = "O" .and. ::oBitmap:hBitmap != 0
::oBitmap:destroy()
ENDIF
/*define bitmap*/
IF !Empty( cBitmap )
IF At( ".", cBitmap ) > 0
IF File( cBitmap )
DEFINE BITMAP ::oBitmap FILENAME cBitmap
ENDIF
ELSE
DEFINE BITMAP ::oBitmap RESOURCE cBitmap
ENDIF
ENDIF
RETURN NIL
/*-------------------------------------------------------------------------------------------------*/
METHOD TMyTitle:SetTitle( cTitle )
DEFAULT cTitle := "TTitle"
::cTitle := cTitle
::Refresh()
RETURN NIL
/*-------------------------------------------------------------------------------------------------*/
METHOD TMyTitle:Default()
::CoorsUpdate()
RETURN NIL
/*-------------------------------------------------------------------------------------------------*/
METHOD TMyTitle:Initiate( hDlg )
Super:Initiate( hDlg )
RETURN ::Default()
/*-------------------------------------------------------------------------------------------------*/
/*metodo para obtener coordenadas del control y pasarlo a data de la clase*/
METHOD TMyTitle:CoorsUpdate()
::aRect := GetClientRect( ::hWnd )
::nTop := ::aRect[1]
::nLeft := ::aRect[2]
::nBottom := ::aRect[3]
::nRight := ::aRect[4]
RETURN NIL
/*-------------------------------------------------------------------------------------------------*/
/*meotodo para pintado*/
METHOD TMyTitle:Paint()
LOCAL nTitTop := 0
LOCAL nTitLeft := 0
LOCAL aInfo := ::DispBegin()
/*dibuja recuadro degradado*/
IF !::lVertical
IF ::lGlass
GradientGlass( ::hDC, ::aRect, ::nClrBegin, ::nClrEnd )
ELSE
Gradient( ::hDC, { 0, 0, ::nBottom, ::nRight }, ::nClrBegin, ::nClrEnd, .T. )
ENDIF
ELSE
Gradient( ::hDC, { 0, 0, ::nBottom, ::nRight }, ::nClrBegin, ::nClrEnd, .F. )
ENDIF
/*dibuja bitmap */
IF ::oBitmap != nil .and. ! Empty( ::oBitmap:hBitmap )
IF ::oBitmap:lHasAlpha
ABPaint( ::hDC, 0, 0, ::oBitmap:hBitmap , 200 )
ELSE
DrawTransparent( ::hDC, ::oBitmap:hBitmap, 0, 0 )
ENDIF
nTitLeft := ::oBitmap:nWidth() + 10
ELSE
nTitLeft := 0
ENDIF
/*dibuja borde negro del recuadro*/
IF ::lBorder
aBox( ::hDC, { 0, 0, ::nBottom-1, ::nRight-1 } )
ENDIF
nTitTop := ( ::nHeight() / 2 ) - ( ::oFontTitle:nHeight() / 2 )
/*dibuja titulo*/
::Say( nTitTop, nTitLeft, ::cTitle, ::nClrText,, ::oFontTitle, .T., .T. )
::DispEnd( aInfo )
RETURN NIL
/*-------------------------------------------------------------------------------------------------*/
/*metodo para eliminar objeto*/
METHOD TMyTitle:Destroy()
/*elimina pbjeto bitmap*/
IF ::oBitmap:hBitmap != 0
::oBitmap:destroy()
ENDIF
/*elimina objeto font*/
IF ::oFontTitle:hFont != 0
::oFontTitle:end()
ENDIF
/*elimina objeto windows*/
IF ::hWnd != 0
Super:destroy()
ENDIF
RETURN NIL
/*-------------------------------------------------------------------------------------------------*/
/*metodo para pinta la caja negra en el contorno del control*/
STATIC FUNCTION ABox( hDC, aRect )
LOCAL nTop, nLeft, nBottom, nRight
/*pasa valores de arreglo a variables*/
nTop := aRect[ 1 ]
nLeft := aRect[ 2 ]
nBottom := aRect[ 3 ]
nRight := aRect[ 4 ]
/*se posiciona*/
MoveTo( hDC, nLeft, nTop )
/*dibuja borde de caja*/
LineTo( hDC, nRight, nTop )
LineTo( hDC, nRight, nBottom )
LineTo( hDC, nLeft, nBottom )
LineTo( hDC, nLeft, nTop )
RETURN NIL
/*-------------------------------------------------------------------------------------------------*/
/*metodo para pintado de color en degradado*/
STATIC FUNCTION GradientGlass( hDC, aRect, nClrBegin, nClrEnd )
LOCAL nTop, nLeft, nBottom, nRight
/*pasa valores de arreglo a variables*/
nTop := aRect[ 1 ]
nLeft := aRect[ 2 ]
nBottom := aRect[ 3 ]
nRight := aRect[ 4 ]
/*dibuja los colores con degradado*/
Gradient( hDC, { 0, 0, nBottom/2, nRight }, nClrBegin, CLR_BLACK, .T. )
Gradient( hDC, { nBottom/2, 0, nBottom , nRight }, CLR_BLACK, nClrBegin, .T. )
RETURN NIL
/*-------------------------------------------------------------------------------------------------*/
/*EOF*/
/*-------------------------------------------------------------------------------------------------*/