Calendário

evertonlb · December 18, 2015

Bom dia amigos. Preciso colocar um calendário no meu software... não precisa ser nada muito elaborado que registre compromissos e coisas semelhantes.. só preciso de um calendário que dê para mudar meses e anos.

Dei uma olhada nas mensagens do fórum mas infelizmente não encontrei nada que pudesse me ajudar!

Tô aceitando sugestões! rsrsrsr

Att.

Everton

vagner · December 18, 2015

Olá, procure por Calendar nos samples

Alain da Silva · December 18, 2015

#Include "FiveWin.Ch"

#Include "Obj2Hb.Ch"

Function Calend(ODT,OOBJ)

Local oFont, oFont2, oFonte, oFont3

Local oDlg, nVar2, oPrueba1

Local oPrueba, oBtn[ 10], oCombo[ 2 ]

Local nVar1 := nVar2 := 1

Local aLenguajes := { " Portugues ", ;

" Catalao ", ;

" Euskera ", ;

" Galego ", ;

" Espanhol ", ;

" Italiano ", ;

" Ingles ", ;

" Frances ", ;

" Alemao " }

Local aCombinacion:={ " Cores 1" , ;

" Cores 2" , ;

" Cores 3" , ;

" Cores 4" , ;

" Cores 5" , ;

" Cores 6" }

Local aTit_Color := aComboTitulo()

Local aCue_Color := aComboCuerpo()

Local aDom_Color := aComboDomingo()

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.

SET _3DLOOK ON

// Se activa el archivo de recursos a utilizar.

DEFINE FONT oFont NAME "Arial" SIZE 0,-14

DEFINE FONT oFont3 NAME "Ms Sans Serif" SIZE 0,-13

//set date french

SET DATE BRIT

DEFINE DIALOG oDlg TITLE "Calendario ;

FROM 10,10 TO 360, 280 PIXEL COLOR "N/W" ;

STYLE nOR( DS_MODALFRAME )

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

oDlg:lHelpIcon := .F.

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

//oPrueba1:bLButtonUp := {|| Msginfo("Prova do Bloco bLButtonUp")}

// 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....

// Aqui tem um Erro, Que NÆo Consegui Descobrir.

// Para pintar los dias festivos..

oPrueba1:aFestivos[ 1] := {} //Festivos de Enero

oPrueba1:aFestivos[ 2] := {} //Festivos de Ferbrero

oPrueba1:aFestivos[ 3] := {} //Festivos de Marzo

oPrueba1:aFestivos[ 4] := {} //Festivos de Abril

oPrueba1:aFestivos[ 5] := {} //Festivos de Mayo

oPrueba1:aFestivos[ 6] := {} //Festivos de Junio

oPrueba1:aFestivos[ 7] := {} //Festivos de Julio

oPrueba1:aFestivos[ 8] := {} //Festivos de Agosto

oPrueba1:aFestivos[ 9] := {07} //Festivos de Septiembre

oPrueba1:aFestivos[10] := {12} //Festivos de Octubre

oPrueba1:aFestivos[11] := {2,15} //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 ) }

@ 5,140 COMBOBOX oCombo[ 1 ] VAR nVar1 ;

ITEMS aLenguajes OF oDlg ;

SIZE 50,150 ;

FONT oFont3 ;

PIXEL ;

ON CHANGE ( oPrueba1:nLanguage := nVar1, ;

oPrueba1:Language(), ;

oPrueba1:Paint() )

@ 20,140 COMBOBOX oCombo[ 1 ] VAR nVar2 ;

ITEMS aCombinacion OF oDlg ;

SIZE 50,150 ;

FONT oFont3 ;

PIXEL ;

ON CHANGE ( oPrueba1:aColorTitulo := aTit_Color[ nVar2], ;

oPrueba1:aColorCuerpo := aCue_Color[ nVar2], ;

oPrueba1:aColorBoton := aTit_Color[ nVar2], ;

oPrueba1:FijaClrDomingo( aDom_Color[ nVar2]), ;

oPrueba1:RestaurarColor(), ;

oPrueba1:Paint() )

@ 35,140 BUTTON oBtn[ 1] PROMPT "Provar/Teste" ;

OF oDlg PIXEL SIZE 50,12 ;

FONT oFont ;

ACTION( MsgInfo( oPrueba1:aFecha[2], ;

"Data Selecionada Pelo Usuario" ) )

@ 50,140 BUTTON oBtn[ 2] PROMPT "31/12/2008 " ;

OF oDlg PIXEL SIZE 50,12 ;

FONT oFont ;

ACTION oPrueba1:IrFecha( CtoD("31/12/2008") )

