problema con SetFont

[MOISES]

Hola,

En una clase, asignaba ::oFont así:


METHOD New ( nTop, nLeft, nWidth, nHeight, oWnd, oFont, nLANGUAGE ) CLASS TMiCalendario
DEFAULT nTop:=5, nLeft:=5,nWidth:=120,nHeight:=120 //Bingen
DEFAULT nLanguage := L_SPANISH
[...]
::oWnd := oWnd
::oFont := oFont



Ahora, ::oFont:SetFont( oFont ) me dice que "No existe el método: SETFONT".

Por favor, ¿cómo lo soluciono?.

Muchas gracias por la atención.

[cnavarro]

O haces <oCtrl>:SetFont(..) o dentro de tu clase heredada de TControl, pones simplemente ::SetFont(... ), pero ::ofont no tiene ese metodo

[MOISES]

Hola Cristóbal:

Probé con ::SetFont( oFont ) y sigue el EXCESS RELEASE.

Además, en teoría debería ser ::oFont := SetFont( oFont ), pero tampoco sirve.

Por ejemplo, así uso oFont internamente:

STATIC FUNCTION DibujaTitulos(hDC, nAltoFila, nCol1, nCol2,;
nAnchoCol, oFontMes, oFont, aColorTitulo,;
cMesPalabra, cAno, aDiaSemana)

LOCAL aPuntos[4]
LOCAL A

// Formato letra
SelectObject(hDC, oFont:hFont) //Se selecciona el tipo de letra.
SetTextColor( hDC, aColorTitulo[5] )
SetBkColor( hDC, aColorTitulo[2] )

