Jump to content
Fivewin Brasil

Alteração na classe TCALENDAR


CTOAS

Recommended Posts

Amigos, fiz uma pequena alteração na classe e estou postando a alteração, marcado em vermelho.


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

* 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_SPANISH 1 //BINGEN

#define L_CATALA 2

#define L_EUSKERA 3

#define L_GALEGO 4

#define L_PORTUGUES 5

#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

DATA aFestivos AS ARRAY INIT ARRAY(12) READONLY

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(3) READONLY && Alteração do limite do Array de 2 para 3 por Christianoid=red>

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 ReDefine( nId, oWnd, oFont,nLANGUAGE ) 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 <--- ORIGINAL

// 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 ReDefine( nId, oWnd, oFont ) CLASS TMiCalendario

*

* ::nId = nId

* ::hWnd = 0

* ::oWnd = oWnd

*

* if acBitmaps != nil

* ::SetBitmaps( acBitmaps )

* else

* ::lOwnerDraw = .f.

* endif

*

* oWnd:DefControl( Self )

*return Self

METHOD Display() CLASS TMiCalendario

IF ::lContinuar

::lContinuar := .F.

::BeginPaint()

::Paint()

::EndPaint()

::lContinuar := .T.

ELSE

MsgInfo("Para controlar que no pase dos veces")

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 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("El objeto no se destruyo")

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

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]

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

// 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 "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 ::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 := { 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

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

::aFecha[ 3] := IF(SUBSTR(::cDiaMes,1,1)=" ",STRTRAN(::cDiaMes," ","0"),::cDiaMes) ;

+ "/" + IF(SUBSTR(::cMesNumero,1,1)=" ",STRTRAN(::cMesNumero," ","0"),::cMesNumero) ;

+ "/" + ::cAno && Nova saida de data formato DD/MM/AAAA por Christiano

id=red>

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

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

id=code>

id=code>

logoforum.jpg

Editado por - ctoas on 19/04/2010 02:32:00

Link to comment
Share on other sites

Amigos, fiz uma pequena alteração na classe e estou postando a alteração, marcado em vermelho.


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

* 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_SPANISH 1 //BINGEN

#define L_CATALA 2

#define L_EUSKERA 3

#define L_GALEGO 4

#define L_PORTUGUES 5

#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

DATA aFestivos AS ARRAY INIT ARRAY(12) READONLY

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(3) READONLY && Alteração do limite do Array de 2 para 3 por Christianoid=red>

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 ReDefine( nId, oWnd, oFont,nLANGUAGE ) 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 <--- ORIGINAL

// 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 ReDefine( nId, oWnd, oFont ) CLASS TMiCalendario

*

* ::nId = nId

* ::hWnd = 0

* ::oWnd = oWnd

*

* if acBitmaps != nil

* ::SetBitmaps( acBitmaps )

* else

* ::lOwnerDraw = .f.

* endif

*

* oWnd:DefControl( Self )

*return Self

METHOD Display() CLASS TMiCalendario

IF ::lContinuar

::lContinuar := .F.

::BeginPaint()

::Paint()

::EndPaint()

::lContinuar := .T.

ELSE

MsgInfo("Para controlar que no pase dos veces")

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 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("El objeto no se destruyo")

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

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]

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

// 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 "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 ::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 := { 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

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

::aFecha[ 3] := IF(SUBSTR(::cDiaMes,1,1)=" ",STRTRAN(::cDiaMes," ","0"),::cDiaMes) ;

+ "/" + IF(SUBSTR(::cMesNumero,1,1)=" ",STRTRAN(::cMesNumero," ","0"),::cMesNumero) ;

+ "/" + ::cAno && Nova saida de data formato DD/MM/AAAA por Christiano

id=red>

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

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

id=code>

id=code>

logoforum.jpg

Editado por - ctoas on 19/04/2010 02:32:00

Link to comment
Share on other sites

Era só o que faltava... emboiolou de vez... kkkkkkk

Visual, você quem faz, esta modificação que você usa, é by eu!! Ela veio crua, crua!!

Abraços.

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe

dentinho.jpg?rnd=0.830315402649066

Link to comment
Share on other sites

C tá melhorando, viu? Gostei!

Mas, onde o usuário troca as cores do Calendário?

Não o deixe preso em uma única cor, não é legal.

Abraços.

João Santos - São Paulo.

kmt_karinha@pop.com.br

joao@pleno.com.br

Fone: (11) 3106-2832 / 8243-5632

FWH 2.7 - xHARBOUR WorkShop.Exe

dentinho.jpg?rnd=0.830315402649066

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
×
  • Create New...