Hola,
En una clase, asignaba ::oFont así:
METHOD New ( nTop, nLeft, nWidth, nHeight, oWnd, oFont, nLANGUAGE ) CLASS TMiCalendario
DEFAULT nTop:=5, nLeft:=5,nWidth:=120,nHeight:=120 //Bingen
DEFAULT nLanguage := L_SPANISH
[...]
::oWnd := oWnd
::oFont := oFont
Ahora, ::oFont:SetFont( oFont ) me dice que "No existe el método: SETFONT".
Por favor, ¿cómo lo soluciono?.
Muchas gracias por la atención.
problema con SetFont
-
cnavarro
- Posts: 6572
- Joined: Wed Feb 15, 2012 8:25 pm
- Location: España
- Has thanked: 4 times
- Been thanked: 6 times
Re: problema con SetFont
O haces <oCtrl>:SetFont(..) o dentro de tu clase heredada de TControl, pones simplemente ::SetFont(... ), pero ::ofont no tiene ese metodo
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Re: problema con SetFont
Hola Cristóbal:
Probé con ::SetFont( oFont ) y sigue el EXCESS RELEASE.
Además, en teoría debería ser ::oFont := SetFont( oFont ), pero tampoco sirve.
Por ejemplo, así uso oFont internamente:
STATIC FUNCTION DibujaTitulos(hDC, nAltoFila, nCol1, nCol2,;
nAnchoCol, oFontMes, oFont, aColorTitulo,;
cMesPalabra, cAno, aDiaSemana)
LOCAL aPuntos[4]
LOCAL A
// Formato letra
SelectObject(hDC, oFont:hFont) //Se selecciona el tipo de letra.
SetTextColor( hDC, aColorTitulo[5] )
SetBkColor( hDC, aColorTitulo[2] )
// Se dibujan los titulos de los dias.
A := 0
aPuntos[ 1] := nAltoFila
aPuntos[ 3] := nAltoFila * 2
FOR A = 0 TO 6
aPuntos[ 2] := nCol1 + ( A * nAnchoCol )
aPuntos[ 4] := aPuntos[2] + nAnchoCol
DrawText( hDC, LEFT(aDiaSemana[ A + 1],3), aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
NEXT A
// Se dibuja el mes en palabras.
SelectObject(hDC, oFontMes:hFont)
SetTextColor(hDC, aColorTitulo[4])
aPuntos[ 1] := 3
aPuntos[ 2] := 2
aPuntos[ 3] := nAltoFila - 1
aPuntos[ 4] := nCol2 - (nAnchoCol*2) - 1
DrawText( hDC, cMesPalabra, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
// Se dibuja el numero del año
aPuntos[ 2] := aPuntos[ 4] + 2
aPuntos[ 4] := nCol2 - 1
DrawText( hDC, cAno, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
RETURN NIL
Probé con ::SetFont( oFont ) y sigue el EXCESS RELEASE.
Además, en teoría debería ser ::oFont := SetFont( oFont ), pero tampoco sirve.
Por ejemplo, así uso oFont internamente:
STATIC FUNCTION DibujaTitulos(hDC, nAltoFila, nCol1, nCol2,;
nAnchoCol, oFontMes, oFont, aColorTitulo,;
cMesPalabra, cAno, aDiaSemana)
LOCAL aPuntos[4]
LOCAL A
// Formato letra
SelectObject(hDC, oFont:hFont) //Se selecciona el tipo de letra.
SetTextColor( hDC, aColorTitulo[5] )
SetBkColor( hDC, aColorTitulo[2] )
// Se dibujan los titulos de los dias.
A := 0
aPuntos[ 1] := nAltoFila
aPuntos[ 3] := nAltoFila * 2
FOR A = 0 TO 6
aPuntos[ 2] := nCol1 + ( A * nAnchoCol )
aPuntos[ 4] := aPuntos[2] + nAnchoCol
DrawText( hDC, LEFT(aDiaSemana[ A + 1],3), aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
NEXT A
// Se dibuja el mes en palabras.
SelectObject(hDC, oFontMes:hFont)
SetTextColor(hDC, aColorTitulo[4])
aPuntos[ 1] := 3
aPuntos[ 2] := 2
aPuntos[ 3] := nAltoFila - 1
aPuntos[ 4] := nCol2 - (nAnchoCol*2) - 1
DrawText( hDC, cMesPalabra, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
// Se dibuja el numero del año
aPuntos[ 2] := aPuntos[ 4] + 2
aPuntos[ 4] := nCol2 - 1
DrawText( hDC, cAno, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
RETURN NIL
Saludos / Regards,
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
-
cnavarro
- Posts: 6572
- Joined: Wed Feb 15, 2012 8:25 pm
- Location: España
- Has thanked: 4 times
- Been thanked: 6 times
Re: problema con SetFont
Moises, creo que solo con:
es suficiente
No debes hacer
justamente es lo que hace el primer codigo
Code: Select all | Expand
::SetFont( oFont ) es suficiente
No debes hacer
Code: Select all | Expand
::oFont := ::SetFont( oFont ) justamente es lo que hace el primer codigo
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Re: problema con SetFont
Hola Cristóbal,
Probé efectivamente ::SetFont( oFont ) sin éxito.
Sigue diciendo
Pongo un ejemplo a ver si vemos que se me escapa. Muchas gracias.
Probé efectivamente ::SetFont( oFont ) sin éxito.
Sigue diciendo
23/02/2015 14:51:26: EXCESS RELEASE OF FONT Ms Sans Serif[ hFont : 0] ( nCount : 0 )
<-TFONT:END(246) <-MSGDATE(176) <-MAIN(47)
------------------------------------------------------------
Pongo un ejemplo a ver si vemos que se me escapa. Muchas gracias.
Code: Select all | Expand
/******************************************************** Clase para mostrar y gestionar Calendarios en FW ** Desarrollada por Rodrigo Soto y Bingen Ugaldebere ** 2.002 - 2.003 ********************************************************#include "FiveWin.ch"#include "InKey.ch"//#include "Constant.ch"#include "Objects.ch"#define K_MAS 43#define K_MENOS 45#define K_DIVISION 47#define K_HOY 72#define L_PORTUGUES 1#define L_CATALA 2#define L_EUSKERA 3#define L_GALEGO 4#define L_SPANISH 5 //BINGEN#define L_ITALIANO 6#define L_ENGLISH 7#define L_FRANCAIS 8#define L_DEUSTCH 9REQUEST HB_LANG_ESWINREQUEST HB_CODEPAGE_ESWINFUNCTION Main() LOCAL oWnd HB_LangSelect("ESWIN") HB_CDPSELECT("ESWIN") SET EPOCH TO 1950 SET CENTURY ON SET DATE FORMAT TO "DD/MM/YYYY" MsgInfo( MsgDate(DATE()), "Date Returned")RETURN( NIL )// -----------------------------------------------------------------------// -----------------------------------------------------------------------// Funci¢n ...: MsgDate()// Descripci¢n: Calendario// Par metros : Ninguno.// Devuelve ..:// Datos que devuelve el calendario.// * dFechaControl , la fecha seleccionado, formato fecha.//// * nMesNumero , el numero del mes , formato numero// * cMesNumero , el numero del mes , formato caracter// * cMesPalabra , el nombre del mes//// * nDiaSemana , el numero del dia de la semana formato numero// * cDiaSemana , el numero del dia de la semana formato caracter// * cDiaPalabra , el nombre del dia de la semana// * nDiaMes , el dia del mes formato numero// * cDiaMes , el dia del mes formato caracter// * cDiaMesPalabra, el dia del mes en palabras.//// * nAno , el numero del año formato numero// * cAno , el numero del año formato caracter// * cAnoPalabra , el numero del año en palabras.//// * array con formatos de fecha.// * aFecha[ 1] , XX de enero del XXXX// * aFecha[ 2] , Domingo,XX de Septiembre de XXXX//// *Se encuentra habilitado el boton derecho del mouse con otras// *opciones, mientras veo donde coloco los botones...//// *METODOS// * CambiarMes( nMes)// * MesSiguinte() INLINE ::CambiarMes( +1)// * MesAnterior() INLINE ::CambiarMes( -1)// * AnoSiguinte() INLINE ::CambiarMes( 12)// * AnoAnterior() INLINE ::CambiarMes(-12)//// -----------------------------------------------------------------------function MsgDate( dDate, cPrompt, oGet ) Local oFont, oFont2, oFonte, oFont3 Local oDlg, nVar2, oPrueba1 Local oPrueba, oBtn[ 10], oCombo[ 2 ] Local nVar1 := nVar2 := 1 LOCAL aClrFestivo := { rgb( 255, 255, 255),; //Color borde superior rgb( 255, 255, 0),; //Color relleno rgb( 180, 180, 0),; //Color borde inferior rgb( 0, 0, 0) } //color texto.... LOCAL aColorCuerpo := {rgb( 154, 242, 250),; //Color borde superior rgb( 11, 196, 210),; //Color relleno rgb( 9, 138, 149),; //Color borde inferior rgb( 0, 0, 0),; //color texto.... Rgb( 9, 138, 149) } //color al perder el foco... Local aColorTitulo := {Rgb( 10, 165, 177),; // Color Borde superior Rgb( 0, 128, 128),; // Color de Relleno Rgb( 5, 82, 88),; // Color Borde inferior rgb( 205, 205, 155),; // Color Letra mes y año Rgb( 205, 205, 155) } // Color de los dias. Local aColorBoton := {Rgb( 10, 165, 177),; // Color Borde superior Rgb( 0, 128, 128),; // Color de Relleno Rgb( 5, 82, 88),; // Color Borde inferior rgb( 205, 205, 155),; // Color Letra mes y año Rgb( 205, 205, 155) } // Color de los dias. // Definición del Dialogo DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0,-24 DEFINE DIALOG oDlg TITLE "Seleccione una fecha" ; FROM 10,10 TO 320, 270 PIXEL ; STYLE nOR( DS_MODALFRAME ) oDlg:nStyle := nOr( oDlg:nStyle, 4 ) oDlg:lHelpIcon := .F. oPrueba1:= TMiCalendario(): New ( 5, 5, 120, 120, oDlg, oFont, 5) //oPrueba1:bLButtonUp := {|| MsgInfo( oPrueba1:dFechaControl, ; // "Fecha Seleccionada por el Usuario" ) } oPrueba1:bLButtonUp := {|| oDlg:End() } // Para pintar los domingos de otro color... oPrueba1:FijaClrDomingo( {rgb( 255, 255, 255),; //Color borde superior rgb( 220, 220, 220),; //Color relleno rgb( 128, 128, 128),; //Color borde inferior rgb( 0, 0, 0) } ) //color texto.... // Para pintar los dias festivos.. oPrueba1:aFestivos[ 1] := {1} //Festivos de Enero oPrueba1:aFestivos[ 2] := {} //Festivos de Ferbrero oPrueba1:aFestivos[ 3] := {} //Festivos de Marzo oPrueba1:aFestivos[ 4] := {18,19} //Festivos de Abril oPrueba1:aFestivos[ 5] := {1,21} //Festivos de Mayo oPrueba1:aFestivos[ 6] := {16} //Festivos de Junio oPrueba1:aFestivos[ 7] := {} //Festivos de Julio oPrueba1:aFestivos[ 8] := {15} //Festivos de Agosto oPrueba1:aFestivos[ 9] := {18,19} //Festivos de Septiembre oPrueba1:aFestivos[10] := {} //Festivos de Octubre oPrueba1:aFestivos[11] := {1} //Festivos de Noviembre oPrueba1:aFestivos[12] := {25} //Festivos de Diciembre oPrueba1:aColorFestivo := aClrFestivo oPrueba1:FijaClrFestivo() // Al cambiar de mes... se asignan nuevos festivos... // Este es un metodo alternativo de marcar los festivos.. oPrueba1:bCambioMes := { || FijarFestivos( oPrueba1 ) } ACTIVATE DIALOG oDlg CENTERED // Se sacan los recursos de memoria. //RELEASE FONT oFont oFont:End() if oGet != NIL oGet:VarPut( oPrueba1:dFechaControl ) oGet:Refresh() endifReturn (oPrueba1:dFechaControl)// -----------------------------------------------------------------------// Esta funcion es una alternativa al pintado de los festivos..STATIC FUNCTION FijarFestivos( oCalendario ) LOCAL aClrFestivo := { rgb( 177, 218, 173),; //Color borde superior rgb( 121, 192, 114),; //Color relleno rgb( 70, 141, 50),; //Color borde inferior rgb( 0, 0, 0) } //color texto.... DO CASE CASE oCalendario:nMesNumero == 1 oCalendario:ColorDia( 1, aClrFestivo ) CASE oCalendario:nMesNumero == 2 CASE oCalendario:nMesNumero == 3 CASE oCalendario:nMesNumero == 4 oCalendario:ColorDia(18, aClrFestivo ) oCalendario:ColorDia(19, aClrFestivo ) CASE oCalendario:nMesNumero == 5 oCalendario:ColorDia( 1, aClrFestivo ) oCalendario:ColorDia(21, aClrFestivo ) CASE oCalendario:nMesNumero == 6 oCalendario:ColorDia(16, aClrFestivo ) CASE oCalendario:nMesNumero == 7 CASE oCalendario:nMesNumero == 8 oCalendario:ColorDia(15, aClrFestivo ) CASE oCalendario:nMesNumero == 9 oCalendario:ColorDia(18, aClrFestivo ) oCalendario:ColorDia(19, aClrFestivo ) CASE oCalendario:nMesNumero == 10 CASE oCalendario:nMesNumero == 11 oCalendario:ColorDia( 1, aClrFestivo ) CASE oCalendario:nMesNumero == 12 oCalendario:ColorDia(25, aClrFestivo ) ENDCASERETURN NIL//-----------------------------------------------------------------------//Saludos / Regards,
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
Re: problema con SetFont
Y la clase
// -----------------------------------------------------------------------
CLASS TMiCalendario FROM TControl
// -----------------------------------------------------------------------
DATA lContinuar AS LOGICAL INIT .T.
DATA lConFoco AS LOGICAL INIT .T.
DATA oFont
DATA lFont AS LOGICAL INIT .F.
DATA oFontMes
DATA oFontTxt
DATA oFontBtn
DATA nPosFila // la posicion de la fila
DATA nPosCol // la posicion de la columna
DATA nPosBoton // la columna del boton.
DATA aDiaSemana AS ARRAY INIT ARRAY( 7)
DATA aXY AS ARRAY INIT ARRAY(42)
DATA aBoton AS ARRAY INIT ARRAY( 5)
DATA aDias AS ARRAY INIT ARRAY(42)
DATA aClrDias AS ARRAY INIT ARRAY(42)
DATA aColorCuerpo AS ARRAY
DATA aColorTitulo AS ARRAY
DATA aColorBoton AS ARRAY
DATA aColorDomingo AS ARRAY
DATA aColorFestivo AS ARRAY
// Tinha o Erro de GPF aqui, quando usava READONLY
DATA aFestivos AS ARRAY INIT ARRAY(12) //READONLY gerava erro
DATA nAltoFila
DATA nAnchoCol
DATA nAnchoBoton
DATA aTitBoton
DATA nFila1
DATA nFila2
DATA nCol1
DATA nCol2
DATA nPrimerDia AS NUMERIC INIT 1
DATA nUltimoDia AS NUMERIC INIT 42
DATA lSelectOK AS LOGICAL INIT .T.
DATA bCambioMes //Block a ejecutar cuando cambie el mes...
DATA bFestivos //Bingen
DATA nLanguage //Bingen
DATA aMeses AS ARRAY INIT ARRAY(12) //Bingen
DATA nLastDay AS NUMERIC INIT 1
// Datos relacionados con la fecha seleccionada.
DATA dFechaControl
DATA nMesNumero READONLY
DATA cMesNumero READONLY
DATA cMesPalabra READONLY
DATA nDiaSemana READONLY
DATA cDiaSemana READONLY
DATA cDiaPalabra READONLY
DATA nDiaMes READONLY
DATA cDiaMes READONLY
DATA cDiaMesPalabra READONLY
DATA nAno READONLY
DATA cAno READONLY
DATA cAnoPalabra READONLY
DATA aFecha AS ARRAY INIT ARRAY(2) READONLY
DATA aVencto AS ARRAY INIT ARRAY(8) READONLY
// aFecha, es un array con formatos de fecha
// aVencto, es un array con las fechas de vencimiento 15,30,45,60 dias...
// DATAS para reasignar teclas de navegacion.
DATA nK_AnoAdelenta AS NUMERIC INIT VK_NEXT
DATA nK_AnoAtras AS NUMERIC INIT VK_PRIOR
DATA nK_MesAdelenta AS NUMERIC INIT K_MAS
DATA nK_MesAtras AS NUMERIC INIT K_MENOS
DATA nK_Menu AS NUMERIC INIT K_DIVISION
DATA nK_Hoy AS NUMERIC INIT K_HOY
DATA nPosicion
DATA lTodoseCalculo AS LOGICAL INIT .F.
DATA lProcesarTecla AS LOGICAL INIT .T.
DATA lMostrarBoton AS LOGICAL INIT .T.
CLASSDATA lRegistered AS LOGICAL
METHOD New( ) CONSTRUCTOR //Bingen
METHOD Display()
METHOD Paint()
METHOD Language() //Bingen
METHOD LButtonDown( nRow, nCol, nFlags )
METHOD LButtonUp( nRow, nCol )
METHOD RButtonUp( nRow, nCol, nKeyFlags )
METHOD FijarFecha( dFecha )
METHOD CalcularDias( dFecha )
METHOD FijaClrs()
METHOD FijaClrDomingo()
METHOD FijaClrFestivo()
METHOD RestaurarColor() INLINE ::FijaClrs(), ::FijaClrDomingo(), ::FijaClrFestivo()
METHOD ColorDia( nDia, aColores )
METHOD Default()
METHOD Destroy()
METHOD MouseMove( nRow, nCol, nKeyFlags )
METHOD GetDlgCode( nLastKey )
METHOD VerAlSalir()
METHOD VerAlEntrar()
METHOD PintarBoton(hDC, nColor, nRow, nCol)
METHOD KeyChar( nKey, nFlags )
METHOD KeyDown( nKey, nFlags )
// Estos metodos devuelven verdadero o falso segun se encuentren
// dentro del cuerpo del calendario o en el area de botones.
METHOD lCuerpo( nRow, nCol)
METHOD lBotones( nRow, nCol)
// Metodos para moverse entre los meses
METHOD CambiarMes(nMeses, lProcesar)
METHOD MesSiguinte() INLINE ::CambiarMes( 1)
METHOD MesAnterior() INLINE ::CambiarMes( -1)
METHOD AnoSiguiente() INLINE ::CambiarMes( 12)
METHOD AnoAnterior() INLINE ::CambiarMes(-12)
METHOD Hoy() INLINE ::IrFecha( Date() )
METHOD IrFecha( dNvaFecha )
// Metodos para tomar y dejar el foco.
METHOD LostFocus( hCtlFocus ) INLINE ::Super:LostFocus( hCtlFocus ), ::VerAlSalir()
METHOD GotFocus() INLINE ::setfocus(), ::VerAlEntrar()
ENDCLASS
METHOD New (nTop, nLeft, nWidth, nHeight, oWnd, oFont, nLANGUAGE ) CLASS TMiCalendario
DEFAULT nTop:=5, nLeft:=5,nWidth:=120,nHeight:=120 //Bingen
DEFAULT nLanguage := L_SPANISH
// Coordenadas de la region de dibujo.
::nTop := nTop
::nLeft := nLeft
::nBottom := ::nTop + nHeight
::nRight := ::nLeft + nWidth
::dFechaControl := Date()
::bFestivos := {|| ARRAY(0) } //Bingen
::nLanguage := nLanguage //Bingen
::Language() //Bingen
// Array con dias festivos...
::aFestivos := { {}, {}, {},;
{}, {}, {},;
{}, {}, {},;
{}, {}, {} }
::oWnd := oWnd
//::oFont := oFont //ojo
::SetFont( oFont ) // sigue fallando
::lFont := !oFONT=Nil
::nPosFila := 1
::nPosCol := 1
::nPosBoton := 1
::aColorCuerpo := { nRgb(235,235,210),; // Color Borde superior
nRgb(205,205,155),; // Color de Relleno
nRgb(150,150, 75),; // Color Borde inferior
nRgb( 0, 0, 0),; // Color del texto,
nRgb(130,130, 65)} // Color dia seleccionado al perder el foco
::aColorTitulo := { nRgb(170,170, 80),; // Color Borde superior
nRgb(130,130, 65),; // Color de Relleno
nRgb(100,100, 50),; // Color Borde inferior
::aColorCuerpo[2],; // Color Letra mes y año
nRgb(255,255,255) } // Color de los dias.
::aColorBoton := { nRgb(170,170, 80),; // Color Borde superior
nRgb(130,130, 65),; // Color de Relleno
nRgb(100,100, 50),; // Color Borde inferior
::aColorCuerpo[2],; // Color Letra
::aColorCuerpo[2] } // Color relleno cuando se selecciona.
::aColorDomingo := ::aColorTitulo
::aColorFestivo := ::aColorTitulo
::nPosicion := day(::dFechaControl)
::FijaClrs()
::FijaClrDomingo()
::FijaClrFestivo()
::nStyle := nOr(WS_CHILD, WS_VISIBLE, WS_TABSTOP)
::Register()
If !Empty( oWnd:hWnd )
::Create()
oWnd:AddControl( Self )
Else
oWnd:DefControl( Self )
Endif
Return Self
METHOD Display() CLASS TMiCalendario
IF ::lContinuar
::lContinuar := .F.
::BeginPaint()
::Paint()
::EndPaint()
::lContinuar := .T.
ELSE
MsgInfo("Para Ccontrolar Que Nao Passe Duas Vezes")
ENDIF
RETURN SELF
METHOD Paint() CLASS TMiCalendario
// Se recupera identificador del boton.
Local hDC := ::GetDC()
Local nColor
IF !::lTodoseCalculo
::Default()
::SetSize(::nCol2 + 1,::nFila2 + 1 + IF(::lMostrarBoton, ::nAltoFila, 0 ), .t. ) //Bingen
::lTodoseCalculo := .T.
ENDIF
// Comienza el dibujo
DibujarTodo( hDC, ::nAltoFila, ::nAnchoCol, ::nFila1, ::nFila2,;
::nCol1, ::nCol2, ::oFont, ::aDiaSemana,;
::aXY, ::oFontTxt, ::aDias, ::aColorTitulo, ::aClrDias, ::aColorCuerpo, ::aColorBoton,;
::cMesPalabra, ::oFontMes, ::cAno,;
::oFontBtn, ::aBoton, ::nAnchoBoton, ::aTitBoton, ::bFestivos ) //Bingen
// Se pinta si esta con el foco o no.
if ::lFocused
MarcarDia( hDC, ::aXY[::nPosicion], nrgb(255, 0, 0))
else
MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5])
endif
// Se libera el identificador del boton.
::ReleaseDC()
Return Self
STATIC FUNCTION DibujarTodo( hDC, nAltoFila, nAnchoCol, nFila1, nFila2,;
nCol1, nCol2, oFont, aDiaSemana, aConPuntos,;
oFontTxt,aDias, aColorTitulo, aClrDias, aColorCuerpo, aColorBoton,;
cMesPalabra, oFontMes, cAno, ;
oFontBtn, aBoton, nAnchoBoton,;
aTitBoton, bFestivos ) //Bingen
Local A
Local aLosPuntos := aConPuntos[42]
// Se dibuja el cuerpo del calendario
DibujaCuerpo( hDC, aConPuntos, aClrDias, aColorCuerpo)
// Se dibujan los dias.
DibujaDias( hDC, oFont, aDias, aConPuntos, aClrDias, bFestivos )
// Se dibujan la parte superior del calendario
DibujaEncabezado(hDC, nFila1, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
aDiaSemana, oFont, aColorTitulo,;
cMesPalabra, oFontMes, cAno )
// Se dibujan los titulos del encabezado.
DibujaTitulos(hDC, nAltoFila, nCol1, nCol2, nAnchoCol,;
oFontMes, oFontTxt, aColorTitulo, cMesPalabra,;
cAno, aDiaSemana)
// Se dibujan los botones.
DibujaBotones(hDC, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
oFontBtn, aColorBoton, aBoton, aTitBoton, nAnchoBoton)
return NIL
STATIC FUNCTION DibujaDias( hDC, oFont, aDias, aXY, aClrDias, bFestivos)
Local HBROCHAANTERIOR, HOLDPEN
Local A, aFESTIVOS:=ARRAY(0), nCOLOR:=0
Local hBrocha
Local hPen1
Local hPen2
DEFAULT bFestivos := {|| ARRAY(0) }
aFESTIVOS:=EVAL(bFestivos)
// Se dibujan los dias.
SelectObject( hDC, oFont:hFont)
FOR A = 1 TO 42
// Se crea brocha para pintar el fondo del recuadro...
hBrocha := CreateSolidBrush ( aClrDias[ A][ 2] )
// se carga la brocha, se guarda la brocha anterior y se pinta
hBrochaAnterior := SelectObject (hDC, hBrocha)
FillRect( hDc, aXY[A], hBrocha )
// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF
// Aqui se dibujan los bordes....
// UNO. se cargan los lapices...
hPen1 := CreatePen(PS_SOLID, 1, aClrDias[ A][ 1]) //Claro nrgb(235,235,210)
hPen2 := CreatePen(PS_SOLID, 1, aClrDias[ A][ 3]) //Oscuro nrgb(160,160, 75)
// Se carga el lapices y se dibuja borde superior..
hOldPen := SelectObject( hDC, hPen1 )
MoveTo(hDc , aXY[ A][ 2] - 1, aXY[ A][ 3] )
LineTo(hDc, aXY[ A][ 2] - 1, aXY[ A][ 1] - 1 )
LineTo(hDc, aXY[ A][ 4] , aXY[ A][ 1] - 1 )
// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen1 )
MsgInfo("O objeto nao se destruiu")
ENDIF
// Se carga el lapices y se dibuja borde inferior..
hOldPen := SelectObject( hDC, hPen2 )
MoveTo(hDc , aXY[ A][ 2], aXY[ A][ 3] )
LineTo(hDc, aXY[ A][ 4], aXY[ A][ 3] )
LineTo(hDc, aXY[ A][ 4], aXY[ A][ 1] - 2 )
// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF
// Se dibuja el texto...
SetBkColor( hDC, aClrDias[ A][ 2] )
nCOLOR:=ASCAN(aFESTIVOS, {|aVal| aVal[1] == VAL(aDias[A]) }) //Comprobar festivos
IF nCOLOR>0 //Bingen
SetTextColor( hDC, aFESTIVOS[nCOLOR,2])
ELSE
SetTextColor( hDC, aClrDias[ A][ 4] )
ENDIF
DrawText( hDC, " " + aDias[A] + " ", aXY[A],;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
NEXT A
RETURN NIL
STATIC FUNCTION DibujaCuerpo( hDC, aXY, aClrDias, aColorCuerpo )
// Se crea el lapiz a utilizar.
Local A, HOLDPEN
Local hPen1
Local hPen2
Local hBrocha
Local hBrochaAnterior
// Se dibujan los bordes del cuerpo
hPen1 := CreatePen(PS_SOLID, 1, aColorCuerpo[ 1])
hPen2 := CreatePen(PS_SOLID, 1, Getsyscolor(16) )
// Se carga el lapices y se dibuja borde superior..
hOldPen := SelectObject( hDC, hPen1 )
MoveTo(hDc , aXY[ 1][ 2] - 2, aXY[ 1][ 1] - 1 )
LineTo(hDc, aXY[ 1][ 2] - 2, aXY[36][ 3] + 2 )
// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF
// Se carga el lapices y se dibuja borde inferior..
hOldPen := SelectObject( hDC, hPen2 )
MoveTo(hDc , aXY[36][ 2] - 1, aXY[36][ 3] + 1 )
LineTo(hDc, aXY[42][ 4] + 1, aXY[36][ 3] + 1 )
LineTo(hDc, aXY[42][ 4] + 1, -1 )
// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF
RETURN NIL
STATIC FUNCTION DibujaEncabezado(hDC, nFila1, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
aDiaSemana, oFont, aColorTitulo,;
cMesPalabra, oFontMes, cAno )
// Se crea el lapiz a utilizar.
Local hPen1 := CreatePen(PS_SOLID, 1, aColorTitulo[1]) //Lapiz claro
Local hPen2 := CreatePen(PS_SOLID, 1, aColorTitulo[3]) //Lapiz oscuro
Local hPenAnterior
Local aPuntos[4]
Local A
// Se crea brocha pintar la parte superior y luego
// se carga la brocha y se guarda la anterior brocha.
Local hBrocha := CreateSolidBrush ( aColorTitulo[2] )
Local hBrochaAnterior := SelectObject (hDC, hBrocha)
// Se pinta el recuadro.
FillRect( hDc, { 2, nCol1, nFila1 - 1, nCol2 }, hBrocha )
// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF
// Se dibuja el contorno se selecciona lapiz.
// Linea superior y linea izquierda
hPenAnterior := SelectObject( hDC, hPen1 )
MoveTo(hDC, nCol2 - 1, 1)
LineTo(hDC, nCol1 , 1)
LineTo(hDC, nCol1 , nFila1 - 1)
LineTo(hDC, nCol1 - 1, nFila1 - 1)
LineTo(hDC, nCol1 - 1, 0)
LineTo(hDC, nCol2 , 0)
//Linea horizontal del centro.
MoveTo(hDC, nCol2 - 1, nAltoFila)
LineTO(hDC, nCol1 - 1, nAltoFila)
MoveTo(hDC, nCol2 - (nAnchoCol * 2), 2)
LineTo(hDC, nCol2 - (nAnchoCol * 2), nAltoFila)
For A = 1 to 6
MoveTo(hDC, (nAnchoCol * A) + nCol1, nAltoFila)
LineTo(hDC, (nAnchoCol * A) + nCol1, nAltoFila * 2)
Next a
// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF
// Se dibuja el contorno se selecciona lapiz.
// Linea superior y linea izquierda
hPenAnterior := SelectObject( hDC, hPen2 )
MoveTo(hDC, nCol2 - 1, 1)
LineTo(hDC, nCol2 - 1, nFila1 - 1)
LineTo(hDC, nCol1 - 2, nFila1 - 1)
//Linea horizontal del centro.
MoveTo(hDC, nCol2 - 1, nAltoFila - 1)
LineTO(hDC, nCol1 - 2, nAltoFila - 1)
MoveTo(hDC, nCol2 - (nAnchoCol * 2) - 1, 0)
LineTo(hDC, nCol2 - (nAnchoCol * 2) - 1, nAltoFila)
For A = 1 to 6
MoveTo(hDC, (nAnchoCol * A) + nCol1 - 1, nAltoFila)
LineTo(hDC, (nAnchoCol * A) + nCol1 - 1, nAltoFila * 2)
Next a
// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF
RETURN NIL
STATIC FUNCTION DibujaTitulos(hDC, nAltoFila, nCol1, nCol2,;
nAnchoCol, oFontMes, oFont, aColorTitulo,;
cMesPalabra, cAno, aDiaSemana)
LOCAL aPuntos[4]
LOCAL A
// Formato letra
SelectObject(hDC, oFont:hFont) //Se selecciona el tipo de letra.
SetTextColor( hDC, aColorTitulo[5] )
SetBkColor( hDC, aColorTitulo[2] )
// Se dibujan los titulos de los dias.
A := 0
aPuntos[ 1] := nAltoFila
aPuntos[ 3] := nAltoFila * 2
FOR A = 0 TO 6
aPuntos[ 2] := nCol1 + ( A * nAnchoCol )
aPuntos[ 4] := aPuntos[2] + nAnchoCol
DrawText( hDC, LEFT(aDiaSemana[ A + 1],3), aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
NEXT A
// Se dibuja el mes en palabras.
SelectObject(hDC, oFontMes:hFont)
SetTextColor(hDC, aColorTitulo[4])
aPuntos[ 1] := 3
aPuntos[ 2] := 2
aPuntos[ 3] := nAltoFila - 1
aPuntos[ 4] := nCol2 - (nAnchoCol*2) - 1
DrawText( hDC, cMesPalabra, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
// Se dibuja el numero del año
aPuntos[ 2] := aPuntos[ 4] + 2
aPuntos[ 4] := nCol2 - 1
DrawText( hDC, cAno, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
RETURN NIL
STATIC FUNCTION DibujaBotones(hDC, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
oFont, aColorBoton, aBoton, aTitBoton, nAnchoBoton )
// Se crea el lapiz a utilizar.
Local hPen1 := CreatePen(PS_SOLID, 1, aColorBoton[1]) //Lapiz claro
Local hPen2 := CreatePen(PS_SOLID, 1, aColorBoton[3]) //Lapiz oscuro
Local hPenAnterior
Local aPuntos[5]
Local A
// Se crea brocha pintar la parte superior y luego
// se carga la brocha y se guarda la anterior brocha.
Local hBrocha := CreateSolidBrush ( aColorBoton[2] )
Local hBrochaAnterior := SelectObject (hDC, hBrocha)
// Se pinta el recuadro.
FillRect( hDc, { nFila2 + 2, nCol1, nFila2 + nAltoFila - 1, nCol2 }, hBrocha )
// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF
// Se dibuja el contorno se selecciona lapiz.
// Linea superior y linea izquierda
hPenAnterior := SelectObject( hDC, hPen1 )
MoveTo(hDC, nCol2 - 1, nFila2 + 1)
LineTo(hDC, nCol1 , nFila2 + 1)
LineTo(hDC, nCol1 , nFila2 + nAltoFila - 1)
LineTo(hDC, nCol1 - 1, nFila2 + nAltoFila - 1)
LineTo(hDC, nCol1 - 1, nFila2 )
For A = 1 to 4
MoveTo(hDC, (nAnchoBoton * A) + nCol1 + 1, nFila2 + 1)
LineTo(hDC, (nAnchoBoton * A) + nCol1 + 1, nFila2 + nAltoFila)
Next a
// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF
// Se dibuja el contorno se selecciona lapiz.
// Linea inferior y linea derecha
hPenAnterior := SelectObject( hDC, hPen2 )
MoveTo(hDC, nCol2 , nFila2 + 1)
LineTo(hDC, nCol2 , nFila2 + nAltoFila )
LineTo(hDC, nCol1 - 2, nFila2 + nAltoFila )
LineTo(hDC, nCol1 - 2, nFila2 + nAltoFila - 1)
LineTo(hDC, nCol2 - 1, nFila2 + nAltoFila - 1)
LineTo(hDC, nCol2 - 1, nFila2 + 1)
For A = 1 to 4
MoveTo(hDC, (nAnchoBoton * A) + nCol1, nFila2 + 1)
LineTo(hDC, (nAnchoBoton * A) + nCol1, nFila2 + nAltoFila)
Next a
// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF
// Formato letra
SelectObject(hDC, oFont:hFont) //Se selecciona el tipo de letra.
SetTextColor( hDC, aColorBoton[5] )
SetBkColor( hDC, aColorBoton[2] )
// Se dibujan los titulos de los botones //Bingen
DrawText( hDC, aTitBoton[1], aBoton[ 1],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[2], aBoton[ 2],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[3], aBoton[ 3],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[4], aBoton[ 4],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[5], aBoton[ 5],;
nOr(32, 4, 1 ) )
RETURN NIL
METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TMiCalendario
// Se recupera identificador del boton.
Local hDC := ::GetDC()
Local nAltoFila := ::nAltoFila
Local nAnchoCol := ::nAnchoCol
Local nFila1 := ::nFila1
Local nFila2 := ::nFila2
Local n := 1
Local nPos := 0
Local nPosAnterior := ::nPosicion
Local B
// Se fija que el objeto tenga el foco.
::SetFocus()
// Se determina el recuadro donde se da el click
IF ::lCuerpo( nRow, nCol)
// Se determina el numero de fila
While nRow > ( nPos + nFila1 + nAltoFila ) .and. n < 7
nPos += ::nAltoFila
n++
end
::nPosFila := n
// Se determina la posicion de la columna.
n := 1
nPos := 0
While nCol > ( nPos + nAnchoCol + ::nCol1 ) .and. n < 7
nPos += nAnchoCol
n++
end
::nPosCol := n
// Se pinta el dia seleccionado.
::nPosicion := ( (::nPosFila - 1) * 7) + ::nPosCol
B = ALLTRIM( ::aDias[::nPosicion])
IF !EMPTY( B )
MarcarDia( hDC, ::aXY[nPosAnterior], ::aClrDias[ nPosAnterior ][2])
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
// Se actualizan los datos fecha.
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
ELSE
IF ::lCuerpo( nRow, nCol) //Bingen
TONE(500,3)
::lSelectOK :=.F.
ENDIF
::nPosicion := nPosAnterior
ENDIF
ENDIF
// Se evalua si es la linea de los botones.
IF ::lBotones( nRow, nCol)
// Se determina la posicion de la columna.
n := 1
nPos := 0
While nCol > ( nPos + ::nAnchoBoton + ::nCol1 ) .and. n < 5
nPos += ::nAnchoBoton
n++
end
::nPosBoton := n
::PintarBoton(hDC, ::aColorBoton[5], nRow, nCol)
// Se evalua el boton seleccionado.
DO CASE
CASE ::nPosBoton == 1
::MesAnterior()
CASE ::nPosBoton == 2
::MesSiguinte()
CASE ::nPosBoton == 3
::AnoAnterior()
CASE ::nPosBoton == 4
::AnoSiguiente()
CASE ::nPosBoton == 5
::IrFecha( Date())
ENDCASE
ENDIF
// Se libera el identificador del boton.
::ReleaseDC()
return Self
METHOD LButtonUp( nRow, nCol ) CLASS TMiCalendario
LOCAL hDC := ::GetDC()
IF ::lSelectOK
::PintarBoton(hDC, ::aColorBoton[2], nRow, nCol)
IF ::lCuerpo( nRow, nCol)
::Super:LButtonUp( nRow, nCol )
ENDIF
ELSE
::lSelectOK:=.T.
ENDIF
::ReleaseDC()
RETURN Self
METHOD RButtonUp( nRow, nCol, nKeyFlags ) CLASS TMiCalendario
Local oMenu
::SetFocus()
MENU oMenu POPUP
MENUITEM ::aTitBoton[1] ACTION ::MesAnterior()
MENUITEM ::aTitBoton[2] ACTION ::MesSiguinte()
MENUITEM ::aTitBoton[5] ACTION ::Hoy()
MENUITEM "Otro Mes"
MENU
MENUITEM ::aMESES[ 1] ACTION ::CambiarMes( 1 - ::nMesNumero )
MENUITEM ::aMESES[ 2] ACTION ::CambiarMes( 2 - ::nMesNumero )
MENUITEM ::aMESES[ 3] ACTION ::CambiarMes( 3 - ::nMesNumero )
MENUITEM ::aMESES[ 4] ACTION ::CambiarMes( 4 - ::nMesNumero )
MENUITEM ::aMESES[ 5] ACTION ::CambiarMes( 5 - ::nMesNumero )
MENUITEM ::aMESES[ 6] ACTION ::CambiarMes( 6 - ::nMesNumero )
MENUITEM ::aMESES[ 7] ACTION ::CambiarMes( 7 - ::nMesNumero )
MENUITEM ::aMESES[ 8] ACTION ::CambiarMes( 8 - ::nMesNumero )
MENUITEM ::aMESES[ 9] ACTION ::CambiarMes( 9 - ::nMesNumero )
MENUITEM ::aMESES[10] ACTION ::CambiarMes(10 - ::nMesNumero )
MENUITEM ::aMESES[11] ACTION ::CambiarMes(11 - ::nMesNumero )
MENUITEM ::aMESES[12] ACTION ::CambiarMes(12 - ::nMesNumero )
ENDMENU
SEPARATOR
MENUITEM ::aTitBoton[3] ACTION ::AnoAnterior()
MENUITEM ::aTitBoton[4] ACTION ::AnoSiguiente()
IF !::lMostrarBoton //Bingen
MENUITEM "Mostrar Botones" ACTION ::SetSize(::nWidth(),::nheight() + ::nAltoFila, .t. ),;
::ReSize(),;
::lMostrarBoton := .T.
ELSE
MENUITEM "Ocultar Botones" ACTION ::SetSize(::nWidth(),::nheight() - ::nAltoFila, .t. ),;
::ReSize(),;
::lMostrarBoton := .F.
ENDIF
ENDMENU
ACTIVATE POPUP oMenu AT nRow, nCol OF Self
RETURN SELF
METHOD lBotones( nRow, nCol) CLASS TMiCalendario
RETURN iif( (nRow > ::nFila2 .and. ;
nCol > ::nCol1 .and. ;
nCol <= ::nCol2), .T., .F.)
METHOD lCuerpo( nRow, nCol) CLASS TMiCalendario
RETURN iif( (nRow > ::nFila1 .and.;
nRow <= ::nFila2 .and.;
nCol > ::nCol1 .and.;
nCol <= ::nCol2), .T., .F.)
METHOD Default() CLASS TMiCalendario
Local B := 1
Local aPuntos[ 5]
* Local aPunt := GetClientRec(::hWnd)
local ofu
// Estos son los datos de las columnas.
::nCol1 := 1 //Inicio Columna
::nAnchoCol := CalcularAncho(::nCol1, ::nWidth() ) //El ancho de la columna
::nCol2 := (::nAnchoCol * 7 ) + ::nCol1 //Final Columna
// Estos son los datos de la fila
::nAltoFila := CalcularAlto( ::nHeight() ) //El alto de la fila.
::nFila1 := ::nAltoFila * 2 //Ubicacion primera linea a dibujar
::nFila2 := ::nAltoFila * 8 //Fila Final
// Font del título 75% de la altura de la celda
::oFontMes := TFont():New( "Arial", 0, -(::nAltoFila*.75),, .t. ) //Bingen
// Font de los textos de los días 50% de la altura de la celda
::oFontTXT := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen
// Font para los días por defecto del 5O% de la altura de la celda
::oFont := IF(::lFont,::oFont,TFont():New( "Arial", 0, -(::nAltoFila*.50),, .t. )) //Bingen
// Font para los botones 4O% de la altura de la celda
::oFontBtn := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen
// Se crea matriz con los datos dia del mes.
// Coordenadas filas
aPuntos[ 1] := ::nFila1 + 1
aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2
FOR B = 1 TO 7
//Coordenadas columnas.
aPuntos[ 2] := ::nCol1 + ( ::nAnchoCol * ( B - 1) ) + 1
aPuntos[ 4] := aPuntos[ 2] + ::nAnchoCol - 2
::aXY[ B ] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 7] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 14] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 21] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 28] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 35] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
NEXT B
FOR B = 1 TO 7
::aXY[ B + 7][1] := ::aXY[ B ][1] + ::nAltoFila
::aXY[ B + 14][1] := ::aXY[ B + 7][1] + ::nAltoFila
::aXY[ B + 21][1] := ::aXY[ B + 14][1] + ::nAltoFila
::aXY[ B + 28][1] := ::aXY[ B + 21][1] + ::nAltoFila
::aXY[ B + 35][1] := ::aXY[ B + 28][1] + ::nAltoFila
::aXY[ B + 7][3] := ::aXY[ B + 7][1] + ::nAltoFila - 2
::aXY[ B + 14][3] := ::aXY[ B + 14][1] + ::nAltoFila - 2
::aXY[ B + 21][3] := ::aXY[ B + 21][1] + ::nAltoFila - 2
::aXY[ B + 28][3] := ::aXY[ B + 28][1] + ::nAltoFila - 2
::aXY[ B + 35][3] := ::aXY[ B + 35][1] + ::nAltoFila - 2
NEXT B
// Se calcula el ancho de los botones.
::nAnchoBoton := int( (::nCol2 - ::nCol1) / 5)
// Se crean las coordenadas del boton.
aPuntos[ 1] := ::nFila2 + 1
aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2
FOR B = 1 TO 5
// Coordenadas columnas.
aPuntos[ 2] := ::nCol1 + ( ::nAnchoBoton * ( B - 1) ) + 1
aPuntos[ 4] := aPuntos[ 2] + ::nAnchoBoton - 2
::aBoton[B] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4], aPuntos[5] }
NEXT B
// Se fijan los datos de la fecha.
::FijarFecha( ::dFechaControl )
::nLastDay := ::nDiaMes
RETURN SELF
METHOD FijaClrs( aColores ) CLASS TMiCalendario
Local A
::aColorCuerpo := iif( aColores == NIL, ::aColorCuerpo, aColores )
// Se fijan los colores de bordes y de fondo de cada uno de los
// cuadritos...
FOR A = 1 TO 42
::aClrDias[ A] := { ::aColorCuerpo[ 1],; // Color Borde superior
::aColorCuerpo[ 2],; // Color de Relleno
::aColorCuerpo[ 3],; // Color Borde inferior
::aColorCuerpo[ 4] } // Color del texto,
NEXT A
RETURN NIL
METHOD FijaClrDomingo( aColores ) CLASS TMiCalendario
LOCAL A
::aColorDomingo := iif( aColores == NIL, ::aColorDomingo, aColores )
// Se fijan los colores para los dias domingo...
FOR A = 7 TO 42 step 7
::aClrDias[ A] := { ::aColorDomingo[ 1],; // Color Borde superior
::aColorDomingo[ 2],; // Color de Relleno
::aColorDomingo[ 3],; // Color Borde inferior
::aColorDomingo[ 4] } // Color del texto,
NEXT A
RETURN NIL
METHOD FijaClrFestivo() CLASS TMiCalendario
LOCAL aDiasFestivos := ::aFestivos[ ::nMesNumero]
LOCAL nFestivos := LEN( aDiasFestivos )
LOCAL nDia := 0
LOCAL A
// Se fijan los colores para los dias domingo...
IF nFestivos > 0
FOR A = 1 TO nFestivos
nDia := aDiasFestivos[ A]
::ColorDia( nDia, ::aColorFestivo )
NEXT A
ENDIF
RETURN NIL
METHOD ColorDia( nDia, aColores ) CLASS TMiCalendario
::aClrDias[ ::nPrimerDia + ndia - 1 ] := aColores
RETURN NIL
METHOD FijarFecha( dFecha ) CLASS TMiCalendario
dFecha = iif( dFecha == NIL, Date(), dFecha )
::dFechaControl := dFecha
::CalcularDias( ::dFechaControl )
::nMesNumero := Month(::dFechaControl)
::cMesNumero := STR(::nMesNumero, 2, 0)
::cMesPalabra := IF(::nMesNumero=NIL,"", ::aMESES[::nMesNumero])
::nDiaSemana := if( (::nDiaSemana := dow(::dFechaControl) - 1) = 0, 7, ::nDiaSemana)
::cDiaSemana := str(::nDiaSemana,2,0)
::cDiaPalabra := ::aDiaSemana[::nDiaSemana]
::nDiaMes := Day(::dFechaControl )
::cDiaMes := str(::nDiaMes,2,0)
::cDiaMesPalabra:= FormarFrase(::nDiaMes)
::nAno := year( ::dFechaControl )
::cAno := ALLTRIM( str(::nAno, 4, 0 ))
::cAnoPalabra := FormarFrase(::nAno )
::aFecha[ 1] := ::cDiaMes + " de " + ::cMesPalabra + " de " + ::cAno
::aFecha[ 2] := ::cDiaPalabra + ", " + ::cDiaMes + " de " + ::cMesPalabra + " de " + ::cAno
// aqui agregar todos los otros formatos que sean posibles.
RETURN SELF
METHOD CalcularDias( dFecha ) CLASS TMiCalendario // TMiEjemplo
Local FechaInicioMes
Local nDiaSemana
Local nMes := Month( dFecha )
Local nAno := Year( dFecha )
Local aDiaFinMes := {31,28,31,30,31,30,31,31,30,31,30,31}
Local aLosDias[42]
Local B
Local CELMES, CELANO, NDIAFINALMES
// Se limpian los dias.
FOR B = 1 TO 42
aLosDias[ B] := " " // Para sobrescribir el dibujo anterior
NEXT B
// Dia de la semana.
FechaInicioMes := ctod( "01/" + str(nMes,2,0) + "/" + str(nAno,4,0) )
cElMes := IF(::nMesNumero=NIL,"", ::aMESES[::nMesNumero])
cElAno := STR(nAno,4)
aDiaFinMes[ 2] := iif( CtoD("29/02/" + cElAno) = CtoD("0"), 28, 29)
nDiaFinalMes := aDiaFinMes[nMes]
nDiaSemana := dow(FechaInicioMes) - 1
nDiaSemana := IIF( nDiaSemana = 0, 7, nDiaSemana)
FOR B = 1 TO nDiaFinalMes
aLosDias[ B + nDiaSemana - 1 ] := str(B,2,0)
NEXT B
::aDias := aLosDias
::nPrimerDia := nDiaSemana
::nUltimoDia := B + nDiaSemana - 2
::nPosicion := day(dfecha) + nDiaSemana - 1
RETURN SELF
METHOD Destroy() CLASS TMiCalendario
::oFontMes:End()
::oFontTxt:End()
::oFont:End()
::oFontBtn:End()
RETURN ::Super:Destroy()
METHOD CambiarMes( nMeses, lProcesar ) CLASS TMiCalendario
Local aDiaFinMes := {31,28,31,30,31,30,31,31,30,31,30,31}
Local nNumeroMes := ::nMesNumero
Local dNvaFecha
Local hDC
Local AnchoRelleno := (::nAnchoCol * 5) - 4
Local nDia
DEFAULT nMeses := 1, lProcesar := .F.
// Se obtiene el controlador
IF (nMeses<> 0 .or. lProcesar)
hDC := ::GetDC()
// Se desmarca el dia...
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2] )
ENDIF
// Si el numero es cero, pues nada se hace y lprocesar, para obligar a procesar.
IF (nMeses<> 0 .or. lProcesar)
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2] )
// Se comprueba que no sea mayor que doce el aumento de mes.
nNumeroMes += nMeses
DO CASE
CASE nNumeroMes > 12
::nMesNumero := nNumeroMes - 12
::nAno++
CASE nNumeroMes < 1
::nMesNumero := 12 + nNumeroMes
::nAno--
OTHERWISE
::nMesNumero := nNumeroMes
ENDCASE
// Se verifica año bisciesto
aDiaFinMes[ 2] := iif( CtoD("29/02/" + str(::nAno,4,0) ) = CtoD("0"), 28, 29)
// Se determina el dia de cambio...
nDia := iif( ::nLastDay > aDiaFinMes[ ::nMesNumero ],;
aDiaFinMes[ ::nMesNumero ],;
::nLastDay )
dNvaFecha := CtoD( STR( nDia ,2,0) + "/" +;
STR(::nMesNumero,2,0) + "/" +;
STR(::nAno, 4,0) )
::FijarFecha( dNvaFecha )
// Se restauran los colores...
::RestaurarColor()
// Se evalua bloque de codigo al cambiar de mes...
IF !EMPTY( ::bCambioMes )
Eval( ::bCambioMes )
ENDIF
// Se dibujan los dias.
DibujaDias( hDC, ::oFont, ::aDias, ::aXY,;
::aClrDias, ::bFestivos )
// Se dibujan los titulos del mes y año.
DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,;
::nAnchoCol, ::oFontMes, ::oFont, ::aColorTitulo,;
xPadc(::cMesPalabra, AnchoRelleno), ::cAno, ::aDiaSemana)
* ::nPosicion := ::nDiaSemana
* MsgInfo( ::nPosicion )
MarcarDia( hDC, ::aXY[::nPosicion], nRgb(255, 0, 0))
// Se libera el identificador
::ReleaseDC()
ENDIF
RETURN Self
METHOD VerAlSalir() CLASS TMiCalendario
// Metodo cuando se abandona
// Se recupera el identificador.
LOCAL hDC := ::GetDC()
::lConFoco := .F.
MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5])
// Se destruye el identificador.
::ReleaseDC()
return Self
METHOD VerAlEntrar() CLASS TMiCalendario
// Metodo cuando se abandona
// Se recupera el identificador.
LOCAL hDC := ::GetDC()
IF !::lTodoseCalculo
::Default()
::SetSize(::nCol2 + 1,::nFila2 + 1 + IF(::lMostrarBoton, ::nAltoFila, 0 ), .t. ) //Bingen
::lTodoseCalculo := .T.
ENDIF
::lConFoco := .T.
MarcarDia( hDC, ::aXY[::nPosicion], nrgb(255, 0, 0)) //::aColorTitulo[5]
// Se destruye el identificador.
::ReleaseDC()
return Self
METHOD GetDlgCode( nLastKey ) CLASS TMiCalendario
// This method is very similar to TControl:GetDlgCode() but it is
// necessary to have WHEN working
if .not. ::oWnd:lValidating
if nLastKey == VK_UP .or. nLastKey == VK_DOWN ;
.or. nLastKey == VK_RETURN .or. nLastKey == VK_TAB
::oWnd:nLastKey = nLastKey
else
::oWnd:nLastKey = 0
endif
endif
return If( IsWindowEnabled( ::hWnd ), DLGC_WANTALLKEYS, 0 )
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TMiCalendario
CursorHand()
// Se evalua si es la linea de los botones.
* IF nRow > nFila2 .and. ;
* nCol > ::nCol1 .and. nCol <= ::nCol2
*
* ENDIF
RETURN SELF
METHOD PintarBoton(hDC, nColor, nRow, nCol) CLASS TMiCalendario //Bingen
// se carga la brocha y se guarda la anterior brocha.
Local hBrocha := CreateSolidBrush ( nColor )
Local hBrochaAnterior := SelectObject (hDC, hBrocha)
Local aPuntos := ::aBoton[::nPosBoton]
// Se pinta el recuadro.
FillRect( hDc, {aPuntos[ 1] + 1,;
aPuntos[ 2] + 1,;
aPuntos[ 3],;
aPuntos[ 4]}, hBrocha )
// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF
// Formato letra
SelectObject(hDC, IF(::lCuerpo( nRow, nCol),::oFont:hFont,::oFontBtn:hFont)) //Bingen
SetTextColor( hDC, ::aColorBoton[5] )
SetBkColor( hDC, nColor )
// Se dibujan los titulos de los botones
DrawText( hDC, ::aTitBoton[::nPosBoton], aPuntos,;
nOr(32, 4, 1 ) )
RETURN SELF
METHOD KeyChar( nKey, nFlags ) CLASS TMiCalendario
do case
case nKey == ::nK_MesAdelenta
::MesSiguinte()
case nKey == ::nK_MesAtras
::MesAnterior()
case nKey == ::nK_Menu
::RButtonUp( ::nAltoFila, ::nAnchoCol, 0 )
otherwise
return ::Super:KeyChar( nKey, nFlags )
endcase
return SELF
METHOD KeyDown( nKey, nFlags ) CLASS TMiCalendario
Local hDC
Local nPosAnterior := ::nPosicion
do case
case nKey == VK_RETURN //Bingen
::LButtonUp( ::aXY[::nPosicion,1], ::aXY[::nPosicion,2])
case nKey == VK_END
IF ::nPosicion < ::nUltimoDia
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nUltimoDia
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF
case nKey == VK_HOME
IF ::nPosicion > ::nPrimerDia
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nPrimerDia
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF
case nKey == VK_DOWN
IF ::lProcesarTecla
::lProcesarTecla := .F.
IF (::nPosicion + 7) < 42 .and. !empty(::aDias[(::nPosicion + 7)])
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nPosicion + 7
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF
::lProcesarTecla := .T.
ENDIF
case nKey == VK_UP
IF ::lProcesarTecla
::lProcesarTecla := .F.
IF (::nPosicion - 7) > 0 .and. !empty(::aDias[(::nPosicion - 7)])
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nPosicion - 7
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF
::lProcesarTecla := .T.
ENDIF
case nKey == VK_LEFT
IF ::lProcesarTecla
::lProcesarTecla := .F.
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion --
IF ::nPosicion < ::nPrimerDia
::nPosicion := ::nUltimoDia
ENDIF
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::ReleaseDC()
::nLastDay := ::nDiaMes
::lProcesarTecla := .T.
ENDIF
case nKey == VK_RIGHT
IF ::lProcesarTecla
::lProcesarTecla := .F.
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion ++
IF ::nPosicion > ::nUltimoDia
::nPosicion := ::nPrimerDia
ENDIF
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::ReleaseDC()
::nLastDay := ::nDiaMes
::lProcesarTecla := .T.
ENDIF
case nKey == VK_TAB .OR. nKey == VK_ESCAPE
return ::Super:KeyDown( nKey, nFlags )
case nKey == ::nK_AnoAtras
::AnoAnterior()
case nKey == ::nK_AnoAdelenta
::AnoSiguiente()
case nKey == ::nK_Hoy
::IrFecha( Date())
otherwise
return ::Super:KeyDown( nKey, nFlags )
endcase
RETURN SELF
METHOD IrFecha( dNvaFecha ) CLASS TMiCalendario
// Se recupera identificador del boton.
Local hDC := ::GetDC()
Local AnchoRelleno := (::nAnchoCol * 5) - 4
// Se desmarca el dia...
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion ][ 2] )
// Se fija la fecha.
::FijarFecha( dNvaFecha )
::nLastDay := ::nDiaMes
// Se restauran los colores...
::RestaurarColor()
// Se evalua bloque de codigo al cambiar de mes...
IF !EMPTY( ::bCambioMes )
Eval( ::bCambioMes )
ENDIF
// Se dibujan los dias.
DibujaDias( hDC, ::oFont, ::aDias, ::aXY,;
::aClrDias, ::bFestivos )
// Se dibujan los titulos del mes y año.
DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,;
::nAnchoCol, ::oFontMes, ::oFont, ::aColorTitulo,;
xPadc(::cMesPalabra, AnchoRelleno), ::cAno, ::aDiaSemana)
MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5] )
// Se libera el identificador
::ReleaseDC()
RETURN NIL
/*-------------------------------------------------------------------------*/
METHOD Language() CLASS TMiCalendario //Bingen
// Soporte multilenguaje
IF ::nLanguage = L_PORTUGUES
::aMESES := { "Janeiro" , "Fevereiro", "Março" ,"Abril",;
"Maio" , "Junho" , "Julho" ,"Agosto",;
"Setembro" , "Outubro" , "Novembro" ,"Dezembro"}
::aDiaSemana := {"Segunda","Terça","Quarta","Quinta",;
"_","Sábado","Domingo"}
::aTitBoton := {"&-Mês", "&+Mês", "< Ano", "Ano >", "Hoje"}
ELSEIF ::nLanguage = L_CATALA
::aMESES := { "Gener" , "Febrer" , "Març" ,"Abril",;
"Maig" , "Juny" , "Juliol" ,"Agost",;
"Setembre" , "Octubre", "Novembre","Desembre"}
::aDiaSemana := {"Dilluns","Dimarts","Dimecres","Dijous",;
"Divendres","Dissabte","Diumenge"}
::aTitBoton := {"&-Mes", "&+Mes", "-Any", "+Any", "Avuy"}
ELSEIF ::nLanguage = L_EUSKERA
::aMESES := { "Urtarrila", "Otsaila", "Martxoa" , "Apirila",;
"Maiatza" , "Ekaina" , "Uztaila" , "Abuztua",;
"Iraila" , "Urria" , "Azaroa" , "Abendua"}
::aDiaSemana := {"Astelehena","Asteartea","Asteazkena","Osteguna",;
"Ostirala","Larunbata","Igandea"}
::aTitBoton := {"&-Hil", "&+Hil", "-Urte", "+Urte", "Gaur"}
ELSEIF ::nLanguage = L_GALEGO
::aMESES := { "Xaneiro" , "Febreiro", "Marzal" ,"Abril",;
"Maio" , "Xuño" , "Xulio" ,"Agosto",;
"Septembro" , "Octubro" , "Novembro" ,"Decembro"}
::aDiaSemana := {"Luns","Martes","Mércores","Xoves",;
"Venres","Sabado","Domingo"}
::aTitBoton := {"&-Mes", "&+Mes", "< Año", "Año >", "Hoxe"}
ELSEIF ::nLanguage = L_SPANISH
::aMESES := { "Enero" , "Febrero", "Marzo" ,"Abril",;
"Mayo" , "Junio" , "Julio" ,"Agosto",;
"Septiembre", "Octubre", "Noviembre","Diciembre"}
::aDiaSemana := {"Lunes","Martes","Miercoles","Jueves",;
"Viernes","Sabado","Domingo"}
::aTitBoton := {"&-Mes", "&+Mes", "-Año", "+Año", "Hoy"}
ELSEIF ::nLanguage = L_ITALIANO
::aMESES := { "Gennaio" , "Febbraio" , "Marzo" ,"Aprile",;
"Maggio" , "Giugno" , "Luglio" ,"Agosto",;
"Settembre" , "Ottobre" , "Novembre" ,"Dicembre"}
::aDiaSemana := {"Lunedi","Martedi","Mercoledi","Giovedi",;
"Venerdi","Sabato","Domenica"}
::aTitBoton := {"&-Mese", "&+Mese", "-Anno", "+Anno", "Oggi"}
ELSEIF ::nLanguage = L_ENGLISH
::aMESES := { "Jannuary" , "February" , "March" ,"April",;
"May" , "June" , "July" ,"August",;
"September" , "October" , "November" ,"December"}
::aDiaSemana := {"Monday","Tuesday","Wednesday","Thursday",;
"Friday","Saturday","Sunday"}
::aTitBoton := {"&-Month", "&+Month", "-Year", "+Year", "Today"}
ELSEIF ::nLanguage = L_FRANCAIS
::aMESES := { "Janvier" , "Février" , "Mars" ,"Avril",;
"Mai" , "Juin" , "Juillet" ,"Août",;
"Septembre" , "Octobre" , "Novembre" ,"Decembre"}
::aDiaSemana := {"Lundi","Mardi","Mercredi","Jeudi",;
"Vendredi","Samedi","Dimanche"}
::aTitBoton := {"&-Mois", "&+Mois", "-An", "+An", "Auj'hui"}
ELSEIF ::nLanguage = L_DEUSTCH
::aMESES := { "Januar" , "Februar" , "März" ,"April",;
"Mai" , "Juni" , "Juli" ,"August",;
"September" , "Oktober" , "November" ,"Dezember"}
::aDiaSemana := {"Montag","Dienstag","Mittwoch","Donnerstag",;
"Freitag","Samstag","Sonntag"}
::aTitBoton := {"&-Monat", "&+Monat", "-Jahr", "+Jahr", "Heute"}
ENDIF
// Para realimentar los datos fechas con los nuevos valores.
::FijarFecha( ::dFechaControl )
RETURN NIL
STATIC FUNCTION CalcularAncho( nEspacioIzq,nWidth )
Local nColumnaAncho
nColumnaAncho := int( ( nWidth - nEspacioIzq ) / 7)
RETURN nColumnaAncho
STATIC FUNCTION CalcularAlto( nHeight )
Local nFilaAlto
nFilaAlto := int(( nHeight - 1) /
RETURN nFilaAlto
STATIC FUNCTION MarcarDia( hDC, aPuntos, nColor)
// Se crea el lapiz a utilizar.y se carga.
Local hPen1 := CreatePen(PS_SOLID, 3, nColor)
Local hPenAnterior := SelectObject(hDC, hPen1)
// Se dibuja el rectangulo
MoveTo(hDC, aPuntos[2] + 1, aPuntos[1] + 1)
LineTo(hDC, aPuntos[4] - 3, aPuntos[1] + 1)
LineTo(hDC, aPuntos[4] - 3, aPuntos[3] - 2)
LineTo(hDC, aPuntos[2] + 1, aPuntos[3] - 2)
LineTo(hDC, aPuntos[2] + 1, aPuntos[1] + 1)
// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF
RETURN NIL
STATIC FUNCTION FormarFrase(ElNumero)
//ElNumero , corresponde al numero que se debera frasear.
//Se definen variables locales de control.
LOCAL Pon_la_Y := ""
LOCAL Pon_Mil := ""
LOCAL CtrlTexto := "" //Almacenara a ELNUMERO en formato texto.
LOCAL FraseNumero:= ""
LOCAL ValorPos[11]
LOCAL Num_A[30]
LOCAL Num_B[ 9]
LOCAL Num_C[10]
//Se llenan matricez de control de palabras.
Num_A[ 1] = "" ; Num_A[ 16] = "Quince "
Num_A[ 2] = "Un " ; Num_A[ 17] = "Dieciseis "
Num_A[ 3] = "Dos " ; Num_A[ 18] = "Diecisiete "
Num_A[ 4] = "Tres " ; Num_A[ 19] = "Dieciocho "
Num_A[ 5] = "Cuatro " ; Num_A[ 20] = "Diecinueve "
Num_A[ 6] = "Cinco " ; Num_A[ 21] = "Veinte "
Num_A[ 7] = "Seis " ; Num_A[ 22] = "Veintiun "
Num_A[ 8] = "Siete " ; Num_A[ 23] = "Veintidos "
Num_A[ 9] = "Ocho " ; Num_A[ 24] = "Vientitres "
Num_A[ 10] = "Nueve " ; Num_A[ 25] = "Veinticuatro "
Num_A[ 11] = "Diez " ; Num_A[ 26] = "Veinticinco "
Num_A[ 12] = "Once " ; Num_A[ 27] = "Veintiseis "
Num_A[ 13] = "Doce " ; Num_A[ 28] = "Veintisiete "
Num_A[ 14] = "Trece " ; Num_A[ 29] = "Veintiocho "
Num_A[ 15] = "Catorce " ; Num_A[ 30] = "Veintinueve "
Num_B[ 1] = "Diez " ; Num_C[ 1] = ""
Num_B[ 2] = "Veinte " ; Num_C[ 2] = "Ciento "
Num_B[ 3] = "Treinta " ; Num_C[ 3] = "Doscientos "
Num_B[ 4] = "Cuarenta " ; Num_C[ 4] = "Trescientos "
Num_B[ 5] = "Cincuenta " ; Num_C[ 5] = "Cuatrocientos "
Num_B[ 6] = "Sesenta " ; Num_C[ 6] = "Quinientos "
Num_B[ 7] = "Setenta " ; Num_C[ 7] = "Seiscientos "
Num_B[ 8] = "Ochenta " ; Num_C[ 8] = "Setecientos "
Num_B[ 9] = "Noventa " ; Num_C[ 9] = "Ochocientos "
Num_C[ 10] = "Novecientos "
//Se vacias valores de control
CtrlTexto = STR(ElNumero,8,0)
ValorPos[ 1] = VAL(Substr(CtrlTexto,8,1))
ValorPos[ 2] = VAL(Substr(CtrlTexto,7,1))
ValorPos[ 3] = VAL(Substr(CtrlTexto,6,1))
ValorPos[ 4] = VAL(Substr(CtrlTexto,5,1))
ValorPos[ 5] = VAL(Substr(CtrlTexto,4,1))
ValorPos[ 6] = VAL(Substr(CtrlTexto,3,1))
ValorPos[ 7] = VAL(Substr(CtrlTexto,2,1))
ValorPos[ 8] = VAL(Substr(CtrlTexto,1,1))
ValorPos[ 9] = VAL(Substr(CtrlTexto,7,2))
ValorPos[10] = VAL(Substr(CtrlTexto,4,2))
ValorPos[11] = VAL(Substr(CtrlTexto,1,2))
//Se comienza a generar la frase de control comenzando por las
//unidades.
Pon_la_Y = IF(ValorPos[ 1] = 0,"","y ")
IF ValorPos[ 2] < 3
FraseNumero = Num_A[ValorPos[ 9] + 1]
ELSE
FraseNumero = Num_B[ValorPos[ 2]] + Pon_la_Y + ;
IF(ValorPos[ 9] > 20,Num_A[ValorPos[ 1]+1],"")
ENDIF
//se continua formado la frase para las centenas
Num_C[ 2] = IF((ValorPos[ 1] + ValorPos[ 2]) = 0,"Cien ","Ciento ")
FraseNumero = Num_C[ValorPos[ 3] + 1] + FraseNumero
//se continua formado la frase para los miles
Pon_Mil = IF((ValorPos[ 4] + ValorPos[ 5] + ValorPos[ 6]) = 0,"","Mil ")
Pon_la_Y = IF( ValorPos[ 4] = 0,"","y ")
IF ValorPos[ 5] < 3
FraseNumero = Num_A[ValorPos[10] + 1] + Pon_Mil + FraseNumero
ELSE
FraseNumero = Num_B[ValorPos[ 5]] + Pon_la_Y +;
Num_A[ValorPos[ 4] + 1] + Pon_Mil + FraseNumero
ENDIF
RETURN FraseNumero
// -----------------------------------------------------------------------
CLASS TMiCalendario FROM TControl
// -----------------------------------------------------------------------
DATA lContinuar AS LOGICAL INIT .T.
DATA lConFoco AS LOGICAL INIT .T.
DATA oFont
DATA lFont AS LOGICAL INIT .F.
DATA oFontMes
DATA oFontTxt
DATA oFontBtn
DATA nPosFila // la posicion de la fila
DATA nPosCol // la posicion de la columna
DATA nPosBoton // la columna del boton.
DATA aDiaSemana AS ARRAY INIT ARRAY( 7)
DATA aXY AS ARRAY INIT ARRAY(42)
DATA aBoton AS ARRAY INIT ARRAY( 5)
DATA aDias AS ARRAY INIT ARRAY(42)
DATA aClrDias AS ARRAY INIT ARRAY(42)
DATA aColorCuerpo AS ARRAY
DATA aColorTitulo AS ARRAY
DATA aColorBoton AS ARRAY
DATA aColorDomingo AS ARRAY
DATA aColorFestivo AS ARRAY
// Tinha o Erro de GPF aqui, quando usava READONLY
DATA aFestivos AS ARRAY INIT ARRAY(12) //READONLY gerava erro
DATA nAltoFila
DATA nAnchoCol
DATA nAnchoBoton
DATA aTitBoton
DATA nFila1
DATA nFila2
DATA nCol1
DATA nCol2
DATA nPrimerDia AS NUMERIC INIT 1
DATA nUltimoDia AS NUMERIC INIT 42
DATA lSelectOK AS LOGICAL INIT .T.
DATA bCambioMes //Block a ejecutar cuando cambie el mes...
DATA bFestivos //Bingen
DATA nLanguage //Bingen
DATA aMeses AS ARRAY INIT ARRAY(12) //Bingen
DATA nLastDay AS NUMERIC INIT 1
// Datos relacionados con la fecha seleccionada.
DATA dFechaControl
DATA nMesNumero READONLY
DATA cMesNumero READONLY
DATA cMesPalabra READONLY
DATA nDiaSemana READONLY
DATA cDiaSemana READONLY
DATA cDiaPalabra READONLY
DATA nDiaMes READONLY
DATA cDiaMes READONLY
DATA cDiaMesPalabra READONLY
DATA nAno READONLY
DATA cAno READONLY
DATA cAnoPalabra READONLY
DATA aFecha AS ARRAY INIT ARRAY(2) READONLY
DATA aVencto AS ARRAY INIT ARRAY(8) READONLY
// aFecha, es un array con formatos de fecha
// aVencto, es un array con las fechas de vencimiento 15,30,45,60 dias...
// DATAS para reasignar teclas de navegacion.
DATA nK_AnoAdelenta AS NUMERIC INIT VK_NEXT
DATA nK_AnoAtras AS NUMERIC INIT VK_PRIOR
DATA nK_MesAdelenta AS NUMERIC INIT K_MAS
DATA nK_MesAtras AS NUMERIC INIT K_MENOS
DATA nK_Menu AS NUMERIC INIT K_DIVISION
DATA nK_Hoy AS NUMERIC INIT K_HOY
DATA nPosicion
DATA lTodoseCalculo AS LOGICAL INIT .F.
DATA lProcesarTecla AS LOGICAL INIT .T.
DATA lMostrarBoton AS LOGICAL INIT .T.
CLASSDATA lRegistered AS LOGICAL
METHOD New( ) CONSTRUCTOR //Bingen
METHOD Display()
METHOD Paint()
METHOD Language() //Bingen
METHOD LButtonDown( nRow, nCol, nFlags )
METHOD LButtonUp( nRow, nCol )
METHOD RButtonUp( nRow, nCol, nKeyFlags )
METHOD FijarFecha( dFecha )
METHOD CalcularDias( dFecha )
METHOD FijaClrs()
METHOD FijaClrDomingo()
METHOD FijaClrFestivo()
METHOD RestaurarColor() INLINE ::FijaClrs(), ::FijaClrDomingo(), ::FijaClrFestivo()
METHOD ColorDia( nDia, aColores )
METHOD Default()
METHOD Destroy()
METHOD MouseMove( nRow, nCol, nKeyFlags )
METHOD GetDlgCode( nLastKey )
METHOD VerAlSalir()
METHOD VerAlEntrar()
METHOD PintarBoton(hDC, nColor, nRow, nCol)
METHOD KeyChar( nKey, nFlags )
METHOD KeyDown( nKey, nFlags )
// Estos metodos devuelven verdadero o falso segun se encuentren
// dentro del cuerpo del calendario o en el area de botones.
METHOD lCuerpo( nRow, nCol)
METHOD lBotones( nRow, nCol)
// Metodos para moverse entre los meses
METHOD CambiarMes(nMeses, lProcesar)
METHOD MesSiguinte() INLINE ::CambiarMes( 1)
METHOD MesAnterior() INLINE ::CambiarMes( -1)
METHOD AnoSiguiente() INLINE ::CambiarMes( 12)
METHOD AnoAnterior() INLINE ::CambiarMes(-12)
METHOD Hoy() INLINE ::IrFecha( Date() )
METHOD IrFecha( dNvaFecha )
// Metodos para tomar y dejar el foco.
METHOD LostFocus( hCtlFocus ) INLINE ::Super:LostFocus( hCtlFocus ), ::VerAlSalir()
METHOD GotFocus() INLINE ::setfocus(), ::VerAlEntrar()
ENDCLASS
METHOD New (nTop, nLeft, nWidth, nHeight, oWnd, oFont, nLANGUAGE ) CLASS TMiCalendario
DEFAULT nTop:=5, nLeft:=5,nWidth:=120,nHeight:=120 //Bingen
DEFAULT nLanguage := L_SPANISH
// Coordenadas de la region de dibujo.
::nTop := nTop
::nLeft := nLeft
::nBottom := ::nTop + nHeight
::nRight := ::nLeft + nWidth
::dFechaControl := Date()
::bFestivos := {|| ARRAY(0) } //Bingen
::nLanguage := nLanguage //Bingen
::Language() //Bingen
// Array con dias festivos...
::aFestivos := { {}, {}, {},;
{}, {}, {},;
{}, {}, {},;
{}, {}, {} }
::oWnd := oWnd
//::oFont := oFont //ojo
::SetFont( oFont ) // sigue fallando
::lFont := !oFONT=Nil
::nPosFila := 1
::nPosCol := 1
::nPosBoton := 1
::aColorCuerpo := { nRgb(235,235,210),; // Color Borde superior
nRgb(205,205,155),; // Color de Relleno
nRgb(150,150, 75),; // Color Borde inferior
nRgb( 0, 0, 0),; // Color del texto,
nRgb(130,130, 65)} // Color dia seleccionado al perder el foco
::aColorTitulo := { nRgb(170,170, 80),; // Color Borde superior
nRgb(130,130, 65),; // Color de Relleno
nRgb(100,100, 50),; // Color Borde inferior
::aColorCuerpo[2],; // Color Letra mes y año
nRgb(255,255,255) } // Color de los dias.
::aColorBoton := { nRgb(170,170, 80),; // Color Borde superior
nRgb(130,130, 65),; // Color de Relleno
nRgb(100,100, 50),; // Color Borde inferior
::aColorCuerpo[2],; // Color Letra
::aColorCuerpo[2] } // Color relleno cuando se selecciona.
::aColorDomingo := ::aColorTitulo
::aColorFestivo := ::aColorTitulo
::nPosicion := day(::dFechaControl)
::FijaClrs()
::FijaClrDomingo()
::FijaClrFestivo()
::nStyle := nOr(WS_CHILD, WS_VISIBLE, WS_TABSTOP)
::Register()
If !Empty( oWnd:hWnd )
::Create()
oWnd:AddControl( Self )
Else
oWnd:DefControl( Self )
Endif
Return Self
METHOD Display() CLASS TMiCalendario
IF ::lContinuar
::lContinuar := .F.
::BeginPaint()
::Paint()
::EndPaint()
::lContinuar := .T.
ELSE
MsgInfo("Para Ccontrolar Que Nao Passe Duas Vezes")
ENDIF
RETURN SELF
METHOD Paint() CLASS TMiCalendario
// Se recupera identificador del boton.
Local hDC := ::GetDC()
Local nColor
IF !::lTodoseCalculo
::Default()
::SetSize(::nCol2 + 1,::nFila2 + 1 + IF(::lMostrarBoton, ::nAltoFila, 0 ), .t. ) //Bingen
::lTodoseCalculo := .T.
ENDIF
// Comienza el dibujo
DibujarTodo( hDC, ::nAltoFila, ::nAnchoCol, ::nFila1, ::nFila2,;
::nCol1, ::nCol2, ::oFont, ::aDiaSemana,;
::aXY, ::oFontTxt, ::aDias, ::aColorTitulo, ::aClrDias, ::aColorCuerpo, ::aColorBoton,;
::cMesPalabra, ::oFontMes, ::cAno,;
::oFontBtn, ::aBoton, ::nAnchoBoton, ::aTitBoton, ::bFestivos ) //Bingen
// Se pinta si esta con el foco o no.
if ::lFocused
MarcarDia( hDC, ::aXY[::nPosicion], nrgb(255, 0, 0))
else
MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5])
endif
// Se libera el identificador del boton.
::ReleaseDC()
Return Self
STATIC FUNCTION DibujarTodo( hDC, nAltoFila, nAnchoCol, nFila1, nFila2,;
nCol1, nCol2, oFont, aDiaSemana, aConPuntos,;
oFontTxt,aDias, aColorTitulo, aClrDias, aColorCuerpo, aColorBoton,;
cMesPalabra, oFontMes, cAno, ;
oFontBtn, aBoton, nAnchoBoton,;
aTitBoton, bFestivos ) //Bingen
Local A
Local aLosPuntos := aConPuntos[42]
// Se dibuja el cuerpo del calendario
DibujaCuerpo( hDC, aConPuntos, aClrDias, aColorCuerpo)
// Se dibujan los dias.
DibujaDias( hDC, oFont, aDias, aConPuntos, aClrDias, bFestivos )
// Se dibujan la parte superior del calendario
DibujaEncabezado(hDC, nFila1, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
aDiaSemana, oFont, aColorTitulo,;
cMesPalabra, oFontMes, cAno )
// Se dibujan los titulos del encabezado.
DibujaTitulos(hDC, nAltoFila, nCol1, nCol2, nAnchoCol,;
oFontMes, oFontTxt, aColorTitulo, cMesPalabra,;
cAno, aDiaSemana)
// Se dibujan los botones.
DibujaBotones(hDC, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
oFontBtn, aColorBoton, aBoton, aTitBoton, nAnchoBoton)
return NIL
STATIC FUNCTION DibujaDias( hDC, oFont, aDias, aXY, aClrDias, bFestivos)
Local HBROCHAANTERIOR, HOLDPEN
Local A, aFESTIVOS:=ARRAY(0), nCOLOR:=0
Local hBrocha
Local hPen1
Local hPen2
DEFAULT bFestivos := {|| ARRAY(0) }
aFESTIVOS:=EVAL(bFestivos)
// Se dibujan los dias.
SelectObject( hDC, oFont:hFont)
FOR A = 1 TO 42
// Se crea brocha para pintar el fondo del recuadro...
hBrocha := CreateSolidBrush ( aClrDias[ A][ 2] )
// se carga la brocha, se guarda la brocha anterior y se pinta
hBrochaAnterior := SelectObject (hDC, hBrocha)
FillRect( hDc, aXY[A], hBrocha )
// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF
// Aqui se dibujan los bordes....
// UNO. se cargan los lapices...
hPen1 := CreatePen(PS_SOLID, 1, aClrDias[ A][ 1]) //Claro nrgb(235,235,210)
hPen2 := CreatePen(PS_SOLID, 1, aClrDias[ A][ 3]) //Oscuro nrgb(160,160, 75)
// Se carga el lapices y se dibuja borde superior..
hOldPen := SelectObject( hDC, hPen1 )
MoveTo(hDc , aXY[ A][ 2] - 1, aXY[ A][ 3] )
LineTo(hDc, aXY[ A][ 2] - 1, aXY[ A][ 1] - 1 )
LineTo(hDc, aXY[ A][ 4] , aXY[ A][ 1] - 1 )
// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen1 )
MsgInfo("O objeto nao se destruiu")
ENDIF
// Se carga el lapices y se dibuja borde inferior..
hOldPen := SelectObject( hDC, hPen2 )
MoveTo(hDc , aXY[ A][ 2], aXY[ A][ 3] )
LineTo(hDc, aXY[ A][ 4], aXY[ A][ 3] )
LineTo(hDc, aXY[ A][ 4], aXY[ A][ 1] - 2 )
// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF
// Se dibuja el texto...
SetBkColor( hDC, aClrDias[ A][ 2] )
nCOLOR:=ASCAN(aFESTIVOS, {|aVal| aVal[1] == VAL(aDias[A]) }) //Comprobar festivos
IF nCOLOR>0 //Bingen
SetTextColor( hDC, aFESTIVOS[nCOLOR,2])
ELSE
SetTextColor( hDC, aClrDias[ A][ 4] )
ENDIF
DrawText( hDC, " " + aDias[A] + " ", aXY[A],;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
NEXT A
RETURN NIL
STATIC FUNCTION DibujaCuerpo( hDC, aXY, aClrDias, aColorCuerpo )
// Se crea el lapiz a utilizar.
Local A, HOLDPEN
Local hPen1
Local hPen2
Local hBrocha
Local hBrochaAnterior
// Se dibujan los bordes del cuerpo
hPen1 := CreatePen(PS_SOLID, 1, aColorCuerpo[ 1])
hPen2 := CreatePen(PS_SOLID, 1, Getsyscolor(16) )
// Se carga el lapices y se dibuja borde superior..
hOldPen := SelectObject( hDC, hPen1 )
MoveTo(hDc , aXY[ 1][ 2] - 2, aXY[ 1][ 1] - 1 )
LineTo(hDc, aXY[ 1][ 2] - 2, aXY[36][ 3] + 2 )
// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF
// Se carga el lapices y se dibuja borde inferior..
hOldPen := SelectObject( hDC, hPen2 )
MoveTo(hDc , aXY[36][ 2] - 1, aXY[36][ 3] + 1 )
LineTo(hDc, aXY[42][ 4] + 1, aXY[36][ 3] + 1 )
LineTo(hDc, aXY[42][ 4] + 1, -1 )
// Se destruyen objetos utilizados
SelectObject( hDC, hOldPen )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF
RETURN NIL
STATIC FUNCTION DibujaEncabezado(hDC, nFila1, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
aDiaSemana, oFont, aColorTitulo,;
cMesPalabra, oFontMes, cAno )
// Se crea el lapiz a utilizar.
Local hPen1 := CreatePen(PS_SOLID, 1, aColorTitulo[1]) //Lapiz claro
Local hPen2 := CreatePen(PS_SOLID, 1, aColorTitulo[3]) //Lapiz oscuro
Local hPenAnterior
Local aPuntos[4]
Local A
// Se crea brocha pintar la parte superior y luego
// se carga la brocha y se guarda la anterior brocha.
Local hBrocha := CreateSolidBrush ( aColorTitulo[2] )
Local hBrochaAnterior := SelectObject (hDC, hBrocha)
// Se pinta el recuadro.
FillRect( hDc, { 2, nCol1, nFila1 - 1, nCol2 }, hBrocha )
// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF
// Se dibuja el contorno se selecciona lapiz.
// Linea superior y linea izquierda
hPenAnterior := SelectObject( hDC, hPen1 )
MoveTo(hDC, nCol2 - 1, 1)
LineTo(hDC, nCol1 , 1)
LineTo(hDC, nCol1 , nFila1 - 1)
LineTo(hDC, nCol1 - 1, nFila1 - 1)
LineTo(hDC, nCol1 - 1, 0)
LineTo(hDC, nCol2 , 0)
//Linea horizontal del centro.
MoveTo(hDC, nCol2 - 1, nAltoFila)
LineTO(hDC, nCol1 - 1, nAltoFila)
MoveTo(hDC, nCol2 - (nAnchoCol * 2), 2)
LineTo(hDC, nCol2 - (nAnchoCol * 2), nAltoFila)
For A = 1 to 6
MoveTo(hDC, (nAnchoCol * A) + nCol1, nAltoFila)
LineTo(hDC, (nAnchoCol * A) + nCol1, nAltoFila * 2)
Next a
// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF
// Se dibuja el contorno se selecciona lapiz.
// Linea superior y linea izquierda
hPenAnterior := SelectObject( hDC, hPen2 )
MoveTo(hDC, nCol2 - 1, 1)
LineTo(hDC, nCol2 - 1, nFila1 - 1)
LineTo(hDC, nCol1 - 2, nFila1 - 1)
//Linea horizontal del centro.
MoveTo(hDC, nCol2 - 1, nAltoFila - 1)
LineTO(hDC, nCol1 - 2, nAltoFila - 1)
MoveTo(hDC, nCol2 - (nAnchoCol * 2) - 1, 0)
LineTo(hDC, nCol2 - (nAnchoCol * 2) - 1, nAltoFila)
For A = 1 to 6
MoveTo(hDC, (nAnchoCol * A) + nCol1 - 1, nAltoFila)
LineTo(hDC, (nAnchoCol * A) + nCol1 - 1, nAltoFila * 2)
Next a
// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF
RETURN NIL
STATIC FUNCTION DibujaTitulos(hDC, nAltoFila, nCol1, nCol2,;
nAnchoCol, oFontMes, oFont, aColorTitulo,;
cMesPalabra, cAno, aDiaSemana)
LOCAL aPuntos[4]
LOCAL A
// Formato letra
SelectObject(hDC, oFont:hFont) //Se selecciona el tipo de letra.
SetTextColor( hDC, aColorTitulo[5] )
SetBkColor( hDC, aColorTitulo[2] )
// Se dibujan los titulos de los dias.
A := 0
aPuntos[ 1] := nAltoFila
aPuntos[ 3] := nAltoFila * 2
FOR A = 0 TO 6
aPuntos[ 2] := nCol1 + ( A * nAnchoCol )
aPuntos[ 4] := aPuntos[2] + nAnchoCol
DrawText( hDC, LEFT(aDiaSemana[ A + 1],3), aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
NEXT A
// Se dibuja el mes en palabras.
SelectObject(hDC, oFontMes:hFont)
SetTextColor(hDC, aColorTitulo[4])
aPuntos[ 1] := 3
aPuntos[ 2] := 2
aPuntos[ 3] := nAltoFila - 1
aPuntos[ 4] := nCol2 - (nAnchoCol*2) - 1
DrawText( hDC, cMesPalabra, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
// Se dibuja el numero del año
aPuntos[ 2] := aPuntos[ 4] + 2
aPuntos[ 4] := nCol2 - 1
DrawText( hDC, cAno, aPuntos,;
nOr(32, 4, 1 ) ) //0 IZQUIERDA 1 CENTRO 2 DERECHA
RETURN NIL
STATIC FUNCTION DibujaBotones(hDC, nFila2, nAltoFila,;
nCol1, nCol2, nAnchoCol,;
oFont, aColorBoton, aBoton, aTitBoton, nAnchoBoton )
// Se crea el lapiz a utilizar.
Local hPen1 := CreatePen(PS_SOLID, 1, aColorBoton[1]) //Lapiz claro
Local hPen2 := CreatePen(PS_SOLID, 1, aColorBoton[3]) //Lapiz oscuro
Local hPenAnterior
Local aPuntos[5]
Local A
// Se crea brocha pintar la parte superior y luego
// se carga la brocha y se guarda la anterior brocha.
Local hBrocha := CreateSolidBrush ( aColorBoton[2] )
Local hBrochaAnterior := SelectObject (hDC, hBrocha)
// Se pinta el recuadro.
FillRect( hDc, { nFila2 + 2, nCol1, nFila2 + nAltoFila - 1, nCol2 }, hBrocha )
// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF
// Se dibuja el contorno se selecciona lapiz.
// Linea superior y linea izquierda
hPenAnterior := SelectObject( hDC, hPen1 )
MoveTo(hDC, nCol2 - 1, nFila2 + 1)
LineTo(hDC, nCol1 , nFila2 + 1)
LineTo(hDC, nCol1 , nFila2 + nAltoFila - 1)
LineTo(hDC, nCol1 - 1, nFila2 + nAltoFila - 1)
LineTo(hDC, nCol1 - 1, nFila2 )
For A = 1 to 4
MoveTo(hDC, (nAnchoBoton * A) + nCol1 + 1, nFila2 + 1)
LineTo(hDC, (nAnchoBoton * A) + nCol1 + 1, nFila2 + nAltoFila)
Next a
// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF
// Se dibuja el contorno se selecciona lapiz.
// Linea inferior y linea derecha
hPenAnterior := SelectObject( hDC, hPen2 )
MoveTo(hDC, nCol2 , nFila2 + 1)
LineTo(hDC, nCol2 , nFila2 + nAltoFila )
LineTo(hDC, nCol1 - 2, nFila2 + nAltoFila )
LineTo(hDC, nCol1 - 2, nFila2 + nAltoFila - 1)
LineTo(hDC, nCol2 - 1, nFila2 + nAltoFila - 1)
LineTo(hDC, nCol2 - 1, nFila2 + 1)
For A = 1 to 4
MoveTo(hDC, (nAnchoBoton * A) + nCol1, nFila2 + 1)
LineTo(hDC, (nAnchoBoton * A) + nCol1, nFila2 + nAltoFila)
Next a
// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen2 )
MsgInfo("El objeto no se destruyo")
ENDIF
// Formato letra
SelectObject(hDC, oFont:hFont) //Se selecciona el tipo de letra.
SetTextColor( hDC, aColorBoton[5] )
SetBkColor( hDC, aColorBoton[2] )
// Se dibujan los titulos de los botones //Bingen
DrawText( hDC, aTitBoton[1], aBoton[ 1],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[2], aBoton[ 2],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[3], aBoton[ 3],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[4], aBoton[ 4],;
nOr(32, 4, 1 ) )
DrawText( hDC, aTitBoton[5], aBoton[ 5],;
nOr(32, 4, 1 ) )
RETURN NIL
METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TMiCalendario
// Se recupera identificador del boton.
Local hDC := ::GetDC()
Local nAltoFila := ::nAltoFila
Local nAnchoCol := ::nAnchoCol
Local nFila1 := ::nFila1
Local nFila2 := ::nFila2
Local n := 1
Local nPos := 0
Local nPosAnterior := ::nPosicion
Local B
// Se fija que el objeto tenga el foco.
::SetFocus()
// Se determina el recuadro donde se da el click
IF ::lCuerpo( nRow, nCol)
// Se determina el numero de fila
While nRow > ( nPos + nFila1 + nAltoFila ) .and. n < 7
nPos += ::nAltoFila
n++
end
::nPosFila := n
// Se determina la posicion de la columna.
n := 1
nPos := 0
While nCol > ( nPos + nAnchoCol + ::nCol1 ) .and. n < 7
nPos += nAnchoCol
n++
end
::nPosCol := n
// Se pinta el dia seleccionado.
::nPosicion := ( (::nPosFila - 1) * 7) + ::nPosCol
B = ALLTRIM( ::aDias[::nPosicion])
IF !EMPTY( B )
MarcarDia( hDC, ::aXY[nPosAnterior], ::aClrDias[ nPosAnterior ][2])
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
// Se actualizan los datos fecha.
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
ELSE
IF ::lCuerpo( nRow, nCol) //Bingen
TONE(500,3)
::lSelectOK :=.F.
ENDIF
::nPosicion := nPosAnterior
ENDIF
ENDIF
// Se evalua si es la linea de los botones.
IF ::lBotones( nRow, nCol)
// Se determina la posicion de la columna.
n := 1
nPos := 0
While nCol > ( nPos + ::nAnchoBoton + ::nCol1 ) .and. n < 5
nPos += ::nAnchoBoton
n++
end
::nPosBoton := n
::PintarBoton(hDC, ::aColorBoton[5], nRow, nCol)
// Se evalua el boton seleccionado.
DO CASE
CASE ::nPosBoton == 1
::MesAnterior()
CASE ::nPosBoton == 2
::MesSiguinte()
CASE ::nPosBoton == 3
::AnoAnterior()
CASE ::nPosBoton == 4
::AnoSiguiente()
CASE ::nPosBoton == 5
::IrFecha( Date())
ENDCASE
ENDIF
// Se libera el identificador del boton.
::ReleaseDC()
return Self
METHOD LButtonUp( nRow, nCol ) CLASS TMiCalendario
LOCAL hDC := ::GetDC()
IF ::lSelectOK
::PintarBoton(hDC, ::aColorBoton[2], nRow, nCol)
IF ::lCuerpo( nRow, nCol)
::Super:LButtonUp( nRow, nCol )
ENDIF
ELSE
::lSelectOK:=.T.
ENDIF
::ReleaseDC()
RETURN Self
METHOD RButtonUp( nRow, nCol, nKeyFlags ) CLASS TMiCalendario
Local oMenu
::SetFocus()
MENU oMenu POPUP
MENUITEM ::aTitBoton[1] ACTION ::MesAnterior()
MENUITEM ::aTitBoton[2] ACTION ::MesSiguinte()
MENUITEM ::aTitBoton[5] ACTION ::Hoy()
MENUITEM "Otro Mes"
MENU
MENUITEM ::aMESES[ 1] ACTION ::CambiarMes( 1 - ::nMesNumero )
MENUITEM ::aMESES[ 2] ACTION ::CambiarMes( 2 - ::nMesNumero )
MENUITEM ::aMESES[ 3] ACTION ::CambiarMes( 3 - ::nMesNumero )
MENUITEM ::aMESES[ 4] ACTION ::CambiarMes( 4 - ::nMesNumero )
MENUITEM ::aMESES[ 5] ACTION ::CambiarMes( 5 - ::nMesNumero )
MENUITEM ::aMESES[ 6] ACTION ::CambiarMes( 6 - ::nMesNumero )
MENUITEM ::aMESES[ 7] ACTION ::CambiarMes( 7 - ::nMesNumero )
MENUITEM ::aMESES[ 8] ACTION ::CambiarMes( 8 - ::nMesNumero )
MENUITEM ::aMESES[ 9] ACTION ::CambiarMes( 9 - ::nMesNumero )
MENUITEM ::aMESES[10] ACTION ::CambiarMes(10 - ::nMesNumero )
MENUITEM ::aMESES[11] ACTION ::CambiarMes(11 - ::nMesNumero )
MENUITEM ::aMESES[12] ACTION ::CambiarMes(12 - ::nMesNumero )
ENDMENU
SEPARATOR
MENUITEM ::aTitBoton[3] ACTION ::AnoAnterior()
MENUITEM ::aTitBoton[4] ACTION ::AnoSiguiente()
IF !::lMostrarBoton //Bingen
MENUITEM "Mostrar Botones" ACTION ::SetSize(::nWidth(),::nheight() + ::nAltoFila, .t. ),;
::ReSize(),;
::lMostrarBoton := .T.
ELSE
MENUITEM "Ocultar Botones" ACTION ::SetSize(::nWidth(),::nheight() - ::nAltoFila, .t. ),;
::ReSize(),;
::lMostrarBoton := .F.
ENDIF
ENDMENU
ACTIVATE POPUP oMenu AT nRow, nCol OF Self
RETURN SELF
METHOD lBotones( nRow, nCol) CLASS TMiCalendario
RETURN iif( (nRow > ::nFila2 .and. ;
nCol > ::nCol1 .and. ;
nCol <= ::nCol2), .T., .F.)
METHOD lCuerpo( nRow, nCol) CLASS TMiCalendario
RETURN iif( (nRow > ::nFila1 .and.;
nRow <= ::nFila2 .and.;
nCol > ::nCol1 .and.;
nCol <= ::nCol2), .T., .F.)
METHOD Default() CLASS TMiCalendario
Local B := 1
Local aPuntos[ 5]
* Local aPunt := GetClientRec(::hWnd)
local ofu
// Estos son los datos de las columnas.
::nCol1 := 1 //Inicio Columna
::nAnchoCol := CalcularAncho(::nCol1, ::nWidth() ) //El ancho de la columna
::nCol2 := (::nAnchoCol * 7 ) + ::nCol1 //Final Columna
// Estos son los datos de la fila
::nAltoFila := CalcularAlto( ::nHeight() ) //El alto de la fila.
::nFila1 := ::nAltoFila * 2 //Ubicacion primera linea a dibujar
::nFila2 := ::nAltoFila * 8 //Fila Final
// Font del título 75% de la altura de la celda
::oFontMes := TFont():New( "Arial", 0, -(::nAltoFila*.75),, .t. ) //Bingen
// Font de los textos de los días 50% de la altura de la celda
::oFontTXT := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen
// Font para los días por defecto del 5O% de la altura de la celda
::oFont := IF(::lFont,::oFont,TFont():New( "Arial", 0, -(::nAltoFila*.50),, .t. )) //Bingen
// Font para los botones 4O% de la altura de la celda
::oFontBtn := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen
// Se crea matriz con los datos dia del mes.
// Coordenadas filas
aPuntos[ 1] := ::nFila1 + 1
aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2
FOR B = 1 TO 7
//Coordenadas columnas.
aPuntos[ 2] := ::nCol1 + ( ::nAnchoCol * ( B - 1) ) + 1
aPuntos[ 4] := aPuntos[ 2] + ::nAnchoCol - 2
::aXY[ B ] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 7] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 14] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 21] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 28] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
::aXY[ B + 35] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] }
NEXT B
FOR B = 1 TO 7
::aXY[ B + 7][1] := ::aXY[ B ][1] + ::nAltoFila
::aXY[ B + 14][1] := ::aXY[ B + 7][1] + ::nAltoFila
::aXY[ B + 21][1] := ::aXY[ B + 14][1] + ::nAltoFila
::aXY[ B + 28][1] := ::aXY[ B + 21][1] + ::nAltoFila
::aXY[ B + 35][1] := ::aXY[ B + 28][1] + ::nAltoFila
::aXY[ B + 7][3] := ::aXY[ B + 7][1] + ::nAltoFila - 2
::aXY[ B + 14][3] := ::aXY[ B + 14][1] + ::nAltoFila - 2
::aXY[ B + 21][3] := ::aXY[ B + 21][1] + ::nAltoFila - 2
::aXY[ B + 28][3] := ::aXY[ B + 28][1] + ::nAltoFila - 2
::aXY[ B + 35][3] := ::aXY[ B + 35][1] + ::nAltoFila - 2
NEXT B
// Se calcula el ancho de los botones.
::nAnchoBoton := int( (::nCol2 - ::nCol1) / 5)
// Se crean las coordenadas del boton.
aPuntos[ 1] := ::nFila2 + 1
aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2
FOR B = 1 TO 5
// Coordenadas columnas.
aPuntos[ 2] := ::nCol1 + ( ::nAnchoBoton * ( B - 1) ) + 1
aPuntos[ 4] := aPuntos[ 2] + ::nAnchoBoton - 2
::aBoton[B] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4], aPuntos[5] }
NEXT B
// Se fijan los datos de la fecha.
::FijarFecha( ::dFechaControl )
::nLastDay := ::nDiaMes
RETURN SELF
METHOD FijaClrs( aColores ) CLASS TMiCalendario
Local A
::aColorCuerpo := iif( aColores == NIL, ::aColorCuerpo, aColores )
// Se fijan los colores de bordes y de fondo de cada uno de los
// cuadritos...
FOR A = 1 TO 42
::aClrDias[ A] := { ::aColorCuerpo[ 1],; // Color Borde superior
::aColorCuerpo[ 2],; // Color de Relleno
::aColorCuerpo[ 3],; // Color Borde inferior
::aColorCuerpo[ 4] } // Color del texto,
NEXT A
RETURN NIL
METHOD FijaClrDomingo( aColores ) CLASS TMiCalendario
LOCAL A
::aColorDomingo := iif( aColores == NIL, ::aColorDomingo, aColores )
// Se fijan los colores para los dias domingo...
FOR A = 7 TO 42 step 7
::aClrDias[ A] := { ::aColorDomingo[ 1],; // Color Borde superior
::aColorDomingo[ 2],; // Color de Relleno
::aColorDomingo[ 3],; // Color Borde inferior
::aColorDomingo[ 4] } // Color del texto,
NEXT A
RETURN NIL
METHOD FijaClrFestivo() CLASS TMiCalendario
LOCAL aDiasFestivos := ::aFestivos[ ::nMesNumero]
LOCAL nFestivos := LEN( aDiasFestivos )
LOCAL nDia := 0
LOCAL A
// Se fijan los colores para los dias domingo...
IF nFestivos > 0
FOR A = 1 TO nFestivos
nDia := aDiasFestivos[ A]
::ColorDia( nDia, ::aColorFestivo )
NEXT A
ENDIF
RETURN NIL
METHOD ColorDia( nDia, aColores ) CLASS TMiCalendario
::aClrDias[ ::nPrimerDia + ndia - 1 ] := aColores
RETURN NIL
METHOD FijarFecha( dFecha ) CLASS TMiCalendario
dFecha = iif( dFecha == NIL, Date(), dFecha )
::dFechaControl := dFecha
::CalcularDias( ::dFechaControl )
::nMesNumero := Month(::dFechaControl)
::cMesNumero := STR(::nMesNumero, 2, 0)
::cMesPalabra := IF(::nMesNumero=NIL,"", ::aMESES[::nMesNumero])
::nDiaSemana := if( (::nDiaSemana := dow(::dFechaControl) - 1) = 0, 7, ::nDiaSemana)
::cDiaSemana := str(::nDiaSemana,2,0)
::cDiaPalabra := ::aDiaSemana[::nDiaSemana]
::nDiaMes := Day(::dFechaControl )
::cDiaMes := str(::nDiaMes,2,0)
::cDiaMesPalabra:= FormarFrase(::nDiaMes)
::nAno := year( ::dFechaControl )
::cAno := ALLTRIM( str(::nAno, 4, 0 ))
::cAnoPalabra := FormarFrase(::nAno )
::aFecha[ 1] := ::cDiaMes + " de " + ::cMesPalabra + " de " + ::cAno
::aFecha[ 2] := ::cDiaPalabra + ", " + ::cDiaMes + " de " + ::cMesPalabra + " de " + ::cAno
// aqui agregar todos los otros formatos que sean posibles.
RETURN SELF
METHOD CalcularDias( dFecha ) CLASS TMiCalendario // TMiEjemplo
Local FechaInicioMes
Local nDiaSemana
Local nMes := Month( dFecha )
Local nAno := Year( dFecha )
Local aDiaFinMes := {31,28,31,30,31,30,31,31,30,31,30,31}
Local aLosDias[42]
Local B
Local CELMES, CELANO, NDIAFINALMES
// Se limpian los dias.
FOR B = 1 TO 42
aLosDias[ B] := " " // Para sobrescribir el dibujo anterior
NEXT B
// Dia de la semana.
FechaInicioMes := ctod( "01/" + str(nMes,2,0) + "/" + str(nAno,4,0) )
cElMes := IF(::nMesNumero=NIL,"", ::aMESES[::nMesNumero])
cElAno := STR(nAno,4)
aDiaFinMes[ 2] := iif( CtoD("29/02/" + cElAno) = CtoD("0"), 28, 29)
nDiaFinalMes := aDiaFinMes[nMes]
nDiaSemana := dow(FechaInicioMes) - 1
nDiaSemana := IIF( nDiaSemana = 0, 7, nDiaSemana)
FOR B = 1 TO nDiaFinalMes
aLosDias[ B + nDiaSemana - 1 ] := str(B,2,0)
NEXT B
::aDias := aLosDias
::nPrimerDia := nDiaSemana
::nUltimoDia := B + nDiaSemana - 2
::nPosicion := day(dfecha) + nDiaSemana - 1
RETURN SELF
METHOD Destroy() CLASS TMiCalendario
::oFontMes:End()
::oFontTxt:End()
::oFont:End()
::oFontBtn:End()
RETURN ::Super:Destroy()
METHOD CambiarMes( nMeses, lProcesar ) CLASS TMiCalendario
Local aDiaFinMes := {31,28,31,30,31,30,31,31,30,31,30,31}
Local nNumeroMes := ::nMesNumero
Local dNvaFecha
Local hDC
Local AnchoRelleno := (::nAnchoCol * 5) - 4
Local nDia
DEFAULT nMeses := 1, lProcesar := .F.
// Se obtiene el controlador
IF (nMeses<> 0 .or. lProcesar)
hDC := ::GetDC()
// Se desmarca el dia...
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2] )
ENDIF
// Si el numero es cero, pues nada se hace y lprocesar, para obligar a procesar.
IF (nMeses<> 0 .or. lProcesar)
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2] )
// Se comprueba que no sea mayor que doce el aumento de mes.
nNumeroMes += nMeses
DO CASE
CASE nNumeroMes > 12
::nMesNumero := nNumeroMes - 12
::nAno++
CASE nNumeroMes < 1
::nMesNumero := 12 + nNumeroMes
::nAno--
OTHERWISE
::nMesNumero := nNumeroMes
ENDCASE
// Se verifica año bisciesto
aDiaFinMes[ 2] := iif( CtoD("29/02/" + str(::nAno,4,0) ) = CtoD("0"), 28, 29)
// Se determina el dia de cambio...
nDia := iif( ::nLastDay > aDiaFinMes[ ::nMesNumero ],;
aDiaFinMes[ ::nMesNumero ],;
::nLastDay )
dNvaFecha := CtoD( STR( nDia ,2,0) + "/" +;
STR(::nMesNumero,2,0) + "/" +;
STR(::nAno, 4,0) )
::FijarFecha( dNvaFecha )
// Se restauran los colores...
::RestaurarColor()
// Se evalua bloque de codigo al cambiar de mes...
IF !EMPTY( ::bCambioMes )
Eval( ::bCambioMes )
ENDIF
// Se dibujan los dias.
DibujaDias( hDC, ::oFont, ::aDias, ::aXY,;
::aClrDias, ::bFestivos )
// Se dibujan los titulos del mes y año.
DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,;
::nAnchoCol, ::oFontMes, ::oFont, ::aColorTitulo,;
xPadc(::cMesPalabra, AnchoRelleno), ::cAno, ::aDiaSemana)
* ::nPosicion := ::nDiaSemana
* MsgInfo( ::nPosicion )
MarcarDia( hDC, ::aXY[::nPosicion], nRgb(255, 0, 0))
// Se libera el identificador
::ReleaseDC()
ENDIF
RETURN Self
METHOD VerAlSalir() CLASS TMiCalendario
// Metodo cuando se abandona
// Se recupera el identificador.
LOCAL hDC := ::GetDC()
::lConFoco := .F.
MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5])
// Se destruye el identificador.
::ReleaseDC()
return Self
METHOD VerAlEntrar() CLASS TMiCalendario
// Metodo cuando se abandona
// Se recupera el identificador.
LOCAL hDC := ::GetDC()
IF !::lTodoseCalculo
::Default()
::SetSize(::nCol2 + 1,::nFila2 + 1 + IF(::lMostrarBoton, ::nAltoFila, 0 ), .t. ) //Bingen
::lTodoseCalculo := .T.
ENDIF
::lConFoco := .T.
MarcarDia( hDC, ::aXY[::nPosicion], nrgb(255, 0, 0)) //::aColorTitulo[5]
// Se destruye el identificador.
::ReleaseDC()
return Self
METHOD GetDlgCode( nLastKey ) CLASS TMiCalendario
// This method is very similar to TControl:GetDlgCode() but it is
// necessary to have WHEN working
if .not. ::oWnd:lValidating
if nLastKey == VK_UP .or. nLastKey == VK_DOWN ;
.or. nLastKey == VK_RETURN .or. nLastKey == VK_TAB
::oWnd:nLastKey = nLastKey
else
::oWnd:nLastKey = 0
endif
endif
return If( IsWindowEnabled( ::hWnd ), DLGC_WANTALLKEYS, 0 )
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TMiCalendario
CursorHand()
// Se evalua si es la linea de los botones.
* IF nRow > nFila2 .and. ;
* nCol > ::nCol1 .and. nCol <= ::nCol2
*
* ENDIF
RETURN SELF
METHOD PintarBoton(hDC, nColor, nRow, nCol) CLASS TMiCalendario //Bingen
// se carga la brocha y se guarda la anterior brocha.
Local hBrocha := CreateSolidBrush ( nColor )
Local hBrochaAnterior := SelectObject (hDC, hBrocha)
Local aPuntos := ::aBoton[::nPosBoton]
// Se pinta el recuadro.
FillRect( hDc, {aPuntos[ 1] + 1,;
aPuntos[ 2] + 1,;
aPuntos[ 3],;
aPuntos[ 4]}, hBrocha )
// Se restaura la brocha y destruye la utilizada
SelectObject (hDC, hBrochaAnterior )
IF !DeleteObject( hBrocha )
MsgInfo("Parece que no se destruyo")
ENDIF
// Formato letra
SelectObject(hDC, IF(::lCuerpo( nRow, nCol),::oFont:hFont,::oFontBtn:hFont)) //Bingen
SetTextColor( hDC, ::aColorBoton[5] )
SetBkColor( hDC, nColor )
// Se dibujan los titulos de los botones
DrawText( hDC, ::aTitBoton[::nPosBoton], aPuntos,;
nOr(32, 4, 1 ) )
RETURN SELF
METHOD KeyChar( nKey, nFlags ) CLASS TMiCalendario
do case
case nKey == ::nK_MesAdelenta
::MesSiguinte()
case nKey == ::nK_MesAtras
::MesAnterior()
case nKey == ::nK_Menu
::RButtonUp( ::nAltoFila, ::nAnchoCol, 0 )
otherwise
return ::Super:KeyChar( nKey, nFlags )
endcase
return SELF
METHOD KeyDown( nKey, nFlags ) CLASS TMiCalendario
Local hDC
Local nPosAnterior := ::nPosicion
do case
case nKey == VK_RETURN //Bingen
::LButtonUp( ::aXY[::nPosicion,1], ::aXY[::nPosicion,2])
case nKey == VK_END
IF ::nPosicion < ::nUltimoDia
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nUltimoDia
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF
case nKey == VK_HOME
IF ::nPosicion > ::nPrimerDia
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nPrimerDia
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF
case nKey == VK_DOWN
IF ::lProcesarTecla
::lProcesarTecla := .F.
IF (::nPosicion + 7) < 42 .and. !empty(::aDias[(::nPosicion + 7)])
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nPosicion + 7
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF
::lProcesarTecla := .T.
ENDIF
case nKey == VK_UP
IF ::lProcesarTecla
::lProcesarTecla := .F.
IF (::nPosicion - 7) > 0 .and. !empty(::aDias[(::nPosicion - 7)])
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion := ::nPosicion - 7
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::nLastDay := ::nDiaMes
::ReleaseDC()
ENDIF
::lProcesarTecla := .T.
ENDIF
case nKey == VK_LEFT
IF ::lProcesarTecla
::lProcesarTecla := .F.
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion --
IF ::nPosicion < ::nPrimerDia
::nPosicion := ::nUltimoDia
ENDIF
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::ReleaseDC()
::nLastDay := ::nDiaMes
::lProcesarTecla := .T.
ENDIF
case nKey == VK_RIGHT
IF ::lProcesarTecla
::lProcesarTecla := .F.
hDC := ::GetDC()
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion][ 2])
::nPosicion ++
IF ::nPosicion > ::nUltimoDia
::nPosicion := ::nPrimerDia
ENDIF
MarcarDia( hDC, ::aXY[::nPosicion], nRGB(255,0,0))
::FijarFecha( CtoD( ::aDias[::nPosicion] + "/" +;
::cMesNumero + "/" +;
::cAno ) )
::ReleaseDC()
::nLastDay := ::nDiaMes
::lProcesarTecla := .T.
ENDIF
case nKey == VK_TAB .OR. nKey == VK_ESCAPE
return ::Super:KeyDown( nKey, nFlags )
case nKey == ::nK_AnoAtras
::AnoAnterior()
case nKey == ::nK_AnoAdelenta
::AnoSiguiente()
case nKey == ::nK_Hoy
::IrFecha( Date())
otherwise
return ::Super:KeyDown( nKey, nFlags )
endcase
RETURN SELF
METHOD IrFecha( dNvaFecha ) CLASS TMiCalendario
// Se recupera identificador del boton.
Local hDC := ::GetDC()
Local AnchoRelleno := (::nAnchoCol * 5) - 4
// Se desmarca el dia...
MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion ][ 2] )
// Se fija la fecha.
::FijarFecha( dNvaFecha )
::nLastDay := ::nDiaMes
// Se restauran los colores...
::RestaurarColor()
// Se evalua bloque de codigo al cambiar de mes...
IF !EMPTY( ::bCambioMes )
Eval( ::bCambioMes )
ENDIF
// Se dibujan los dias.
DibujaDias( hDC, ::oFont, ::aDias, ::aXY,;
::aClrDias, ::bFestivos )
// Se dibujan los titulos del mes y año.
DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,;
::nAnchoCol, ::oFontMes, ::oFont, ::aColorTitulo,;
xPadc(::cMesPalabra, AnchoRelleno), ::cAno, ::aDiaSemana)
MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5] )
// Se libera el identificador
::ReleaseDC()
RETURN NIL
/*-------------------------------------------------------------------------*/
METHOD Language() CLASS TMiCalendario //Bingen
// Soporte multilenguaje
IF ::nLanguage = L_PORTUGUES
::aMESES := { "Janeiro" , "Fevereiro", "Março" ,"Abril",;
"Maio" , "Junho" , "Julho" ,"Agosto",;
"Setembro" , "Outubro" , "Novembro" ,"Dezembro"}
::aDiaSemana := {"Segunda","Terça","Quarta","Quinta",;
"_","Sábado","Domingo"}
::aTitBoton := {"&-Mês", "&+Mês", "< Ano", "Ano >", "Hoje"}
ELSEIF ::nLanguage = L_CATALA
::aMESES := { "Gener" , "Febrer" , "Març" ,"Abril",;
"Maig" , "Juny" , "Juliol" ,"Agost",;
"Setembre" , "Octubre", "Novembre","Desembre"}
::aDiaSemana := {"Dilluns","Dimarts","Dimecres","Dijous",;
"Divendres","Dissabte","Diumenge"}
::aTitBoton := {"&-Mes", "&+Mes", "-Any", "+Any", "Avuy"}
ELSEIF ::nLanguage = L_EUSKERA
::aMESES := { "Urtarrila", "Otsaila", "Martxoa" , "Apirila",;
"Maiatza" , "Ekaina" , "Uztaila" , "Abuztua",;
"Iraila" , "Urria" , "Azaroa" , "Abendua"}
::aDiaSemana := {"Astelehena","Asteartea","Asteazkena","Osteguna",;
"Ostirala","Larunbata","Igandea"}
::aTitBoton := {"&-Hil", "&+Hil", "-Urte", "+Urte", "Gaur"}
ELSEIF ::nLanguage = L_GALEGO
::aMESES := { "Xaneiro" , "Febreiro", "Marzal" ,"Abril",;
"Maio" , "Xuño" , "Xulio" ,"Agosto",;
"Septembro" , "Octubro" , "Novembro" ,"Decembro"}
::aDiaSemana := {"Luns","Martes","Mércores","Xoves",;
"Venres","Sabado","Domingo"}
::aTitBoton := {"&-Mes", "&+Mes", "< Año", "Año >", "Hoxe"}
ELSEIF ::nLanguage = L_SPANISH
::aMESES := { "Enero" , "Febrero", "Marzo" ,"Abril",;
"Mayo" , "Junio" , "Julio" ,"Agosto",;
"Septiembre", "Octubre", "Noviembre","Diciembre"}
::aDiaSemana := {"Lunes","Martes","Miercoles","Jueves",;
"Viernes","Sabado","Domingo"}
::aTitBoton := {"&-Mes", "&+Mes", "-Año", "+Año", "Hoy"}
ELSEIF ::nLanguage = L_ITALIANO
::aMESES := { "Gennaio" , "Febbraio" , "Marzo" ,"Aprile",;
"Maggio" , "Giugno" , "Luglio" ,"Agosto",;
"Settembre" , "Ottobre" , "Novembre" ,"Dicembre"}
::aDiaSemana := {"Lunedi","Martedi","Mercoledi","Giovedi",;
"Venerdi","Sabato","Domenica"}
::aTitBoton := {"&-Mese", "&+Mese", "-Anno", "+Anno", "Oggi"}
ELSEIF ::nLanguage = L_ENGLISH
::aMESES := { "Jannuary" , "February" , "March" ,"April",;
"May" , "June" , "July" ,"August",;
"September" , "October" , "November" ,"December"}
::aDiaSemana := {"Monday","Tuesday","Wednesday","Thursday",;
"Friday","Saturday","Sunday"}
::aTitBoton := {"&-Month", "&+Month", "-Year", "+Year", "Today"}
ELSEIF ::nLanguage = L_FRANCAIS
::aMESES := { "Janvier" , "Février" , "Mars" ,"Avril",;
"Mai" , "Juin" , "Juillet" ,"Août",;
"Septembre" , "Octobre" , "Novembre" ,"Decembre"}
::aDiaSemana := {"Lundi","Mardi","Mercredi","Jeudi",;
"Vendredi","Samedi","Dimanche"}
::aTitBoton := {"&-Mois", "&+Mois", "-An", "+An", "Auj'hui"}
ELSEIF ::nLanguage = L_DEUSTCH
::aMESES := { "Januar" , "Februar" , "März" ,"April",;
"Mai" , "Juni" , "Juli" ,"August",;
"September" , "Oktober" , "November" ,"Dezember"}
::aDiaSemana := {"Montag","Dienstag","Mittwoch","Donnerstag",;
"Freitag","Samstag","Sonntag"}
::aTitBoton := {"&-Monat", "&+Monat", "-Jahr", "+Jahr", "Heute"}
ENDIF
// Para realimentar los datos fechas con los nuevos valores.
::FijarFecha( ::dFechaControl )
RETURN NIL
STATIC FUNCTION CalcularAncho( nEspacioIzq,nWidth )
Local nColumnaAncho
nColumnaAncho := int( ( nWidth - nEspacioIzq ) / 7)
RETURN nColumnaAncho
STATIC FUNCTION CalcularAlto( nHeight )
Local nFilaAlto
nFilaAlto := int(( nHeight - 1) /
RETURN nFilaAlto
STATIC FUNCTION MarcarDia( hDC, aPuntos, nColor)
// Se crea el lapiz a utilizar.y se carga.
Local hPen1 := CreatePen(PS_SOLID, 3, nColor)
Local hPenAnterior := SelectObject(hDC, hPen1)
// Se dibuja el rectangulo
MoveTo(hDC, aPuntos[2] + 1, aPuntos[1] + 1)
LineTo(hDC, aPuntos[4] - 3, aPuntos[1] + 1)
LineTo(hDC, aPuntos[4] - 3, aPuntos[3] - 2)
LineTo(hDC, aPuntos[2] + 1, aPuntos[3] - 2)
LineTo(hDC, aPuntos[2] + 1, aPuntos[1] + 1)
// Se destruyen objetos utilizados
SelectObject( hDC, hPenAnterior )
IF !DeleteObject( hPen1 )
MsgInfo("El objeto no se destruyo")
ENDIF
RETURN NIL
STATIC FUNCTION FormarFrase(ElNumero)
//ElNumero , corresponde al numero que se debera frasear.
//Se definen variables locales de control.
LOCAL Pon_la_Y := ""
LOCAL Pon_Mil := ""
LOCAL CtrlTexto := "" //Almacenara a ELNUMERO en formato texto.
LOCAL FraseNumero:= ""
LOCAL ValorPos[11]
LOCAL Num_A[30]
LOCAL Num_B[ 9]
LOCAL Num_C[10]
//Se llenan matricez de control de palabras.
Num_A[ 1] = "" ; Num_A[ 16] = "Quince "
Num_A[ 2] = "Un " ; Num_A[ 17] = "Dieciseis "
Num_A[ 3] = "Dos " ; Num_A[ 18] = "Diecisiete "
Num_A[ 4] = "Tres " ; Num_A[ 19] = "Dieciocho "
Num_A[ 5] = "Cuatro " ; Num_A[ 20] = "Diecinueve "
Num_A[ 6] = "Cinco " ; Num_A[ 21] = "Veinte "
Num_A[ 7] = "Seis " ; Num_A[ 22] = "Veintiun "
Num_A[ 8] = "Siete " ; Num_A[ 23] = "Veintidos "
Num_A[ 9] = "Ocho " ; Num_A[ 24] = "Vientitres "
Num_A[ 10] = "Nueve " ; Num_A[ 25] = "Veinticuatro "
Num_A[ 11] = "Diez " ; Num_A[ 26] = "Veinticinco "
Num_A[ 12] = "Once " ; Num_A[ 27] = "Veintiseis "
Num_A[ 13] = "Doce " ; Num_A[ 28] = "Veintisiete "
Num_A[ 14] = "Trece " ; Num_A[ 29] = "Veintiocho "
Num_A[ 15] = "Catorce " ; Num_A[ 30] = "Veintinueve "
Num_B[ 1] = "Diez " ; Num_C[ 1] = ""
Num_B[ 2] = "Veinte " ; Num_C[ 2] = "Ciento "
Num_B[ 3] = "Treinta " ; Num_C[ 3] = "Doscientos "
Num_B[ 4] = "Cuarenta " ; Num_C[ 4] = "Trescientos "
Num_B[ 5] = "Cincuenta " ; Num_C[ 5] = "Cuatrocientos "
Num_B[ 6] = "Sesenta " ; Num_C[ 6] = "Quinientos "
Num_B[ 7] = "Setenta " ; Num_C[ 7] = "Seiscientos "
Num_B[ 8] = "Ochenta " ; Num_C[ 8] = "Setecientos "
Num_B[ 9] = "Noventa " ; Num_C[ 9] = "Ochocientos "
Num_C[ 10] = "Novecientos "
//Se vacias valores de control
CtrlTexto = STR(ElNumero,8,0)
ValorPos[ 1] = VAL(Substr(CtrlTexto,8,1))
ValorPos[ 2] = VAL(Substr(CtrlTexto,7,1))
ValorPos[ 3] = VAL(Substr(CtrlTexto,6,1))
ValorPos[ 4] = VAL(Substr(CtrlTexto,5,1))
ValorPos[ 5] = VAL(Substr(CtrlTexto,4,1))
ValorPos[ 6] = VAL(Substr(CtrlTexto,3,1))
ValorPos[ 7] = VAL(Substr(CtrlTexto,2,1))
ValorPos[ 8] = VAL(Substr(CtrlTexto,1,1))
ValorPos[ 9] = VAL(Substr(CtrlTexto,7,2))
ValorPos[10] = VAL(Substr(CtrlTexto,4,2))
ValorPos[11] = VAL(Substr(CtrlTexto,1,2))
//Se comienza a generar la frase de control comenzando por las
//unidades.
Pon_la_Y = IF(ValorPos[ 1] = 0,"","y ")
IF ValorPos[ 2] < 3
FraseNumero = Num_A[ValorPos[ 9] + 1]
ELSE
FraseNumero = Num_B[ValorPos[ 2]] + Pon_la_Y + ;
IF(ValorPos[ 9] > 20,Num_A[ValorPos[ 1]+1],"")
ENDIF
//se continua formado la frase para las centenas
Num_C[ 2] = IF((ValorPos[ 1] + ValorPos[ 2]) = 0,"Cien ","Ciento ")
FraseNumero = Num_C[ValorPos[ 3] + 1] + FraseNumero
//se continua formado la frase para los miles
Pon_Mil = IF((ValorPos[ 4] + ValorPos[ 5] + ValorPos[ 6]) = 0,"","Mil ")
Pon_la_Y = IF( ValorPos[ 4] = 0,"","y ")
IF ValorPos[ 5] < 3
FraseNumero = Num_A[ValorPos[10] + 1] + Pon_Mil + FraseNumero
ELSE
FraseNumero = Num_B[ValorPos[ 5]] + Pon_la_Y +;
Num_A[ValorPos[ 4] + 1] + Pon_Mil + FraseNumero
ENDIF
RETURN FraseNumero
Saludos / Regards,
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
-
cnavarro
- Posts: 6572
- Joined: Wed Feb 15, 2012 8:25 pm
- Location: España
- Has thanked: 4 times
- Been thanked: 6 times
Re: problema con SetFont
intenta quitarle el ::oFont:End() en el metodo Destroy
Podrias poner el codigo anterior en un <code>?
Podrias poner el codigo anterior en un <code>?
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Re: problema con SetFont
Aquí tienes el ejemplo completo:
http://rg.to/file/6cbe13abc7999ea032a39 ... a.prg.html
Muchas gracias Cristóbal.
http://rg.to/file/6cbe13abc7999ea032a39 ... a.prg.html
Muchas gracias Cristóbal.
Saludos / Regards,
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
-
cnavarro
- Posts: 6572
- Joined: Wed Feb 15, 2012 8:25 pm
- Location: España
- Has thanked: 4 times
- Been thanked: 6 times
Re: problema con SetFont
No soy capaz de descargarlo
Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Re: problema con SetFont
Code: Select all | Expand
CLASS TMiCalendario FROM TControl DATA lContinuar AS LOGICAL INIT .T. DATA lConFoco AS LOGICAL INIT .T. DATA oFont DATA lFont AS LOGICAL INIT .F. DATA oFontMes DATA oFontTxt DATA oFontBtn DATA nPosFila // la posicion de la fila DATA nPosCol // la posicion de la columna DATA nPosBoton // la columna del boton. DATA aDiaSemana AS ARRAY INIT ARRAY( 7) DATA aXY AS ARRAY INIT ARRAY(42) DATA aBoton AS ARRAY INIT ARRAY( 5) DATA aDias AS ARRAY INIT ARRAY(42) DATA aClrDias AS ARRAY INIT ARRAY(42) DATA aColorCuerpo AS ARRAY DATA aColorTitulo AS ARRAY DATA aColorBoton AS ARRAY DATA aColorDomingo AS ARRAY DATA aColorFestivo AS ARRAY DATA aFestivos AS ARRAY INIT ARRAY(12) //READONLY gerava erro DATA nAltoFila DATA nAnchoCol DATA nAnchoBoton DATA aTitBoton DATA nFila1 DATA nFila2 DATA nCol1 DATA nCol2 DATA nPrimerDia AS NUMERIC INIT 1 DATA nUltimoDia AS NUMERIC INIT 42 DATA lSelectOK AS LOGICAL INIT .T. DATA bCambioMes //Block a ejecutar cuando cambie el mes... DATA bFestivos //Bingen DATA nLanguage //Bingen DATA aMeses AS ARRAY INIT ARRAY(12) //Bingen DATA nLastDay AS NUMERIC INIT 1 // Datos relacionados con la fecha seleccionada. DATA dFechaControl DATA nMesNumero READONLY DATA cMesNumero READONLY DATA cMesPalabra READONLY DATA nDiaSemana READONLY DATA cDiaSemana READONLY DATA cDiaPalabra READONLY DATA nDiaMes READONLY DATA cDiaMes READONLY DATA cDiaMesPalabra READONLY DATA nAno READONLY DATA cAno READONLY DATA cAnoPalabra READONLY DATA aFecha AS ARRAY INIT ARRAY(2) READONLY DATA aVencto AS ARRAY INIT ARRAY(8) READONLY// aFecha, es un array con formatos de fecha// aVencto, es un array con las fechas de vencimiento 15,30,45,60 dias... // DATAS para reasignar teclas de navegacion. DATA nK_AnoAdelenta AS NUMERIC INIT VK_NEXT DATA nK_AnoAtras AS NUMERIC INIT VK_PRIOR DATA nK_MesAdelenta AS NUMERIC INIT K_MAS DATA nK_MesAtras AS NUMERIC INIT K_MENOS DATA nK_Menu AS NUMERIC INIT K_DIVISION DATA nK_Hoy AS NUMERIC INIT K_HOY DATA nPosicion DATA lTodoseCalculo AS LOGICAL INIT .F. DATA lProcesarTecla AS LOGICAL INIT .T. DATA lMostrarBoton AS LOGICAL INIT .T. CLASSDATA lRegistered AS LOGICAL METHOD New( ) CONSTRUCTOR //Bingen METHOD Display() METHOD Paint() METHOD Language() //Bingen METHOD LButtonDown( nRow, nCol, nFlags ) METHOD LButtonUp( nRow, nCol ) METHOD RButtonUp( nRow, nCol, nKeyFlags ) METHOD FijarFecha( dFecha ) METHOD CalcularDias( dFecha ) METHOD FijaClrs() METHOD FijaClrDomingo() METHOD FijaClrFestivo() METHOD RestaurarColor() INLINE ::FijaClrs(), ::FijaClrDomingo(), ::FijaClrFestivo() METHOD ColorDia( nDia, aColores ) METHOD Default() METHOD Destroy() METHOD MouseMove( nRow, nCol, nKeyFlags ) METHOD GetDlgCode( nLastKey ) METHOD VerAlSalir() METHOD VerAlEntrar() METHOD PintarBoton(hDC, nColor, nRow, nCol) METHOD KeyChar( nKey, nFlags ) METHOD KeyDown( nKey, nFlags ) // Estos metodos devuelven verdadero o falso segun se encuentren // dentro del cuerpo del calendario o en el area de botones. METHOD lCuerpo( nRow, nCol) METHOD lBotones( nRow, nCol) // Metodos para moverse entre los meses METHOD CambiarMes(nMeses, lProcesar) METHOD MesSiguinte() INLINE ::CambiarMes( 1) METHOD MesAnterior() INLINE ::CambiarMes( -1) METHOD AnoSiguiente() INLINE ::CambiarMes( 12) METHOD AnoAnterior() INLINE ::CambiarMes(-12) METHOD Hoy() INLINE ::IrFecha( Date() ) METHOD IrFecha( dNvaFecha ) // Metodos para tomar y dejar el foco. METHOD LostFocus( hCtlFocus ) INLINE ::Super:LostFocus( hCtlFocus ), ::VerAlSalir() METHOD GotFocus() INLINE ::setfocus(), ::VerAlEntrar() ENDCLASS METHOD New (nTop, nLeft, nWidth, nHeight, oWnd, oFont, nLANGUAGE ) CLASS TMiCalendario DEFAULT nTop:=5, nLeft:=5,nWidth:=120,nHeight:=120 //Bingen DEFAULT nLanguage := L_SPANISH // Coordenadas de la region de dibujo. ::nTop := nTop ::nLeft := nLeft ::nBottom := ::nTop + nHeight ::nRight := ::nLeft + nWidth ::dFechaControl := Date() ::bFestivos := {|| ARRAY(0) } //Bingen ::nLanguage := nLanguage //Bingen ::Language() //Bingen // Array con dias festivos... ::aFestivos := { {}, {}, {},; {}, {}, {},; {}, {}, {},; {}, {}, {} } ::oWnd := oWnd //::oFont := oFont //ojo ::SetFont( oFont ) // sigue fallando ::lFont := !oFONT=Nil ::nPosFila := 1 ::nPosCol := 1 ::nPosBoton := 1 ::aColorCuerpo := { nRgb(235,235,210),; // Color Borde superior nRgb(205,205,155),; // Color de Relleno nRgb(150,150, 75),; // Color Borde inferior nRgb( 0, 0, 0),; // Color del texto, nRgb(130,130, 65)} // Color dia seleccionado al perder el foco ::aColorTitulo := { nRgb(170,170, 80),; // Color Borde superior nRgb(130,130, 65),; // Color de Relleno nRgb(100,100, 50),; // Color Borde inferior ::aColorCuerpo[2],; // Color Letra mes y año nRgb(255,255,255) } // Color de los dias. ::aColorBoton := { nRgb(170,170, 80),; // Color Borde superior nRgb(130,130, 65),; // Color de Relleno nRgb(100,100, 50),; // Color Borde inferior ::aColorCuerpo[2],; // Color Letra ::aColorCuerpo[2] } // Color relleno cuando se selecciona. ::aColorDomingo := ::aColorTitulo ::aColorFestivo := ::aColorTitulo ::nPosicion := day(::dFechaControl) ::FijaClrs() ::FijaClrDomingo() ::FijaClrFestivo() ::nStyle := nOr(WS_CHILD, WS_VISIBLE, WS_TABSTOP) ::Register() If !Empty( oWnd:hWnd ) ::Create() oWnd:AddControl( Self ) Else oWnd:DefControl( Self ) Endif Return SelfMETHOD Display() CLASS TMiCalendario IF ::lContinuar ::lContinuar := .F. ::BeginPaint() ::Paint() ::EndPaint() ::lContinuar := .T. ELSE MsgInfo("Para Ccontrolar Que Nao Passe Duas Vezes") ENDIFRETURN SELFMETHOD 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 SelfSTATIC 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 NILSTATIC 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 ARETURN NILSTATIC 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") ENDIFRETURN NILSTATIC 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") ENDIFRETURN NILSTATIC 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 DERECHARETURN NILSTATIC 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 NILMETHOD 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 SelfMETHOD 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 SelfMETHOD RButtonUp( nRow, nCol, nKeyFlags ) CLASS TMiCalendario Local oMenu ::SetFocus() MENU oMenu POPUP MENUITEM ::aTitBoton[1] ACTION ::MesAnterior() MENUITEM ::aTitBoton[2] ACTION ::MesSiguinte() MENUITEM ::aTitBoton[5] ACTION ::Hoy() MENUITEM "Otro Mes" MENU MENUITEM ::aMESES[ 1] ACTION ::CambiarMes( 1 - ::nMesNumero ) MENUITEM ::aMESES[ 2] ACTION ::CambiarMes( 2 - ::nMesNumero ) MENUITEM ::aMESES[ 3] ACTION ::CambiarMes( 3 - ::nMesNumero ) MENUITEM ::aMESES[ 4] ACTION ::CambiarMes( 4 - ::nMesNumero ) MENUITEM ::aMESES[ 5] ACTION ::CambiarMes( 5 - ::nMesNumero ) MENUITEM ::aMESES[ 6] ACTION ::CambiarMes( 6 - ::nMesNumero ) MENUITEM ::aMESES[ 7] ACTION ::CambiarMes( 7 - ::nMesNumero ) MENUITEM ::aMESES[ 8] ACTION ::CambiarMes( 8 - ::nMesNumero ) MENUITEM ::aMESES[ 9] ACTION ::CambiarMes( 9 - ::nMesNumero ) MENUITEM ::aMESES[10] ACTION ::CambiarMes(10 - ::nMesNumero ) MENUITEM ::aMESES[11] ACTION ::CambiarMes(11 - ::nMesNumero ) MENUITEM ::aMESES[12] ACTION ::CambiarMes(12 - ::nMesNumero ) ENDMENU SEPARATOR MENUITEM ::aTitBoton[3] ACTION ::AnoAnterior() MENUITEM ::aTitBoton[4] ACTION ::AnoSiguiente() IF !::lMostrarBoton //Bingen MENUITEM "Mostrar Botones" ACTION ::SetSize(::nWidth(),::nheight() + ::nAltoFila, .t. ),; ::ReSize(),; ::lMostrarBoton := .T. ELSE MENUITEM "Ocultar Botones" ACTION ::SetSize(::nWidth(),::nheight() - ::nAltoFila, .t. ),; ::ReSize(),; ::lMostrarBoton := .F. ENDIF ENDMENU ACTIVATE POPUP oMenu AT nRow, nCol OF SelfRETURN SELFMETHOD lBotones( nRow, nCol) CLASS TMiCalendarioRETURN iif( (nRow > ::nFila2 .and. ; nCol > ::nCol1 .and. ; nCol <= ::nCol2), .T., .F.)METHOD lCuerpo( nRow, nCol) CLASS TMiCalendarioRETURN iif( (nRow > ::nFila1 .and.; nRow <= ::nFila2 .and.; nCol > ::nCol1 .and.; nCol <= ::nCol2), .T., .F.)METHOD Default() CLASS TMiCalendario Local B := 1 Local aPuntos[ 5]* Local aPunt := GetClientRec(::hWnd)local ofu // Estos son los datos de las columnas. ::nCol1 := 1 //Inicio Columna ::nAnchoCol := CalcularAncho(::nCol1, ::nWidth() ) //El ancho de la columna ::nCol2 := (::nAnchoCol * 7 ) + ::nCol1 //Final Columna // Estos son los datos de la fila ::nAltoFila := CalcularAlto( ::nHeight() ) //El alto de la fila. ::nFila1 := ::nAltoFila * 2 //Ubicacion primera linea a dibujar ::nFila2 := ::nAltoFila * 8 //Fila Final // Font del título 75% de la altura de la celda ::oFontMes := TFont():New( "Arial", 0, -(::nAltoFila*.75),, .t. ) //Bingen // Font de los textos de los días 50% de la altura de la celda ::oFontTXT := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen // Font para los días por defecto del 5O% de la altura de la celda ::oFont := IF(::lFont,::oFont,TFont():New( "Arial", 0, -(::nAltoFila*.50),, .t. )) //Bingen // Font para los botones 4O% de la altura de la celda ::oFontBtn := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen // Se crea matriz con los datos dia del mes. // Coordenadas filas aPuntos[ 1] := ::nFila1 + 1 aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2 FOR B = 1 TO 7 //Coordenadas columnas. aPuntos[ 2] := ::nCol1 + ( ::nAnchoCol * ( B - 1) ) + 1 aPuntos[ 4] := aPuntos[ 2] + ::nAnchoCol - 2 ::aXY[ B ] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } ::aXY[ B + 7] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } ::aXY[ B + 14] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } ::aXY[ B + 21] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } ::aXY[ B + 28] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } ::aXY[ B + 35] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } NEXT B FOR B = 1 TO 7 ::aXY[ B + 7][1] := ::aXY[ B ][1] + ::nAltoFila ::aXY[ B + 14][1] := ::aXY[ B + 7][1] + ::nAltoFila ::aXY[ B + 21][1] := ::aXY[ B + 14][1] + ::nAltoFila ::aXY[ B + 28][1] := ::aXY[ B + 21][1] + ::nAltoFila ::aXY[ B + 35][1] := ::aXY[ B + 28][1] + ::nAltoFila ::aXY[ B + 7][3] := ::aXY[ B + 7][1] + ::nAltoFila - 2 ::aXY[ B + 14][3] := ::aXY[ B + 14][1] + ::nAltoFila - 2 ::aXY[ B + 21][3] := ::aXY[ B + 21][1] + ::nAltoFila - 2 ::aXY[ B + 28][3] := ::aXY[ B + 28][1] + ::nAltoFila - 2 ::aXY[ B + 35][3] := ::aXY[ B + 35][1] + ::nAltoFila - 2 NEXT B // Se calcula el ancho de los botones. ::nAnchoBoton := int( (::nCol2 - ::nCol1) / 5) // Se crean las coordenadas del boton. aPuntos[ 1] := ::nFila2 + 1 aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2 FOR B = 1 TO 5 // Coordenadas columnas. aPuntos[ 2] := ::nCol1 + ( ::nAnchoBoton * ( B - 1) ) + 1 aPuntos[ 4] := aPuntos[ 2] + ::nAnchoBoton - 2 ::aBoton[B] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4], aPuntos[5] } NEXT B // Se fijan los datos de la fecha. ::FijarFecha( ::dFechaControl ) ::nLastDay := ::nDiaMesRETURN SELFMETHOD 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 ARETURN NILMETHOD 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 ARETURN NILMETHOD 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 ENDIFRETURN NILMETHOD ColorDia( nDia, aColores ) CLASS TMiCalendario ::aClrDias[ ::nPrimerDia + ndia - 1 ] := aColoresRETURN NILMETHOD 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 SELFMETHOD 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 - 1RETURN SELFMETHOD 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() ENDIFRETURN SelfMETHOD 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 SelfMETHOD 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 SelfMETHOD 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 endifreturn 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** ENDIFRETURN SELFMETHOD 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 SELFMETHOD 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 ) endcasereturn SELFMETHOD 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 ) endcaseRETURN SELFMETHOD IrFecha( dNvaFecha ) CLASS TMiCalendario // Se recupera identificador del boton. Local hDC := ::GetDC() Local AnchoRelleno := (::nAnchoCol * 5) - 4 // Se desmarca el dia... MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion ][ 2] ) // Se fija la fecha. ::FijarFecha( dNvaFecha ) ::nLastDay := ::nDiaMes // Se restauran los colores... ::RestaurarColor() // Se evalua bloque de codigo al cambiar de mes... IF !EMPTY( ::bCambioMes ) Eval( ::bCambioMes ) ENDIF // Se dibujan los dias. DibujaDias( hDC, ::oFont, ::aDias, ::aXY,; ::aClrDias, ::bFestivos ) // Se dibujan los titulos del mes y año. DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,; ::nAnchoCol, ::oFontMes, ::oFont, ::aColorTitulo,; xPadc(::cMesPalabra, AnchoRelleno), ::cAno, ::aDiaSemana) MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5] ) // Se libera el identificador ::ReleaseDC()RETURN NIL/*-------------------------------------------------------------------------*/METHOD Language() CLASS TMiCalendario //Bingen // Soporte multilenguaje IF ::nLanguage = L_PORTUGUES ::aMESES := { "Janeiro" , "Fevereiro", "Março" ,"Abril",; "Maio" , "Junho" , "Julho" ,"Agosto",; "Setembro" , "Outubro" , "Novembro" ,"Dezembro"} ::aDiaSemana := {"Segunda","Terça","Quarta","Quinta",; "_","Sábado","Domingo"} ::aTitBoton := {"&-Mês", "&+Mês", "< Ano", "Ano >", "Hoje"} ELSEIF ::nLanguage = L_CATALA ::aMESES := { "Gener" , "Febrer" , "Març" ,"Abril",; "Maig" , "Juny" , "Juliol" ,"Agost",; "Setembre" , "Octubre", "Novembre","Desembre"} ::aDiaSemana := {"Dilluns","Dimarts","Dimecres","Dijous",; "Divendres","Dissabte","Diumenge"} ::aTitBoton := {"&-Mes", "&+Mes", "-Any", "+Any", "Avuy"} ELSEIF ::nLanguage = L_EUSKERA ::aMESES := { "Urtarrila", "Otsaila", "Martxoa" , "Apirila",; "Maiatza" , "Ekaina" , "Uztaila" , "Abuztua",; "Iraila" , "Urria" , "Azaroa" , "Abendua"} ::aDiaSemana := {"Astelehena","Asteartea","Asteazkena","Osteguna",; "Ostirala","Larunbata","Igandea"} ::aTitBoton := {"&-Hil", "&+Hil", "-Urte", "+Urte", "Gaur"} ELSEIF ::nLanguage = L_GALEGO ::aMESES := { "Xaneiro" , "Febreiro", "Marzal" ,"Abril",; "Maio" , "Xuño" , "Xulio" ,"Agosto",; "Septembro" , "Octubro" , "Novembro" ,"Decembro"} ::aDiaSemana := {"Luns","Martes","Mércores","Xoves",; "Venres","Sabado","Domingo"} ::aTitBoton := {"&-Mes", "&+Mes", "< Año", "Año >", "Hoxe"} ELSEIF ::nLanguage = L_SPANISH ::aMESES := { "Enero" , "Febrero", "Marzo" ,"Abril",; "Mayo" , "Junio" , "Julio" ,"Agosto",; "Septiembre", "Octubre", "Noviembre","Diciembre"} ::aDiaSemana := {"Lunes","Martes","Miercoles","Jueves",; "Viernes","Sabado","Domingo"} ::aTitBoton := {"&-Mes", "&+Mes", "-Año", "+Año", "Hoy"} ELSEIF ::nLanguage = L_ITALIANO ::aMESES := { "Gennaio" , "Febbraio" , "Marzo" ,"Aprile",; "Maggio" , "Giugno" , "Luglio" ,"Agosto",; "Settembre" , "Ottobre" , "Novembre" ,"Dicembre"} ::aDiaSemana := {"Lunedi","Martedi","Mercoledi","Giovedi",; "Venerdi","Sabato","Domenica"} ::aTitBoton := {"&-Mese", "&+Mese", "-Anno", "+Anno", "Oggi"} ELSEIF ::nLanguage = L_ENGLISH ::aMESES := { "Jannuary" , "February" , "March" ,"April",; "May" , "June" , "July" ,"August",; "September" , "October" , "November" ,"December"} ::aDiaSemana := {"Monday","Tuesday","Wednesday","Thursday",; "Friday","Saturday","Sunday"} ::aTitBoton := {"&-Month", "&+Month", "-Year", "+Year", "Today"} ELSEIF ::nLanguage = L_FRANCAIS ::aMESES := { "Janvier" , "Février" , "Mars" ,"Avril",; "Mai" , "Juin" , "Juillet" ,"Août",; "Septembre" , "Octobre" , "Novembre" ,"Decembre"} ::aDiaSemana := {"Lundi","Mardi","Mercredi","Jeudi",; "Vendredi","Samedi","Dimanche"} ::aTitBoton := {"&-Mois", "&+Mois", "-An", "+An", "Auj'hui"} ELSEIF ::nLanguage = L_DEUSTCH ::aMESES := { "Januar" , "Februar" , "März" ,"April",; "Mai" , "Juni" , "Juli" ,"August",; "September" , "Oktober" , "November" ,"Dezember"} ::aDiaSemana := {"Montag","Dienstag","Mittwoch","Donnerstag",; "Freitag","Samstag","Sonntag"} ::aTitBoton := {"&-Monat", "&+Monat", "-Jahr", "+Jahr", "Heute"} ENDIF// Para realimentar los datos fechas con los nuevos valores. ::FijarFecha( ::dFechaControl )RETURN NILSTATIC FUNCTION CalcularAncho( nEspacioIzq,nWidth ) Local nColumnaAncho nColumnaAncho := int( ( nWidth - nEspacioIzq ) / 7)RETURN nColumnaAnchoSTATIC FUNCTION CalcularAlto( nHeight ) Local nFilaAlto nFilaAlto := int(( nHeight - 1) / 8)RETURN nFilaAltoSTATIC 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") ENDIFRETURN NILSTATIC 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 ENDIFRETURN FraseNumero Saludos / Regards,
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
Re: problema con SetFont
Parte 1
Code: Select all | Expand
// -----------------------------------------------------------------------CLASS TMiCalendario FROM TControl// ----------------------------------------------------------------------- DATA lContinuar AS LOGICAL INIT .T. DATA lConFoco AS LOGICAL INIT .T. DATA oFont DATA lFont AS LOGICAL INIT .F. DATA oFontMes DATA oFontTxt DATA oFontBtn DATA nPosFila // la posicion de la fila DATA nPosCol // la posicion de la columna DATA nPosBoton // la columna del boton. DATA aDiaSemana AS ARRAY INIT ARRAY( 7) DATA aXY AS ARRAY INIT ARRAY(42) DATA aBoton AS ARRAY INIT ARRAY( 5) DATA aDias AS ARRAY INIT ARRAY(42) DATA aClrDias AS ARRAY INIT ARRAY(42) DATA aColorCuerpo AS ARRAY DATA aColorTitulo AS ARRAY DATA aColorBoton AS ARRAY DATA aColorDomingo AS ARRAY DATA aColorFestivo AS ARRAY // Tinha o Erro de GPF aqui, quando usava READONLY DATA aFestivos AS ARRAY INIT ARRAY(12) //READONLY gerava erro DATA nAltoFila DATA nAnchoCol DATA nAnchoBoton DATA aTitBoton DATA nFila1 DATA nFila2 DATA nCol1 DATA nCol2 DATA nPrimerDia AS NUMERIC INIT 1 DATA nUltimoDia AS NUMERIC INIT 42 DATA lSelectOK AS LOGICAL INIT .T. DATA bCambioMes //Block a ejecutar cuando cambie el mes... DATA bFestivos //Bingen DATA nLanguage //Bingen DATA aMeses AS ARRAY INIT ARRAY(12) //Bingen DATA nLastDay AS NUMERIC INIT 1 // Datos relacionados con la fecha seleccionada. DATA dFechaControl DATA nMesNumero READONLY DATA cMesNumero READONLY DATA cMesPalabra READONLY DATA nDiaSemana READONLY DATA cDiaSemana READONLY DATA cDiaPalabra READONLY DATA nDiaMes READONLY DATA cDiaMes READONLY DATA cDiaMesPalabra READONLY DATA nAno READONLY DATA cAno READONLY DATA cAnoPalabra READONLY DATA aFecha AS ARRAY INIT ARRAY(2) READONLY DATA aVencto AS ARRAY INIT ARRAY(8) READONLY// aFecha, es un array con formatos de fecha// aVencto, es un array con las fechas de vencimiento 15,30,45,60 dias... // DATAS para reasignar teclas de navegacion. DATA nK_AnoAdelenta AS NUMERIC INIT VK_NEXT DATA nK_AnoAtras AS NUMERIC INIT VK_PRIOR DATA nK_MesAdelenta AS NUMERIC INIT K_MAS DATA nK_MesAtras AS NUMERIC INIT K_MENOS DATA nK_Menu AS NUMERIC INIT K_DIVISION DATA nK_Hoy AS NUMERIC INIT K_HOY DATA nPosicion DATA lTodoseCalculo AS LOGICAL INIT .F. DATA lProcesarTecla AS LOGICAL INIT .T. DATA lMostrarBoton AS LOGICAL INIT .T. CLASSDATA lRegistered AS LOGICAL METHOD New( ) CONSTRUCTOR //Bingen METHOD Display() METHOD Paint() METHOD Language() //Bingen METHOD LButtonDown( nRow, nCol, nFlags ) METHOD LButtonUp( nRow, nCol ) METHOD RButtonUp( nRow, nCol, nKeyFlags ) METHOD FijarFecha( dFecha ) METHOD CalcularDias( dFecha ) METHOD FijaClrs() METHOD FijaClrDomingo() METHOD FijaClrFestivo() METHOD RestaurarColor() INLINE ::FijaClrs(), ::FijaClrDomingo(), ::FijaClrFestivo() METHOD ColorDia( nDia, aColores ) METHOD Default() METHOD Destroy() METHOD MouseMove( nRow, nCol, nKeyFlags ) METHOD GetDlgCode( nLastKey ) METHOD VerAlSalir() METHOD VerAlEntrar() METHOD PintarBoton(hDC, nColor, nRow, nCol) METHOD KeyChar( nKey, nFlags ) METHOD KeyDown( nKey, nFlags ) // Estos metodos devuelven verdadero o falso segun se encuentren // dentro del cuerpo del calendario o en el area de botones. METHOD lCuerpo( nRow, nCol) METHOD lBotones( nRow, nCol) // Metodos para moverse entre los meses METHOD CambiarMes(nMeses, lProcesar) METHOD MesSiguinte() INLINE ::CambiarMes( 1) METHOD MesAnterior() INLINE ::CambiarMes( -1) METHOD AnoSiguiente() INLINE ::CambiarMes( 12) METHOD AnoAnterior() INLINE ::CambiarMes(-12) METHOD Hoy() INLINE ::IrFecha( Date() ) METHOD IrFecha( dNvaFecha ) // Metodos para tomar y dejar el foco. METHOD LostFocus( hCtlFocus ) INLINE ::Super:LostFocus( hCtlFocus ), ::VerAlSalir() METHOD GotFocus() INLINE ::setfocus(), ::VerAlEntrar() ENDCLASS METHOD New (nTop, nLeft, nWidth, nHeight, oWnd, oFont, nLANGUAGE ) CLASS TMiCalendario DEFAULT nTop:=5, nLeft:=5,nWidth:=120,nHeight:=120 //Bingen DEFAULT nLanguage := L_SPANISH // Coordenadas de la region de dibujo. ::nTop := nTop ::nLeft := nLeft ::nBottom := ::nTop + nHeight ::nRight := ::nLeft + nWidth ::dFechaControl := Date() ::bFestivos := {|| ARRAY(0) } //Bingen ::nLanguage := nLanguage //Bingen ::Language() //Bingen // Array con dias festivos... ::aFestivos := { {}, {}, {},; {}, {}, {},; {}, {}, {},; {}, {}, {} } ::oWnd := oWnd //::oFont := oFont //ojo ::SetFont( oFont ) // sigue fallando ::lFont := !oFONT=Nil ::nPosFila := 1 ::nPosCol := 1 ::nPosBoton := 1 ::aColorCuerpo := { nRgb(235,235,210),; // Color Borde superior nRgb(205,205,155),; // Color de Relleno nRgb(150,150, 75),; // Color Borde inferior nRgb( 0, 0, 0),; // Color del texto, nRgb(130,130, 65)} // Color dia seleccionado al perder el foco ::aColorTitulo := { nRgb(170,170, 80),; // Color Borde superior nRgb(130,130, 65),; // Color de Relleno nRgb(100,100, 50),; // Color Borde inferior ::aColorCuerpo[2],; // Color Letra mes y año nRgb(255,255,255) } // Color de los dias. ::aColorBoton := { nRgb(170,170, 80),; // Color Borde superior nRgb(130,130, 65),; // Color de Relleno nRgb(100,100, 50),; // Color Borde inferior ::aColorCuerpo[2],; // Color Letra ::aColorCuerpo[2] } // Color relleno cuando se selecciona. ::aColorDomingo := ::aColorTitulo ::aColorFestivo := ::aColorTitulo ::nPosicion := day(::dFechaControl) ::FijaClrs() ::FijaClrDomingo() ::FijaClrFestivo() ::nStyle := nOr(WS_CHILD, WS_VISIBLE, WS_TABSTOP) ::Register() If !Empty( oWnd:hWnd ) ::Create() oWnd:AddControl( Self ) Else oWnd:DefControl( Self ) Endif Return SelfMETHOD Display() CLASS TMiCalendario IF ::lContinuar ::lContinuar := .F. ::BeginPaint() ::Paint() ::EndPaint() ::lContinuar := .T. ELSE MsgInfo("Para Ccontrolar Que Nao Passe Duas Vezes") ENDIFRETURN SELFMETHOD 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 SelfSTATIC 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 NILSTATIC 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 ARETURN NILSTATIC 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") ENDIFRETURN NILSTATIC 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") ENDIFRETURN NIL Saludos / Regards,
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
Re: problema con SetFont
Parte 2
Code: Select all | Expand
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 DERECHARETURN NILSTATIC 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 NILMETHOD 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 SelfMETHOD 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 SelfMETHOD RButtonUp( nRow, nCol, nKeyFlags ) CLASS TMiCalendario Local oMenu ::SetFocus() MENU oMenu POPUP MENUITEM ::aTitBoton[1] ACTION ::MesAnterior() MENUITEM ::aTitBoton[2] ACTION ::MesSiguinte() MENUITEM ::aTitBoton[5] ACTION ::Hoy() MENUITEM "Otro Mes" MENU MENUITEM ::aMESES[ 1] ACTION ::CambiarMes( 1 - ::nMesNumero ) MENUITEM ::aMESES[ 2] ACTION ::CambiarMes( 2 - ::nMesNumero ) MENUITEM ::aMESES[ 3] ACTION ::CambiarMes( 3 - ::nMesNumero ) MENUITEM ::aMESES[ 4] ACTION ::CambiarMes( 4 - ::nMesNumero ) MENUITEM ::aMESES[ 5] ACTION ::CambiarMes( 5 - ::nMesNumero ) MENUITEM ::aMESES[ 6] ACTION ::CambiarMes( 6 - ::nMesNumero ) MENUITEM ::aMESES[ 7] ACTION ::CambiarMes( 7 - ::nMesNumero ) MENUITEM ::aMESES[ 8] ACTION ::CambiarMes( 8 - ::nMesNumero ) MENUITEM ::aMESES[ 9] ACTION ::CambiarMes( 9 - ::nMesNumero ) MENUITEM ::aMESES[10] ACTION ::CambiarMes(10 - ::nMesNumero ) MENUITEM ::aMESES[11] ACTION ::CambiarMes(11 - ::nMesNumero ) MENUITEM ::aMESES[12] ACTION ::CambiarMes(12 - ::nMesNumero ) ENDMENU SEPARATOR MENUITEM ::aTitBoton[3] ACTION ::AnoAnterior() MENUITEM ::aTitBoton[4] ACTION ::AnoSiguiente() IF !::lMostrarBoton //Bingen MENUITEM "Mostrar Botones" ACTION ::SetSize(::nWidth(),::nheight() + ::nAltoFila, .t. ),; ::ReSize(),; ::lMostrarBoton := .T. ELSE MENUITEM "Ocultar Botones" ACTION ::SetSize(::nWidth(),::nheight() - ::nAltoFila, .t. ),; ::ReSize(),; ::lMostrarBoton := .F. ENDIF ENDMENU ACTIVATE POPUP oMenu AT nRow, nCol OF SelfRETURN SELFMETHOD lBotones( nRow, nCol) CLASS TMiCalendarioRETURN iif( (nRow > ::nFila2 .and. ; nCol > ::nCol1 .and. ; nCol <= ::nCol2), .T., .F.)METHOD lCuerpo( nRow, nCol) CLASS TMiCalendarioRETURN iif( (nRow > ::nFila1 .and.; nRow <= ::nFila2 .and.; nCol > ::nCol1 .and.; nCol <= ::nCol2), .T., .F.)METHOD Default() CLASS TMiCalendario Local B := 1 Local aPuntos[ 5]* Local aPunt := GetClientRec(::hWnd)local ofu // Estos son los datos de las columnas. ::nCol1 := 1 //Inicio Columna ::nAnchoCol := CalcularAncho(::nCol1, ::nWidth() ) //El ancho de la columna ::nCol2 := (::nAnchoCol * 7 ) + ::nCol1 //Final Columna // Estos son los datos de la fila ::nAltoFila := CalcularAlto( ::nHeight() ) //El alto de la fila. ::nFila1 := ::nAltoFila * 2 //Ubicacion primera linea a dibujar ::nFila2 := ::nAltoFila * 8 //Fila Final // Font del título 75% de la altura de la celda ::oFontMes := TFont():New( "Arial", 0, -(::nAltoFila*.75),, .t. ) //Bingen // Font de los textos de los días 50% de la altura de la celda ::oFontTXT := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen // Font para los días por defecto del 5O% de la altura de la celda ::oFont := IF(::lFont,::oFont,TFont():New( "Arial", 0, -(::nAltoFila*.50),, .t. )) //Bingen // Font para los botones 4O% de la altura de la celda ::oFontBtn := TFont():New( "Arial", 0, -(::nAltoFila*.40),, .t. ) //Bingen // Se crea matriz con los datos dia del mes. // Coordenadas filas aPuntos[ 1] := ::nFila1 + 1 aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2 FOR B = 1 TO 7 //Coordenadas columnas. aPuntos[ 2] := ::nCol1 + ( ::nAnchoCol * ( B - 1) ) + 1 aPuntos[ 4] := aPuntos[ 2] + ::nAnchoCol - 2 ::aXY[ B ] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } ::aXY[ B + 7] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } ::aXY[ B + 14] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } ::aXY[ B + 21] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } ::aXY[ B + 28] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } ::aXY[ B + 35] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4] } NEXT B FOR B = 1 TO 7 ::aXY[ B + 7][1] := ::aXY[ B ][1] + ::nAltoFila ::aXY[ B + 14][1] := ::aXY[ B + 7][1] + ::nAltoFila ::aXY[ B + 21][1] := ::aXY[ B + 14][1] + ::nAltoFila ::aXY[ B + 28][1] := ::aXY[ B + 21][1] + ::nAltoFila ::aXY[ B + 35][1] := ::aXY[ B + 28][1] + ::nAltoFila ::aXY[ B + 7][3] := ::aXY[ B + 7][1] + ::nAltoFila - 2 ::aXY[ B + 14][3] := ::aXY[ B + 14][1] + ::nAltoFila - 2 ::aXY[ B + 21][3] := ::aXY[ B + 21][1] + ::nAltoFila - 2 ::aXY[ B + 28][3] := ::aXY[ B + 28][1] + ::nAltoFila - 2 ::aXY[ B + 35][3] := ::aXY[ B + 35][1] + ::nAltoFila - 2 NEXT B // Se calcula el ancho de los botones. ::nAnchoBoton := int( (::nCol2 - ::nCol1) / 5) // Se crean las coordenadas del boton. aPuntos[ 1] := ::nFila2 + 1 aPuntos[ 3] := aPuntos[ 1] + ::nAltoFila - 2 FOR B = 1 TO 5 // Coordenadas columnas. aPuntos[ 2] := ::nCol1 + ( ::nAnchoBoton * ( B - 1) ) + 1 aPuntos[ 4] := aPuntos[ 2] + ::nAnchoBoton - 2 ::aBoton[B] := { aPuntos[1], aPuntos[2], aPuntos[3], aPuntos[4], aPuntos[5] } NEXT B // Se fijan los datos de la fecha. ::FijarFecha( ::dFechaControl ) ::nLastDay := ::nDiaMesRETURN SELFMETHOD 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 ARETURN NILMETHOD 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 ARETURN NILMETHOD 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 ENDIFRETURN NILMETHOD ColorDia( nDia, aColores ) CLASS TMiCalendario ::aClrDias[ ::nPrimerDia + ndia - 1 ] := aColoresRETURN NILMETHOD 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 SELFMETHOD 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 - 1RETURN SELF Saludos / Regards,
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
Re: problema con SetFont
Parte 3
Code: Select all | Expand
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() ENDIFRETURN SelfMETHOD 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 SelfMETHOD 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 SelfMETHOD 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 endifreturn 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** ENDIFRETURN SELFMETHOD 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 SELFMETHOD 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 ) endcasereturn SELFMETHOD 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 ) endcaseRETURN SELFMETHOD IrFecha( dNvaFecha ) CLASS TMiCalendario // Se recupera identificador del boton. Local hDC := ::GetDC() Local AnchoRelleno := (::nAnchoCol * 5) - 4 // Se desmarca el dia... MarcarDia( hDC, ::aXY[::nPosicion], ::aClrDias[::nPosicion ][ 2] ) // Se fija la fecha. ::FijarFecha( dNvaFecha ) ::nLastDay := ::nDiaMes // Se restauran los colores... ::RestaurarColor() // Se evalua bloque de codigo al cambiar de mes... IF !EMPTY( ::bCambioMes ) Eval( ::bCambioMes ) ENDIF // Se dibujan los dias. DibujaDias( hDC, ::oFont, ::aDias, ::aXY,; ::aClrDias, ::bFestivos ) // Se dibujan los titulos del mes y año. DibujaTitulos(hDC, ::nAltoFila, ::nCol1, ::nCol2,; ::nAnchoCol, ::oFontMes, ::oFont, ::aColorTitulo,; xPadc(::cMesPalabra, AnchoRelleno), ::cAno, ::aDiaSemana) MarcarDia( hDC, ::aXY[::nPosicion], ::aColorCuerpo[5] ) // Se libera el identificador ::ReleaseDC()RETURN NIL/*-------------------------------------------------------------------------*/METHOD Language() CLASS TMiCalendario //Bingen // Soporte multilenguaje IF ::nLanguage = L_PORTUGUES ::aMESES := { "Janeiro" , "Fevereiro", "Março" ,"Abril",; "Maio" , "Junho" , "Julho" ,"Agosto",; "Setembro" , "Outubro" , "Novembro" ,"Dezembro"} ::aDiaSemana := {"Segunda","Terça","Quarta","Quinta",; "_","Sábado","Domingo"} ::aTitBoton := {"&-Mês", "&+Mês", "< Ano", "Ano >", "Hoje"} ELSEIF ::nLanguage = L_CATALA ::aMESES := { "Gener" , "Febrer" , "Març" ,"Abril",; "Maig" , "Juny" , "Juliol" ,"Agost",; "Setembre" , "Octubre", "Novembre","Desembre"} ::aDiaSemana := {"Dilluns","Dimarts","Dimecres","Dijous",; "Divendres","Dissabte","Diumenge"} ::aTitBoton := {"&-Mes", "&+Mes", "-Any", "+Any", "Avuy"} ELSEIF ::nLanguage = L_EUSKERA ::aMESES := { "Urtarrila", "Otsaila", "Martxoa" , "Apirila",; "Maiatza" , "Ekaina" , "Uztaila" , "Abuztua",; "Iraila" , "Urria" , "Azaroa" , "Abendua"} ::aDiaSemana := {"Astelehena","Asteartea","Asteazkena","Osteguna",; "Ostirala","Larunbata","Igandea"} ::aTitBoton := {"&-Hil", "&+Hil", "-Urte", "+Urte", "Gaur"} ELSEIF ::nLanguage = L_GALEGO ::aMESES := { "Xaneiro" , "Febreiro", "Marzal" ,"Abril",; "Maio" , "Xuño" , "Xulio" ,"Agosto",; "Septembro" , "Octubro" , "Novembro" ,"Decembro"} ::aDiaSemana := {"Luns","Martes","Mércores","Xoves",; "Venres","Sabado","Domingo"} ::aTitBoton := {"&-Mes", "&+Mes", "< Año", "Año >", "Hoxe"} ELSEIF ::nLanguage = L_SPANISH ::aMESES := { "Enero" , "Febrero", "Marzo" ,"Abril",; "Mayo" , "Junio" , "Julio" ,"Agosto",; "Septiembre", "Octubre", "Noviembre","Diciembre"} ::aDiaSemana := {"Lunes","Martes","Miercoles","Jueves",; "Viernes","Sabado","Domingo"} ::aTitBoton := {"&-Mes", "&+Mes", "-Año", "+Año", "Hoy"} ELSEIF ::nLanguage = L_ITALIANO ::aMESES := { "Gennaio" , "Febbraio" , "Marzo" ,"Aprile",; "Maggio" , "Giugno" , "Luglio" ,"Agosto",; "Settembre" , "Ottobre" , "Novembre" ,"Dicembre"} ::aDiaSemana := {"Lunedi","Martedi","Mercoledi","Giovedi",; "Venerdi","Sabato","Domenica"} ::aTitBoton := {"&-Mese", "&+Mese", "-Anno", "+Anno", "Oggi"} ELSEIF ::nLanguage = L_ENGLISH ::aMESES := { "Jannuary" , "February" , "March" ,"April",; "May" , "June" , "July" ,"August",; "September" , "October" , "November" ,"December"} ::aDiaSemana := {"Monday","Tuesday","Wednesday","Thursday",; "Friday","Saturday","Sunday"} ::aTitBoton := {"&-Month", "&+Month", "-Year", "+Year", "Today"} ELSEIF ::nLanguage = L_FRANCAIS ::aMESES := { "Janvier" , "Février" , "Mars" ,"Avril",; "Mai" , "Juin" , "Juillet" ,"Août",; "Septembre" , "Octobre" , "Novembre" ,"Decembre"} ::aDiaSemana := {"Lundi","Mardi","Mercredi","Jeudi",; "Vendredi","Samedi","Dimanche"} ::aTitBoton := {"&-Mois", "&+Mois", "-An", "+An", "Auj'hui"} ELSEIF ::nLanguage = L_DEUSTCH ::aMESES := { "Januar" , "Februar" , "März" ,"April",; "Mai" , "Juni" , "Juli" ,"August",; "September" , "Oktober" , "November" ,"Dezember"} ::aDiaSemana := {"Montag","Dienstag","Mittwoch","Donnerstag",; "Freitag","Samstag","Sonntag"} ::aTitBoton := {"&-Monat", "&+Monat", "-Jahr", "+Jahr", "Heute"} ENDIF// Para realimentar los datos fechas con los nuevos valores. ::FijarFecha( ::dFechaControl )RETURN NILSTATIC FUNCTION CalcularAncho( nEspacioIzq,nWidth ) Local nColumnaAncho nColumnaAncho := int( ( nWidth - nEspacioIzq ) / 7)RETURN nColumnaAnchoSTATIC FUNCTION CalcularAlto( nHeight ) Local nFilaAlto nFilaAlto := int(( nHeight - 1) / 8)RETURN nFilaAltoSTATIC 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") ENDIFRETURN NILSTATIC 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 ENDIFRETURN FraseNumero Saludos / Regards,
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
-
cnavarro
- Posts: 6572
- Joined: Wed Feb 15, 2012 8:25 pm
- Location: España
- Has thanked: 4 times
- Been thanked: 6 times
Re: problema con SetFont
Quitando un pequeño detalle de cambio en el tamaño de las letras de los dias de la semana cuando cambias de mes o de año, a mi me funciona bien
Y en el metodo Default, me he permitido hacer este cambio
Lo ideal es que para controlar la posible perdida de recursos, puedes utilizar
Y en el metodo Default, me he permitido hacer este cambio
Code: Select all | Expand
.../... if !::lFont if !Empty( ::oFont ) ::oFont:End() endif ::oFont := TFont():New( "Arial", 0, -0.50*::nAltoFila, , .t. ) // ::oFont := IF(::lFont,::oFont,TFont():New( "Arial", 0, -(::nAltoFila*.50),, .t. )) //Bingen endif.../... Lo ideal es que para controlar la posible perdida de recursos, puedes utilizar
Code: Select all | Expand
Function Main() SetResDebug( .T. ).../...//al final despues del activate, si existiera //Hb_GCall(.t.) //CLEAR MEMORY if File( "checkres.txt" ) FErase( "checkres.txt" ) endif CheckRes()return Cristobal Navarro
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
Re: problema con SetFont
Hola Cristóbal,
Muchas gracias por tu ayuda, ya funciona perfecto.
Muchas gracias por tu ayuda, ya funciona perfecto.
Saludos / Regards,
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40