// Se dibujan los titulos de los dias.
A := 0
aPuntos[ 1] := nAltoFila
aPuntos[ 3] := nAltoFila * 2
FOR A = 0 TO 6
aPuntos[ 2] := nCol1 + ( A * nAnchoCol )
aPuntos[ 4] := aPuntos[2] + nAnchoCol
DrawText( hDC, LEFT(aDiaSemana[ A + 1],3), aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
NEXT A

// Se dibuja el mes en palabras.
SelectObject(hDC, oFontMes:hFont)
SetTextColor(hDC, aColorTitulo[4])
aPuntos[ 1] := 3
aPuntos[ 2] := 2
aPuntos[ 3] := nAltoFila - 1
aPuntos[ 4] := nCol2 - (nAnchoCol*2) - 1
DrawText( hDC, cMesPalabra, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA

// Se dibuja el numero del año
aPuntos[ 2] := aPuntos[ 4] + 2
aPuntos[ 4] := nCol2 - 1
DrawText( hDC, cAno, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA

RETURN NIL

[cnavarro]

Moises, creo que solo con:

Code: Select all  Expand view

::SetFont( oFont )
 

es suficiente
No debes hacer

Code: Select all  Expand view

::oFont  := ::SetFont( oFont )
 

justamente es lo que hace el primer codigo

[MOISES]

Hola Cristóbal,

Probé efectivamente ::SetFont( oFont ) sin éxito.

Sigue diciendo

23/02/2015 14:51:26: EXCESS RELEASE OF FONT Ms Sans Serif[ hFont : 0] ( nCount : 0 )
<-TFONT:END(246) <-MSGDATE(176) <-MAIN(47)
------------------------------------------------------------

Pongo un ejemplo a ver si vemos que se me escapa. Muchas gracias.

Code: Select all  Expand view

/*******************************************************
*  Clase para mostrar y gestionar Calendarios en FW   *
*  Desarrollada por Rodrigo Soto y Bingen Ugaldebere  *
*  2.002 - 2.003                                      *
*******************************************************

#include "FiveWin.ch"
#include "InKey.ch"
//#include "Constant.ch"
#include "Objects.ch"

#define  K_MAS      43
#define  K_MENOS    45
#define  K_DIVISION 47
#define  K_HOY      72

#define  L_PORTUGUES 1
#define  L_CATALA    2
#define  L_EUSKERA   3
#define  L_GALEGO    4
#define  L_SPANISH   5     //BINGEN
#define  L_ITALIANO  6
#define  L_ENGLISH   7
#define  L_FRANCAIS  8
#define  L_DEUSTCH   9




REQUEST HB_LANG_ESWIN
REQUEST HB_CODEPAGE_ESWIN


FUNCTION Main()

   LOCAL oWnd


   HB_LangSelect("ESWIN")
   HB_CDPSELECT("ESWIN")

   SET EPOCH TO 1950
   SET CENTURY ON
   SET DATE FORMAT TO "DD/MM/YYYY"


   MsgInfo( MsgDate(DATE()), "Date Returned")

RETURN( NIL )
// -----------------------------------------------------------------------



// -----------------------------------------------------------------------
// Funci¢n ...: MsgDate()
// Descripci¢n: Calendario
// Par metros : Ninguno.
// Devuelve ..:
// Datos que devuelve el calendario.
//      * dFechaControl , la fecha seleccionado, formato fecha.
//
//      *  nMesNumero    , el numero del mes    , formato numero
//      *  cMesNumero    , el numero del mes    , formato caracter
//      *  cMesPalabra   , el nombre del mes
//
//      *  nDiaSemana    , el numero del dia de la semana formato numero
//      *  cDiaSemana    , el numero del dia de la semana formato caracter
//      *  cDiaPalabra   , el nombre del dia de la semana
//      *  nDiaMes       , el dia del mes formato numero
//      *  cDiaMes       , el dia del mes formato caracter
//      *  cDiaMesPalabra, el dia del mes en palabras.
//
//      *  nAno          , el numero del año formato numero
//      *  cAno          , el numero del año formato caracter
//      *  cAnoPalabra   , el numero del año en palabras.
//
//      * array con formatos de fecha.
//      *  aFecha[ 1]    , XX de enero del XXXX
//      *  aFecha[ 2]    , Domingo,XX de Septiembre de XXXX
//
// *Se encuentra habilitado el boton derecho del mouse con otras
// *opciones, mientras veo donde coloco los botones...
//
//      *METODOS
//      * CambiarMes( nMes)
//      * MesSiguinte() INLINE ::CambiarMes( +1)
//      * MesAnterior() INLINE ::CambiarMes( -1)
//      * AnoSiguinte() INLINE ::CambiarMes( 12)
//      * AnoAnterior() INLINE ::CambiarMes(-12)
//
// -----------------------------------------------------------------------
function MsgDate( dDate, cPrompt, oGet )

    Local oFont, oFont2, oFonte, oFont3
    Local oDlg, nVar2, oPrueba1
    Local oPrueba, oBtn[ 10], oCombo[ 2 ]
    Local nVar1 := nVar2 := 1

    LOCAL aClrFestivo := { rgb( 255, 255, 255),;   //Color borde superior
                           rgb( 255, 255,   0),;   //Color relleno
                           rgb( 180, 180,   0),;   //Color borde inferior
                           rgb(   0,   0,   0) }   //color texto....

    LOCAL aColorCuerpo := {rgb( 154, 242, 250),;  //Color borde superior
                           rgb(  11, 196, 210),;  //Color relleno
                           rgb(   9, 138, 149),;  //Color borde inferior
                           rgb(   0,   0,   0),;  //color texto....
                           Rgb(   9, 138, 149) }  //color al perder el foco...

    Local aColorTitulo := {Rgb(  10, 165, 177),;  // Color Borde superior
                           Rgb(   0, 128, 128),;  // Color de Relleno
                           Rgb(   5,  82,  88),;  // Color Borde inferior
                           rgb( 205, 205, 155),;  // Color Letra mes y año
                           Rgb( 205, 205, 155) }  // Color de los dias.

    Local aColorBoton  := {Rgb(  10, 165, 177),;  // Color Borde superior
                           Rgb(   0, 128, 128),;  // Color de Relleno
                           Rgb(   5,  82,  88),;  // Color Borde inferior
                           rgb( 205, 205, 155),;  // Color Letra mes y año
                           Rgb( 205, 205, 155) }  // Color de los dias.


    // Definición del Dialogo
    DEFINE FONT oFont  NAME "Ms Sans Serif" SIZE 0,-24

    DEFINE DIALOG oDlg TITLE "Seleccione una fecha" ;
           FROM 10,10 TO 320, 270 PIXEL   ;
           STYLE nOR( DS_MODALFRAME )

    oDlg:nStyle := nOr( oDlg:nStyle, 4 )

    oDlg:lHelpIcon := .F.



    oPrueba1:= TMiCalendario(): New ( 5, 5, 120, 120, oDlg, oFont, 5)

    //oPrueba1:bLButtonUp := {|| MsgInfo( oPrueba1:dFechaControl, ;
    //                                    "Fecha Seleccionada por el Usuario" ) }
    oPrueba1:bLButtonUp := {|| oDlg:End() }



    // Para pintar los domingos de otro color...
    oPrueba1:FijaClrDomingo( {rgb( 255, 255, 255),;   //Color borde superior
                              rgb( 220, 220, 220),;   //Color relleno
                              rgb( 128, 128, 128),;   //Color borde inferior
                              rgb(   0,   0,   0) } ) //color texto....

    // Para pintar los dias festivos..

    oPrueba1:aFestivos[ 1] := {1}      //Festivos de Enero
    oPrueba1:aFestivos[ 2] := {}       //Festivos de Ferbrero
    oPrueba1:aFestivos[ 3] := {}       //Festivos de Marzo
    oPrueba1:aFestivos[ 4] := {18,19}  //Festivos de Abril
    oPrueba1:aFestivos[ 5] := {1,21}   //Festivos de Mayo
    oPrueba1:aFestivos[ 6] := {16}     //Festivos de Junio
    oPrueba1:aFestivos[ 7] := {}       //Festivos de Julio
    oPrueba1:aFestivos[ 8] := {15}     //Festivos de Agosto
    oPrueba1:aFestivos[ 9] := {18,19}  //Festivos de Septiembre
    oPrueba1:aFestivos[10] := {}       //Festivos de Octubre
    oPrueba1:aFestivos[11] := {1}      //Festivos de Noviembre
    oPrueba1:aFestivos[12] := {25}     //Festivos de Diciembre
    oPrueba1:aColorFestivo := aClrFestivo
    oPrueba1:FijaClrFestivo()

    // Al cambiar de mes... se asignan nuevos festivos...
    // Este es un metodo alternativo de marcar los festivos..
    oPrueba1:bCambioMes := { || FijarFestivos( oPrueba1 ) }


    ACTIVATE DIALOG oDlg CENTERED

    // Se sacan los recursos de memoria.
    //RELEASE FONT oFont
    oFont:End()

   if oGet != NIL
      oGet:VarPut( oPrueba1:dFechaControl )
      oGet:Refresh()
   endif


Return (oPrueba1:dFechaControl)
// -----------------------------------------------------------------------



// Esta funcion es una alternativa al pintado de los festivos..
STATIC FUNCTION FijarFestivos( oCalendario )

    LOCAL aClrFestivo := { rgb( 177, 218, 173),;   //Color borde superior
                           rgb( 121, 192, 114),;   //Color relleno
                           rgb(  70, 141,  50),;   //Color borde inferior
                           rgb(   0,   0,   0) }   //color texto....

    DO CASE
        CASE oCalendario:nMesNumero == 1
             oCalendario:ColorDia( 1, aClrFestivo )

        CASE oCalendario:nMesNumero == 2


        CASE oCalendario:nMesNumero == 3


        CASE oCalendario:nMesNumero == 4
             oCalendario:ColorDia(18, aClrFestivo )
             oCalendario:ColorDia(19, aClrFestivo )

        CASE oCalendario:nMesNumero == 5
             oCalendario:ColorDia( 1, aClrFestivo )
             oCalendario:ColorDia(21, aClrFestivo )

        CASE oCalendario:nMesNumero == 6
             oCalendario:ColorDia(16, aClrFestivo )

        CASE oCalendario:nMesNumero == 7

        CASE oCalendario:nMesNumero == 8
             oCalendario:ColorDia(15, aClrFestivo )

        CASE oCalendario:nMesNumero == 9
             oCalendario:ColorDia(18, aClrFestivo )
             oCalendario:ColorDia(19, aClrFestivo )

        CASE oCalendario:nMesNumero == 10

        CASE oCalendario:nMesNumero == 11
             oCalendario:ColorDia( 1, aClrFestivo )

        CASE oCalendario:nMesNumero == 12
             oCalendario:ColorDia(25, aClrFestivo )

       ENDCASE

RETURN NIL
//-----------------------------------------------------------------------//

[MOISES]

Y la clase
// -----------------------------------------------------------------------
CLASS TMiCalendario FROM TControl
// -----------------------------------------------------------------------

DATA lContinuar AS LOGICAL INIT .T.
DATA lConFoco AS LOGICAL INIT .T.
DATA oFont
DATA lFont AS LOGICAL INIT .F.
DATA oFontMes
DATA oFontTxt
DATA oFontBtn
DATA nPosFila // la posicion de la fila
DATA nPosCol // la posicion de la columna
DATA nPosBoton // la columna del boton.
DATA aDiaSemana AS ARRAY INIT ARRAY( 7)
DATA aXY AS ARRAY INIT ARRAY(42)
DATA aBoton AS ARRAY INIT ARRAY( 5)
DATA aDias AS ARRAY INIT ARRAY(42)
DATA aClrDias AS ARRAY INIT ARRAY(42)
DATA aColorCuerpo AS ARRAY
DATA aColorTitulo AS ARRAY
DATA aColorBoton AS ARRAY
DATA aColorDomingo AS ARRAY
DATA aColorFestivo AS ARRAY
// Tinha o Erro de GPF aqui, quando usava READONLY
DATA aFestivos AS ARRAY INIT ARRAY(12) //READONLY gerava erro
DATA nAltoFila
DATA nAnchoCol
DATA nAnchoBoton
DATA aTitBoton
DATA nFila1
DATA nFila2
DATA nCol1
DATA nCol2
DATA nPrimerDia AS NUMERIC INIT 1
DATA nUltimoDia AS NUMERIC INIT 42
DATA lSelectOK AS LOGICAL INIT .T.
DATA bCambioMes //Block a ejecutar cuando cambie el mes...
DATA bFestivos //Bingen
DATA nLanguage //Bingen
DATA aMeses AS ARRAY INIT ARRAY(12) //Bingen
DATA nLastDay AS NUMERIC INIT 1

// Datos relacionados con la fecha seleccionada.
DATA dFechaControl
DATA nMesNumero READONLY
DATA cMesNumero READONLY
DATA cMesPalabra READONLY
DATA nDiaSemana READONLY
DATA cDiaSemana READONLY
DATA cDiaPalabra READONLY
DATA nDiaMes READONLY
DATA cDiaMes READONLY
DATA cDiaMesPalabra READONLY
DATA nAno READONLY
DATA cAno READONLY
DATA cAnoPalabra READONLY
DATA aFecha AS ARRAY INIT ARRAY(2) READONLY
DATA aVencto AS ARRAY INIT ARRAY(8) READONLY
// aFecha, es un array con formatos de fecha
// aVencto, es un array con las fechas de vencimiento 15,30,45,60 dias...

// DATAS para reasignar teclas de navegacion.
DATA nK_AnoAdelenta AS NUMERIC INIT VK_NEXT
DATA nK_AnoAtras AS NUMERIC INIT VK_PRIOR
DATA nK_MesAdelenta AS NUMERIC INIT K_MAS
DATA nK_MesAtras AS NUMERIC INIT K_MENOS
DATA nK_Menu AS NUMERIC INIT K_DIVISION
DATA nK_Hoy AS NUMERIC INIT K_HOY

DATA nPosicion
DATA lTodoseCalculo AS LOGICAL INIT .F.
DATA lProcesarTecla AS LOGICAL INIT .T.
DATA lMostrarBoton AS LOGICAL INIT .T.

CLASSDATA lRegistered AS LOGICAL

METHOD New( ) CONSTRUCTOR //Bingen

METHOD Display()

METHOD Paint()

METHOD Language() //Bingen

METHOD LButtonDown( nRow, nCol, nFlags )
METHOD LButtonUp( nRow, nCol )
METHOD RButtonUp( nRow, nCol, nKeyFlags )

METHOD FijarFecha( dFecha )
METHOD CalcularDias( dFecha )
METHOD FijaClrs()
METHOD FijaClrDomingo()
METHOD FijaClrFestivo()
METHOD RestaurarColor() INLINE ::FijaClrs(), ::FijaClrDomingo(), ::FijaClrFestivo()
METHOD ColorDia( nDia, aColores )

METHOD Default()

METHOD Destroy()
METHOD MouseMove( nRow, nCol, nKeyFlags )

METHOD GetDlgCode( nLastKey )
METHOD VerAlSalir()
METHOD VerAlEntrar()
METHOD PintarBoton(hDC, nColor, nRow, nCol)
METHOD KeyChar( nKey, nFlags )
METHOD KeyDown( nKey, nFlags )

// Estos metodos devuelven verdadero o falso segun se encuentren
// dentro del cuerpo del calendario o en el area de botones.
METHOD lCuerpo( nRow, nCol)
METHOD lBotones( nRow, nCol)

// Metodos para moverse entre los meses
METHOD CambiarMes(nMeses, lProcesar)
METHOD MesSiguinte() INLINE ::CambiarMes( 1)
METHOD MesAnterior() INLINE ::CambiarMes( -1)
METHOD AnoSiguiente() INLINE ::CambiarMes( 12)
METHOD AnoAnterior() INLINE ::CambiarMes(-12)
METHOD Hoy() INLINE ::IrFecha( Date() )
METHOD IrFecha( dNvaFecha )

// Metodos para tomar y dejar el foco.
METHOD LostFocus( hCtlFocus ) INLINE ::Super:LostFocus( hCtlFocus ), ::VerAlSalir()
METHOD GotFocus() INLINE ::setfocus(), ::VerAlEntrar()

ENDCLASS

METHOD New (nTop, nLeft, nWidth, nHeight, oWnd, oFont, nLANGUAGE ) CLASS TMiCalendario
DEFAULT nTop:=5, nLeft:=5,nWidth:=120,nHeight:=120 //Bingen
DEFAULT nLanguage := L_SPANISH

// Coordenadas de la region de dibujo.
::nTop := nTop
::nLeft := nLeft
::nBottom := ::nTop + nHeight
::nRight := ::nLeft + nWidth

::dFechaControl := Date()
::bFestivos := {|| ARRAY(0) } //Bingen
::nLanguage := nLanguage //Bingen
::Language() //Bingen

// Array con dias festivos...
::aFestivos := { {}, {}, {},;
{}, {}, {},;
{}, {}, {},;
{}, {}, {} }

::oWnd := oWnd
//::oFont := oFont //ojo
::SetFont( oFont ) // sigue fallando



::lFont := !oFONT=Nil
::nPosFila := 1
::nPosCol := 1
::nPosBoton := 1
::aColorCuerpo := { nRgb(235,235,210),; // Color Borde superior
nRgb(205,205,155),; // Color de Relleno
nRgb(150,150, 75),; // Color Borde inferior
nRgb( 0, 0, 0),; // Color del texto,
nRgb(130,130, 65)} // Color dia seleccionado al perder el foco

::aColorTitulo := { nRgb(170,170, 80),; // Color Borde superior
nRgb(130,130, 65),; // Color de Relleno
nRgb(100,100, 50),; // Color Borde inferior
::aColorCuerpo[2],; // Color Letra mes y año
nRgb(255,255,255) } // Color de los dias.

::aColorBoton := { nRgb(170,170, 80),; // Color Borde superior
nRgb(130,130, 65),; // Color de Relleno
nRgb(100,100, 50),; // Color Borde inferior
::aColorCuerpo[2],; // Color Letra
::aColorCuerpo[2] } // Color relleno cuando se selecciona.

::aColorDomingo := ::aColorTitulo
::aColorFestivo := ::aColorTitulo


::nPosicion := day(::dFechaControl)
::FijaClrs()
::FijaClrDomingo()
::FijaClrFestivo()

::nStyle := nOr(WS_CHILD, WS_VISIBLE, WS_TABSTOP)

::Register()

If !Empty( oWnd:hWnd )
::Create()
oWnd:AddControl( Self )
Else
oWnd:DefControl( Self )
Endif

Return Self

METHOD Display() CLASS TMiCalendario

IF ::lContinuar
::lContinuar := .F.
::BeginPaint()
::Paint()
::EndPaint()
::lContinuar := .T.
ELSE
MsgInfo("Para Ccontrolar Que Nao Passe Duas Vezes")
ENDIF

RETURN SELF


METHOD Paint() CLASS TMiCalendario
// Se recupera identificador del boton.
Local hDC := ::GetDC()
Local nColor

IF !::lTodoseCalculo
::Default()
::SetSize(::nCol2 + 1,::nFila2 + 1 + IF(::lMostrarBoton, ::nAltoFila, 0 ), .t. ) //Bingen
::lTodoseCalculo := .T.
ENDIF

// Comienza el dibujo
DibujarTodo( hDC, ::nAltoFila, ::nAnchoCol, ::nFila1, ::nFila2,;
::nCol1, ::nCol2, ::oFont, ::aDiaSemana,;
::aXY, ::oFontTxt, ::aDias, ::aColorTitulo, ::aClrDias, ::aColorCuerpo, ::aColorBoton,;
::cMesPalabra, ::oFontMes, ::cAno,;
::oFontBtn, ::aBoton, ::nAnchoBoton, ::aTitBoton, ::bFestivos ) //Bingen

// Se pinta si esta con el foco o no.
if ::lFocused
MarcarDia( hDC, ::aXY[::nPosicion], nrgb(255, 0, 0))
else
MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5])
endif

// Se libera el identificador del boton.
::ReleaseDC()

Return Self


STATIC FUNCTION DibujarTodo( hDC, nAltoFila, nAnchoCol, nFila1, nFila2,;
nCol1, nCol2, oFont, aDiaSemana, aConPuntos,;
oFontTxt,aDias, aColorTitulo, aClrDias, aColorCuerpo, aColorBoton,;
cMesPalabra, oFontMes, cAno, ;
oFontBtn, aBoton, nAnchoBoton,;
aTitBoton, bFestivos ) //Bingen

Local A
Local aLosPuntos := aConPuntos[42]

// Se dibuja el cuerpo del calendario
DibujaCuerpo( hDC, aConPuntos, aClrDias, aColorCuerpo)

// Se dibujan los dias.
DibujaDias( hDC, oFont, aDias, aConPuntos, aClrDias, bFestivos )

// Se dibujan la parte superior del calendario
DibujaEncabezado(hDC, nFila1, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
aDiaSemana, oFont, aColorTitulo,;
cMesPalabra, oFontMes, cAno )

// Se dibujan los titulos del encabezado.
DibujaTitulos(hDC, nAltoFila, nCol1, nCol2, nAnchoCol,;
oFontMes, oFontTxt, aColorTitulo, cMesPalabra,;
cAno, aDiaSemana)

// Se dibujan los botones.
DibujaBotones(hDC, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
oFontBtn, aColorBoton, aBoton, aTitBoton, nAnchoBoton)

return NIL

STATIC FUNCTION DibujaDias( hDC, oFont, aDias, aXY, aClrDias, bFestivos)

Local HBROCHAANTERIOR, HOLDPEN
Local A, aFESTIVOS:=ARRAY(0), nCOLOR:=0
Local hBrocha
Local hPen1
Local hPen2

DEFAULT bFestivos := {|| ARRAY(0) }

aFESTIVOS:=EVAL(bFestivos)

// Se dibujan los dias.
SelectObject( hDC, oFont:hFont)

FOR A = 1 TO 42
// Se crea brocha para pintar el fondo del recuadro...
hBrocha := CreateSolidBrush ( aClrDias[ A][ 2] )

// se carga la brocha, se guarda la brocha anterior y se pinta
hBrochaAnterior := SelectObject (hDC, hBrocha)
FillRect( hDc, aXY[A], hBrocha )

// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF

// Aqui se dibujan los bordes....
// UNO. se cargan los lapices...
hPen1 := CreatePen(PS_SOLID, 1, aClrDias[ A][ 1]) //Claro nrgb(235,235,210)
hPen2 := CreatePen(PS_SOLID, 1, aClrDias[ A][ 3]) //Oscuro nrgb(160,160, 75)

// Se carga el lapices y se dibuja borde superior..
hOldPen := SelectObject( hDC, hPen1 )
MoveTo(hDc , aXY[ A][ 2] - 1, aXY[ A][ 3] )
LineTo(hDc, aXY[ A][ 2] - 1, aXY[ A][ 1] - 1 )
LineTo(hDc, aXY[ A][ 4] , aXY[ A][ 1] - 1 )

// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen1 )
MsgInfo("O objeto nao se destruiu")
ENDIF

// Se carga el lapices y se dibuja borde inferior..
hOldPen := SelectObject( hDC, hPen2 )
MoveTo(hDc , aXY[ A][ 2], aXY[ A][ 3] )
LineTo(hDc, aXY[ A][ 4], aXY[ A][ 3] )
LineTo(hDc, aXY[ A][ 4], aXY[ A][ 1] - 2 )

// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF

// Se dibuja el texto...
SetBkColor( hDC, aClrDias[ A][ 2] )
nCOLOR:=ASCAN(aFESTIVOS, {|aVal| aVal[1] == VAL(aDias[A]) }) //Comprobar festivos
IF nCOLOR>0 //Bingen
SetTextColor( hDC, aFESTIVOS[nCOLOR,2])
ELSE
SetTextColor( hDC, aClrDias[ A][ 4] )
ENDIF

DrawText( hDC, " " + aDias[A] + " ", aXY[A],;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA

NEXT A

RETURN NIL

STATIC FUNCTION DibujaCuerpo( hDC, aXY, aClrDias, aColorCuerpo )
// Se crea el lapiz a utilizar.
Local A, HOLDPEN
Local hPen1
Local hPen2
Local hBrocha
Local hBrochaAnterior

// Se dibujan los bordes del cuerpo
hPen1 := CreatePen(PS_SOLID, 1, aColorCuerpo[ 1])
hPen2 := CreatePen(PS_SOLID, 1, Getsyscolor(16) )

// Se carga el lapices y se dibuja borde superior..
hOldPen := SelectObject( hDC, hPen1 )
MoveTo(hDc , aXY[ 1][ 2] - 2, aXY[ 1][ 1] - 1 )
LineTo(hDc, aXY[ 1][ 2] - 2, aXY[36][ 3] + 2 )

// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF

// Se carga el lapices y se dibuja borde inferior..
hOldPen := SelectObject( hDC, hPen2 )
MoveTo(hDc , aXY[36][ 2] - 1, aXY[36][ 3] + 1 )
LineTo(hDc, aXY[42][ 4] + 1, aXY[36][ 3] + 1 )
LineTo(hDc, aXY[42][ 4] + 1, -1 )

// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF

RETURN NIL

STATIC FUNCTION DibujaEncabezado(hDC, nFila1, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
aDiaSemana, oFont, aColorTitulo,;
cMesPalabra, oFontMes, cAno )

// Se crea el lapiz a utilizar.
Local hPen1 := CreatePen(PS_SOLID, 1, aColorTitulo[1]) //Lapiz claro
Local hPen2 := CreatePen(PS_SOLID, 1, aColorTitulo[3]) //Lapiz oscuro
Local hPenAnterior
Local aPuntos[4]
Local A

// Se crea brocha pintar la parte superior y luego
// se carga la brocha y se guarda la anterior brocha.
Local hBrocha := CreateSolidBrush ( aColorTitulo[2] )
Local hBrochaAnterior := SelectObject (hDC, hBrocha)


// Se pinta el recuadro.
FillRect( hDc, { 2, nCol1, nFila1 - 1, nCol2 }, hBrocha )

// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF

// Se dibuja el contorno se selecciona lapiz.
// Linea superior y linea izquierda
hPenAnterior := SelectObject( hDC, hPen1 )
MoveTo(hDC, nCol2 - 1, 1)
LineTo(hDC, nCol1 , 1)
LineTo(hDC, nCol1 , nFila1 - 1)
LineTo(hDC, nCol1 - 1, nFila1 - 1)
LineTo(hDC, nCol1 - 1, 0)
LineTo(hDC, nCol2 , 0)

//Linea horizontal del centro.
MoveTo(hDC, nCol2 - 1, nAltoFila)
LineTO(hDC, nCol1 - 1, nAltoFila)

MoveTo(hDC, nCol2 - (nAnchoCol * 2), 2)
LineTo(hDC, nCol2 - (nAnchoCol * 2), nAltoFila)

For A = 1 to 6
MoveTo(hDC, (nAnchoCol * A) + nCol1, nAltoFila)
LineTo(hDC, (nAnchoCol * A) + nCol1, nAltoFila * 2)
Next a


// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF

// Se dibuja el contorno se selecciona lapiz.
// Linea superior y linea izquierda
hPenAnterior := SelectObject( hDC, hPen2 )
MoveTo(hDC, nCol2 - 1, 1)
LineTo(hDC, nCol2 - 1, nFila1 - 1)
LineTo(hDC, nCol1 - 2, nFila1 - 1)

//Linea horizontal del centro.
MoveTo(hDC, nCol2 - 1, nAltoFila - 1)
LineTO(hDC, nCol1 - 2, nAltoFila - 1)

MoveTo(hDC, nCol2 - (nAnchoCol * 2) - 1, 0)
LineTo(hDC, nCol2 - (nAnchoCol * 2) - 1, nAltoFila)

For A = 1 to 6
MoveTo(hDC, (nAnchoCol * A) + nCol1 - 1, nAltoFila)
LineTo(hDC, (nAnchoCol * A) + nCol1 - 1, nAltoFila * 2)
Next a

// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF


RETURN NIL

STATIC FUNCTION DibujaTitulos(hDC, nAltoFila, nCol1, nCol2,;
nAnchoCol, oFontMes, oFont, aColorTitulo,;
cMesPalabra, cAno, aDiaSemana)

LOCAL aPuntos[4]
LOCAL A

// Formato letra
SelectObject(hDC, oFont:hFont) //Se selecciona el tipo de letra.
SetTextColor( hDC, aColorTitulo[5] )
SetBkColor( hDC, aColorTitulo[2] )

// Se dibujan los titulos de los dias.
A := 0
aPuntos[ 1] := nAltoFila
aPuntos[ 3] := nAltoFila * 2
FOR A = 0 TO 6
aPuntos[ 2] := nCol1 + ( A * nAnchoCol )
aPuntos[ 4] := aPuntos[2] + nAnchoCol
DrawText( hDC, LEFT(aDiaSemana[ A + 1],3), aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
NEXT A

// Se dibuja el mes en palabras.
SelectObject(hDC, oFontMes:hFont)
SetTextColor(hDC, aColorTitulo[4])
aPuntos[ 1] := 3
aPuntos[ 2] := 2
aPuntos[ 3] := nAltoFila - 1
aPuntos[ 4] := nCol2 - (nAnchoCol*2) - 1
DrawText( hDC, cMesPalabra, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA

// Se dibuja el numero del año
aPuntos[ 2] := aPuntos[ 4] + 2
aPuntos[ 4] := nCol2 - 1
DrawText( hDC, cAno, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA

RETURN NIL

STATIC FUNCTION DibujaBotones(hDC, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
oFont, aColorBoton, aBoton, aTitBoton, nAnchoBoton )

// Se crea el lapiz a utilizar.
Local hPen1 := CreatePen(PS_SOLID, 1, aColorBoton[1]) //Lapiz claro
Local hPen2 := CreatePen(PS_SOLID, 1, aColorBoton[3]) //Lapiz oscuro
Local hPenAnterior
Local aPuntos[5]
Local A

// Se crea brocha pintar la parte superior y luego
// se carga la brocha y se guarda la anterior brocha.
Local hBrocha := CreateSolidBrush ( aColorBoton[2] )
Local hBrochaAnterior := SelectObject (hDC, hBrocha)


// Se pinta el recuadro.
FillRect( hDc, { nFila2 + 2, nCol1, nFila2 + nAltoFila - 1, nCol2 }, hBrocha )

// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF

// Se dibuja el contorno se selecciona lapiz.
// Linea superior y linea izquierda
hPenAnterior := SelectObject( hDC, hPen1 )
MoveTo(hDC, nCol2 - 1, nFila2 + 1)
LineTo(hDC, nCol1 , nFila2 + 1)
LineTo(hDC, nCol1 , nFila2 + nAltoFila - 1)
LineTo(hDC, nCol1 - 1, nFila2 + nAltoFila - 1)
LineTo(hDC, nCol1 - 1, nFila2 )

For A = 1 to 4
MoveTo(hDC, (nAnchoBoton * A) + nCol1 + 1, nFila2 + 1)
LineTo(hDC, (nAnchoBoton * A) + nCol1 + 1, nFila2 + nAltoFila)
Next a

// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF

// Se dibuja el contorno se selecciona lapiz.
// Linea inferior y linea derecha
hPenAnterior := SelectObject( hDC, hPen2 )
MoveTo(hDC, nCol2 , nFila2 + 1)
LineTo(hDC, nCol2 , nFila2 + nAltoFila )
LineTo(hDC, nCol1 - 2, nFila2 + nAltoFila )
LineTo(hDC, nCol1 - 2, nFila2 + nAltoFila - 1)
LineTo(hDC, nCol2 - 1, nFila2 + nAltoFila - 1)
LineTo(hDC, nCol2 - 1, nFila2 + 1)

For A = 1 to 4
MoveTo(hDC, (nAnchoBoton * A) + nCol1, nFila2 + 1)
LineTo(hDC, (nAnchoBoton * A) + nCol1, nFila2 + nAltoFila)
Next a


// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF

// Formato letra
SelectObject(hDC, oFont:hFont) //Se selecciona el tipo de letra.
SetTextColor( hDC, aColorBoton[5] )
SetBkColor( hDC, aColorBoton[2] )

// Se dibujan los titulos de los botones //Bingen
DrawText( hDC, aTitBoton[1], aBoton[ 1],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[2], aBoton[ 2],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[3], aBoton[ 3],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[4], aBoton[ 4],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[5], aBoton[ 5],;
nOr(32, 4, 1 ) )

RETURN NIL

METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TMiCalendario
// Se recupera identificador del boton.
Local hDC := ::GetDC()
Local nAltoFila := ::nAltoFila
Local nAnchoCol := ::nAnchoCol
Local nFila1 := ::nFila1
Local nFila2 := ::nFila2
Local n := 1
Local nPos := 0
Local nPosAnterior := ::nPosicion
Local B


// Se fija que el objeto tenga el foco.
::SetFocus()

// Se determina el recuadro donde se da el click
IF ::lCuerpo( nRow, nCol)

// Se determina el numero de fila
While nRow > ( nPos + nFila1 + nAltoFila ) .and. n < 7
nPos += ::nAltoFila
n++
end
::nPosFila := n

// Se determina la posicion de la columna.
n := 1
nPos := 0
While nCol > ( nPos + nAnchoCol + ::nCol1 ) .and. n < 7
nPos += nAnchoCol
n++
end
::nPosCol := n


// Se pinta el dia seleccionado.
::nPosicion := ( (::nPosFila - 1) * 7) + ::nPosCol
B = ALLTRIM( ::aDias[::nPosicion])

IF !EMPTY( B )
MarcarDia( hDC, ::aXY[nPosAnterior], ::aClrDias[ nPosAnterior ][2])
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))

// Se actualizan los datos fecha.
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
ELSE
IF ::lCuerpo( nRow, nCol) //Bingen
TONE(500,3)
::lSelectOK :=.F.
ENDIF
::nPosicion := nPosAnterior
ENDIF

ENDIF

// Se evalua si es la linea de los botones.
IF ::lBotones( nRow, nCol)

// Se determina la posicion de la columna.
n := 1
nPos := 0
While nCol > ( nPos + ::nAnchoBoton + ::nCol1 ) .and. n < 5
nPos += ::nAnchoBoton
n++
end

::nPosBoton := n
::PintarBoton(hDC, ::aColorBoton[5], nRow, nCol)

// Se evalua el boton seleccionado.
DO CASE
CASE ::nPosBoton == 1
::MesAnterior()
CASE ::nPosBoton == 2
::MesSiguinte()
CASE ::nPosBoton == 3
::AnoAnterior()
CASE ::nPosBoton == 4
::AnoSiguiente()
CASE ::nPosBoton == 5
::IrFecha( Date())
ENDCASE

ENDIF

// Se libera el identificador del boton.
::ReleaseDC()


return Self

METHOD LButtonUp( nRow, nCol ) CLASS TMiCalendario
LOCAL hDC := ::GetDC()

IF ::lSelectOK
::PintarBoton(hDC, ::aColorBoton[2], nRow, nCol)
IF ::lCuerpo( nRow, nCol)
::Super:LButtonUp( nRow, nCol )
ENDIF
ELSE
::lSelectOK:=.T.
ENDIF

::ReleaseDC()

RETURN Self

METHOD RButtonUp( nRow, nCol, nKeyFlags ) CLASS TMiCalendario
Local oMenu
::SetFocus()
MENU oMenu POPUP
MENUITEM ::aTitBoton[1] ACTION ::MesAnterior()
MENUITEM ::aTitBoton[2] ACTION ::MesSiguinte()
MENUITEM ::aTitBoton[5] ACTION ::Hoy()
MENUITEM "Otro Mes"
MENU
MENUITEM ::aMESES[ 1] ACTION ::CambiarMes( 1 - ::nMesNumero )
MENUITEM ::aMESES[ 2] ACTION ::CambiarMes( 2 - ::nMesNumero )
MENUITEM ::aMESES[ 3] ACTION ::CambiarMes( 3 - ::nMesNumero )
MENUITEM ::aMESES[ 4] ACTION ::CambiarMes( 4 - ::nMesNumero )
MENUITEM ::aMESES[ 5] ACTION ::CambiarMes( 5 - ::nMesNumero )
MENUITEM ::aMESES[ 6] ACTION ::CambiarMes( 6 - ::nMesNumero )
MENUITEM ::aMESES[ 7] ACTION ::CambiarMes( 7 - ::nMesNumero )
MENUITEM ::aMESES[ 8] ACTION ::CambiarMes( 8 - ::nMesNumero )
MENUITEM ::aMESES[ 9] ACTION ::CambiarMes( 9 - ::nMesNumero )
MENUITEM ::aMESES[10] ACTION ::CambiarMes(10 - ::nMesNumero )
MENUITEM ::aMESES[11] ACTION ::CambiarMes(11 - ::nMesNumero )
MENUITEM ::aMESES[12] ACTION ::CambiarMes(12 - ::nMesNumero )
ENDMENU

SEPARATOR
MENUITEM ::aTitBoton[3] ACTION ::AnoAnterior()
MENUITEM ::aTitBoton[4] ACTION ::AnoSiguiente()
IF !::lMostrarBoton //Bingen
MENUITEM "Mostrar Botones" ACTION ::SetSize(::nWidth(),::nheight() + ::nAltoFila, .t. ),;
::ReSize(),;
::lMostrarBoton := .T.
ELSE
MENUITEM "Ocultar Botones" ACTION ::SetSize(::nWidth(),::nheight() - ::nAltoFila, .t. ),;
::ReSize(),;
::lMostrarBoton := .F.
ENDIF

ENDMENU
ACTIVATE POPUP oMenu AT nRow, nCol OF Self

RETURN SELF

METHOD lBotones( nRow, nCol) CLASS TMiCalendario
RETURN iif( (nRow > ::nFila2 .and. ;
nCol > ::nCol1 .and. ;
nCol <= ::nCol2), .T., .F.)


METHOD lCuerpo( nRow, nCol) CLASS TMiCalendario
RETURN iif( (nRow > ::nFila1 .and.;
nRow <= ::nFila2 .and.;
nCol > ::nCol1 .and.;
nCol <= ::nCol2), .T., .F.)

METHOD Default() CLASS TMiCalendario
Local B := 1
Local aPuntos[ 5]
* Local aPunt := GetClientRec(::hWnd)
local ofu

// Estos son los datos de las columnas.
::nCol1 := 1 //Inicio Columna
::nAnchoCol := CalcularAncho(::nCol1, ::nWidth() ) //El ancho de la columna
::nCol2 := (::nAnchoCol * 7 ) + ::nCol1 //Final Columna

// Estos son los datos de la fila
::nAltoFila := CalcularAlto( ::nHeight() ) //El alto de la fila.
::nFila1 := ::nAltoFila * 2 //Ubicacion primera linea a dibujar
::nFila2 := ::nAltoFila * 8 //Fila Final

// Font del título 75% de la altura de la celda
::oFontMes := TFont():New( "Arial", 0, -(::nAltoFila*.75),, .t. ) //Bingen
// Font de los textos de los días 50% de la altura de la celda
::oFontTXT := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen
// Font para los días por defecto del 5O% de la altura de la celda
::oFont := IF(::lFont,::oFont,TFont():New( "Arial", 0, -(::nAltoFila*.50),, .t. )) //Bingen


// Font para los botones 4O% de la altura de la celda
::oFontBtn := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen

// Se crea matriz con los datos dia del mes.
// Coordenadas filas
aPuntos[ 1] := ::nFila1 + 1
aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2

FOR B = 1 TO 7

//Coordenadas columnas.
aPuntos[ 2] := ::nCol1 + ( ::nAnchoCol * ( B - 1) ) + 1
aPuntos[ 4] := aPuntos[ 2] + ::nAnchoCol - 2

::aXY[ B ] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 7] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 14] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 21] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 28] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 35] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }

NEXT B

FOR B = 1 TO 7
::aXY[ B + 7][1] := ::aXY[ B ][1] + ::nAltoFila
::aXY[ B + 14][1] := ::aXY[ B + 7][1] + ::nAltoFila
::aXY[ B + 21][1] := ::aXY[ B + 14][1] + ::nAltoFila
::aXY[ B + 28][1] := ::aXY[ B + 21][1] + ::nAltoFila
::aXY[ B + 35][1] := ::aXY[ B + 28][1] + ::nAltoFila

::aXY[ B + 7][3] := ::aXY[ B + 7][1] + ::nAltoFila - 2
::aXY[ B + 14][3] := ::aXY[ B + 14][1] + ::nAltoFila - 2
::aXY[ B + 21][3] := ::aXY[ B + 21][1] + ::nAltoFila - 2
::aXY[ B + 28][3] := ::aXY[ B + 28][1] + ::nAltoFila - 2
::aXY[ B + 35][3] := ::aXY[ B + 35][1] + ::nAltoFila - 2

NEXT B


// Se calcula el ancho de los botones.
::nAnchoBoton := int( (::nCol2 - ::nCol1) / 5)

// Se crean las coordenadas del boton.
aPuntos[ 1] := ::nFila2 + 1
aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2

FOR B = 1 TO 5

// Coordenadas columnas.
aPuntos[ 2] := ::nCol1 + ( ::nAnchoBoton * ( B - 1) ) + 1
aPuntos[ 4] := aPuntos[ 2] + ::nAnchoBoton - 2

::aBoton[B] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4], aPuntos[5] }
NEXT B

// Se fijan los datos de la fecha.
::FijarFecha( ::dFechaControl )
::nLastDay := ::nDiaMes

RETURN SELF

METHOD FijaClrs( aColores ) CLASS TMiCalendario
Local A

::aColorCuerpo := iif( aColores == NIL, ::aColorCuerpo, aColores )

// Se fijan los colores de bordes y de fondo de cada uno de los
// cuadritos...
FOR A = 1 TO 42
::aClrDias[ A] := { ::aColorCuerpo[ 1],; // Color Borde superior
::aColorCuerpo[ 2],; // Color de Relleno
::aColorCuerpo[ 3],; // Color Borde inferior
::aColorCuerpo[ 4] } // Color del texto,

NEXT A
RETURN NIL

METHOD FijaClrDomingo( aColores ) CLASS TMiCalendario
LOCAL A
::aColorDomingo := iif( aColores == NIL, ::aColorDomingo, aColores )

// Se fijan los colores para los dias domingo...
FOR A = 7 TO 42 step 7
::aClrDias[ A] := { ::aColorDomingo[ 1],; // Color Borde superior
::aColorDomingo[ 2],; // Color de Relleno
::aColorDomingo[ 3],; // Color Borde inferior
::aColorDomingo[ 4] } // Color del texto,
NEXT A
RETURN NIL

METHOD FijaClrFestivo() CLASS TMiCalendario
LOCAL aDiasFestivos := ::aFestivos[ ::nMesNumero]
LOCAL nFestivos := LEN( aDiasFestivos )
LOCAL nDia := 0
LOCAL A

// Se fijan los colores para los dias domingo...
IF nFestivos > 0
FOR A = 1 TO nFestivos
nDia := aDiasFestivos[ A]
::ColorDia( nDia, ::aColorFestivo )
NEXT A
ENDIF
RETURN NIL

METHOD ColorDia( nDia, aColores ) CLASS TMiCalendario
::aClrDias[ ::nPrimerDia + ndia - 1 ] := aColores
RETURN NIL

METHOD FijarFecha( dFecha ) CLASS TMiCalendario

dFecha = iif( dFecha == NIL, Date(), dFecha )

::dFechaControl := dFecha
::CalcularDias( ::dFechaControl )

::nMesNumero := Month(::dFechaControl)
::cMesNumero := STR(::nMesNumero, 2, 0)
::cMesPalabra := IF(::nMesNumero=NIL,"", ::aMESES[::nMesNumero])

::nDiaSemana := if( (::nDiaSemana := dow(::dFechaControl) - 1) = 0, 7, ::nDiaSemana)
::cDiaSemana := str(::nDiaSemana,2,0)
::cDiaPalabra := ::aDiaSemana[::nDiaSemana]
::nDiaMes := Day(::dFechaControl )
::cDiaMes := str(::nDiaMes,2,0)
::cDiaMesPalabra:= FormarFrase(::nDiaMes)

::nAno := year( ::dFechaControl )
::cAno := ALLTRIM( str(::nAno, 4, 0 ))
::cAnoPalabra := FormarFrase(::nAno )

::aFecha[ 1] := ::cDiaMes + " de " + ::cMesPalabra + " de " + ::cAno
::aFecha[ 2] := ::cDiaPalabra + ", " + ::cDiaMes + " de " + ::cMesPalabra + " de " + ::cAno

// aqui agregar todos los otros formatos que sean posibles.
RETURN SELF

METHOD CalcularDias( dFecha ) CLASS TMiCalendario // TMiEjemplo
Local FechaInicioMes
Local nDiaSemana
Local nMes := Month( dFecha )
Local nAno := Year( dFecha )
Local aDiaFinMes := {31,28,31,30,31,30,31,31,30,31,30,31}
Local aLosDias[42]
Local B
Local CELMES, CELANO, NDIAFINALMES

// Se limpian los dias.
FOR B = 1 TO 42
aLosDias[ B] := " " // Para sobrescribir el dibujo anterior
NEXT B


// Dia de la semana.
FechaInicioMes := ctod( "01/" + str(nMes,2,0) + "/" + str(nAno,4,0) )
cElMes := IF(::nMesNumero=NIL,"", ::aMESES[::nMesNumero])
cElAno := STR(nAno,4)
aDiaFinMes[ 2] := iif( CtoD("29/02/" + cElAno) = CtoD("0"), 28, 29)
nDiaFinalMes := aDiaFinMes[nMes]
nDiaSemana := dow(FechaInicioMes) - 1
nDiaSemana := IIF( nDiaSemana = 0, 7, nDiaSemana)

FOR B = 1 TO nDiaFinalMes
aLosDias[ B + nDiaSemana - 1 ] := str(B,2,0)
NEXT B

::aDias := aLosDias
::nPrimerDia := nDiaSemana
::nUltimoDia := B + nDiaSemana - 2
::nPosicion := day(dfecha) + nDiaSemana - 1
RETURN SELF

METHOD Destroy() CLASS TMiCalendario

::oFontMes:End()
::oFontTxt:End()
::oFont:End()
::oFontBtn:End()

RETURN ::Super:Destroy()


METHOD CambiarMes( nMeses, lProcesar ) CLASS TMiCalendario
Local aDiaFinMes := {31,28,31,30,31,30,31,31,30,31,30,31}
Local nNumeroMes := ::nMesNumero
Local dNvaFecha
Local hDC
Local AnchoRelleno := (::nAnchoCol * 5) - 4
Local nDia

DEFAULT nMeses := 1, lProcesar := .F.



// Se obtiene el controlador
IF (nMeses<> 0 .or. lProcesar)
hDC := ::GetDC()
// Se desmarca el dia...
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2] )
ENDIF

// Si el numero es cero, pues nada se hace y lprocesar, para obligar a procesar.
IF (nMeses<> 0 .or. lProcesar)

MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2] )
// Se comprueba que no sea mayor que doce el aumento de mes.
nNumeroMes += nMeses

DO CASE
CASE nNumeroMes > 12
::nMesNumero := nNumeroMes - 12
::nAno++
CASE nNumeroMes < 1
::nMesNumero := 12 + nNumeroMes
::nAno--
OTHERWISE
::nMesNumero := nNumeroMes
ENDCASE

// Se verifica año bisciesto
aDiaFinMes[ 2] := iif( CtoD("29/02/" + str(::nAno,4,0) ) = CtoD("0"), 28, 29)

// Se determina el dia de cambio...
nDia := iif( ::nLastDay > aDiaFinMes[ ::nMesNumero ],;
aDiaFinMes[ ::nMesNumero ],;
::nLastDay )

dNvaFecha := CtoD( STR( nDia ,2,0) + "/" +;
STR(::nMesNumero,2,0) + "/" +;
STR(::nAno, 4,0) )

::FijarFecha( dNvaFecha )

// Se restauran los colores...
::RestaurarColor()

// Se evalua bloque de codigo al cambiar de mes...
IF !EMPTY( ::bCambioMes )
Eval( ::bCambioMes )
ENDIF

// Se dibujan los dias.
DibujaDias( hDC, ::oFont, ::aDias, ::aXY,;
::aClrDias, ::bFestivos )

// Se dibujan los titulos del mes y año.
DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,;
::nAnchoCol, ::oFontMes, ::oFont, ::aColorTitulo,;
xPadc(::cMesPalabra, AnchoRelleno), ::cAno, ::aDiaSemana)

* ::nPosicion := ::nDiaSemana
* MsgInfo( ::nPosicion )

MarcarDia( hDC, ::aXY[::nPosicion], nRgb(255, 0, 0))

// Se libera el identificador
::ReleaseDC()

ENDIF
RETURN Self

METHOD VerAlSalir() CLASS TMiCalendario
// Metodo cuando se abandona
// Se recupera el identificador.
LOCAL hDC := ::GetDC()

::lConFoco := .F.
MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5])

// Se destruye el identificador.
::ReleaseDC()

return Self

METHOD VerAlEntrar() CLASS TMiCalendario
// Metodo cuando se abandona
// Se recupera el identificador.
LOCAL hDC := ::GetDC()

IF !::lTodoseCalculo
::Default()
::SetSize(::nCol2 + 1,::nFila2 + 1 + IF(::lMostrarBoton, ::nAltoFila, 0 ), .t. ) //Bingen
::lTodoseCalculo := .T.
ENDIF

::lConFoco := .T.
MarcarDia( hDC, ::aXY[::nPosicion], nrgb(255, 0, 0)) //::aColorTitulo[5]

// Se destruye el identificador.
::ReleaseDC()

return Self


METHOD GetDlgCode( nLastKey ) CLASS TMiCalendario

// This method is very similar to TControl:GetDlgCode() but it is
// necessary to have WHEN working

if .not. ::oWnd:lValidating
if nLastKey == VK_UP .or. nLastKey == VK_DOWN ;
.or. nLastKey == VK_RETURN .or. nLastKey == VK_TAB
::oWnd:nLastKey = nLastKey
else
::oWnd:nLastKey = 0
endif
endif

return If( IsWindowEnabled( ::hWnd ), DLGC_WANTALLKEYS, 0 )

METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TMiCalendario
CursorHand()

// Se evalua si es la linea de los botones.
* IF nRow > nFila2 .and. ;
* nCol > ::nCol1 .and. nCol <= ::nCol2
*
* ENDIF

RETURN SELF

METHOD PintarBoton(hDC, nColor, nRow, nCol) CLASS TMiCalendario //Bingen
// se carga la brocha y se guarda la anterior brocha.
Local hBrocha := CreateSolidBrush ( nColor )
Local hBrochaAnterior := SelectObject (hDC, hBrocha)
Local aPuntos := ::aBoton[::nPosBoton]


// Se pinta el recuadro.
FillRect( hDc, {aPuntos[ 1] + 1,;
aPuntos[ 2] + 1,;
aPuntos[ 3],;
aPuntos[ 4]}, hBrocha )

// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF

// Formato letra
SelectObject(hDC, IF(::lCuerpo( nRow, nCol),::oFont:hFont,::oFontBtn:hFont)) //Bingen
SetTextColor( hDC, ::aColorBoton[5] )
SetBkColor( hDC, nColor )

// Se dibujan los titulos de los botones
DrawText( hDC, ::aTitBoton[::nPosBoton], aPuntos,;
nOr(32, 4, 1 ) )

RETURN SELF

METHOD KeyChar( nKey, nFlags ) CLASS TMiCalendario

do case
case nKey == ::nK_MesAdelenta
::MesSiguinte()

case nKey == ::nK_MesAtras
::MesAnterior()

case nKey == ::nK_Menu
::RButtonUp( ::nAltoFila, ::nAnchoCol, 0 )

otherwise
return ::Super:KeyChar( nKey, nFlags )
endcase
return SELF

METHOD KeyDown( nKey, nFlags ) CLASS TMiCalendario
Local hDC
Local nPosAnterior := ::nPosicion

do case
case nKey == VK_RETURN //Bingen
::LButtonUp( ::aXY[::nPosicion,1], ::aXY[::nPosicion,2])

case nKey == VK_END
IF ::nPosicion < ::nUltimoDia
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nUltimoDia
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF

case nKey == VK_HOME
IF ::nPosicion > ::nPrimerDia
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nPrimerDia
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF

case nKey == VK_DOWN
IF ::lProcesarTecla
::lProcesarTecla := .F.
IF (::nPosicion + 7) < 42 .and. !empty(::aDias[(::nPosicion + 7)])
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nPosicion + 7

MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )

::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF
::lProcesarTecla := .T.
ENDIF

case nKey == VK_UP
IF ::lProcesarTecla
::lProcesarTecla := .F.
IF (::nPosicion - 7) > 0 .and. !empty(::aDias[(::nPosicion - 7)])
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nPosicion - 7

MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF
::lProcesarTecla := .T.
ENDIF

case nKey == VK_LEFT
IF ::lProcesarTecla
::lProcesarTecla := .F.
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion --

IF ::nPosicion < ::nPrimerDia
::nPosicion := ::nUltimoDia
ENDIF
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::ReleaseDC()
::nLastDay := ::nDiaMes
::lProcesarTecla := .T.
ENDIF

case nKey == VK_RIGHT
IF ::lProcesarTecla
::lProcesarTecla := .F.
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion ++

IF ::nPosicion > ::nUltimoDia
::nPosicion := ::nPrimerDia
ENDIF
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::ReleaseDC()
::nLastDay := ::nDiaMes
::lProcesarTecla := .T.
ENDIF

case nKey == VK_TAB .OR. nKey == VK_ESCAPE
return ::Super:KeyDown( nKey, nFlags )

case nKey == ::nK_AnoAtras
::AnoAnterior()

case nKey == ::nK_AnoAdelenta
::AnoSiguiente()

case nKey == ::nK_Hoy
::IrFecha( Date())

otherwise
return ::Super:KeyDown( nKey, nFlags )

endcase

RETURN SELF

METHOD IrFecha( dNvaFecha ) CLASS TMiCalendario
// Se recupera identificador del boton.
Local hDC := ::GetDC()
Local AnchoRelleno := (::nAnchoCol * 5) - 4

// Se desmarca el dia...
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion ][ 2] )


// Se fija la fecha.
::FijarFecha( dNvaFecha )
::nLastDay := ::nDiaMes

// Se restauran los colores...
::RestaurarColor()

// Se evalua bloque de codigo al cambiar de mes...
IF !EMPTY( ::bCambioMes )
Eval( ::bCambioMes )
ENDIF

// Se dibujan los dias.
DibujaDias( hDC, ::oFont, ::aDias, ::aXY,;
::aClrDias, ::bFestivos )

// Se dibujan los titulos del mes y año.
DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,;
::nAnchoCol, ::oFontMes, ::oFont, ::aColorTitulo,;
xPadc(::cMesPalabra, AnchoRelleno), ::cAno, ::aDiaSemana)



MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5] )

// Se libera el identificador
::ReleaseDC()
RETURN NIL


/*-------------------------------------------------------------------------*/
METHOD Language() CLASS TMiCalendario //Bingen

// Soporte multilenguaje
IF ::nLanguage = L_PORTUGUES
::aMESES := { "Janeiro" , "Fevereiro", "Março" ,"Abril",;
"Maio" , "Junho" , "Julho" ,"Agosto",;
"Setembro" , "Outubro" , "Novembro" ,"Dezembro"}

::aDiaSemana := {"Segunda","Terça","Quarta","Quinta",;
"_","Sábado","Domingo"}

::aTitBoton := {"&-Mês", "&+Mês", "< Ano", "Ano >", "Hoje"}

ELSEIF ::nLanguage = L_CATALA
::aMESES := { "Gener" , "Febrer" , "Març" ,"Abril",;
"Maig" , "Juny" , "Juliol" ,"Agost",;
"Setembre" , "Octubre", "Novembre","Desembre"}

::aDiaSemana := {"Dilluns","Dimarts","Dimecres","Dijous",;
"Divendres","Dissabte","Diumenge"}

::aTitBoton := {"&-Mes", "&+Mes", "-Any", "+Any", "Avuy"}

ELSEIF ::nLanguage = L_EUSKERA
::aMESES := { "Urtarrila", "Otsaila", "Martxoa" , "Apirila",;
"Maiatza" , "Ekaina" , "Uztaila" , "Abuztua",;
"Iraila" , "Urria" , "Azaroa" , "Abendua"}

::aDiaSemana := {"Astelehena","Asteartea","Asteazkena","Osteguna",;
"Ostirala","Larunbata","Igandea"}

::aTitBoton := {"&-Hil", "&+Hil", "-Urte", "+Urte", "Gaur"}

ELSEIF ::nLanguage = L_GALEGO
::aMESES := { "Xaneiro" , "Febreiro", "Marzal" ,"Abril",;
"Maio" , "Xuño" , "Xulio" ,"Agosto",;
"Septembro" , "Octubro" , "Novembro" ,"Decembro"}

::aDiaSemana := {"Luns","Martes","Mércores","Xoves",;
"Venres","Sabado","Domingo"}

::aTitBoton := {"&-Mes", "&+Mes", "< Año", "Año >", "Hoxe"}

ELSEIF ::nLanguage = L_SPANISH
::aMESES := { "Enero" , "Febrero", "Marzo" ,"Abril",;
"Mayo" , "Junio" , "Julio" ,"Agosto",;
"Septiembre", "Octubre", "Noviembre","Diciembre"}

::aDiaSemana := {"Lunes","Martes","Miercoles","Jueves",;
"Viernes","Sabado","Domingo"}

::aTitBoton := {"&-Mes", "&+Mes", "-Año", "+Año", "Hoy"}

ELSEIF ::nLanguage = L_ITALIANO
::aMESES := { "Gennaio" , "Febbraio" , "Marzo" ,"Aprile",;
"Maggio" , "Giugno" , "Luglio" ,"Agosto",;
"Settembre" , "Ottobre" , "Novembre" ,"Dicembre"}

::aDiaSemana := {"Lunedi","Martedi","Mercoledi","Giovedi",;
"Venerdi","Sabato","Domenica"}

::aTitBoton := {"&-Mese", "&+Mese", "-Anno", "+Anno", "Oggi"}

ELSEIF ::nLanguage = L_ENGLISH
::aMESES := { "Jannuary" , "February" , "March" ,"April",;
"May" , "June" , "July" ,"August",;
"September" , "October" , "November" ,"December"}

::aDiaSemana := {"Monday","Tuesday","Wednesday","Thursday",;
"Friday","Saturday","Sunday"}

::aTitBoton := {"&-Month", "&+Month", "-Year", "+Year", "Today"}

ELSEIF ::nLanguage = L_FRANCAIS
::aMESES := { "Janvier" , "Février" , "Mars" ,"Avril",;
"Mai" , "Juin" , "Juillet" ,"Août",;
"Septembre" , "Octobre" , "Novembre" ,"Decembre"}

::aDiaSemana := {"Lundi","Mardi","Mercredi","Jeudi",;
"Vendredi","Samedi","Dimanche"}

::aTitBoton := {"&-Mois", "&+Mois", "-An", "+An", "Auj'hui"}

ELSEIF ::nLanguage = L_DEUSTCH
::aMESES := { "Januar" , "Februar" , "März" ,"April",;
"Mai" , "Juni" , "Juli" ,"August",;
"September" , "Oktober" , "November" ,"Dezember"}

::aDiaSemana := {"Montag","Dienstag","Mittwoch","Donnerstag",;
"Freitag","Samstag","Sonntag"}

::aTitBoton := {"&-Monat", "&+Monat", "-Jahr", "+Jahr", "Heute"}

ENDIF

// Para realimentar los datos fechas con los nuevos valores.
::FijarFecha( ::dFechaControl )

RETURN NIL

STATIC FUNCTION CalcularAncho( nEspacioIzq,nWidth )
Local nColumnaAncho
nColumnaAncho := int( ( nWidth - nEspacioIzq ) / 7)
RETURN nColumnaAncho

STATIC FUNCTION CalcularAlto( nHeight )
Local nFilaAlto
nFilaAlto := int(( nHeight - 1) /
RETURN nFilaAlto

STATIC FUNCTION MarcarDia( hDC, aPuntos, nColor)
// Se crea el lapiz a utilizar.y se carga.
Local hPen1 := CreatePen(PS_SOLID, 3, nColor)
Local hPenAnterior := SelectObject(hDC, hPen1)

// Se dibuja el rectangulo
MoveTo(hDC, aPuntos[2] + 1, aPuntos[1] + 1)
LineTo(hDC, aPuntos[4] - 3, aPuntos[1] + 1)
LineTo(hDC, aPuntos[4] - 3, aPuntos[3] - 2)
LineTo(hDC, aPuntos[2] + 1, aPuntos[3] - 2)
LineTo(hDC, aPuntos[2] + 1, aPuntos[1] + 1)

// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF
RETURN NIL

STATIC FUNCTION FormarFrase(ElNumero)
//ElNumero , corresponde al numero que se debera frasear.

//Se definen variables locales de control.
LOCAL Pon_la_Y := ""
LOCAL Pon_Mil := ""
LOCAL CtrlTexto := "" //Almacenara a ELNUMERO en formato texto.
LOCAL FraseNumero:= ""
LOCAL ValorPos[11]
LOCAL Num_A[30]
LOCAL Num_B[ 9]
LOCAL Num_C[10]

//Se llenan matricez de control de palabras.
Num_A[ 1] = "" ; Num_A[ 16] = "Quince "
Num_A[ 2] = "Un " ; Num_A[ 17] = "Dieciseis "
Num_A[ 3] = "Dos " ; Num_A[ 18] = "Diecisiete "
Num_A[ 4] = "Tres " ; Num_A[ 19] = "Dieciocho "
Num_A[ 5] = "Cuatro " ; Num_A[ 20] = "Diecinueve "
Num_A[ 6] = "Cinco " ; Num_A[ 21] = "Veinte "
Num_A[ 7] = "Seis " ; Num_A[ 22] = "Veintiun "
Num_A[ 8] = "Siete " ; Num_A[ 23] = "Veintidos "
Num_A[ 9] = "Ocho " ; Num_A[ 24] = "Vientitres "
Num_A[ 10] = "Nueve " ; Num_A[ 25] = "Veinticuatro "
Num_A[ 11] = "Diez " ; Num_A[ 26] = "Veinticinco "
Num_A[ 12] = "Once " ; Num_A[ 27] = "Veintiseis "
Num_A[ 13] = "Doce " ; Num_A[ 28] = "Veintisiete "
Num_A[ 14] = "Trece " ; Num_A[ 29] = "Veintiocho "
Num_A[ 15] = "Catorce " ; Num_A[ 30] = "Veintinueve "

Num_B[ 1] = "Diez " ; Num_C[ 1] = ""
Num_B[ 2] = "Veinte " ; Num_C[ 2] = "Ciento "
Num_B[ 3] = "Treinta " ; Num_C[ 3] = "Doscientos "
Num_B[ 4] = "Cuarenta " ; Num_C[ 4] = "Trescientos "
Num_B[ 5] = "Cincuenta " ; Num_C[ 5] = "Cuatrocientos "
Num_B[ 6] = "Sesenta " ; Num_C[ 6] = "Quinientos "
Num_B[ 7] = "Setenta " ; Num_C[ 7] = "Seiscientos "
Num_B[ 8] = "Ochenta " ; Num_C[ 8] = "Setecientos "
Num_B[ 9] = "Noventa " ; Num_C[ 9] = "Ochocientos "
Num_C[ 10] = "Novecientos "

//Se vacias valores de control
CtrlTexto = STR(ElNumero,8,0)
ValorPos[ 1] = VAL(Substr(CtrlTexto,8,1))
ValorPos[ 2] = VAL(Substr(CtrlTexto,7,1))
ValorPos[ 3] = VAL(Substr(CtrlTexto,6,1))
ValorPos[ 4] = VAL(Substr(CtrlTexto,5,1))
ValorPos[ 5] = VAL(Substr(CtrlTexto,4,1))
ValorPos[ 6] = VAL(Substr(CtrlTexto,3,1))
ValorPos[ 7] = VAL(Substr(CtrlTexto,2,1))
ValorPos[ 8] = VAL(Substr(CtrlTexto,1,1))
ValorPos[ 9] = VAL(Substr(CtrlTexto,7,2))
ValorPos[10] = VAL(Substr(CtrlTexto,4,2))
ValorPos[11] = VAL(Substr(CtrlTexto,1,2))

//Se comienza a generar la frase de control comenzando por las
//unidades.
Pon_la_Y = IF(ValorPos[ 1] = 0,"","y ")
IF ValorPos[ 2] < 3
FraseNumero = Num_A[ValorPos[ 9] + 1]
ELSE
FraseNumero = Num_B[ValorPos[ 2]] + Pon_la_Y + ;
IF(ValorPos[ 9] > 20,Num_A[ValorPos[ 1]+1],"")
ENDIF

//se continua formado la frase para las centenas
Num_C[ 2] = IF((ValorPos[ 1] + ValorPos[ 2]) = 0,"Cien ","Ciento ")
FraseNumero = Num_C[ValorPos[ 3] + 1] + FraseNumero

//se continua formado la frase para los miles
Pon_Mil = IF((ValorPos[ 4] + ValorPos[ 5] + ValorPos[ 6]) = 0,"","Mil ")
Pon_la_Y = IF( ValorPos[ 4] = 0,"","y ")

IF ValorPos[ 5] < 3
FraseNumero = Num_A[ValorPos[10] + 1] + Pon_Mil + FraseNumero
ELSE
FraseNumero = Num_B[ValorPos[ 5]] + Pon_la_Y +;
Num_A[ValorPos[ 4] + 1] + Pon_Mil + FraseNumero
ENDIF

RETURN FraseNumero

[cnavarro]

intenta quitarle el ::oFont:End() en el metodo Destroy

Podrias poner el codigo anterior en un <code>?

[MOISES]

Aquí tienes el ejemplo completo:

http://rg.to/file/6cbe13abc7999ea032a39 ... a.prg.html

Muchas gracias Cristóbal.

[cnavarro]

No soy capaz de descargarlo

[MOISES]

Code: Select all  Expand view

CLASS TMiCalendario FROM TControl
        DATA lContinuar       AS LOGICAL INIT .T.
        DATA lConFoco         AS LOGICAL INIT .T.
        DATA oFont
        DATA lFont            AS LOGICAL INIT .F.
        DATA oFontMes
        DATA oFontTxt
        DATA oFontBtn
        DATA nPosFila      // la posicion de la fila
        DATA nPosCol       // la posicion de la columna
        DATA nPosBoton     // la columna del boton.
        DATA aDiaSemana    AS ARRAY INIT ARRAY( 7)
        DATA aXY           AS ARRAY INIT ARRAY(42)
        DATA aBoton        AS ARRAY INIT ARRAY( 5)
        DATA aDias         AS ARRAY INIT ARRAY(42)
        DATA aClrDias      AS ARRAY INIT ARRAY(42)
        DATA aColorCuerpo  AS ARRAY
        DATA aColorTitulo  AS ARRAY
        DATA aColorBoton   AS ARRAY
        DATA aColorDomingo AS ARRAY
        DATA aColorFestivo AS ARRAY
            DATA aFestivos     AS ARRAY INIT ARRAY(12) //READONLY gerava erro
        DATA nAltoFila
        DATA nAnchoCol
        DATA nAnchoBoton
        DATA aTitBoton
        DATA nFila1
        DATA nFila2
        DATA nCol1
        DATA nCol2
        DATA nPrimerDia    AS NUMERIC INIT  1
        DATA nUltimoDia    AS NUMERIC INIT 42
        DATA lSelectOK     AS LOGICAL INIT .T.
        DATA bCambioMes    //Block a ejecutar cuando cambie el mes...
        DATA bFestivos     //Bingen
        DATA nLanguage     //Bingen
        DATA aMeses        AS ARRAY INIT ARRAY(12) //Bingen
        DATA nLastDay      AS NUMERIC INIT  1
     // Datos relacionados con la fecha seleccionada.
        DATA dFechaControl
        DATA nMesNumero             READONLY
        DATA cMesNumero             READONLY
        DATA cMesPalabra            READONLY
        DATA nDiaSemana             READONLY
        DATA cDiaSemana             READONLY
        DATA cDiaPalabra            READONLY
        DATA nDiaMes                READONLY
        DATA cDiaMes                READONLY
        DATA cDiaMesPalabra         READONLY
        DATA nAno                   READONLY
        DATA cAno                   READONLY
        DATA cAnoPalabra            READONLY
        DATA aFecha  AS ARRAY INIT ARRAY(2) READONLY
        DATA aVencto AS ARRAY INIT ARRAY(8) READONLY
// aFecha, es un array con formatos de fecha
// aVencto, es un array con las fechas de vencimiento 15,30,45,60 dias...
         // DATAS para reasignar teclas de navegacion.
            DATA nK_AnoAdelenta  AS NUMERIC INIT VK_NEXT
            DATA nK_AnoAtras     AS NUMERIC INIT VK_PRIOR
            DATA nK_MesAdelenta  AS NUMERIC INIT K_MAS
            DATA nK_MesAtras     AS NUMERIC INIT K_MENOS
        DATA nK_Menu         AS NUMERIC INIT K_DIVISION
        DATA nK_Hoy          AS NUMERIC INIT K_HOY
        DATA nPosicion
        DATA lTodoseCalculo   AS LOGICAL INIT .F.
        DATA lProcesarTecla   AS LOGICAL INIT .T.
        DATA lMostrarBoton    AS LOGICAL INIT .T.
        CLASSDATA lRegistered AS LOGICAL

            METHOD New( ) CONSTRUCTOR  //Bingen
            METHOD Display()
            METHOD Paint()
           METHOD Language()  //Bingen
            METHOD LButtonDown( nRow, nCol, nFlags )
            METHOD LButtonUp( nRow, nCol )
            METHOD RButtonUp( nRow, nCol, nKeyFlags )
        METHOD FijarFecha( dFecha )
            METHOD CalcularDias( dFecha )
            METHOD FijaClrs()
            METHOD FijaClrDomingo()
        METHOD FijaClrFestivo()
        METHOD RestaurarColor() INLINE ::FijaClrs(), ::FijaClrDomingo(), ::FijaClrFestivo()
            METHOD ColorDia( nDia, aColores )
        METHOD Default()
            METHOD Destroy()
            METHOD MouseMove( nRow, nCol, nKeyFlags )
        METHOD GetDlgCode( nLastKey )
        METHOD VerAlSalir()
        METHOD VerAlEntrar()
            METHOD PintarBoton(hDC, nColor, nRow, nCol)
            METHOD KeyChar( nKey, nFlags )
            METHOD KeyDown( nKey, nFlags )
         // Estos metodos devuelven verdadero o falso segun se encuentren
     // dentro del cuerpo del calendario o en el area de botones.
        METHOD lCuerpo( nRow, nCol)
        METHOD lBotones( nRow, nCol)
         // Metodos para moverse entre los meses
        METHOD CambiarMes(nMeses, lProcesar)
            METHOD MesSiguinte()  INLINE ::CambiarMes(  1)
            METHOD MesAnterior()  INLINE ::CambiarMes( -1)
            METHOD AnoSiguiente() INLINE ::CambiarMes( 12)
            METHOD AnoAnterior()  INLINE ::CambiarMes(-12)
        METHOD Hoy()          INLINE ::IrFecha( Date() )
            METHOD IrFecha( dNvaFecha )
         // Metodos para tomar y dejar el foco.
            METHOD LostFocus( hCtlFocus ) INLINE ::Super:LostFocus( hCtlFocus ), ::VerAlSalir()
            METHOD GotFocus() INLINE ::setfocus(), ::VerAlEntrar()
      ENDCLASS

      METHOD New (nTop, nLeft, nWidth, nHeight, oWnd, oFont, nLANGUAGE ) CLASS TMiCalendario
         DEFAULT nTop:=5, nLeft:=5,nWidth:=120,nHeight:=120  //Bingen
             DEFAULT nLanguage := L_SPANISH

          // Coordenadas de la region de dibujo.
             ::nTop      := nTop
             ::nLeft     := nLeft
             ::nBottom   := ::nTop  + nHeight
             ::nRight    := ::nLeft + nWidth

             ::dFechaControl := Date()
         ::bFestivos     := {|| ARRAY(0)  }  //Bingen
         ::nLanguage   := nLanguage          //Bingen
         ::Language()                        //Bingen

          // Array con dias festivos...
         ::aFestivos     := { {}, {}, {},;
                                  {}, {}, {},;
                                  {}, {}, {},;
                  {}, {}, {}  }

             ::oWnd      := oWnd
         //::oFont     := oFont    //ojo
             ::SetFont( oFont )  // sigue fallando



             ::lFont     := !oFONT=Nil
         ::nPosFila  := 1
         ::nPosCol   := 1
         ::nPosBoton := 1
         ::aColorCuerpo := { nRgb(235,235,210),; // Color Borde superior
                             nRgb(205,205,155),; // Color de Relleno
                 nRgb(150,150, 75),; // Color Borde inferior
                 nRgb(  0,  0,  0),; // Color del texto,
                 nRgb(130,130, 65)}  // Color dia seleccionado al perder el foco

         ::aColorTitulo := { nRgb(170,170, 80),; // Color Borde superior
                             nRgb(130,130, 65),; // Color de Relleno
                 nRgb(100,100, 50),; // Color Borde inferior
                 ::aColorCuerpo[2],; // Color Letra mes y año
                 nRgb(255,255,255) } // Color de los dias.

         ::aColorBoton  := { nRgb(170,170, 80),; // Color Borde superior
                             nRgb(130,130, 65),; // Color de Relleno
                 nRgb(100,100, 50),; // Color Borde inferior
                 ::aColorCuerpo[2],; // Color Letra
                 ::aColorCuerpo[2] } // Color relleno cuando se selecciona.

             ::aColorDomingo := ::aColorTitulo
         ::aColorFestivo := ::aColorTitulo


         ::nPosicion    := day(::dFechaControl)
         ::FijaClrs()
         ::FijaClrDomingo()
             ::FijaClrFestivo()

             ::nStyle    := nOr(WS_CHILD, WS_VISIBLE, WS_TABSTOP)

             ::Register()

             If !Empty( oWnd:hWnd )
                ::Create()
                oWnd:AddControl( Self )
             Else
                oWnd:DefControl( Self )
             Endif

      Return Self

METHOD Display() CLASS TMiCalendario

       IF ::lContinuar
          ::lContinuar := .F.
      ::BeginPaint()
          ::Paint()
      ::EndPaint()
          ::lContinuar := .T.
       ELSE
          MsgInfo("Para Ccontrolar Que Nao Passe Duas Vezes")
       ENDIF

RETURN SELF


METHOD Paint() CLASS TMiCalendario
    // Se recupera identificador del boton.
       Local hDC    := ::GetDC()
       Local nColor

       IF !::lTodoseCalculo
           ::Default()
           ::SetSize(::nCol2 + 1,::nFila2 + 1 + IF(::lMostrarBoton, ::nAltoFila, 0 ), .t. )  //Bingen
       ::lTodoseCalculo := .T.
       ENDIF

    // Comienza el dibujo
       DibujarTodo( hDC, ::nAltoFila, ::nAnchoCol, ::nFila1, ::nFila2,;
                         ::nCol1, ::nCol2, ::oFont, ::aDiaSemana,;
             ::aXY, ::oFontTxt, ::aDias, ::aColorTitulo, ::aClrDias, ::aColorCuerpo, ::aColorBoton,;
                         ::cMesPalabra, ::oFontMes, ::cAno,;
                         ::oFontBtn, ::aBoton, ::nAnchoBoton, ::aTitBoton, ::bFestivos )  //Bingen

    // Se pinta si esta con el foco o no.
      if ::lFocused
         MarcarDia( hDC, ::aXY[::nPosicion], nrgb(255, 0, 0))
      else
         MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5])
      endif

    // Se libera el identificador del boton.
       ::ReleaseDC()

Return Self


STATIC FUNCTION DibujarTodo( hDC, nAltoFila, nAnchoCol, nFila1, nFila2,;
                                 nCol1, nCol2, oFont, aDiaSemana, aConPuntos,;
                 oFontTxt,aDias, aColorTitulo, aClrDias, aColorCuerpo, aColorBoton,;
                 cMesPalabra, oFontMes, cAno, ;
                 oFontBtn, aBoton, nAnchoBoton,;
                 aTitBoton, bFestivos )  //Bingen

       Local A
       Local aLosPuntos := aConPuntos[42]

    // Se dibuja el cuerpo del calendario
       DibujaCuerpo( hDC, aConPuntos, aClrDias, aColorCuerpo)

    // Se dibujan los dias.
       DibujaDias( hDC, oFont, aDias, aConPuntos, aClrDias, bFestivos )

    // Se dibujan la parte superior del calendario
       DibujaEncabezado(hDC,  nFila1, nFila2, nAltoFila,;
                        nCol1,  nCol2, nAnchoCol,;
                        aDiaSemana,  oFont, aColorTitulo,;
                        cMesPalabra, oFontMes, cAno )

    // Se dibujan los titulos del encabezado.
       DibujaTitulos(hDC, nAltoFila, nCol1, nCol2, nAnchoCol,;
                oFontMes, oFontTxt, aColorTitulo, cMesPalabra,;
        cAno, aDiaSemana)

    // Se dibujan los botones.
       DibujaBotones(hDC, nFila2, nAltoFila,;
                   nCol1,  nCol2, nAnchoCol,;
                   oFontBtn,  aColorBoton, aBoton, aTitBoton, nAnchoBoton)

return NIL

STATIC FUNCTION DibujaDias( hDC, oFont, aDias, aXY, aClrDias, bFestivos)

       Local HBROCHAANTERIOR, HOLDPEN
       Local A, aFESTIVOS:=ARRAY(0), nCOLOR:=0
       Local hBrocha
       Local hPen1
       Local hPen2

       DEFAULT bFestivos   := {|| ARRAY(0) }

       aFESTIVOS:=EVAL(bFestivos)

    // Se dibujan los dias.
       SelectObject( hDC, oFont:hFont)

       FOR A = 1 TO 42
        // Se crea brocha para pintar el fondo del recuadro...
           hBrocha := CreateSolidBrush ( aClrDias[ A][ 2] )

        // se carga la brocha, se guarda la brocha anterior y se pinta
           hBrochaAnterior := SelectObject (hDC, hBrocha)
           FillRect( hDc, aXY[A], hBrocha )

        // Se restaura la brocha y destruye la utilizada
           SelectObject (hDC, hBrochaAnterior )
           IF !DeleteObject( hBrocha )
              MsgInfo("Parece que no se destruyo")
           ENDIF

        // Aqui se dibujan los bordes....
    // UNO. se cargan los lapices...
           hPen1 := CreatePen(PS_SOLID, 1, aClrDias[ A][ 1])   //Claro nrgb(235,235,210)
           hPen2 := CreatePen(PS_SOLID, 1, aClrDias[ A][ 3])   //Oscuro nrgb(160,160, 75)

        // Se carga el lapices y se dibuja borde superior..
           hOldPen := SelectObject( hDC, hPen1 )
           MoveTo(hDc , aXY[ A][ 2] - 1, aXY[ A][ 3]     )
           LineTo(hDc,  aXY[ A][ 2] - 1, aXY[ A][ 1] - 1 )
           LineTo(hDc,  aXY[ A][ 4]    , aXY[ A][ 1] - 1 )

        // Se destruyen objetos utilizados
           SelectObject( hDC, hOldPen )
           IF !DeleteObject( hPen1 )
               MsgInfo("O objeto nao se destruiu")
           ENDIF

        // Se carga el lapices y se dibuja borde inferior..
           hOldPen := SelectObject( hDC, hPen2 )
           MoveTo(hDc , aXY[ A][ 2], aXY[ A][ 3]     )
           LineTo(hDc,  aXY[ A][ 4], aXY[ A][ 3]     )
           LineTo(hDc,  aXY[ A][ 4], aXY[ A][ 1] - 2 )

        // Se destruyen objetos utilizados
           SelectObject( hDC, hOldPen )
           IF !DeleteObject( hPen2 )
           MsgInfo("El objeto no se destruyo")
           ENDIF

    // Se dibuja el texto...
            SetBkColor(   hDC, aClrDias[ A][ 2] )
            nCOLOR:=ASCAN(aFESTIVOS, {|aVal| aVal[1] == VAL(aDias[A]) }) //Comprobar festivos
            IF nCOLOR>0    //Bingen
              SetTextColor( hDC, aFESTIVOS[nCOLOR,2])
            ELSE
             SetTextColor( hDC, aClrDias[ A][ 4] )
            ENDIF

            DrawText( hDC, " " + aDias[A] + "  ", aXY[A],;
                      nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA

       NEXT A

RETURN NIL

STATIC FUNCTION DibujaCuerpo( hDC, aXY, aClrDias, aColorCuerpo  )
    // Se crea el lapiz a utilizar.
       Local A, HOLDPEN
       Local hPen1
       Local hPen2
       Local hBrocha
       Local hBrochaAnterior

     // Se dibujan los bordes del cuerpo
        hPen1 := CreatePen(PS_SOLID, 1, aColorCuerpo[ 1])
        hPen2 := CreatePen(PS_SOLID, 1, Getsyscolor(16) )

     // Se carga el lapices y se dibuja borde superior..
        hOldPen := SelectObject( hDC, hPen1 )
        MoveTo(hDc , aXY[ 1][ 2] - 2, aXY[ 1][ 1] - 1 )
        LineTo(hDc,  aXY[ 1][ 2] - 2, aXY[36][ 3] + 2 )

     // Se destruyen objetos utilizados
        SelectObject( hDC, hOldPen )
        IF !DeleteObject( hPen1 )
           MsgInfo("El objeto no se destruyo")
        ENDIF

     // Se carga el lapices y se dibuja borde inferior..
        hOldPen := SelectObject( hDC, hPen2 )
        MoveTo(hDc , aXY[36][ 2] - 1, aXY[36][ 3] + 1 )
        LineTo(hDc,  aXY[42][ 4] + 1, aXY[36][ 3] + 1 )
        LineTo(hDc,  aXY[42][ 4] + 1, -1              )

     // Se destruyen objetos utilizados
        SelectObject( hDC, hOldPen )
        IF !DeleteObject( hPen2 )
           MsgInfo("El objeto no se destruyo")
        ENDIF

RETURN NIL

STATIC FUNCTION DibujaEncabezado(hDC,  nFila1, nFila2, nAltoFila,;
                                     nCol1,  nCol2, nAnchoCol,;
                  aDiaSemana,  oFont, aColorTitulo,;
                  cMesPalabra, oFontMes, cAno )

    // Se crea el lapiz a utilizar.
       Local hPen1 := CreatePen(PS_SOLID, 1, aColorTitulo[1]) //Lapiz claro
       Local hPen2 := CreatePen(PS_SOLID, 1, aColorTitulo[3]) //Lapiz oscuro
       Local hPenAnterior
       Local aPuntos[4]
       Local A

    // Se crea brocha pintar la parte superior y luego
    // se carga la brocha y se guarda la anterior brocha.
       Local hBrocha         := CreateSolidBrush ( aColorTitulo[2] )
       Local hBrochaAnterior := SelectObject (hDC, hBrocha)


    // Se pinta el recuadro.
       FillRect( hDc, { 2, nCol1, nFila1 - 1, nCol2 }, hBrocha )

    // Se restaura la brocha y destruye la utilizada
       SelectObject (hDC, hBrochaAnterior )
       IF !DeleteObject( hBrocha )
          MsgInfo("Parece que no se destruyo")
       ENDIF

    // Se dibuja el contorno se selecciona lapiz.
       // Linea superior y linea izquierda
       hPenAnterior := SelectObject( hDC, hPen1 )
       MoveTo(hDC, nCol2 - 1, 1)
       LineTo(hDC, nCol1    , 1)
       LineTo(hDC, nCol1    , nFila1 - 1)
       LineTo(hDC, nCol1 - 1, nFila1 - 1)
       LineTo(hDC, nCol1 - 1, 0)
       LineTo(hDC, nCol2    , 0)

       //Linea horizontal del centro.
       MoveTo(hDC, nCol2 - 1, nAltoFila)
       LineTO(hDC, nCol1 - 1, nAltoFila)

       MoveTo(hDC, nCol2 - (nAnchoCol * 2), 2)
       LineTo(hDC, nCol2 - (nAnchoCol * 2), nAltoFila)

       For A = 1 to 6
           MoveTo(hDC, (nAnchoCol * A) + nCol1, nAltoFila)
           LineTo(hDC, (nAnchoCol * A) + nCol1, nAltoFila * 2)
       Next a


     // Se destruyen objetos utilizados
        SelectObject( hDC, hPenAnterior )
        IF !DeleteObject( hPen1 )
       MsgInfo("El objeto no se destruyo")
        ENDIF

    // Se dibuja el contorno se selecciona lapiz.
       // Linea superior y linea izquierda
       hPenAnterior := SelectObject( hDC, hPen2 )
       MoveTo(hDC, nCol2 - 1, 1)
       LineTo(hDC, nCol2 - 1, nFila1 - 1)
       LineTo(hDC, nCol1 - 2, nFila1 - 1)

       //Linea horizontal del centro.
       MoveTo(hDC, nCol2 - 1, nAltoFila - 1)
       LineTO(hDC, nCol1 - 2, nAltoFila - 1)

       MoveTo(hDC, nCol2 - (nAnchoCol * 2) - 1, 0)
       LineTo(hDC, nCol2 - (nAnchoCol * 2) - 1, nAltoFila)

       For A = 1 to 6
           MoveTo(hDC, (nAnchoCol * A) + nCol1 - 1, nAltoFila)
           LineTo(hDC, (nAnchoCol * A) + nCol1 - 1, nAltoFila * 2)
       Next a

     // Se destruyen objetos utilizados
        SelectObject( hDC, hPenAnterior )
        IF !DeleteObject( hPen2 )
       MsgInfo("El objeto no se destruyo")
        ENDIF


RETURN NIL

STATIC FUNCTION DibujaTitulos(hDC, nAltoFila, nCol1, nCol2,;
                        nAnchoCol,  oFontMes, oFont, aColorTitulo,;
            cMesPalabra, cAno, aDiaSemana)

       LOCAL aPuntos[4]
       LOCAL A

    // Formato letra
       SelectObject(hDC, oFont:hFont)  //Se selecciona el tipo de letra.
       SetTextColor( hDC, aColorTitulo[5] )
       SetBkColor(   hDC, aColorTitulo[2] )

    // Se dibujan los titulos de los dias.
       A := 0
       aPuntos[ 1] := nAltoFila
       aPuntos[ 3] := nAltoFila * 2
       FOR A = 0 TO 6
           aPuntos[ 2] := nCol1 + ( A * nAnchoCol )
       aPuntos[ 4] := aPuntos[2] + nAnchoCol
           DrawText( hDC, LEFT(aDiaSemana[ A + 1],3), aPuntos,;
                     nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
       NEXT A

    // Se dibuja el mes en palabras.
       SelectObject(hDC, oFontMes:hFont)
       SetTextColor(hDC, aColorTitulo[4])
       aPuntos[ 1] := 3
       aPuntos[ 2] := 2
       aPuntos[ 3] := nAltoFila - 1
       aPuntos[ 4] := nCol2 - (nAnchoCol*2) - 1
       DrawText( hDC, cMesPalabra, aPuntos,;
                 nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA

    // Se dibuja el numero del año
       aPuntos[ 2] := aPuntos[ 4] + 2
       aPuntos[ 4] := nCol2 - 1
       DrawText( hDC, cAno, aPuntos,;
                 nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA

RETURN NIL

STATIC FUNCTION DibujaBotones(hDC, nFila2, nAltoFila,;
                                    nCol1,  nCol2, nAnchoCol,;
                    oFont, aColorBoton, aBoton, aTitBoton, nAnchoBoton )

    // Se crea el lapiz a utilizar.
       Local hPen1 := CreatePen(PS_SOLID, 1, aColorBoton[1]) //Lapiz claro
       Local hPen2 := CreatePen(PS_SOLID, 1, aColorBoton[3]) //Lapiz oscuro
       Local hPenAnterior
       Local aPuntos[5]
       Local A

    // Se crea brocha pintar la parte superior y luego
    // se carga la brocha y se guarda la anterior brocha.
       Local hBrocha         := CreateSolidBrush ( aColorBoton[2] )
       Local hBrochaAnterior := SelectObject (hDC, hBrocha)


    // Se pinta el recuadro.
       FillRect( hDc, { nFila2 + 2, nCol1, nFila2 + nAltoFila - 1, nCol2 }, hBrocha )

    // Se restaura la brocha y destruye la utilizada
       SelectObject (hDC, hBrochaAnterior )
       IF !DeleteObject( hBrocha )
          MsgInfo("Parece que no se destruyo")
       ENDIF

    // Se dibuja el contorno se selecciona lapiz.
       // Linea superior y linea izquierda
       hPenAnterior := SelectObject( hDC, hPen1 )
       MoveTo(hDC, nCol2 - 1, nFila2 + 1)
       LineTo(hDC, nCol1    , nFila2 + 1)
       LineTo(hDC, nCol1    , nFila2 + nAltoFila - 1)
       LineTo(hDC, nCol1 - 1, nFila2 + nAltoFila - 1)
       LineTo(hDC, nCol1 - 1, nFila2    )

       For A = 1 to 4
           MoveTo(hDC, (nAnchoBoton * A) + nCol1 + 1, nFila2 + 1)
           LineTo(hDC, (nAnchoBoton * A) + nCol1 + 1, nFila2 + nAltoFila)
       Next a

     // Se destruyen objetos utilizados
        SelectObject( hDC, hPenAnterior )
        IF !DeleteObject( hPen1 )
       MsgInfo("El objeto no se destruyo")
        ENDIF

    // Se dibuja el contorno se selecciona lapiz.
       // Linea inferior y linea derecha
       hPenAnterior := SelectObject( hDC, hPen2 )
       MoveTo(hDC, nCol2    , nFila2 + 1)
       LineTo(hDC, nCol2    , nFila2 + nAltoFila )
       LineTo(hDC, nCol1 - 2, nFila2 + nAltoFila )
       LineTo(hDC, nCol1 - 2, nFila2 + nAltoFila - 1)
       LineTo(hDC, nCol2 - 1, nFila2 + nAltoFila - 1)
       LineTo(hDC, nCol2 - 1, nFila2 + 1)

       For A = 1 to 4
           MoveTo(hDC, (nAnchoBoton * A) + nCol1, nFila2 + 1)
           LineTo(hDC, (nAnchoBoton * A) + nCol1, nFila2 + nAltoFila)
       Next a


     // Se destruyen objetos utilizados
        SelectObject( hDC, hPenAnterior )
        IF !DeleteObject( hPen2 )
       MsgInfo("El objeto no se destruyo")
        ENDIF

    // Formato letra
       SelectObject(hDC, oFont:hFont)  //Se selecciona el tipo de letra.
       SetTextColor( hDC, aColorBoton[5] )
       SetBkColor(   hDC, aColorBoton[2] )

    // Se dibujan los titulos de los botones       //Bingen
       DrawText( hDC, aTitBoton[1], aBoton[ 1],;
                     nOr(32, 4, 1 ) )
       DrawText( hDC, aTitBoton[2], aBoton[ 2],;
                     nOr(32, 4, 1 ) )
       DrawText( hDC, aTitBoton[3], aBoton[ 3],;
                     nOr(32, 4, 1 ) )
       DrawText( hDC, aTitBoton[4], aBoton[ 4],;
                     nOr(32, 4, 1 ) )
       DrawText( hDC, aTitBoton[5], aBoton[ 5],;
                     nOr(32, 4, 1 ) )

RETURN NIL

METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TMiCalendario
    // Se recupera identificador del boton.
       Local hDC       := ::GetDC()
       Local nAltoFila := ::nAltoFila
       Local nAnchoCol := ::nAnchoCol
       Local nFila1    := ::nFila1
       Local nFila2    := ::nFila2
       Local n         := 1
       Local nPos      := 0
       Local nPosAnterior := ::nPosicion
       Local B


    // Se fija que el objeto tenga el foco.
       ::SetFocus()

    // Se determina el recuadro donde se da el click
       IF ::lCuerpo( nRow, nCol)

       // Se determina el numero de fila
          While nRow > ( nPos + nFila1 + nAltoFila ) .and. n < 7
                nPos += ::nAltoFila
                n++
          end
          ::nPosFila := n

       // Se determina la posicion de la columna.
          n    := 1
      nPos := 0
          While nCol > ( nPos + nAnchoCol + ::nCol1 ) .and. n < 7
                nPos += nAnchoCol
                n++
          end
          ::nPosCol  := n


       // Se pinta el dia seleccionado.
          ::nPosicion := ( (::nPosFila - 1) * 7) + ::nPosCol
          B = ALLTRIM( ::aDias[::nPosicion])

      IF !EMPTY( B )
             MarcarDia( hDC, ::aXY[nPosAnterior], ::aClrDias[ nPosAnterior ][2])
             MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))

          // Se actualizan los datos fecha.
             ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                 ::cMesNumero         + "/" +;
                             ::cAno ) )
             ::nLastDay := ::nDiaMes
      ELSE
           IF ::lCuerpo( nRow, nCol)    //Bingen
             TONE(500,3)
         ::lSelectOK :=.F.
       ENDIF
           ::nPosicion := nPosAnterior
      ENDIF

       ENDIF

    // Se evalua si es la linea de los botones.
       IF ::lBotones( nRow, nCol)

       // Se determina la posicion de la columna.
          n    := 1
      nPos := 0
          While nCol > ( nPos + ::nAnchoBoton + ::nCol1 ) .and. n < 5
                nPos += ::nAnchoBoton
                n++
          end

          ::nPosBoton  := n
      ::PintarBoton(hDC, ::aColorBoton[5], nRow, nCol)

       // Se evalua el boton seleccionado.
      DO CASE
         CASE ::nPosBoton == 1
              ::MesAnterior()
         CASE ::nPosBoton == 2
              ::MesSiguinte()
         CASE ::nPosBoton == 3
                  ::AnoAnterior()
         CASE ::nPosBoton == 4
                  ::AnoSiguiente()
         CASE ::nPosBoton == 5
                  ::IrFecha( Date())
      ENDCASE

       ENDIF

    // Se libera el identificador del boton.
        ::ReleaseDC()


return Self

METHOD LButtonUp( nRow, nCol )  CLASS TMiCalendario
       LOCAL hDC := ::GetDC()

       IF ::lSelectOK
        ::PintarBoton(hDC, ::aColorBoton[2], nRow, nCol)
        IF ::lCuerpo( nRow, nCol)
           ::Super:LButtonUp( nRow, nCol )
        ENDIF
       ELSE
        ::lSelectOK:=.T.
       ENDIF

       ::ReleaseDC()

RETURN Self

METHOD RButtonUp( nRow, nCol, nKeyFlags ) CLASS TMiCalendario
       Local oMenu
       ::SetFocus()
       MENU oMenu POPUP
            MENUITEM ::aTitBoton[1] ACTION ::MesAnterior()
            MENUITEM ::aTitBoton[2] ACTION ::MesSiguinte()
        MENUITEM ::aTitBoton[5] ACTION ::Hoy()
        MENUITEM "Otro Mes"
          MENU
              MENUITEM ::aMESES[ 1] ACTION ::CambiarMes( 1 - ::nMesNumero )
              MENUITEM ::aMESES[ 2] ACTION ::CambiarMes( 2 - ::nMesNumero )
              MENUITEM ::aMESES[ 3] ACTION ::CambiarMes( 3 - ::nMesNumero )
              MENUITEM ::aMESES[ 4] ACTION ::CambiarMes( 4 - ::nMesNumero )
              MENUITEM ::aMESES[ 5] ACTION ::CambiarMes( 5 - ::nMesNumero )
              MENUITEM ::aMESES[ 6] ACTION ::CambiarMes( 6 - ::nMesNumero )
              MENUITEM ::aMESES[ 7] ACTION ::CambiarMes( 7 - ::nMesNumero )
              MENUITEM ::aMESES[ 8] ACTION ::CambiarMes( 8 - ::nMesNumero )
              MENUITEM ::aMESES[ 9] ACTION ::CambiarMes( 9 - ::nMesNumero )
              MENUITEM ::aMESES[10] ACTION ::CambiarMes(10 - ::nMesNumero )
              MENUITEM ::aMESES[11] ACTION ::CambiarMes(11 - ::nMesNumero )
              MENUITEM ::aMESES[12] ACTION ::CambiarMes(12 - ::nMesNumero )
          ENDMENU

            SEPARATOR
            MENUITEM ::aTitBoton[3] ACTION ::AnoAnterior()
            MENUITEM ::aTitBoton[4] ACTION ::AnoSiguiente()
            IF !::lMostrarBoton                                             //Bingen
           MENUITEM "Mostrar Botones" ACTION ::SetSize(::nWidth(),::nheight() + ::nAltoFila, .t. ),;
                                             ::ReSize(),;
                                                 ::lMostrarBoton := .T.
            ELSE
           MENUITEM "Ocultar Botones" ACTION ::SetSize(::nWidth(),::nheight() - ::nAltoFila, .t. ),;
                                             ::ReSize(),;
                                                 ::lMostrarBoton := .F.
        ENDIF

       ENDMENU
       ACTIVATE POPUP oMenu AT nRow, nCol OF Self

RETURN SELF

METHOD lBotones( nRow, nCol) CLASS TMiCalendario
RETURN iif( (nRow  > ::nFila2  .and. ;
             nCol  > ::nCol1   .and. ;
             nCol <= ::nCol2), .T., .F.)


METHOD lCuerpo( nRow, nCol)  CLASS TMiCalendario
RETURN iif( (nRow  > ::nFila1  .and.;
             nRow <= ::nFila2  .and.;
             nCol  > ::nCol1   .and.;
         nCol <= ::nCol2), .T., .F.)

METHOD Default() CLASS TMiCalendario
       Local B := 1
       Local aPuntos[ 5]
*      Local aPunt   := GetClientRec(::hWnd)
local ofu

    // Estos son los datos de las columnas.
       ::nCol1     := 1                                   //Inicio Columna
       ::nAnchoCol := CalcularAncho(::nCol1, ::nWidth() ) //El ancho de la columna
       ::nCol2     := (::nAnchoCol * 7 ) + ::nCol1        //Final Columna

    // Estos son los datos de la fila
       ::nAltoFila := CalcularAlto( ::nHeight() )         //El alto de la fila.
       ::nFila1    := ::nAltoFila * 2                     //Ubicacion primera linea a dibujar
       ::nFila2    := ::nAltoFila * 8                     //Fila Final

    // Font del título 75% de la altura de la celda
       ::oFontMes := TFont():New( "Arial", 0, -(::nAltoFila*.75),, .t. ) //Bingen
    // Font de los textos de los días 50% de la altura de la celda
       ::oFontTXT := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen
    // Font para los días por defecto del 5O% de la altura de la celda
       ::oFont    := IF(::lFont,::oFont,TFont():New( "Arial", 0, -(::nAltoFila*.50),, .t. )) //Bingen


    // Font para los botones 4O% de la altura de la celda
       ::oFontBtn := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen

    // Se crea matriz con los datos dia del mes.
    // Coordenadas filas
       aPuntos[ 1] := ::nFila1 + 1
       aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2

        FOR  B = 1 TO 7

       //Coordenadas columnas.
             aPuntos[ 2] := ::nCol1  + ( ::nAnchoCol * ( B - 1) ) + 1
             aPuntos[ 4] := aPuntos[ 2] + ::nAnchoCol - 2

             ::aXY[ B     ] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
             ::aXY[ B +  7] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
             ::aXY[ B + 14] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
             ::aXY[ B + 21] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
         ::aXY[ B + 28] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
             ::aXY[ B + 35] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }

    NEXT B

    FOR  B = 1 TO 7
             ::aXY[ B +  7][1] := ::aXY[ B     ][1] + ::nAltoFila
             ::aXY[ B + 14][1] := ::aXY[ B +  7][1] + ::nAltoFila
             ::aXY[ B + 21][1] := ::aXY[ B + 14][1] + ::nAltoFila
             ::aXY[ B + 28][1] := ::aXY[ B + 21][1] + ::nAltoFila
             ::aXY[ B + 35][1] := ::aXY[ B + 28][1] + ::nAltoFila

             ::aXY[ B +  7][3] := ::aXY[ B +  7][1] + ::nAltoFila - 2
             ::aXY[ B + 14][3] := ::aXY[ B + 14][1] + ::nAltoFila - 2
             ::aXY[ B + 21][3] := ::aXY[ B + 21][1] + ::nAltoFila - 2
             ::aXY[ B + 28][3] := ::aXY[ B + 28][1] + ::nAltoFila - 2
             ::aXY[ B + 35][3] := ::aXY[ B + 35][1] + ::nAltoFila - 2

        NEXT B


     // Se calcula el ancho de los botones.
        ::nAnchoBoton := int( (::nCol2 - ::nCol1) / 5)

     // Se crean las coordenadas del boton.
       aPuntos[ 1] := ::nFila2 + 1
       aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2

        FOR  B = 1 TO 5

          // Coordenadas columnas.
             aPuntos[ 2] := ::nCol1  + ( ::nAnchoBoton * ( B - 1) ) + 1
             aPuntos[ 4] := aPuntos[ 2] + ::nAnchoBoton - 2

             ::aBoton[B] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4], aPuntos[5] }
    NEXT B

     // Se fijan los datos de la fecha.
        ::FijarFecha( ::dFechaControl )
    ::nLastDay := ::nDiaMes

RETURN SELF

METHOD FijaClrs( aColores )  CLASS TMiCalendario
       Local A

       ::aColorCuerpo := iif( aColores == NIL, ::aColorCuerpo, aColores )

     // Se fijan los colores de bordes y de fondo de cada uno de los
     // cuadritos...
        FOR A = 1 TO 42
            ::aClrDias[ A] := { ::aColorCuerpo[ 1],; // Color Borde superior
                            ::aColorCuerpo[ 2],; // Color de Relleno
                ::aColorCuerpo[ 3],; // Color Borde inferior
                ::aColorCuerpo[ 4] } // Color del texto,

    NEXT A
RETURN NIL

METHOD FijaClrDomingo( aColores ) CLASS TMiCalendario
       LOCAL A
       ::aColorDomingo := iif( aColores == NIL, ::aColorDomingo, aColores )

    // Se fijan los colores para los dias domingo...
       FOR A = 7 TO 42 step 7
            ::aClrDias[ A] := { ::aColorDomingo[ 1],; // Color Borde superior
                            ::aColorDomingo[ 2],; // Color de Relleno
                ::aColorDomingo[ 3],; // Color Borde inferior
                ::aColorDomingo[ 4] } // Color del texto,
       NEXT A
RETURN NIL

METHOD FijaClrFestivo() CLASS TMiCalendario
       LOCAL aDiasFestivos := ::aFestivos[ ::nMesNumero]
       LOCAL nFestivos     := LEN( aDiasFestivos )
       LOCAL nDia          := 0
       LOCAL A

    // Se fijan los colores para los dias domingo...
       IF nFestivos > 0
          FOR A = 1 TO nFestivos
              nDia := aDiasFestivos[ A]
              ::ColorDia( nDia, ::aColorFestivo )
          NEXT A
       ENDIF
RETURN NIL

METHOD ColorDia( nDia, aColores ) CLASS TMiCalendario
       ::aClrDias[ ::nPrimerDia + ndia - 1 ] := aColores
RETURN NIL

METHOD FijarFecha( dFecha ) CLASS TMiCalendario

       dFecha = iif( dFecha == NIL, Date(), dFecha )

       ::dFechaControl := dFecha
       ::CalcularDias( ::dFechaControl )

       ::nMesNumero    := Month(::dFechaControl)
       ::cMesNumero    := STR(::nMesNumero, 2, 0)
       ::cMesPalabra   := IF(::nMesNumero=NIL,"", ::aMESES[::nMesNumero])

       ::nDiaSemana    := if( (::nDiaSemana := dow(::dFechaControl) - 1) = 0, 7, ::nDiaSemana)
       ::cDiaSemana    := str(::nDiaSemana,2,0)
       ::cDiaPalabra   := ::aDiaSemana[::nDiaSemana]
       ::nDiaMes       := Day(::dFechaControl )
       ::cDiaMes       := str(::nDiaMes,2,0)
       ::cDiaMesPalabra:= FormarFrase(::nDiaMes)

       ::nAno          := year( ::dFechaControl )
       ::cAno          := ALLTRIM( str(::nAno, 4, 0 ))
       ::cAnoPalabra   := FormarFrase(::nAno )

       ::aFecha[ 1]    := ::cDiaMes + " de " + ::cMesPalabra + " de " + ::cAno
       ::aFecha[ 2]    := ::cDiaPalabra + ", " + ::cDiaMes + " de " + ::cMesPalabra + " de " + ::cAno

// aqui agregar todos los otros formatos que sean posibles.
RETURN SELF

METHOD CalcularDias( dFecha ) CLASS TMiCalendario // TMiEjemplo
       Local FechaInicioMes
       Local nDiaSemana
       Local nMes       := Month( dFecha )
       Local nAno       := Year(  dFecha )
       Local aDiaFinMes := {31,28,31,30,31,30,31,31,30,31,30,31}
       Local aLosDias[42]
       Local B
       Local CELMES, CELANO, NDIAFINALMES

    // Se limpian los dias.
       FOR B = 1 TO 42
           aLosDias[ B] := "    " // Para sobrescribir el dibujo anterior
       NEXT B


    // Dia de la semana.
       FechaInicioMes := ctod( "01/" + str(nMes,2,0) + "/" + str(nAno,4,0) )
       cElMes         := IF(::nMesNumero=NIL,"", ::aMESES[::nMesNumero])
       cElAno         := STR(nAno,4)
       aDiaFinMes[ 2] := iif( CtoD("29/02/" + cElAno) = CtoD("0"), 28, 29)
       nDiaFinalMes   := aDiaFinMes[nMes]
       nDiaSemana     := dow(FechaInicioMes) - 1
       nDiaSemana     := IIF( nDiaSemana = 0, 7, nDiaSemana)

    FOR B = 1 TO nDiaFinalMes
        aLosDias[ B + nDiaSemana - 1 ] := str(B,2,0)
    NEXT B

       ::aDias        := aLosDias
       ::nPrimerDia   := nDiaSemana
       ::nUltimoDia   := B + nDiaSemana - 2
       ::nPosicion    := day(dfecha) + nDiaSemana - 1
RETURN SELF

METHOD Destroy() CLASS TMiCalendario

   ::oFontMes:End()
   ::oFontTxt:End()
   //::oFont:End()
   ::oFontBtn:End()

RETURN ::Super:Destroy()


METHOD CambiarMes( nMeses, lProcesar ) CLASS TMiCalendario
       Local aDiaFinMes := {31,28,31,30,31,30,31,31,30,31,30,31}
       Local nNumeroMes := ::nMesNumero
       Local dNvaFecha
       Local hDC
       Local AnchoRelleno := (::nAnchoCol * 5) - 4
       Local nDia

       DEFAULT nMeses   := 1, lProcesar := .F.



    // Se obtiene el controlador
       IF (nMeses<> 0 .or. lProcesar)
          hDC := ::GetDC()
          // Se desmarca el dia...
             MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2] )
       ENDIF

    // Si el numero es cero, pues nada se hace y lprocesar, para obligar a procesar.
       IF (nMeses<> 0 .or. lProcesar)

             MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2] )
          // Se comprueba que no sea mayor que doce el aumento de mes.
             nNumeroMes += nMeses

             DO CASE
                CASE nNumeroMes > 12
                     ::nMesNumero := nNumeroMes - 12
                     ::nAno++
                CASE nNumeroMes < 1
                     ::nMesNumero := 12 + nNumeroMes
                 ::nAno--
                OTHERWISE
                  ::nMesNumero := nNumeroMes
             ENDCASE

          // Se verifica año bisciesto
             aDiaFinMes[ 2] := iif( CtoD("29/02/" + str(::nAno,4,0) ) = CtoD("0"), 28, 29)

          // Se determina el dia de cambio...
              nDia := iif( ::nLastDay > aDiaFinMes[ ::nMesNumero ],;
                          aDiaFinMes[ ::nMesNumero ],;
              ::nLastDay )

             dNvaFecha := CtoD( STR(  nDia      ,2,0) + "/" +;
                                STR(::nMesNumero,2,0) + "/" +;
                        STR(::nAno,      4,0) )

         ::FijarFecha( dNvaFecha )

          // Se restauran los colores...
         ::RestaurarColor()

          // Se evalua bloque de codigo al cambiar de mes...
         IF !EMPTY( ::bCambioMes )
                Eval( ::bCambioMes )
         ENDIF

          // Se dibujan los dias.
         DibujaDias( hDC, ::oFont, ::aDias, ::aXY,;
                     ::aClrDias, ::bFestivos  )

      // Se dibujan los titulos del mes y año.
             DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,;
                   ::nAnchoCol,  ::oFontMes, ::oFont, ::aColorTitulo,;
                 xPadc(::cMesPalabra, AnchoRelleno), ::cAno, ::aDiaSemana)

*            ::nPosicion := ::nDiaSemana
*        MsgInfo( ::nPosicion )

             MarcarDia( hDC, ::aXY[::nPosicion], nRgb(255,  0,  0))

          // Se libera el identificador
             ::ReleaseDC()

       ENDIF
RETURN Self

METHOD VerAlSalir() CLASS TMiCalendario
    // Metodo cuando se abandona
    // Se recupera el identificador.
       LOCAL hDC := ::GetDC()

       ::lConFoco := .F.
       MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5])

    // Se destruye el identificador.
       ::ReleaseDC()

return Self

METHOD VerAlEntrar() CLASS TMiCalendario
    // Metodo cuando se abandona
    // Se recupera el identificador.
       LOCAL hDC := ::GetDC()

       IF !::lTodoseCalculo
           ::Default()
           ::SetSize(::nCol2 + 1,::nFila2 + 1 + IF(::lMostrarBoton, ::nAltoFila, 0 ), .t. )  //Bingen
       ::lTodoseCalculo := .T.
       ENDIF

       ::lConFoco := .T.
       MarcarDia( hDC, ::aXY[::nPosicion], nrgb(255, 0, 0)) //::aColorTitulo[5]

    // Se destruye el identificador.
       ::ReleaseDC()

return Self


METHOD GetDlgCode( nLastKey ) CLASS TMiCalendario

   // This method is very similar to TControl:GetDlgCode() but it is
   // necessary to have WHEN working

   if .not. ::oWnd:lValidating
      if nLastKey == VK_UP .or. nLastKey == VK_DOWN ;
         .or. nLastKey == VK_RETURN .or. nLastKey == VK_TAB
         ::oWnd:nLastKey = nLastKey
      else
         ::oWnd:nLastKey = 0
      endif
   endif

return If( IsWindowEnabled( ::hWnd ), DLGC_WANTALLKEYS, 0 )

METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TMiCalendario
       CursorHand()

    // Se evalua si es la linea de los botones.
*       IF nRow  > nFila2 .and. ;
*          nCol  > ::nCol1  .and. nCol <= ::nCol2
*
*       ENDIF

RETURN SELF

METHOD PintarBoton(hDC, nColor, nRow, nCol) CLASS TMiCalendario  //Bingen
    // se carga la brocha y se guarda la anterior brocha.
       Local hBrocha         := CreateSolidBrush ( nColor )
       Local hBrochaAnterior := SelectObject (hDC, hBrocha)
       Local aPuntos         := ::aBoton[::nPosBoton]


    // Se pinta el recuadro.
       FillRect( hDc, {aPuntos[ 1] + 1,;
                       aPuntos[ 2] + 1,;
               aPuntos[ 3],;
               aPuntos[ 4]}, hBrocha )

    // Se restaura la brocha y destruye la utilizada
       SelectObject (hDC, hBrochaAnterior )
       IF !DeleteObject( hBrocha )
          MsgInfo("Parece que no se destruyo")
       ENDIF

    // Formato letra
       SelectObject(hDC, IF(::lCuerpo( nRow, nCol),::oFont:hFont,::oFontBtn:hFont))  //Bingen
       SetTextColor( hDC, ::aColorBoton[5] )
       SetBkColor(   hDC, nColor )

    // Se dibujan los titulos de los botones
       DrawText( hDC, ::aTitBoton[::nPosBoton], aPuntos,;
                     nOr(32, 4, 1 ) )

RETURN SELF

METHOD KeyChar( nKey, nFlags ) CLASS TMiCalendario

       do case
          case nKey == ::nK_MesAdelenta
               ::MesSiguinte()

          case nKey == ::nK_MesAtras
               ::MesAnterior()

      case nKey == ::nK_Menu
               ::RButtonUp( ::nAltoFila, ::nAnchoCol, 0 )

      otherwise
               return ::Super:KeyChar( nKey, nFlags )
       endcase
return SELF

METHOD KeyDown( nKey, nFlags ) CLASS TMiCalendario
       Local hDC
       Local nPosAnterior := ::nPosicion

       do case
          case nKey == VK_RETURN      //Bingen
                 ::LButtonUp(  ::aXY[::nPosicion,1], ::aXY[::nPosicion,2])

          case nKey == VK_END
               IF ::nPosicion < ::nUltimoDia
                  hDC := ::GetDC()
                  MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
                  ::nPosicion :=  ::nUltimoDia
                  MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                  ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                      ::cMesNumero         + "/" +;
                                      ::cAno ) )
          ::nLastDay := ::nDiaMes
                  ::ReleaseDC()
               ENDIF

          case nKey == VK_HOME
               IF ::nPosicion > ::nPrimerDia
                  hDC := ::GetDC()
                  MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
                  ::nPosicion :=  ::nPrimerDia
                  MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                  ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                      ::cMesNumero         + "/" +;
                                      ::cAno ) )
          ::nLastDay := ::nDiaMes
                  ::ReleaseDC()
               ENDIF

          case nKey == VK_DOWN
           IF ::lProcesarTecla
              ::lProcesarTecla := .F.
                  IF (::nPosicion + 7) < 42 .and. !empty(::aDias[(::nPosicion + 7)])
                     hDC := ::GetDC()
                     MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
                     ::nPosicion := ::nPosicion + 7

                     MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                     ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                         ::cMesNumero         + "/" +;
                                         ::cAno ) )

                    ::nLastDay := ::nDiaMes
                    ::ReleaseDC()
                  ENDIF
              ::lProcesarTecla := .T.
               ENDIF

          case nKey == VK_UP
           IF ::lProcesarTecla
              ::lProcesarTecla := .F.
                  IF (::nPosicion - 7) > 0 .and. !empty(::aDias[(::nPosicion - 7)])
                     hDC := ::GetDC()
                     MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
                     ::nPosicion := ::nPosicion - 7

                     MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                     ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                         ::cMesNumero         + "/" +;
                                         ::cAno ) )
                     ::nLastDay := ::nDiaMes
                     ::ReleaseDC()
                  ENDIF
              ::lProcesarTecla := .T.
               ENDIF

          case nKey == VK_LEFT
           IF ::lProcesarTecla
              ::lProcesarTecla := .F.
                  hDC := ::GetDC()
                  MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
              ::nPosicion --

                  IF ::nPosicion <  ::nPrimerDia
                     ::nPosicion := ::nUltimoDia
              ENDIF
                  MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                  ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                      ::cMesNumero         + "/" +;
                                      ::cAno ) )
                  ::ReleaseDC()
          ::nLastDay := ::nDiaMes
              ::lProcesarTecla := .T.
               ENDIF

      case nKey == VK_RIGHT
           IF ::lProcesarTecla
              ::lProcesarTecla := .F.
                  hDC := ::GetDC()
                  MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
                  ::nPosicion ++

                  IF ::nPosicion > ::nUltimoDia
                     ::nPosicion := ::nPrimerDia
                  ENDIF
                  MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                  ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                      ::cMesNumero         + "/" +;
                                     ::cAno ) )
                  ::ReleaseDC()
          ::nLastDay := ::nDiaMes
              ::lProcesarTecla := .T.
               ENDIF

      case nKey == VK_TAB .OR. nKey == VK_ESCAPE
               return ::Super:KeyDown( nKey, nFlags )

          case nKey == ::nK_AnoAtras
           ::AnoAnterior()

          case nKey == ::nK_AnoAdelenta
           ::AnoSiguiente()

          case nKey == ::nK_Hoy
               ::IrFecha( Date())

      otherwise
               return ::Super:KeyDown( nKey, nFlags )

       endcase

RETURN SELF

METHOD IrFecha( dNvaFecha ) CLASS TMiCalendario
    // Se recupera identificador del boton.
       Local hDC       := ::GetDC()
       Local AnchoRelleno := (::nAnchoCol * 5) - 4

    // Se desmarca el dia...
       MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion ][ 2] )


    // Se fija la fecha.
       ::FijarFecha( dNvaFecha )
       ::nLastDay := ::nDiaMes

    // Se restauran los colores...
       ::RestaurarColor()

    // Se evalua bloque de codigo al cambiar de mes...
       IF !EMPTY( ::bCambioMes )
           Eval( ::bCambioMes )
       ENDIF

    // Se dibujan los dias.
       DibujaDias( hDC, ::oFont, ::aDias, ::aXY,;
                   ::aClrDias, ::bFestivos )

    // Se dibujan los titulos del mes y año.
       DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,;
                   ::nAnchoCol,  ::oFontMes, ::oFont, ::aColorTitulo,;
                 xPadc(::cMesPalabra, AnchoRelleno),      ::cAno, ::aDiaSemana)



      MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5] )

   // Se libera el identificador
      ::ReleaseDC()
RETURN NIL


/*-------------------------------------------------------------------------*/
METHOD Language() CLASS TMiCalendario    //Bingen

  // Soporte multilenguaje
  IF ::nLanguage = L_PORTUGUES
     ::aMESES := { "Janeiro"   , "Fevereiro", "Março"    ,"Abril",;
                   "Maio"      , "Junho"    , "Julho"    ,"Agosto",;
                   "Setembro"  , "Outubro"  , "Novembro" ,"Dezembro"}

     ::aDiaSemana   := {"Segunda","Terça","Quarta","Quinta",;
                        "_","Sábado","Domingo"}

     ::aTitBoton    := {"&-Mês", "&+Mês", "< Ano", "Ano >", "Hoje"}

  ELSEIF ::nLanguage = L_CATALA
     ::aMESES := { "Gener"     , "Febrer" , "Març"    ,"Abril",;
                   "Maig"      , "Juny"   , "Juliol"  ,"Agost",;
                   "Setembre"  , "Octubre", "Novembre","Desembre"}

     ::aDiaSemana   := {"Dilluns","Dimarts","Dimecres","Dijous",;
                        "Divendres","Dissabte","Diumenge"}

     ::aTitBoton    := {"&-Mes", "&+Mes", "-Any", "+Any", "Avuy"}

  ELSEIF ::nLanguage = L_EUSKERA
     ::aMESES := { "Urtarrila", "Otsaila", "Martxoa" , "Apirila",;
                   "Maiatza"  , "Ekaina" , "Uztaila" , "Abuztua",;
                   "Iraila"   , "Urria"  , "Azaroa"  , "Abendua"}

     ::aDiaSemana   := {"Astelehena","Asteartea","Asteazkena","Osteguna",;
                        "Ostirala","Larunbata","Igandea"}

     ::aTitBoton    := {"&-Hil", "&+Hil", "-Urte", "+Urte", "Gaur"}

  ELSEIF ::nLanguage = L_GALEGO
     ::aMESES := { "Xaneiro"   , "Febreiro", "Marzal"   ,"Abril",;
                   "Maio"      , "Xuño"    , "Xulio"    ,"Agosto",;
                   "Septembro" , "Octubro" , "Novembro" ,"Decembro"}

     ::aDiaSemana   := {"Luns","Martes","Mércores","Xoves",;
                        "Venres","Sabado","Domingo"}

     ::aTitBoton    := {"&-Mes", "&+Mes", "< Año", "Año >", "Hoxe"}

  ELSEIF ::nLanguage = L_SPANISH
     ::aMESES := { "Enero"     , "Febrero", "Marzo"    ,"Abril",;
                   "Mayo"      , "Junio"  , "Julio"    ,"Agosto",;
                   "Septiembre", "Octubre", "Noviembre","Diciembre"}

     ::aDiaSemana   := {"Lunes","Martes","Miercoles","Jueves",;
                        "Viernes","Sabado","Domingo"}

     ::aTitBoton    := {"&-Mes", "&+Mes", "-Año", "+Año", "Hoy"}

  ELSEIF ::nLanguage = L_ITALIANO
     ::aMESES := { "Gennaio"   , "Febbraio" , "Marzo"    ,"Aprile",;
                   "Maggio"    , "Giugno"   , "Luglio"   ,"Agosto",;
                   "Settembre" , "Ottobre"  , "Novembre" ,"Dicembre"}

     ::aDiaSemana   := {"Lunedi","Martedi","Mercoledi","Giovedi",;
                        "Venerdi","Sabato","Domenica"}

     ::aTitBoton    := {"&-Mese", "&+Mese", "-Anno", "+Anno", "Oggi"}

  ELSEIF ::nLanguage = L_ENGLISH
     ::aMESES := { "Jannuary"  , "February" , "March"    ,"April",;
                   "May"       , "June"     , "July"     ,"August",;
                   "September" , "October"  , "November" ,"December"}

     ::aDiaSemana   := {"Monday","Tuesday","Wednesday","Thursday",;
                        "Friday","Saturday","Sunday"}

     ::aTitBoton    := {"&-Month", "&+Month", "-Year", "+Year", "Today"}

  ELSEIF ::nLanguage = L_FRANCAIS
     ::aMESES := { "Janvier"  , "Février" , "Mars"    ,"Avril",;
                   "Mai"       , "Juin"     , "Juillet"     ,"Août",;
                   "Septembre" , "Octobre"  , "Novembre" ,"Decembre"}

     ::aDiaSemana   := {"Lundi","Mardi","Mercredi","Jeudi",;
                        "Vendredi","Samedi","Dimanche"}

     ::aTitBoton    := {"&-Mois", "&+Mois", "-An", "+An", "Auj'hui"}

  ELSEIF ::nLanguage = L_DEUSTCH
     ::aMESES := { "Januar"    , "Februar"  , "März"     ,"April",;
                   "Mai"       , "Juni"     , "Juli"     ,"August",;
                   "September" , "Oktober"  , "November" ,"Dezember"}

     ::aDiaSemana   := {"Montag","Dienstag","Mittwoch","Donnerstag",;
                        "Freitag","Samstag","Sonntag"}

     ::aTitBoton    := {"&-Monat", "&+Monat", "-Jahr", "+Jahr", "Heute"}

  ENDIF

// Para realimentar los datos fechas con los nuevos valores.
   ::FijarFecha( ::dFechaControl )

RETURN NIL

STATIC FUNCTION CalcularAncho( nEspacioIzq,nWidth )
       Local nColumnaAncho
       nColumnaAncho := int( ( nWidth - nEspacioIzq ) / 7)
RETURN nColumnaAncho

STATIC FUNCTION CalcularAlto( nHeight )
       Local nFilaAlto
       nFilaAlto := int(( nHeight - 1) / 8)
RETURN nFilaAlto

STATIC FUNCTION MarcarDia( hDC, aPuntos, nColor)
    // Se crea el lapiz a utilizar.y se carga.
       Local hPen1        := CreatePen(PS_SOLID, 3, nColor)
       Local hPenAnterior := SelectObject(hDC, hPen1)

    // Se dibuja el rectangulo
       MoveTo(hDC, aPuntos[2] + 1, aPuntos[1] + 1)
       LineTo(hDC, aPuntos[4] - 3, aPuntos[1] + 1)
       LineTo(hDC, aPuntos[4] - 3, aPuntos[3] - 2)
       LineTo(hDC, aPuntos[2] + 1, aPuntos[3] - 2)
       LineTo(hDC, aPuntos[2] + 1, aPuntos[1] + 1)

    // Se destruyen objetos utilizados
       SelectObject( hDC, hPenAnterior )
       IF !DeleteObject( hPen1 )
          MsgInfo("El objeto no se destruyo")
       ENDIF
RETURN NIL

STATIC FUNCTION FormarFrase(ElNumero)
          //ElNumero      , corresponde al numero que se debera frasear.

          //Se definen variables locales de control.
            LOCAL Pon_la_Y   := ""
            LOCAL Pon_Mil    := ""
            LOCAL CtrlTexto  := ""    //Almacenara a ELNUMERO en formato texto.
            LOCAL FraseNumero:= ""
            LOCAL ValorPos[11]
            LOCAL Num_A[30]
            LOCAL Num_B[ 9]
            LOCAL Num_C[10]

          //Se llenan matricez de control de palabras.
            Num_A[  1] = ""           ; Num_A[ 16] = "Quince "
            Num_A[  2] = "Un "        ; Num_A[ 17] = "Dieciseis "
            Num_A[  3] = "Dos "       ; Num_A[ 18] = "Diecisiete "
            Num_A[  4] = "Tres "      ; Num_A[ 19] = "Dieciocho "
            Num_A[  5] = "Cuatro "    ; Num_A[ 20] = "Diecinueve "
            Num_A[  6] = "Cinco "     ; Num_A[ 21] = "Veinte "
            Num_A[  7] = "Seis "      ; Num_A[ 22] = "Veintiun "
            Num_A[  8] = "Siete "     ; Num_A[ 23] = "Veintidos "
            Num_A[  9] = "Ocho "      ; Num_A[ 24] = "Vientitres "
            Num_A[ 10] = "Nueve "     ; Num_A[ 25] = "Veinticuatro "
            Num_A[ 11] = "Diez "      ; Num_A[ 26] = "Veinticinco "
            Num_A[ 12] = "Once "      ; Num_A[ 27] = "Veintiseis "
            Num_A[ 13] = "Doce "      ; Num_A[ 28] = "Veintisiete "
            Num_A[ 14] = "Trece "     ; Num_A[ 29] = "Veintiocho "
            Num_A[ 15] = "Catorce "   ; Num_A[ 30] = "Veintinueve "

            Num_B[  1] = "Diez "      ; Num_C[  1] = ""
            Num_B[  2] = "Veinte "    ; Num_C[  2] = "Ciento "
            Num_B[  3] = "Treinta "   ; Num_C[  3] = "Doscientos "
            Num_B[  4] = "Cuarenta "  ; Num_C[  4] = "Trescientos "
            Num_B[  5] = "Cincuenta " ; Num_C[  5] = "Cuatrocientos "
            Num_B[  6] = "Sesenta "   ; Num_C[  6] = "Quinientos "
            Num_B[  7] = "Setenta "   ; Num_C[  7] = "Seiscientos "
            Num_B[  8] = "Ochenta "   ; Num_C[  8] = "Setecientos "
            Num_B[  9] = "Noventa "   ; Num_C[  9] = "Ochocientos "
                                        Num_C[ 10] = "Novecientos "

          //Se vacias valores de control
            CtrlTexto    = STR(ElNumero,8,0)
            ValorPos[ 1] = VAL(Substr(CtrlTexto,8,1))
            ValorPos[ 2] = VAL(Substr(CtrlTexto,7,1))
            ValorPos[ 3] = VAL(Substr(CtrlTexto,6,1))
            ValorPos[ 4] = VAL(Substr(CtrlTexto,5,1))
            ValorPos[ 5] = VAL(Substr(CtrlTexto,4,1))
            ValorPos[ 6] = VAL(Substr(CtrlTexto,3,1))
            ValorPos[ 7] = VAL(Substr(CtrlTexto,2,1))
            ValorPos[ 8] = VAL(Substr(CtrlTexto,1,1))
            ValorPos[ 9] = VAL(Substr(CtrlTexto,7,2))
            ValorPos[10] = VAL(Substr(CtrlTexto,4,2))
            ValorPos[11] = VAL(Substr(CtrlTexto,1,2))

          //Se comienza a generar la frase de control comenzando por las
          //unidades.
            Pon_la_Y = IF(ValorPos[ 1] = 0,"","y ")
            IF ValorPos[ 2] < 3
               FraseNumero = Num_A[ValorPos[ 9] + 1]
            ELSE
               FraseNumero = Num_B[ValorPos[ 2]] + Pon_la_Y + ;
                             IF(ValorPos[ 9] > 20,Num_A[ValorPos[ 1]+1],"")
            ENDIF

          //se continua formado la frase para las centenas
            Num_C[ 2] = IF((ValorPos[ 1] + ValorPos[ 2]) = 0,"Cien ","Ciento ")
            FraseNumero = Num_C[ValorPos[ 3] + 1] + FraseNumero

          //se continua formado la frase para los miles
            Pon_Mil  = IF((ValorPos[ 4]  + ValorPos[ 5] + ValorPos[ 6]) = 0,"","Mil ")
            Pon_la_Y = IF( ValorPos[ 4] = 0,"","y ")

            IF ValorPos[ 5] < 3
               FraseNumero = Num_A[ValorPos[10] + 1] + Pon_Mil + FraseNumero
            ELSE
               FraseNumero = Num_B[ValorPos[ 5]] + Pon_la_Y +;
                             Num_A[ValorPos[ 4] + 1] + Pon_Mil + FraseNumero
            ENDIF

RETURN  FraseNumero
 

[MOISES]

Parte 1

Code: Select all  Expand view

// -----------------------------------------------------------------------
CLASS TMiCalendario FROM TControl
// -----------------------------------------------------------------------

        DATA lContinuar       AS LOGICAL INIT .T.
        DATA lConFoco         AS LOGICAL INIT .T.
        DATA oFont
        DATA lFont            AS LOGICAL INIT .F.
        DATA oFontMes
        DATA oFontTxt
        DATA oFontBtn
        DATA nPosFila      // la posicion de la fila
        DATA nPosCol       // la posicion de la columna
        DATA nPosBoton     // la columna del boton.
        DATA aDiaSemana    AS ARRAY INIT ARRAY( 7)
        DATA aXY           AS ARRAY INIT ARRAY(42)
        DATA aBoton        AS ARRAY INIT ARRAY( 5)
        DATA aDias         AS ARRAY INIT ARRAY(42)
        DATA aClrDias      AS ARRAY INIT ARRAY(42)
        DATA aColorCuerpo  AS ARRAY
        DATA aColorTitulo  AS ARRAY
        DATA aColorBoton   AS ARRAY
        DATA aColorDomingo AS ARRAY
        DATA aColorFestivo AS ARRAY
            // Tinha o Erro de GPF aqui, quando usava READONLY
            DATA aFestivos     AS ARRAY INIT ARRAY(12) //READONLY gerava erro
        DATA nAltoFila
        DATA nAnchoCol
        DATA nAnchoBoton
        DATA aTitBoton
        DATA nFila1
        DATA nFila2
        DATA nCol1
        DATA nCol2
        DATA nPrimerDia    AS NUMERIC INIT  1
        DATA nUltimoDia    AS NUMERIC INIT 42
        DATA lSelectOK     AS LOGICAL INIT .T.
        DATA bCambioMes    //Block a ejecutar cuando cambie el mes...
        DATA bFestivos     //Bingen
        DATA nLanguage     //Bingen
        DATA aMeses        AS ARRAY INIT ARRAY(12) //Bingen
        DATA nLastDay      AS NUMERIC INIT  1

     // Datos relacionados con la fecha seleccionada.
        DATA dFechaControl
        DATA nMesNumero             READONLY
        DATA cMesNumero             READONLY
        DATA cMesPalabra            READONLY
        DATA nDiaSemana             READONLY
        DATA cDiaSemana             READONLY
        DATA cDiaPalabra            READONLY
        DATA nDiaMes                READONLY
        DATA cDiaMes                READONLY
        DATA cDiaMesPalabra         READONLY
        DATA nAno                   READONLY
        DATA cAno                   READONLY
        DATA cAnoPalabra            READONLY
        DATA aFecha  AS ARRAY INIT ARRAY(2) READONLY
        DATA aVencto AS ARRAY INIT ARRAY(8) READONLY
// aFecha, es un array con formatos de fecha
// aVencto, es un array con las fechas de vencimiento 15,30,45,60 dias...

         // DATAS para reasignar teclas de navegacion.
            DATA nK_AnoAdelenta  AS NUMERIC INIT VK_NEXT
            DATA nK_AnoAtras     AS NUMERIC INIT VK_PRIOR
            DATA nK_MesAdelenta  AS NUMERIC INIT K_MAS
            DATA nK_MesAtras     AS NUMERIC INIT K_MENOS
        DATA nK_Menu         AS NUMERIC INIT K_DIVISION
        DATA nK_Hoy          AS NUMERIC INIT K_HOY

        DATA nPosicion
        DATA lTodoseCalculo   AS LOGICAL INIT .F.
        DATA lProcesarTecla   AS LOGICAL INIT .T.
        DATA lMostrarBoton    AS LOGICAL INIT .T.

        CLASSDATA lRegistered AS LOGICAL

            METHOD New( ) CONSTRUCTOR  //Bingen

            METHOD Display()

            METHOD Paint()

            METHOD Language()  //Bingen

            METHOD LButtonDown( nRow, nCol, nFlags )
            METHOD LButtonUp( nRow, nCol )
            METHOD RButtonUp( nRow, nCol, nKeyFlags )

        METHOD FijarFecha( dFecha )
            METHOD CalcularDias( dFecha )
            METHOD FijaClrs()
            METHOD FijaClrDomingo()
        METHOD FijaClrFestivo()
        METHOD RestaurarColor() INLINE ::FijaClrs(), ::FijaClrDomingo(), ::FijaClrFestivo()
            METHOD ColorDia( nDia, aColores )

        METHOD Default()

            METHOD Destroy()
            METHOD MouseMove( nRow, nCol, nKeyFlags )

        METHOD GetDlgCode( nLastKey )
        METHOD VerAlSalir()
        METHOD VerAlEntrar()
            METHOD PintarBoton(hDC, nColor, nRow, nCol)
            METHOD KeyChar( nKey, nFlags )
            METHOD KeyDown( nKey, nFlags )

         // Estos metodos devuelven verdadero o falso segun se encuentren
     // dentro del cuerpo del calendario o en el area de botones.
        METHOD lCuerpo( nRow, nCol)
        METHOD lBotones( nRow, nCol)

         // Metodos para moverse entre los meses
        METHOD CambiarMes(nMeses, lProcesar)
            METHOD MesSiguinte()  INLINE ::CambiarMes(  1)
            METHOD MesAnterior()  INLINE ::CambiarMes( -1)
            METHOD AnoSiguiente() INLINE ::CambiarMes( 12)
            METHOD AnoAnterior()  INLINE ::CambiarMes(-12)
        METHOD Hoy()          INLINE ::IrFecha( Date() )
            METHOD IrFecha( dNvaFecha )

         // Metodos para tomar y dejar el foco.
            METHOD LostFocus( hCtlFocus ) INLINE ::Super:LostFocus( hCtlFocus ), ::VerAlSalir()
            METHOD GotFocus() INLINE ::setfocus(), ::VerAlEntrar()

      ENDCLASS

      METHOD New (nTop, nLeft, nWidth, nHeight, oWnd, oFont, nLANGUAGE ) CLASS TMiCalendario
         DEFAULT nTop:=5, nLeft:=5,nWidth:=120,nHeight:=120  //Bingen
             DEFAULT nLanguage := L_SPANISH

          // Coordenadas de la region de dibujo.
             ::nTop      := nTop
             ::nLeft     := nLeft
             ::nBottom   := ::nTop  + nHeight
             ::nRight    := ::nLeft + nWidth

             ::dFechaControl := Date()
         ::bFestivos     := {|| ARRAY(0)  }  //Bingen
         ::nLanguage   := nLanguage          //Bingen
         ::Language()                        //Bingen

          // Array con dias festivos...
         ::aFestivos     := { {}, {}, {},;
                                  {}, {}, {},;
                                  {}, {}, {},;
                  {}, {}, {}  }

             ::oWnd      := oWnd
         //::oFont     := oFont    //ojo
             ::SetFont( oFont )  // sigue fallando



             ::lFont     := !oFONT=Nil
         ::nPosFila  := 1
         ::nPosCol   := 1
         ::nPosBoton := 1
         ::aColorCuerpo := { nRgb(235,235,210),; // Color Borde superior
                             nRgb(205,205,155),; // Color de Relleno
                 nRgb(150,150, 75),; // Color Borde inferior
                 nRgb(  0,  0,  0),; // Color del texto,
                 nRgb(130,130, 65)}  // Color dia seleccionado al perder el foco

         ::aColorTitulo := { nRgb(170,170, 80),; // Color Borde superior
                             nRgb(130,130, 65),; // Color de Relleno
                 nRgb(100,100, 50),; // Color Borde inferior
                 ::aColorCuerpo[2],; // Color Letra mes y año
                 nRgb(255,255,255) } // Color de los dias.

         ::aColorBoton  := { nRgb(170,170, 80),; // Color Borde superior
                             nRgb(130,130, 65),; // Color de Relleno
                 nRgb(100,100, 50),; // Color Borde inferior
                 ::aColorCuerpo[2],; // Color Letra
                 ::aColorCuerpo[2] } // Color relleno cuando se selecciona.

             ::aColorDomingo := ::aColorTitulo
         ::aColorFestivo := ::aColorTitulo


         ::nPosicion    := day(::dFechaControl)
         ::FijaClrs()
         ::FijaClrDomingo()
             ::FijaClrFestivo()

             ::nStyle    := nOr(WS_CHILD, WS_VISIBLE, WS_TABSTOP)

             ::Register()

             If !Empty( oWnd:hWnd )
                ::Create()
                oWnd:AddControl( Self )
             Else
                oWnd:DefControl( Self )
             Endif

      Return Self

METHOD Display() CLASS TMiCalendario

       IF ::lContinuar
          ::lContinuar := .F.
      ::BeginPaint()
          ::Paint()
      ::EndPaint()
          ::lContinuar := .T.
       ELSE
          MsgInfo("Para Ccontrolar Que Nao Passe Duas Vezes")
       ENDIF

RETURN SELF


METHOD Paint() CLASS TMiCalendario
    // Se recupera identificador del boton.
       Local hDC    := ::GetDC()
       Local nColor

       IF !::lTodoseCalculo
           ::Default()
           ::SetSize(::nCol2 + 1,::nFila2 + 1 + IF(::lMostrarBoton, ::nAltoFila, 0 ), .t. )  //Bingen
       ::lTodoseCalculo := .T.
       ENDIF

    // Comienza el dibujo
       DibujarTodo( hDC, ::nAltoFila, ::nAnchoCol, ::nFila1, ::nFila2,;
                         ::nCol1, ::nCol2, ::oFont, ::aDiaSemana,;
             ::aXY, ::oFontTxt, ::aDias, ::aColorTitulo, ::aClrDias, ::aColorCuerpo, ::aColorBoton,;
                         ::cMesPalabra, ::oFontMes, ::cAno,;
                         ::oFontBtn, ::aBoton, ::nAnchoBoton, ::aTitBoton, ::bFestivos )  //Bingen

    // Se pinta si esta con el foco o no.
      if ::lFocused
         MarcarDia( hDC, ::aXY[::nPosicion], nrgb(255, 0, 0))
      else
         MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5])
      endif

    // Se libera el identificador del boton.
       ::ReleaseDC()

Return Self


STATIC FUNCTION DibujarTodo( hDC, nAltoFila, nAnchoCol, nFila1, nFila2,;
                                 nCol1, nCol2, oFont, aDiaSemana, aConPuntos,;
                 oFontTxt,aDias, aColorTitulo, aClrDias, aColorCuerpo, aColorBoton,;
                 cMesPalabra, oFontMes, cAno, ;
                 oFontBtn, aBoton, nAnchoBoton,;
                 aTitBoton, bFestivos )  //Bingen

       Local A
       Local aLosPuntos := aConPuntos[42]

    // Se dibuja el cuerpo del calendario
       DibujaCuerpo( hDC, aConPuntos, aClrDias, aColorCuerpo)

    // Se dibujan los dias.
       DibujaDias( hDC, oFont, aDias, aConPuntos, aClrDias, bFestivos )

    // Se dibujan la parte superior del calendario
       DibujaEncabezado(hDC,  nFila1, nFila2, nAltoFila,;
                        nCol1,  nCol2, nAnchoCol,;
                        aDiaSemana,  oFont, aColorTitulo,;
                        cMesPalabra, oFontMes, cAno )

    // Se dibujan los titulos del encabezado.
       DibujaTitulos(hDC, nAltoFila, nCol1, nCol2, nAnchoCol,;
                oFontMes, oFontTxt, aColorTitulo, cMesPalabra,;
        cAno, aDiaSemana)

    // Se dibujan los botones.
       DibujaBotones(hDC, nFila2, nAltoFila,;
                   nCol1,  nCol2, nAnchoCol,;
                   oFontBtn,  aColorBoton, aBoton, aTitBoton, nAnchoBoton)

return NIL

STATIC FUNCTION DibujaDias( hDC, oFont, aDias, aXY, aClrDias, bFestivos)

       Local HBROCHAANTERIOR, HOLDPEN
       Local A, aFESTIVOS:=ARRAY(0), nCOLOR:=0
       Local hBrocha
       Local hPen1
       Local hPen2

       DEFAULT bFestivos   := {|| ARRAY(0) }

       aFESTIVOS:=EVAL(bFestivos)

    // Se dibujan los dias.
       SelectObject( hDC, oFont:hFont)

       FOR A = 1 TO 42
        // Se crea brocha para pintar el fondo del recuadro...
           hBrocha := CreateSolidBrush ( aClrDias[ A][ 2] )

        // se carga la brocha, se guarda la brocha anterior y se pinta
           hBrochaAnterior := SelectObject (hDC, hBrocha)
           FillRect( hDc, aXY[A], hBrocha )

        // Se restaura la brocha y destruye la utilizada
           SelectObject (hDC, hBrochaAnterior )
           IF !DeleteObject( hBrocha )
              MsgInfo("Parece que no se destruyo")
           ENDIF

        // Aqui se dibujan los bordes....
    // UNO. se cargan los lapices...
           hPen1 := CreatePen(PS_SOLID, 1, aClrDias[ A][ 1])   //Claro nrgb(235,235,210)
           hPen2 := CreatePen(PS_SOLID, 1, aClrDias[ A][ 3])   //Oscuro nrgb(160,160, 75)

        // Se carga el lapices y se dibuja borde superior..
           hOldPen := SelectObject( hDC, hPen1 )
           MoveTo(hDc , aXY[ A][ 2] - 1, aXY[ A][ 3]     )
           LineTo(hDc,  aXY[ A][ 2] - 1, aXY[ A][ 1] - 1 )
           LineTo(hDc,  aXY[ A][ 4]    , aXY[ A][ 1] - 1 )

        // Se destruyen objetos utilizados
           SelectObject( hDC, hOldPen )
           IF !DeleteObject( hPen1 )
               MsgInfo("O objeto nao se destruiu")
           ENDIF

        // Se carga el lapices y se dibuja borde inferior..
           hOldPen := SelectObject( hDC, hPen2 )
           MoveTo(hDc , aXY[ A][ 2], aXY[ A][ 3]     )
           LineTo(hDc,  aXY[ A][ 4], aXY[ A][ 3]     )
           LineTo(hDc,  aXY[ A][ 4], aXY[ A][ 1] - 2 )

        // Se destruyen objetos utilizados
           SelectObject( hDC, hOldPen )
           IF !DeleteObject( hPen2 )
           MsgInfo("El objeto no se destruyo")
           ENDIF

    // Se dibuja el texto...
            SetBkColor(   hDC, aClrDias[ A][ 2] )
            nCOLOR:=ASCAN(aFESTIVOS, {|aVal| aVal[1] == VAL(aDias[A]) }) //Comprobar festivos
            IF nCOLOR>0    //Bingen
              SetTextColor( hDC, aFESTIVOS[nCOLOR,2])
            ELSE
             SetTextColor( hDC, aClrDias[ A][ 4] )
            ENDIF

            DrawText( hDC, " " + aDias[A] + "  ", aXY[A],;
                      nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA

       NEXT A

RETURN NIL

STATIC FUNCTION DibujaCuerpo( hDC, aXY, aClrDias, aColorCuerpo  )
    // Se crea el lapiz a utilizar.
       Local A, HOLDPEN
       Local hPen1
       Local hPen2
       Local hBrocha
       Local hBrochaAnterior

     // Se dibujan los bordes del cuerpo
        hPen1 := CreatePen(PS_SOLID, 1, aColorCuerpo[ 1])
        hPen2 := CreatePen(PS_SOLID, 1, Getsyscolor(16) )

     // Se carga el lapices y se dibuja borde superior..
        hOldPen := SelectObject( hDC, hPen1 )
        MoveTo(hDc , aXY[ 1][ 2] - 2, aXY[ 1][ 1] - 1 )
        LineTo(hDc,  aXY[ 1][ 2] - 2, aXY[36][ 3] + 2 )

     // Se destruyen objetos utilizados
        SelectObject( hDC, hOldPen )
        IF !DeleteObject( hPen1 )
           MsgInfo("El objeto no se destruyo")
        ENDIF

     // Se carga el lapices y se dibuja borde inferior..
        hOldPen := SelectObject( hDC, hPen2 )
        MoveTo(hDc , aXY[36][ 2] - 1, aXY[36][ 3] + 1 )
        LineTo(hDc,  aXY[42][ 4] + 1, aXY[36][ 3] + 1 )
        LineTo(hDc,  aXY[42][ 4] + 1, -1              )

     // Se destruyen objetos utilizados
        SelectObject( hDC, hOldPen )
        IF !DeleteObject( hPen2 )
           MsgInfo("El objeto no se destruyo")
        ENDIF

RETURN NIL

STATIC FUNCTION DibujaEncabezado(hDC,  nFila1, nFila2, nAltoFila,;
                                     nCol1,  nCol2, nAnchoCol,;
                  aDiaSemana,  oFont, aColorTitulo,;
                  cMesPalabra, oFontMes, cAno )

    // Se crea el lapiz a utilizar.
       Local hPen1 := CreatePen(PS_SOLID, 1, aColorTitulo[1]) //Lapiz claro
       Local hPen2 := CreatePen(PS_SOLID, 1, aColorTitulo[3]) //Lapiz oscuro
       Local hPenAnterior
       Local aPuntos[4]
       Local A

    // Se crea brocha pintar la parte superior y luego
    // se carga la brocha y se guarda la anterior brocha.
       Local hBrocha         := CreateSolidBrush ( aColorTitulo[2] )
       Local hBrochaAnterior := SelectObject (hDC, hBrocha)


    // Se pinta el recuadro.
       FillRect( hDc, { 2, nCol1, nFila1 - 1, nCol2 }, hBrocha )

    // Se restaura la brocha y destruye la utilizada
       SelectObject (hDC, hBrochaAnterior )
       IF !DeleteObject( hBrocha )
          MsgInfo("Parece que no se destruyo")
       ENDIF

    // Se dibuja el contorno se selecciona lapiz.
       // Linea superior y linea izquierda
       hPenAnterior := SelectObject( hDC, hPen1 )
       MoveTo(hDC, nCol2 - 1, 1)
       LineTo(hDC, nCol1    , 1)
       LineTo(hDC, nCol1    , nFila1 - 1)
       LineTo(hDC, nCol1 - 1, nFila1 - 1)
       LineTo(hDC, nCol1 - 1, 0)
       LineTo(hDC, nCol2    , 0)

       //Linea horizontal del centro.
       MoveTo(hDC, nCol2 - 1, nAltoFila)
       LineTO(hDC, nCol1 - 1, nAltoFila)

       MoveTo(hDC, nCol2 - (nAnchoCol * 2), 2)
       LineTo(hDC, nCol2 - (nAnchoCol * 2), nAltoFila)

       For A = 1 to 6
           MoveTo(hDC, (nAnchoCol * A) + nCol1, nAltoFila)
           LineTo(hDC, (nAnchoCol * A) + nCol1, nAltoFila * 2)
       Next a


     // Se destruyen objetos utilizados
        SelectObject( hDC, hPenAnterior )
        IF !DeleteObject( hPen1 )
       MsgInfo("El objeto no se destruyo")
        ENDIF

    // Se dibuja el contorno se selecciona lapiz.
       // Linea superior y linea izquierda
       hPenAnterior := SelectObject( hDC, hPen2 )
       MoveTo(hDC, nCol2 - 1, 1)
       LineTo(hDC, nCol2 - 1, nFila1 - 1)
       LineTo(hDC, nCol1 - 2, nFila1 - 1)

       //Linea horizontal del centro.
       MoveTo(hDC, nCol2 - 1, nAltoFila - 1)
       LineTO(hDC, nCol1 - 2, nAltoFila - 1)

       MoveTo(hDC, nCol2 - (nAnchoCol * 2) - 1, 0)
       LineTo(hDC, nCol2 - (nAnchoCol * 2) - 1, nAltoFila)

       For A = 1 to 6
           MoveTo(hDC, (nAnchoCol * A) + nCol1 - 1, nAltoFila)
           LineTo(hDC, (nAnchoCol * A) + nCol1 - 1, nAltoFila * 2)
       Next a

     // Se destruyen objetos utilizados
        SelectObject( hDC, hPenAnterior )
        IF !DeleteObject( hPen2 )
       MsgInfo("El objeto no se destruyo")
        ENDIF


RETURN NIL
 

[MOISES]

Parte 2

Code: Select all  Expand view

STATIC FUNCTION DibujaTitulos(hDC, nAltoFila, nCol1, nCol2,;
                        nAnchoCol,  oFontMes, oFont, aColorTitulo,;
            cMesPalabra, cAno, aDiaSemana)

       LOCAL aPuntos[4]
       LOCAL A

    // Formato letra
       SelectObject(hDC, oFont:hFont)  //Se selecciona el tipo de letra.
       SetTextColor( hDC, aColorTitulo[5] )
       SetBkColor(   hDC, aColorTitulo[2] )

    // Se dibujan los titulos de los dias.
       A := 0
       aPuntos[ 1] := nAltoFila
       aPuntos[ 3] := nAltoFila * 2
       FOR A = 0 TO 6
           aPuntos[ 2] := nCol1 + ( A * nAnchoCol )
       aPuntos[ 4] := aPuntos[2] + nAnchoCol
           DrawText( hDC, LEFT(aDiaSemana[ A + 1],3), aPuntos,;
                     nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
       NEXT A

    // Se dibuja el mes en palabras.
       SelectObject(hDC, oFontMes:hFont)
       SetTextColor(hDC, aColorTitulo[4])
       aPuntos[ 1] := 3
       aPuntos[ 2] := 2
       aPuntos[ 3] := nAltoFila - 1
       aPuntos[ 4] := nCol2 - (nAnchoCol*2) - 1
       DrawText( hDC, cMesPalabra, aPuntos,;
                 nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA

    // Se dibuja el numero del año
       aPuntos[ 2] := aPuntos[ 4] + 2
       aPuntos[ 4] := nCol2 - 1
       DrawText( hDC, cAno, aPuntos,;
                 nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA

RETURN NIL

STATIC FUNCTION DibujaBotones(hDC, nFila2, nAltoFila,;
                                    nCol1,  nCol2, nAnchoCol,;
                    oFont, aColorBoton, aBoton, aTitBoton, nAnchoBoton )

    // Se crea el lapiz a utilizar.
       Local hPen1 := CreatePen(PS_SOLID, 1, aColorBoton[1]) //Lapiz claro
       Local hPen2 := CreatePen(PS_SOLID, 1, aColorBoton[3]) //Lapiz oscuro
       Local hPenAnterior
       Local aPuntos[5]
       Local A

    // Se crea brocha pintar la parte superior y luego
    // se carga la brocha y se guarda la anterior brocha.
       Local hBrocha         := CreateSolidBrush ( aColorBoton[2] )
       Local hBrochaAnterior := SelectObject (hDC, hBrocha)


    // Se pinta el recuadro.
       FillRect( hDc, { nFila2 + 2, nCol1, nFila2 + nAltoFila - 1, nCol2 }, hBrocha )

    // Se restaura la brocha y destruye la utilizada
       SelectObject (hDC, hBrochaAnterior )
       IF !DeleteObject( hBrocha )
          MsgInfo("Parece que no se destruyo")
       ENDIF

    // Se dibuja el contorno se selecciona lapiz.
       // Linea superior y linea izquierda
       hPenAnterior := SelectObject( hDC, hPen1 )
       MoveTo(hDC, nCol2 - 1, nFila2 + 1)
       LineTo(hDC, nCol1    , nFila2 + 1)
       LineTo(hDC, nCol1    , nFila2 + nAltoFila - 1)
       LineTo(hDC, nCol1 - 1, nFila2 + nAltoFila - 1)
       LineTo(hDC, nCol1 - 1, nFila2    )

       For A = 1 to 4
           MoveTo(hDC, (nAnchoBoton * A) + nCol1 + 1, nFila2 + 1)
           LineTo(hDC, (nAnchoBoton * A) + nCol1 + 1, nFila2 + nAltoFila)
       Next a

     // Se destruyen objetos utilizados
        SelectObject( hDC, hPenAnterior )
        IF !DeleteObject( hPen1 )
       MsgInfo("El objeto no se destruyo")
        ENDIF

    // Se dibuja el contorno se selecciona lapiz.
       // Linea inferior y linea derecha
       hPenAnterior := SelectObject( hDC, hPen2 )
       MoveTo(hDC, nCol2    , nFila2 + 1)
       LineTo(hDC, nCol2    , nFila2 + nAltoFila )
       LineTo(hDC, nCol1 - 2, nFila2 + nAltoFila )
       LineTo(hDC, nCol1 - 2, nFila2 + nAltoFila - 1)
       LineTo(hDC, nCol2 - 1, nFila2 + nAltoFila - 1)
       LineTo(hDC, nCol2 - 1, nFila2 + 1)

       For A = 1 to 4
           MoveTo(hDC, (nAnchoBoton * A) + nCol1, nFila2 + 1)
           LineTo(hDC, (nAnchoBoton * A) + nCol1, nFila2 + nAltoFila)
       Next a


     // Se destruyen objetos utilizados
        SelectObject( hDC, hPenAnterior )
        IF !DeleteObject( hPen2 )
       MsgInfo("El objeto no se destruyo")
        ENDIF

    // Formato letra
       SelectObject(hDC, oFont:hFont)  //Se selecciona el tipo de letra.
       SetTextColor( hDC, aColorBoton[5] )
       SetBkColor(   hDC, aColorBoton[2] )

    // Se dibujan los titulos de los botones       //Bingen
       DrawText( hDC, aTitBoton[1], aBoton[ 1],;
                     nOr(32, 4, 1 ) )
       DrawText( hDC, aTitBoton[2], aBoton[ 2],;
                     nOr(32, 4, 1 ) )
       DrawText( hDC, aTitBoton[3], aBoton[ 3],;
                     nOr(32, 4, 1 ) )
       DrawText( hDC, aTitBoton[4], aBoton[ 4],;
                     nOr(32, 4, 1 ) )
       DrawText( hDC, aTitBoton[5], aBoton[ 5],;
                     nOr(32, 4, 1 ) )

RETURN NIL

METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TMiCalendario
    // Se recupera identificador del boton.
       Local hDC       := ::GetDC()
       Local nAltoFila := ::nAltoFila
       Local nAnchoCol := ::nAnchoCol
       Local nFila1    := ::nFila1
       Local nFila2    := ::nFila2
       Local n         := 1
       Local nPos      := 0
       Local nPosAnterior := ::nPosicion
       Local B


    // Se fija que el objeto tenga el foco.
       ::SetFocus()

    // Se determina el recuadro donde se da el click
       IF ::lCuerpo( nRow, nCol)

       // Se determina el numero de fila
          While nRow > ( nPos + nFila1 + nAltoFila ) .and. n < 7
                nPos += ::nAltoFila
                n++
          end
          ::nPosFila := n

       // Se determina la posicion de la columna.
          n    := 1
      nPos := 0
          While nCol > ( nPos + nAnchoCol + ::nCol1 ) .and. n < 7
                nPos += nAnchoCol
                n++
          end
          ::nPosCol  := n


       // Se pinta el dia seleccionado.
          ::nPosicion := ( (::nPosFila - 1) * 7) + ::nPosCol
          B = ALLTRIM( ::aDias[::nPosicion])

      IF !EMPTY( B )
             MarcarDia( hDC, ::aXY[nPosAnterior], ::aClrDias[ nPosAnterior ][2])
             MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))

          // Se actualizan los datos fecha.
             ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                 ::cMesNumero         + "/" +;
                             ::cAno ) )
             ::nLastDay := ::nDiaMes
      ELSE
           IF ::lCuerpo( nRow, nCol)    //Bingen
             TONE(500,3)
         ::lSelectOK :=.F.
       ENDIF
           ::nPosicion := nPosAnterior
      ENDIF

       ENDIF

    // Se evalua si es la linea de los botones.
       IF ::lBotones( nRow, nCol)

       // Se determina la posicion de la columna.
          n    := 1
      nPos := 0
          While nCol > ( nPos + ::nAnchoBoton + ::nCol1 ) .and. n < 5
                nPos += ::nAnchoBoton
                n++
          end

          ::nPosBoton  := n
      ::PintarBoton(hDC, ::aColorBoton[5], nRow, nCol)

       // Se evalua el boton seleccionado.
      DO CASE
         CASE ::nPosBoton == 1
              ::MesAnterior()
         CASE ::nPosBoton == 2
              ::MesSiguinte()
         CASE ::nPosBoton == 3
                  ::AnoAnterior()
         CASE ::nPosBoton == 4
                  ::AnoSiguiente()
         CASE ::nPosBoton == 5
                  ::IrFecha( Date())
      ENDCASE

       ENDIF

    // Se libera el identificador del boton.
        ::ReleaseDC()


return Self

METHOD LButtonUp( nRow, nCol )  CLASS TMiCalendario
       LOCAL hDC := ::GetDC()

       IF ::lSelectOK
        ::PintarBoton(hDC, ::aColorBoton[2], nRow, nCol)
        IF ::lCuerpo( nRow, nCol)
           ::Super:LButtonUp( nRow, nCol )
        ENDIF
       ELSE
        ::lSelectOK:=.T.
       ENDIF

       ::ReleaseDC()

RETURN Self

METHOD RButtonUp( nRow, nCol, nKeyFlags ) CLASS TMiCalendario
       Local oMenu
       ::SetFocus()
       MENU oMenu POPUP
            MENUITEM ::aTitBoton[1] ACTION ::MesAnterior()
            MENUITEM ::aTitBoton[2] ACTION ::MesSiguinte()
        MENUITEM ::aTitBoton[5] ACTION ::Hoy()
        MENUITEM "Otro Mes"
          MENU
              MENUITEM ::aMESES[ 1] ACTION ::CambiarMes( 1 - ::nMesNumero )
              MENUITEM ::aMESES[ 2] ACTION ::CambiarMes( 2 - ::nMesNumero )
              MENUITEM ::aMESES[ 3] ACTION ::CambiarMes( 3 - ::nMesNumero )
              MENUITEM ::aMESES[ 4] ACTION ::CambiarMes( 4 - ::nMesNumero )
              MENUITEM ::aMESES[ 5] ACTION ::CambiarMes( 5 - ::nMesNumero )
              MENUITEM ::aMESES[ 6] ACTION ::CambiarMes( 6 - ::nMesNumero )
              MENUITEM ::aMESES[ 7] ACTION ::CambiarMes( 7 - ::nMesNumero )
              MENUITEM ::aMESES[ 8] ACTION ::CambiarMes( 8 - ::nMesNumero )
              MENUITEM ::aMESES[ 9] ACTION ::CambiarMes( 9 - ::nMesNumero )
              MENUITEM ::aMESES[10] ACTION ::CambiarMes(10 - ::nMesNumero )
              MENUITEM ::aMESES[11] ACTION ::CambiarMes(11 - ::nMesNumero )
              MENUITEM ::aMESES[12] ACTION ::CambiarMes(12 - ::nMesNumero )
          ENDMENU

            SEPARATOR
            MENUITEM ::aTitBoton[3] ACTION ::AnoAnterior()
            MENUITEM ::aTitBoton[4] ACTION ::AnoSiguiente()
            IF !::lMostrarBoton                                             //Bingen
           MENUITEM "Mostrar Botones" ACTION ::SetSize(::nWidth(),::nheight() + ::nAltoFila, .t. ),;
                                             ::ReSize(),;
                                                 ::lMostrarBoton := .T.
            ELSE
           MENUITEM "Ocultar Botones" ACTION ::SetSize(::nWidth(),::nheight() - ::nAltoFila, .t. ),;
                                             ::ReSize(),;
                                                 ::lMostrarBoton := .F.
        ENDIF

       ENDMENU
       ACTIVATE POPUP oMenu AT nRow, nCol OF Self

RETURN SELF

METHOD lBotones( nRow, nCol) CLASS TMiCalendario
RETURN iif( (nRow  > ::nFila2  .and. ;
             nCol  > ::nCol1   .and. ;
             nCol <= ::nCol2), .T., .F.)


METHOD lCuerpo( nRow, nCol)  CLASS TMiCalendario
RETURN iif( (nRow  > ::nFila1  .and.;
             nRow <= ::nFila2  .and.;
             nCol  > ::nCol1   .and.;
         nCol <= ::nCol2), .T., .F.)

METHOD Default() CLASS TMiCalendario
       Local B := 1
       Local aPuntos[ 5]
*      Local aPunt   := GetClientRec(::hWnd)
local ofu

    // Estos son los datos de las columnas.
       ::nCol1     := 1                                   //Inicio Columna
       ::nAnchoCol := CalcularAncho(::nCol1, ::nWidth() ) //El ancho de la columna
       ::nCol2     := (::nAnchoCol * 7 ) + ::nCol1        //Final Columna

    // Estos son los datos de la fila
       ::nAltoFila := CalcularAlto( ::nHeight() )         //El alto de la fila.
       ::nFila1    := ::nAltoFila * 2                     //Ubicacion primera linea a dibujar
       ::nFila2    := ::nAltoFila * 8                     //Fila Final

    // Font del título 75% de la altura de la celda
       ::oFontMes := TFont():New( "Arial", 0, -(::nAltoFila*.75),, .t. ) //Bingen
    // Font de los textos de los días 50% de la altura de la celda
       ::oFontTXT := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen
    // Font para los días por defecto del 5O% de la altura de la celda
       ::oFont    := IF(::lFont,::oFont,TFont():New( "Arial", 0, -(::nAltoFila*.50),, .t. )) //Bingen


    // Font para los botones 4O% de la altura de la celda
       ::oFontBtn := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen

    // Se crea matriz con los datos dia del mes.
    // Coordenadas filas
       aPuntos[ 1] := ::nFila1 + 1
       aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2

        FOR  B = 1 TO 7

       //Coordenadas columnas.
             aPuntos[ 2] := ::nCol1  + ( ::nAnchoCol * ( B - 1) ) + 1
             aPuntos[ 4] := aPuntos[ 2] + ::nAnchoCol - 2

             ::aXY[ B     ] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
             ::aXY[ B +  7] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
             ::aXY[ B + 14] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
             ::aXY[ B + 21] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
         ::aXY[ B + 28] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
             ::aXY[ B + 35] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }

    NEXT B

    FOR  B = 1 TO 7
             ::aXY[ B +  7][1] := ::aXY[ B     ][1] + ::nAltoFila
             ::aXY[ B + 14][1] := ::aXY[ B +  7][1] + ::nAltoFila
             ::aXY[ B + 21][1] := ::aXY[ B + 14][1] + ::nAltoFila
             ::aXY[ B + 28][1] := ::aXY[ B + 21][1] + ::nAltoFila
             ::aXY[ B + 35][1] := ::aXY[ B + 28][1] + ::nAltoFila

             ::aXY[ B +  7][3] := ::aXY[ B +  7][1] + ::nAltoFila - 2
             ::aXY[ B + 14][3] := ::aXY[ B + 14][1] + ::nAltoFila - 2
             ::aXY[ B + 21][3] := ::aXY[ B + 21][1] + ::nAltoFila - 2
             ::aXY[ B + 28][3] := ::aXY[ B + 28][1] + ::nAltoFila - 2
             ::aXY[ B + 35][3] := ::aXY[ B + 35][1] + ::nAltoFila - 2

        NEXT B


     // Se calcula el ancho de los botones.
        ::nAnchoBoton := int( (::nCol2 - ::nCol1) / 5)

     // Se crean las coordenadas del boton.
       aPuntos[ 1] := ::nFila2 + 1
       aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2

        FOR  B = 1 TO 5

          // Coordenadas columnas.
             aPuntos[ 2] := ::nCol1  + ( ::nAnchoBoton * ( B - 1) ) + 1
             aPuntos[ 4] := aPuntos[ 2] + ::nAnchoBoton - 2

             ::aBoton[B] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4], aPuntos[5] }
    NEXT B

     // Se fijan los datos de la fecha.
        ::FijarFecha( ::dFechaControl )
    ::nLastDay := ::nDiaMes

RETURN SELF

METHOD FijaClrs( aColores )  CLASS TMiCalendario
       Local A

       ::aColorCuerpo := iif( aColores == NIL, ::aColorCuerpo, aColores )

     // Se fijan los colores de bordes y de fondo de cada uno de los
     // cuadritos...
        FOR A = 1 TO 42
            ::aClrDias[ A] := { ::aColorCuerpo[ 1],; // Color Borde superior
                            ::aColorCuerpo[ 2],; // Color de Relleno
                ::aColorCuerpo[ 3],; // Color Borde inferior
                ::aColorCuerpo[ 4] } // Color del texto,

    NEXT A
RETURN NIL

METHOD FijaClrDomingo( aColores ) CLASS TMiCalendario
       LOCAL A
       ::aColorDomingo := iif( aColores == NIL, ::aColorDomingo, aColores )

    // Se fijan los colores para los dias domingo...
       FOR A = 7 TO 42 step 7
            ::aClrDias[ A] := { ::aColorDomingo[ 1],; // Color Borde superior
                            ::aColorDomingo[ 2],; // Color de Relleno
                ::aColorDomingo[ 3],; // Color Borde inferior
                ::aColorDomingo[ 4] } // Color del texto,
       NEXT A
RETURN NIL

METHOD FijaClrFestivo() CLASS TMiCalendario
       LOCAL aDiasFestivos := ::aFestivos[ ::nMesNumero]
       LOCAL nFestivos     := LEN( aDiasFestivos )
       LOCAL nDia          := 0
       LOCAL A

    // Se fijan los colores para los dias domingo...
       IF nFestivos > 0
          FOR A = 1 TO nFestivos
              nDia := aDiasFestivos[ A]
              ::ColorDia( nDia, ::aColorFestivo )
          NEXT A
       ENDIF
RETURN NIL

METHOD ColorDia( nDia, aColores ) CLASS TMiCalendario
       ::aClrDias[ ::nPrimerDia + ndia - 1 ] := aColores
RETURN NIL

METHOD FijarFecha( dFecha ) CLASS TMiCalendario

       dFecha = iif( dFecha == NIL, Date(), dFecha )

       ::dFechaControl := dFecha
       ::CalcularDias( ::dFechaControl )

       ::nMesNumero    := Month(::dFechaControl)
       ::cMesNumero    := STR(::nMesNumero, 2, 0)
       ::cMesPalabra   := IF(::nMesNumero=NIL,"", ::aMESES[::nMesNumero])

       ::nDiaSemana    := if( (::nDiaSemana := dow(::dFechaControl) - 1) = 0, 7, ::nDiaSemana)
       ::cDiaSemana    := str(::nDiaSemana,2,0)
       ::cDiaPalabra   := ::aDiaSemana[::nDiaSemana]
       ::nDiaMes       := Day(::dFechaControl )
       ::cDiaMes       := str(::nDiaMes,2,0)
       ::cDiaMesPalabra:= FormarFrase(::nDiaMes)

       ::nAno          := year( ::dFechaControl )
       ::cAno          := ALLTRIM( str(::nAno, 4, 0 ))
       ::cAnoPalabra   := FormarFrase(::nAno )

       ::aFecha[ 1]    := ::cDiaMes + " de " + ::cMesPalabra + " de " + ::cAno
       ::aFecha[ 2]    := ::cDiaPalabra + ", " + ::cDiaMes + " de " + ::cMesPalabra + " de " + ::cAno

// aqui agregar todos los otros formatos que sean posibles.
RETURN SELF

METHOD CalcularDias( dFecha ) CLASS TMiCalendario // TMiEjemplo
       Local FechaInicioMes
       Local nDiaSemana
       Local nMes       := Month( dFecha )
       Local nAno       := Year(  dFecha )
       Local aDiaFinMes := {31,28,31,30,31,30,31,31,30,31,30,31}
       Local aLosDias[42]
       Local B
       Local CELMES, CELANO, NDIAFINALMES

    // Se limpian los dias.
       FOR B = 1 TO 42
           aLosDias[ B] := "    " // Para sobrescribir el dibujo anterior
       NEXT B


    // Dia de la semana.
       FechaInicioMes := ctod( "01/" + str(nMes,2,0) + "/" + str(nAno,4,0) )
       cElMes         := IF(::nMesNumero=NIL,"", ::aMESES[::nMesNumero])
       cElAno         := STR(nAno,4)
       aDiaFinMes[ 2] := iif( CtoD("29/02/" + cElAno) = CtoD("0"), 28, 29)
       nDiaFinalMes   := aDiaFinMes[nMes]
       nDiaSemana     := dow(FechaInicioMes) - 1
       nDiaSemana     := IIF( nDiaSemana = 0, 7, nDiaSemana)

    FOR B = 1 TO nDiaFinalMes
        aLosDias[ B + nDiaSemana - 1 ] := str(B,2,0)
    NEXT B

       ::aDias        := aLosDias
       ::nPrimerDia   := nDiaSemana
       ::nUltimoDia   := B + nDiaSemana - 2
       ::nPosicion    := day(dfecha) + nDiaSemana - 1