@ 65,140 BUTTON oBtn[ 3] PROMPT "Hoje " ;

OF oDlg PIXEL SIZE 50,12 ;

FONT oFont ;

ACTION oPrueba1:IrFecha( Date() )

@ 80,140 BUTTON oBtn[ 4] PROMPT "Ingles " ;

OF oDlg PIXEL SIZE 50,12 ;

FONT oFont ;

ACTION ( oPrueba1:nLanguage := 7, ;

oPrueba1:Language(), ;

oPrueba1:Paint() )

@ 95,140 BUTTON oBtn[ 5] PROMPT "Espanhol " ;

OF oDlg PIXEL SIZE 50,12 ;

FONT oFont ;

ACTION ( oPrueba1:nLanguage := 5, ;

oPrueba1:Language(), ;

oPrueba1:Paint() )

@ 110,140 BUTTON oBtn[ 6] PROMPT "Nova Cor " ;

OF oDlg PIXEL SIZE 50,12 ;

FONT oFont ;

ACTION ( oPrueba1:aColorCuerpo := aColorCuerpo, ;

oPrueba1:aColorTitulo := aColorTitulo, ;

oPrueba1:aColorBoton := aColorBoton , ;

oPrueba1:RestaurarColor(), ;

oPrueba1:Paint() )

@ 125,140 BUTTON oBtn[ 7] PROMPT "Pintar Dia 15" ;

OF oDlg PIXEL SIZE 50,12 ;

FONT oFont ;

ACTION ( oPrueba1:ColorDia( 15, aClrFestivo ), ;

oPrueba1:Paint() )

@ 145,60 BUTTON oBtn[ 9] PROMPT "&Transportar" ;

OF oDlg PIXEL SIZE 50,12 ;

FONT oFont ;

ACTION( escolher(@odt,oobj,CTOD(STRZERO(oPrueba1:NDIAMES,2)+"/"+STRZERO(oPrueba1:NMesNumero,2)+"/"+oPrueba1:CANO)),oDlg:End() ) CANCEL

oBtn[ 9]:cToolTip := "Sai e Escolhe a Data"

@ 145,5 BUTTON oBtn[ 8] PROMPT "&Sair" ;

OF oDlg PIXEL SIZE 50,12 ;

FONT oFont ;

ACTION( oDlg:End() ) CANCEL

oBtn[ 8]:cToolTip := "Sair do Calendário"

ACTIVATE DIALOG oDlg CENTERED

// Se sacan los recursos de memoria.

RELEASE FONT oFont

RELEASE FONT oFont3

Return .t.

function escolher(odt,oobj,XDT)

ODT:=XDT

IF !EMPTY(OOBJ)

OOBJ:REFRESH()

ENDIF

return .t.

// 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

STATIC FUNCTION aComboTitulo()

Local aDeColores

aDeColores :={ {rgb(170,170, 80), rgb(130,130, 65),rgb(100,100, 50), ;

rgb( 205, 205, 155), Rgb( 205, 205, 155) }, ;

{rgb( 55,170,170), rgb( 40,120,120),rgb( 40,110,110), ;

rgb( 205, 205, 155), Rgb( 205, 205, 155) }, ;

{rgb( 60,160, 60), rgb( 50,125, 50),rgb( 40,110, 40), ;

rgb( 205, 205, 155), Rgb( 205, 205, 155) }, ;

{rgb(190, 60,190), rgb(150, 50,150),rgb(110, 40,110), ;

rgb( 205, 205, 155), Rgb( 205, 205, 155) }, ;

{rgb(190, 63, 63), rgb(150, 50, 50),rgb(110, 40, 40), ;

rgb( 205, 205, 155), Rgb( 205, 205, 155) }, ;

{rgb(125,125,125), rgb(100,100,100),rgb( 75, 75, 75), ;

rgb( 205, 205, 155), Rgb( 205, 205, 155) } }

RETURN aDeColores

STATIC FUNCTION aComboCuerpo()

Local aDeColores

aDeColores :={ {rgb(235,235,210), rgb(205,205,155),rgb(150,150, 75), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) }, ;

{rgb(205,240,240), rgb(145,220,220),rgb( 55,170,170), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) }, ;

{rgb(205,240,205), rgb(175,210,175),rgb( 55,170, 55), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) }, ;

{rgb(240,205,240), rgb(220,145,220),rgb(170, 55,170), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) }, ;

{rgb(240,205,205), rgb(230,180,180),rgb(210,120,120), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) }, ;

{rgb(220,220,220), rgb(180,180,180),rgb(110,110,110), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) } }

RETURN aDeColores

STATIC FUNCTION aComboDomingo()

