Antonio Linares wrote:Francisco,
Por favor publica los cambios que has hecho aqui para que los pueda usar quien quiera. Pero por favor no publiques todo el código fuente de esas clases, sólo los cambios. Gracias,
[/img]
Para personalizar colores en Barra de Botones: (FWH 7.12)
CLASS TBar FROM TControl
DATA nGroups, nMode
DATA nBtnWidth, nBtnHeight
DATA l3D, l2007
DATA nRGB1, nRGB2 //FranciscoA: Agosto 31/2008
CLASSDATA lRegistered AS LOGICAL
/*
METHOD New( oWnd, nBtnWidth, nBtnHeight, l3D, cMode, oCursor, l2007 ) CONSTRUCTOR
METHOD NewAt( nRow, nCol, nWidth, nHeight, nBtnWidth, nBtnHeight, oWnd,;
l3D, cMode, oCursor ) CONSTRUCTOR
*/
//FranciscoA: Agosto 31/2008
METHOD New( oWnd, nBtnWidth, nBtnHeight, l3D, cMode, oCursor, l2007, nRGB1, nRGB2) CONSTRUCTOR
METHOD NewAt( nRow, nCol, nWidth, nHeight, nBtnWidth, nBtnHeight, oWnd,;
l3D, cMode, oCursor, nRGB1, nRGB2 ) CONSTRUCTOR
//-------------------------------------------------------------------------
//METHOD New( oWnd, nBtnWidth, nBtnHeight, l3D, cMode, oCursor, l2007 ) CLASS TBar
//FranciscoA: Agosto 31/2008
METHOD New( oWnd, nBtnWidth, nBtnHeight, l3D, cMode, oCursor, l2007, nRGB1, nRGB2) CLASS TBar
local oRect := oWnd:GetCliRect()
/*
DEFAULT nBtnWidth := BAR_HEIGHT, nBtnHeight := BAR_HEIGHT,;
l3D := .f., cMode := "TOP", l2007 := .F.
*/
//FranciscoA: Agosto 31/2008
DEFAULT nBtnWidth := BAR_HEIGHT, nBtnHeight := BAR_HEIGHT,;
l3D := .f., cMode := "TOP", l2007 := .F., nRGB1:=NIL, nRGB2:=NIL
::nStyle = nOR( WS_BORDER, WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN )
::aControls = {}
::nGroups = 0
::oWnd = oWnd
::nTop = If( cMode == "BOTTOM", oRect:nBottom - nBtnHeight, -1 )
::nLeft = If( cMode == "RIGHT", oRect:nRight - nBtnWidth - ;
If( l3D, 3, 0 ), -1 )
::nBottom = If( cMode == "TOP", nBtnHeight, oRect:nBottom + 1 )
::nRight = If( cMode == "TOP" .or. cMode == "BOTTOM",;
oRect:nRight,;
If( cMode == "LEFT", nBtnWidth + If( l3D, 3, 0 ), oRect:nRight + 1 ) )
::nBtnWidth = nBtnWidth
::nBtnHeight = nBtnHeight
::nId = ::GetNewId()
::lDrag = .f.
::lCaptured = .f.
::nClrPane = If( l3D, GetSysColor( COLOR_BTNFACE ), CLR_GRAY )
::lVisible = .t.
::l3D = l3D
::nMode = AScan( { "TOP", "LEFT", "RIGHT", "BOTTOM", "FLOAT" }, cMode )
::oCursor = oCursor
::lValidating = .f.
::l2007 = l2007
//FranciscoA: Agosto 31/2008
::nRGB1 = nRGB1
::nRGB2 = nRGB2
//----------------------------------------------------------------------------//
//METHOD NewAt( nRow, nCol, nWidth, nHeight, nBtnWidth, nBtnHeight, oWnd, l3D,;
// cMode, oCursor ) CLASS TBar
//FranciscoA: Agosto 31/2008
METHOD NewAt( nRow, nCol, nWidth, nHeight, nBtnWidth, nBtnHeight, oWnd,;
l3D, cMode, oCursor, nRGB1, nRGB2 ) CLASS TBar
local oRect := oWnd:GetCliRect()
/*
DEFAULT nBtnWidth := BAR_HEIGHT, nBtnHeight := BAR_HEIGHT,;
nHeight := BAR_HEIGHT,;
l3D := .f., cMode := "TOP"
*/
//FranciscoA: Agosto 31/2008
DEFAULT nBtnWidth := BAR_HEIGHT, nBtnHeight := BAR_HEIGHT,;
nHeight := BAR_HEIGHT,;
l3D := .f., cMode := "TOP", nRGB1:=NIL, nRGB2:=NIL
::nStyle = nOR( WS_BORDER, WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN )
::aControls = {}
::nGroups = 0
::oWnd = oWnd
::nTop = nRow
::nLeft = nCol
::nBottom = nRow + nHeight - 1
::nRight = nCol + nWidth - 1
::nBtnWidth = nBtnWidth
::nBtnHeight = nBtnHeight
::nId = ::GetNewId()
::lDrag = .f.
::lCaptured = .f.
::nClrPane = If( l3D, GetSysColor( COLOR_BTNFACE ), CLR_GRAY )
::lVisible = .t.
::l3D = l3D
::nMode = AScan( { "TOP", "LEFT", "RIGHT", "BOTTOM", "FLOAT" }, cMode )
::oCursor = oCursor
::lValidating = .f.
::l2007 = .t. //.f. //FranciscoA
//FranciscoA: Agosto 31/2008
::nRGB1 = nRGB1
::nRGB2 = nRGB2
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TBar
local hOldPen, n := 1
local hDarkPen, hLightPen
local oCtrl
local aInfo := ::DispBegin()
/*
if ::l2007
Gradient( ::hDC, { 0, 0, ::nHeight / 4, ::nWidth },;
nRGB( 219, 230, 244 ), nRGB( 207, 221, 239 ), .T. )
Gradient( ::hDC, { ( ::nHeight / 4 ) + 1, 0, ::nHeight, ::nWidth },;
nRGB( 201, 217, 237 ), nRGB( 231, 242, 255 ), .T. )
*/
//FranciscoA: Agosto 31/2008
//l2007 indica degradar. Si no se indican colores personalizados, por defecto toma el celeste de estilo office 2007
if ::l2007
if ::nRGB1 == NIL .or. ::nRGB2 == NIL //si no escogimos los colores ...
Gradient( ::hDC, { 0, 0, ::nHeight / 4, ::nWidth },;
nRGB( 219, 230, 244 ), nRGB( 207, 221, 239 ), .T. )
Gradient( ::hDC, { ( ::nHeight / 4 ) + 1, 0, ::nHeight, ::nWidth },;
nRGB( 201, 217, 237 ), nRGB( 231, 242, 255 ), .T. )
else //colores personalizados
Gradient( ::hDC, { 0, 0, ::nHeight, ::nWidth },;
::nRGB1, ::nRGB2, .T. )
endif
//00000000000000000000000000000000000000000000000000000000000
Para los colores de la Barra de Mensages:
//-------------------COLOR BARRA DE MENSAJES (Esta funcion es llamada desde la classe TMsgBar() )
Function ClrMsgBar()
Return {nRGB(255,228,150),nRGB(167,128,0)}
//------------------------------------------------------------------------//
METHOD Paint() CLASS TMsgBar
local aInfo := ::DispBegin()
local aColors :=ClrMsgBar()
/*
local hDCMem, hOldBmp
static hBmp
if hBmp == nil .and. ::l2007
hBmp = MsgBar2007( ::hDC )
endif
*/
if ::l2007
* Gradient( ::hDC, { 0, 0, ::nHeight / 4, ::nWidth },;
* nRGB( 219, 230, 244 ), nRGB( 207, 221, 239 ), .T. )
* Gradient( ::hDC, { ( ::nHeight / 4 ) + 1, 0, ::nHeight, ::nWidth },;
* nRGB( 201, 217, 237 ), nRGB( 231, 242, 255 ), .T. )
Gradient( ::hDC, { 0, 0, ::nHeight, ::nWidth },;
aColors[1],aColors[2], .T. ) // nRGB(255,228,100),nRGB(167,128,0), .T. )
/*
hDCMem = CreateCompatibleDC( ::hDC )
hOldBmp = SelectObject( hDCMem, hBmp )
StretchBlt( ::hDC, 0, 0, ::nWidth, ::nHeight, hDCMem, 0, 0, nBmpWidth( hBmp ), nBmpHeight( hBmp ), SRCCOPY )
SelectObject( hDCMem, hOldBmp )
DeleteDC( hDCMem )
*/
::Say( ::nHeight / 4 - 2,;
If( ::lCentered, ( ::nWidth / 2 ) - ( GetTextWidth( ::hDC,;
If( Empty( ::cMsg ), ::cMsgDef, ::cMsg ),;
::oWnd:oFont:hFont ) / 2 ), 4 ), If( Empty( ::cMsg ), ::cMsgDef, ::cMsg ),;
::nClrText,,, .T., .T. )
#ifdef __CLIPPER__
ASend( ::aItem, "Paint" )
#else
ASend( ::aItem, "Paint()" )
#endif
if ::bPainted != nil
Eval( ::bPainted, ::hDC )
endif
::DispEnd( aInfo )
return nil
endif
FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
MsgPaint( ::hWnd, ::cMsg, ::cMsgDef, .t.,;
::lCentered, If( Len( ::aItem ) > 0, ::aItem[ 1 ]:nLeft(), 0 ),;
::nClrText, ::nClrPane, ::oFont:hFont,;
::lInset, ::hDC )
#ifdef __CLIPPER__
ASend( ::aItem, "Paint" )
#else
ASend( ::aItem, "Paint()" )
#endif
MsgPaint3L( ::hWnd, ::nClrPane, ::hDC )
::DispEnd( aInfo )
return nil
//---------
Espero les sea de alguna utilidad.
Saludos.
Francisco J. Alegría P.
Chinandega, Nicaragua.[/img]