RETURN SELF



 

[MOISES]

Parte 3

Code: Select all  Expand view

METHOD Destroy() CLASS TMiCalendario

   ::oFontMes:End()
   ::oFontTxt:End()
   //::oFont:End()
   ::oFontBtn:End()

RETURN ::Super:Destroy()


METHOD CambiarMes( nMeses, lProcesar ) CLASS TMiCalendario
       Local aDiaFinMes := {31,28,31,30,31,30,31,31,30,31,30,31}
       Local nNumeroMes := ::nMesNumero
       Local dNvaFecha
       Local hDC
       Local AnchoRelleno := (::nAnchoCol * 5) - 4
       Local nDia

       DEFAULT nMeses   := 1, lProcesar := .F.



    // Se obtiene el controlador
       IF (nMeses<> 0 .or. lProcesar)
          hDC := ::GetDC()
          // Se desmarca el dia...
             MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2] )
       ENDIF

    // Si el numero es cero, pues nada se hace y lprocesar, para obligar a procesar.
       IF (nMeses<> 0 .or. lProcesar)

             MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2] )
          // Se comprueba que no sea mayor que doce el aumento de mes.
             nNumeroMes += nMeses

             DO CASE
                CASE nNumeroMes > 12
                     ::nMesNumero := nNumeroMes - 12
                     ::nAno++
                CASE nNumeroMes < 1
                     ::nMesNumero := 12 + nNumeroMes
                 ::nAno--
                OTHERWISE
                  ::nMesNumero := nNumeroMes
             ENDCASE

          // Se verifica año bisciesto
             aDiaFinMes[ 2] := iif( CtoD("29/02/" + str(::nAno,4,0) ) = CtoD("0"), 28, 29)

          // Se determina el dia de cambio...
              nDia := iif( ::nLastDay > aDiaFinMes[ ::nMesNumero ],;
                          aDiaFinMes[ ::nMesNumero ],;
              ::nLastDay )

             dNvaFecha := CtoD( STR(  nDia      ,2,0) + "/" +;
                                STR(::nMesNumero,2,0) + "/" +;
                        STR(::nAno,      4,0) )

         ::FijarFecha( dNvaFecha )

          // Se restauran los colores...
         ::RestaurarColor()

          // Se evalua bloque de codigo al cambiar de mes...
         IF !EMPTY( ::bCambioMes )
                Eval( ::bCambioMes )
         ENDIF

          // Se dibujan los dias.
         DibujaDias( hDC, ::oFont, ::aDias, ::aXY,;
                     ::aClrDias, ::bFestivos  )

      // Se dibujan los titulos del mes y año.
             DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,;
                   ::nAnchoCol,  ::oFontMes, ::oFont, ::aColorTitulo,;
                 xPadc(::cMesPalabra, AnchoRelleno), ::cAno, ::aDiaSemana)

*            ::nPosicion := ::nDiaSemana
*        MsgInfo( ::nPosicion )

             MarcarDia( hDC, ::aXY[::nPosicion], nRgb(255,  0,  0))

          // Se libera el identificador
             ::ReleaseDC()

       ENDIF
RETURN Self

METHOD VerAlSalir() CLASS TMiCalendario
    // Metodo cuando se abandona
    // Se recupera el identificador.
       LOCAL hDC := ::GetDC()

       ::lConFoco := .F.
       MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5])

    // Se destruye el identificador.
       ::ReleaseDC()

return Self

METHOD VerAlEntrar() CLASS TMiCalendario
    // Metodo cuando se abandona
    // Se recupera el identificador.
       LOCAL hDC := ::GetDC()

       IF !::lTodoseCalculo
           ::Default()
           ::SetSize(::nCol2 + 1,::nFila2 + 1 + IF(::lMostrarBoton, ::nAltoFila, 0 ), .t. )  //Bingen
       ::lTodoseCalculo := .T.
       ENDIF

       ::lConFoco := .T.
       MarcarDia( hDC, ::aXY[::nPosicion], nrgb(255, 0, 0)) //::aColorTitulo[5]

    // Se destruye el identificador.
       ::ReleaseDC()

return Self


METHOD GetDlgCode( nLastKey ) CLASS TMiCalendario

   // This method is very similar to TControl:GetDlgCode() but it is
   // necessary to have WHEN working

   if .not. ::oWnd:lValidating
      if nLastKey == VK_UP .or. nLastKey == VK_DOWN ;
         .or. nLastKey == VK_RETURN .or. nLastKey == VK_TAB
         ::oWnd:nLastKey = nLastKey
      else
         ::oWnd:nLastKey = 0
      endif
   endif

return If( IsWindowEnabled( ::hWnd ), DLGC_WANTALLKEYS, 0 )

METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TMiCalendario
       CursorHand()

    // Se evalua si es la linea de los botones.
*       IF nRow  > nFila2 .and. ;
*          nCol  > ::nCol1  .and. nCol <= ::nCol2
*
*       ENDIF

RETURN SELF

METHOD PintarBoton(hDC, nColor, nRow, nCol) CLASS TMiCalendario  //Bingen
    // se carga la brocha y se guarda la anterior brocha.
       Local hBrocha         := CreateSolidBrush ( nColor )
       Local hBrochaAnterior := SelectObject (hDC, hBrocha)
       Local aPuntos         := ::aBoton[::nPosBoton]


    // Se pinta el recuadro.
       FillRect( hDc, {aPuntos[ 1] + 1,;
                       aPuntos[ 2] + 1,;
               aPuntos[ 3],;
               aPuntos[ 4]}, hBrocha )

    // Se restaura la brocha y destruye la utilizada
       SelectObject (hDC, hBrochaAnterior )
       IF !DeleteObject( hBrocha )
          MsgInfo("Parece que no se destruyo")
       ENDIF

    // Formato letra
       SelectObject(hDC, IF(::lCuerpo( nRow, nCol),::oFont:hFont,::oFontBtn:hFont))  //Bingen
       SetTextColor( hDC, ::aColorBoton[5] )
       SetBkColor(   hDC, nColor )

    // Se dibujan los titulos de los botones
       DrawText( hDC, ::aTitBoton[::nPosBoton], aPuntos,;
                     nOr(32, 4, 1 ) )

RETURN SELF

METHOD KeyChar( nKey, nFlags ) CLASS TMiCalendario

       do case
          case nKey == ::nK_MesAdelenta
               ::MesSiguinte()

          case nKey == ::nK_MesAtras
               ::MesAnterior()

      case nKey == ::nK_Menu
               ::RButtonUp( ::nAltoFila, ::nAnchoCol, 0 )

      otherwise
               return ::Super:KeyChar( nKey, nFlags )
       endcase
return SELF

METHOD KeyDown( nKey, nFlags ) CLASS TMiCalendario
       Local hDC
       Local nPosAnterior := ::nPosicion

       do case
          case nKey == VK_RETURN      //Bingen
                 ::LButtonUp(  ::aXY[::nPosicion,1], ::aXY[::nPosicion,2])

          case nKey == VK_END
               IF ::nPosicion < ::nUltimoDia
                  hDC := ::GetDC()
                  MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
                  ::nPosicion :=  ::nUltimoDia
                  MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                  ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                      ::cMesNumero         + "/" +;
                                      ::cAno ) )
          ::nLastDay := ::nDiaMes
                  ::ReleaseDC()
               ENDIF

          case nKey == VK_HOME
               IF ::nPosicion > ::nPrimerDia
                  hDC := ::GetDC()
                  MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
                  ::nPosicion :=  ::nPrimerDia
                  MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                  ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                      ::cMesNumero         + "/" +;
                                      ::cAno ) )
          ::nLastDay := ::nDiaMes
                  ::ReleaseDC()
               ENDIF

          case nKey == VK_DOWN
           IF ::lProcesarTecla
              ::lProcesarTecla := .F.
                  IF (::nPosicion + 7) < 42 .and. !empty(::aDias[(::nPosicion + 7)])
                     hDC := ::GetDC()
                     MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
                     ::nPosicion := ::nPosicion + 7

                     MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                     ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                         ::cMesNumero         + "/" +;
                                         ::cAno ) )

                    ::nLastDay := ::nDiaMes
                    ::ReleaseDC()
                  ENDIF
              ::lProcesarTecla := .T.
               ENDIF

          case nKey == VK_UP
           IF ::lProcesarTecla
              ::lProcesarTecla := .F.
                  IF (::nPosicion - 7) > 0 .and. !empty(::aDias[(::nPosicion - 7)])
                     hDC := ::GetDC()
                     MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
                     ::nPosicion := ::nPosicion - 7

                     MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                     ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                         ::cMesNumero         + "/" +;
                                         ::cAno ) )
                     ::nLastDay := ::nDiaMes
                     ::ReleaseDC()
                  ENDIF
              ::lProcesarTecla := .T.
               ENDIF

          case nKey == VK_LEFT
           IF ::lProcesarTecla
              ::lProcesarTecla := .F.
                  hDC := ::GetDC()
                  MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
              ::nPosicion --

                  IF ::nPosicion <  ::nPrimerDia
                     ::nPosicion := ::nUltimoDia
              ENDIF
                  MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                  ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                      ::cMesNumero         + "/" +;
                                      ::cAno ) )
                  ::ReleaseDC()
          ::nLastDay := ::nDiaMes
              ::lProcesarTecla := .T.
               ENDIF

      case nKey == VK_RIGHT
           IF ::lProcesarTecla
              ::lProcesarTecla := .F.
                  hDC := ::GetDC()
                  MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
                  ::nPosicion ++

                  IF ::nPosicion > ::nUltimoDia
                     ::nPosicion := ::nPrimerDia
                  ENDIF
                  MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
                  ::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
                                      ::cMesNumero         + "/" +;
                                     ::cAno ) )
                  ::ReleaseDC()
          ::nLastDay := ::nDiaMes
              ::lProcesarTecla := .T.
               ENDIF

      case nKey == VK_TAB .OR. nKey == VK_ESCAPE
               return ::Super:KeyDown( nKey, nFlags )

          case nKey == ::nK_AnoAtras
           ::AnoAnterior()

          case nKey == ::nK_AnoAdelenta
           ::AnoSiguiente()

          case nKey == ::nK_Hoy
               ::IrFecha( Date())

      otherwise
               return ::Super:KeyDown( nKey, nFlags )

       endcase

RETURN SELF

METHOD IrFecha( dNvaFecha ) CLASS TMiCalendario
    // Se recupera identificador del boton.
       Local hDC       := ::GetDC()
       Local AnchoRelleno := (::nAnchoCol * 5) - 4

    // Se desmarca el dia...
       MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion ][ 2] )


    // Se fija la fecha.
       ::FijarFecha( dNvaFecha )
       ::nLastDay := ::nDiaMes

    // Se restauran los colores...
       ::RestaurarColor()

    // Se evalua bloque de codigo al cambiar de mes...
       IF !EMPTY( ::bCambioMes )
           Eval( ::bCambioMes )
       ENDIF

    // Se dibujan los dias.
       DibujaDias( hDC, ::oFont, ::aDias, ::aXY,;
                   ::aClrDias, ::bFestivos )

    // Se dibujan los titulos del mes y año.
       DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,;
                   ::nAnchoCol,  ::oFontMes, ::oFont, ::aColorTitulo,;
                 xPadc(::cMesPalabra, AnchoRelleno),      ::cAno, ::aDiaSemana)



      MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5] )

   // Se libera el identificador
      ::ReleaseDC()
RETURN NIL


/*-------------------------------------------------------------------------*/
METHOD Language() CLASS TMiCalendario    //Bingen

  // Soporte multilenguaje
  IF ::nLanguage = L_PORTUGUES
     ::aMESES := { "Janeiro"   , "Fevereiro", "Março"    ,"Abril",;
                   "Maio"      , "Junho"    , "Julho"    ,"Agosto",;
                   "Setembro"  , "Outubro"  , "Novembro" ,"Dezembro"}

     ::aDiaSemana   := {"Segunda","Terça","Quarta","Quinta",;
                        "_","Sábado","Domingo"}

     ::aTitBoton    := {"&-Mês", "&+Mês", "< Ano", "Ano >", "Hoje"}

  ELSEIF ::nLanguage = L_CATALA
     ::aMESES := { "Gener"     , "Febrer" , "Març"    ,"Abril",;
                   "Maig"      , "Juny"   , "Juliol"  ,"Agost",;
                   "Setembre"  , "Octubre", "Novembre","Desembre"}

     ::aDiaSemana   := {"Dilluns","Dimarts","Dimecres","Dijous",;
                        "Divendres","Dissabte","Diumenge"}

     ::aTitBoton    := {"&-Mes", "&+Mes", "-Any", "+Any", "Avuy"}

  ELSEIF ::nLanguage = L_EUSKERA
     ::aMESES := { "Urtarrila", "Otsaila", "Martxoa" , "Apirila",;
                   "Maiatza"  , "Ekaina" , "Uztaila" , "Abuztua",;
                   "Iraila"   , "Urria"  , "Azaroa"  , "Abendua"}

     ::aDiaSemana   := {"Astelehena","Asteartea","Asteazkena","Osteguna",;
                        "Ostirala","Larunbata","Igandea"}

     ::aTitBoton    := {"&-Hil", "&+Hil", "-Urte", "+Urte", "Gaur"}

  ELSEIF ::nLanguage = L_GALEGO
     ::aMESES := { "Xaneiro"   , "Febreiro", "Marzal"   ,"Abril",;
                   "Maio"      , "Xuño"    , "Xulio"    ,"Agosto",;
                   "Septembro" , "Octubro" , "Novembro" ,"Decembro"}

     ::aDiaSemana   := {"Luns","Martes","Mércores","Xoves",;
                        "Venres","Sabado","Domingo"}

     ::aTitBoton    := {"&-Mes", "&+Mes", "< Año", "Año >", "Hoxe"}

  ELSEIF ::nLanguage = L_SPANISH
     ::aMESES := { "Enero"     , "Febrero", "Marzo"    ,"Abril",;
                   "Mayo"      , "Junio"  , "Julio"    ,"Agosto",;
                   "Septiembre", "Octubre", "Noviembre","Diciembre"}

     ::aDiaSemana   := {"Lunes","Martes","Miercoles","Jueves",;
                        "Viernes","Sabado","Domingo"}

     ::aTitBoton    := {"&-Mes", "&+Mes", "-Año", "+Año", "Hoy"}

  ELSEIF ::nLanguage = L_ITALIANO
     ::aMESES := { "Gennaio"   , "Febbraio" , "Marzo"    ,"Aprile",;
                   "Maggio"    , "Giugno"   , "Luglio"   ,"Agosto",;
                   "Settembre" , "Ottobre"  , "Novembre" ,"Dicembre"}

     ::aDiaSemana   := {"Lunedi","Martedi","Mercoledi","Giovedi",;
                        "Venerdi","Sabato","Domenica"}

     ::aTitBoton    := {"&-Mese", "&+Mese", "-Anno", "+Anno", "Oggi"}

  ELSEIF ::nLanguage = L_ENGLISH
     ::aMESES := { "Jannuary"  , "February" , "March"    ,"April",;
                   "May"       , "June"     , "July"     ,"August",;
                   "September" , "October"  , "November" ,"December"}

     ::aDiaSemana   := {"Monday","Tuesday","Wednesday","Thursday",;
                        "Friday","Saturday","Sunday"}

     ::aTitBoton    := {"&-Month", "&+Month", "-Year", "+Year", "Today"}

  ELSEIF ::nLanguage = L_FRANCAIS
     ::aMESES := { "Janvier"  , "Février" , "Mars"    ,"Avril",;
                   "Mai"       , "Juin"     , "Juillet"     ,"Août",;
                   "Septembre" , "Octobre"  , "Novembre" ,"Decembre"}

     ::aDiaSemana   := {"Lundi","Mardi","Mercredi","Jeudi",;
                        "Vendredi","Samedi","Dimanche"}

     ::aTitBoton    := {"&-Mois", "&+Mois", "-An", "+An", "Auj'hui"}

  ELSEIF ::nLanguage = L_DEUSTCH
     ::aMESES := { "Januar"    , "Februar"  , "März"     ,"April",;
                   "Mai"       , "Juni"     , "Juli"     ,"August",;
                   "September" , "Oktober"  , "November" ,"Dezember"}

     ::aDiaSemana   := {"Montag","Dienstag","Mittwoch","Donnerstag",;
                        "Freitag","Samstag","Sonntag"}

     ::aTitBoton    := {"&-Monat", "&+Monat", "-Jahr", "+Jahr", "Heute"}

  ENDIF

// Para realimentar los datos fechas con los nuevos valores.
   ::FijarFecha( ::dFechaControl )

RETURN NIL

STATIC FUNCTION CalcularAncho( nEspacioIzq,nWidth )
       Local nColumnaAncho
       nColumnaAncho := int( ( nWidth - nEspacioIzq ) / 7)
RETURN nColumnaAncho

STATIC FUNCTION CalcularAlto( nHeight )
       Local nFilaAlto
       nFilaAlto := int(( nHeight - 1) / 8)
RETURN nFilaAlto

STATIC FUNCTION MarcarDia( hDC, aPuntos, nColor)
    // Se crea el lapiz a utilizar.y se carga.
       Local hPen1        := CreatePen(PS_SOLID, 3, nColor)
       Local hPenAnterior := SelectObject(hDC, hPen1)

    // Se dibuja el rectangulo
       MoveTo(hDC, aPuntos[2] + 1, aPuntos[1] + 1)
       LineTo(hDC, aPuntos[4] - 3, aPuntos[1] + 1)
       LineTo(hDC, aPuntos[4] - 3, aPuntos[3] - 2)
       LineTo(hDC, aPuntos[2] + 1, aPuntos[3] - 2)
       LineTo(hDC, aPuntos[2] + 1, aPuntos[1] + 1)

    // Se destruyen objetos utilizados
       SelectObject( hDC, hPenAnterior )
       IF !DeleteObject( hPen1 )
          MsgInfo("El objeto no se destruyo")
       ENDIF
RETURN NIL

STATIC FUNCTION FormarFrase(ElNumero)
          //ElNumero      , corresponde al numero que se debera frasear.

          //Se definen variables locales de control.
            LOCAL Pon_la_Y   := ""
            LOCAL Pon_Mil    := ""
            LOCAL CtrlTexto  := ""    //Almacenara a ELNUMERO en formato texto.
            LOCAL FraseNumero:= ""
            LOCAL ValorPos[11]
            LOCAL Num_A[30]
            LOCAL Num_B[ 9]
            LOCAL Num_C[10]

          //Se llenan matricez de control de palabras.
            Num_A[  1] = ""           ; Num_A[ 16] = "Quince "
            Num_A[  2] = "Un "        ; Num_A[ 17] = "Dieciseis "
            Num_A[  3] = "Dos "       ; Num_A[ 18] = "Diecisiete "
            Num_A[  4] = "Tres "      ; Num_A[ 19] = "Dieciocho "
            Num_A[  5] = "Cuatro "    ; Num_A[ 20] = "Diecinueve "
            Num_A[  6] = "Cinco "     ; Num_A[ 21] = "Veinte "
            Num_A[  7] = "Seis "      ; Num_A[ 22] = "Veintiun "
            Num_A[  8] = "Siete "     ; Num_A[ 23] = "Veintidos "
            Num_A[  9] = "Ocho "      ; Num_A[ 24] = "Vientitres "
            Num_A[ 10] = "Nueve "     ; Num_A[ 25] = "Veinticuatro "
            Num_A[ 11] = "Diez "      ; Num_A[ 26] = "Veinticinco "
            Num_A[ 12] = "Once "      ; Num_A[ 27] = "Veintiseis "
            Num_A[ 13] = "Doce "      ; Num_A[ 28] = "Veintisiete "
            Num_A[ 14] = "Trece "     ; Num_A[ 29] = "Veintiocho "
            Num_A[ 15] = "Catorce "   ; Num_A[ 30] = "Veintinueve "

            Num_B[  1] = "Diez "      ; Num_C[  1] = ""
            Num_B[  2] = "Veinte "    ; Num_C[  2] = "Ciento "
            Num_B[  3] = "Treinta "   ; Num_C[  3] = "Doscientos "
            Num_B[  4] = "Cuarenta "  ; Num_C[  4] = "Trescientos "
            Num_B[  5] = "Cincuenta " ; Num_C[  5] = "Cuatrocientos "
            Num_B[  6] = "Sesenta "   ; Num_C[  6] = "Quinientos "
            Num_B[  7] = "Setenta "   ; Num_C[  7] = "Seiscientos "
            Num_B[  8] = "Ochenta "   ; Num_C[  8] = "Setecientos "
            Num_B[  9] = "Noventa "   ; Num_C[  9] = "Ochocientos "
                                        Num_C[ 10] = "Novecientos "

          //Se vacias valores de control
            CtrlTexto    = STR(ElNumero,8,0)
            ValorPos[ 1] = VAL(Substr(CtrlTexto,8,1))
            ValorPos[ 2] = VAL(Substr(CtrlTexto,7,1))
            ValorPos[ 3] = VAL(Substr(CtrlTexto,6,1))
            ValorPos[ 4] = VAL(Substr(CtrlTexto,5,1))
            ValorPos[ 5] = VAL(Substr(CtrlTexto,4,1))
            ValorPos[ 6] = VAL(Substr(CtrlTexto,3,1))
            ValorPos[ 7] = VAL(Substr(CtrlTexto,2,1))
            ValorPos[ 8] = VAL(Substr(CtrlTexto,1,1))
            ValorPos[ 9] = VAL(Substr(CtrlTexto,7,2))
            ValorPos[10] = VAL(Substr(CtrlTexto,4,2))
            ValorPos[11] = VAL(Substr(CtrlTexto,1,2))

          //Se comienza a generar la frase de control comenzando por las
          //unidades.
            Pon_la_Y = IF(ValorPos[ 1] = 0,"","y ")
            IF ValorPos[ 2] < 3
               FraseNumero = Num_A[ValorPos[ 9] + 1]
            ELSE
               FraseNumero = Num_B[ValorPos[ 2]] + Pon_la_Y + ;
                             IF(ValorPos[ 9] > 20,Num_A[ValorPos[ 1]+1],"")
            ENDIF

          //se continua formado la frase para las centenas
            Num_C[ 2] = IF((ValorPos[ 1] + ValorPos[ 2]) = 0,"Cien ","Ciento ")
            FraseNumero = Num_C[ValorPos[ 3] + 1] + FraseNumero

          //se continua formado la frase para los miles
            Pon_Mil  = IF((ValorPos[ 4]  + ValorPos[ 5] + ValorPos[ 6]) = 0,"","Mil ")
            Pon_la_Y = IF( ValorPos[ 4] = 0,"","y ")

            IF ValorPos[ 5] < 3
               FraseNumero = Num_A[ValorPos[10] + 1] + Pon_Mil + FraseNumero
            ELSE
               FraseNumero = Num_B[ValorPos[ 5]] + Pon_la_Y +;
                             Num_A[ValorPos[ 4] + 1] + Pon_Mil + FraseNumero
            ENDIF

RETURN  FraseNumero


 

[cnavarro]

Quitando un pequeño detalle de cambio en el tamaño de las letras de los dias de la semana cuando cambias de mes o de año, a mi me funciona bien
Y en el metodo Default, me he permitido hacer este cambio

Code: Select all  Expand view

.../...
    if !::lFont
       if !Empty( ::oFont )
          ::oFont:End()
       endif
       ::oFont := TFont():New( "Arial", 0, -0.50*::nAltoFila, , .t. )
    //   ::oFont    := IF(::lFont,::oFont,TFont():New( "Arial", 0, -(::nAltoFila*.50),, .t. )) //Bingen
    endif
.../...
 

Lo ideal es que para controlar la posible perdida de recursos, puedes utilizar

Code: Select all  Expand view

Function Main()

   SetResDebug( .T. )

.../...
//al final despues del activate, si existiera

   //Hb_GCall(.t.)
   //CLEAR MEMORY

   if File( "checkres.txt" )
      FErase( "checkres.txt" )
   endif

   CheckRes()

return

 

[MOISES]

Hola Cristóbal,

Muchas gracias por tu ayuda, ya funciona perfecto.