Local aDeColores

aDeColores :={ {rgb(255,255,255), rgb(220,220,220),rgb(128,128,128), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) }, ;

{rgb(255,255,255), rgb(203,238,238),rgb( 65,192,192), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) }, ;

{rgb(255,255,255), rgb(203,238,203),rgb( 65,192, 65), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) }, ;

{rgb(255,255,255), rgb(238,203,238),rgb(192, 65,192), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) }, ;

{rgb(255,255,255), rgb(238,203,203),rgb(192, 65, 65), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) }, ;

{rgb(255,255,255), rgb(220,220,220),rgb(128,128,128), ;

rgb( 0, 0, 0), Rgb( 130, 130, 65) } }

RETURN aDeColores

// Datos que devuelve el calendario.

kapiaba · December 18, 2015

Que tal?

evertonlb · December 18, 2015

Obrigado Vagner e Kapiaba...

Nossa.. que loco o calendário Kapiaba... esse ai é o Calendar do Samples conforme a dica do Vagner?

Vou colocar esse daí.. muito acima das minhas expectativas!

Att.

Everton

Alain da Silva · December 18, 2015

everton, é praticamente o código que postei. Nesse eu coloquei mais dois botões, sair e transportar a data.

evertonlb · January 4, 2016

everton, é praticamente o código que postei. Nesse eu coloquei mais dois botões, sair e transportar a data.

Boa tarde Boingo... eu uso a versão 6.12 do FW e não encontrei o arquivo Obj2Hb.Ch. Será que tu poderia enviar para evertonlb@uol.com.br

Att.

Everton

kapiaba · January 4, 2016



//----------------------------------------------------------------------------//

//  AUTOR.....: Manuel Exp¢sito Su rez    Soft 4U '98                         //

//  e-Mail....: maex14@dipusevilla.es                                         //

//  CLASE.....: Obj2Hb.CH                                                     //

//  FECHA MOD.: 10/11/2000                                                    //

//  VERSION...: 9.00                                                          //

//  PROPOSITO.: Compatibiliza HARBOUR OOP con Objects                         //

//----------------------------------------------------------------------------//



#ifdef __HARBOUR__


    #xtranslate AS ALL     => AS ANYTYPE     // Compatible con OBJECTS

    #xtranslate AS BLOCK   => AS CODEBLOCK


    // Extraido de Objects.ch


    #xcommand DEFAULT <Desc> [, <DescN> ]      => ;

                      __DFT__( <Desc> ) [ ; __DFT__( <DescN> ) ]


    #xtranslate __DFT__( <Var> := <Dft> ) => ;

                if( <Var> == nil, <Var> := <Dft>, )


    #xtranslate __DFT__( <Var> = <Dft> )  => ;

                __DFT__( <Var> := <Dft> )


    #xtranslate BYNAME <V> [, <VN> ]     => ::<V> := <V> [; ::<VN> := <VN> ]

    #xtranslate BYNAME <V> DEFAULT <Val> => ::<V> := BYDEFAULT <V>, <Val>

    #xtranslate BYDEFAULT <V>, <Val>     => if( <V> == NIL, <Val>, <V> )

    #xtranslate BYNAME <V> IFNONIL       => ;

                                if <V> != NIL ;;

                                    ::<V> := <V> ;;

                                end

    #xtranslate BYDEFAULT <V>, <Val>     => if( <V> == NIL, <Val>, <V> )


    #include "HBClass.ch"


#else


    #include "Objects.ch"


#endif


//----------------------------------------------------------------------------//

evertonlb · January 4, 2016

Obrigado kapiaba... Vou testar agora!!

evertonlb · January 4, 2016

Kapiaba.. eu tenho aqui uma Agenda que você fez.. que tem este mesmo calendário. Nossa cara.. baita trabalho ein?!?!

Bom.. compilei mas agora da um erro dizendo que uma função não existe.. a linha do erro é a seguinte

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

ta faltando uma Classe?

kapiaba · January 4, 2016



*******************************************************

*  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 "Obj2Hb.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


      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_PORTUGUES // 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

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


            MENUITEM ::aTitBoton[2] ACTION ::MesAnterior()


   MENUITEM ::aTitBoton[5] ACTION ::Hoy()


            MENUITEM ( OemToAnsi( "Outro Mˆs" ) )

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

            MENUITEM ::aTitBoton[4] ACTION ::AnoAnterior()


            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)


    // 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",;

                        "Sexta","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


//-> FIM DO PROGRAMA

evertonlb · January 4, 2016

Perfeito Kapiaba... Obrigado cara.. Muito obrigado mesmo!!!

Att.

Everton

Calendário

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation