Buenas dias les paso rutina que tengo en clipper de un colega que hace años creo referente a semanas espero les sirva de ayuda
Code: Select all
*****************************************************************************
* *
* MARTES13.PRG *
* *
* Programa que determina en a¤os, meses, d¡as, horas, minutos y segundos *
* cu nto falta para pr¢ximos MARTES y TRECE *
* *
* Angel Montesdeoca, amontes@ull.es, Diciembre 2002 *
* *
* *
* COMENTARIO: *
* *
* El programa permite determinar el tiempo que falta desde el momento *
* actual hasta el primer MARTES y TRECE. Tambi‚n, desde cualquier momen- *
* to inicial. El a¤o final de b£squeda se puede fijar por el usuario. *
* *
* Tiene otra opci¢n que permite listar todos los MARTES y TRECE, que *
* hay desde una fecha inicial hasta el a¤o que se fije, ‚ste inclusive. *
* *
* *
* EJEMPLO: *
* *
* Si se toma como fecha inicial el 14-07-2010 a las 10:26:10.79, *
* nos muestra el siguiente resultado, para el pr¢ximo MARTES 13-09-2011 *
* a las 00.00.00 horas: *
* *
* 1 a¤o, 1 mes, 29 d¡as, 13 horas, 33 minutos, 49.21 seg. *
* *
*****************************************************************************
set century on // A¤os, cuatro d¡gitos
set date italian // Formato fecha dd-mm-aaaa
MensajeS:= padc(" NO CREAS EN SUPERSTICIONES !!",74)
fecha13:="13-##-####" // Variable para la fecha MARTES Y TRECES
fecha_i:=date() // Fecha inical a partir de la que se hace la b£squeda
hora_i:= SegTime() // Hora inical a partir de la que se hace la b£squeda
year_final=2099 // A¤o hasta el que se hace la b£squeda
MMartesTrece:={} // Matriz para guardar todos los MARTES y TRECE
ope="M" // Opci¢n predeterminada (desde el [M]omento actual),
// al iniciar el programa
ColorPantalla="W/B,N/W" // Color de pantalla: Texto blanco, fondo azul
// V¡deo inverso: Texto amarillo, fondo blanco
ColorResultado="GR++/B" // Color del texto del resultado obtenido
setcolor(ColorPantalla) // Establece el color de pantalla
ventana() // Llama al procedimiento: Ventana de presentaci¢n
WHILE .T. // Bucle del que se sale, al abandonar el programa,
// pulsando Q o S o Esc
asize(mMartesTrece,0) // Borra todos los MARTES y TRECE de consulta anterior
total_a:=total_m:=total_d:=0 // Variables para los a¤os, resto de meses,
// resto de d¡as transcurridos
salir:=.f. // Variable que controla cuando se ha salido
// de los FOR ... NEXT de m s abajo, al encontrar
// el primer MARTES y TRECE
op="FMOQST" // Opciones: F, A¤o final
// M, Momento actual
// O, Otro momento inicial
// Q,S Salir del programa
// T Muestra todos los MARTES y TRECE
opcion=ope // Variable que recoge la opci¢n del ususario,
// primer vez [M]omento inicial
while .not. opcion$op // Bucle para elegir las opciones permitidas
@ 22,3 say padc("Elegir una de las opciones, letra entre [ ]",74)
@ 22,59 get opcion picture "!"
read
if lastkey() = 27 // Con Esc se sale del programa
@ 22,3 say MensajeS
@ 24,0 say ""
return
endif
@ 22,3 say padc("Esc ¢ S ¢ Q, para SALIR del programa",74)
end
do case // Gestiona la opci¢n elegida
case opcion$'QS' .or. lastkey()= 27
@ 22,3 say MensajeS
@ 24,0 say ""
return // Salir del programa
case opcion='M' // Opci¢n: Fecha y hora actual
fecha_i:=date() // Fecha inical: la de hoy
hora_i:=SegTime() // Hora inical: la de este momento
MuestrFH(6,14) // Muestra fecha y hora
case opcion$'OT' // Opci¢n: Fecha y hora puesta por el usuario
@ 7,38 get fecha_i picture "##-##-####" // Fecha inicial del usuario
@ 8,38 get hora_i picture "##:##:##.##"; // Hora inical del usuario
valid val(substr(hora_i,1,2))<=24 .and. ;
val(substr(hora_i,4,2))<=60 .and. ;
val(substr(hora_i,7))<=60
read
MuestrFH(6,38) // Muestra fecha y hora
NotaResultado(fecha13) // Informaci¢n antes del resultado
case opcion='F' // Opci¢n para poner hasta qu‚ a¤o se busca
// No permite a¤o anteriores a la actual
@ 6,63 get year_final picture "####"; // Hasta que a¤o busca MARTES y 13
valid year_final>=val(substr(dtoc(date()),7))
read
@ 6,63 say year_final // Muestra hasta qu‚ a¤os busca MARTES y TRECE
loop // Volver atr s para elegir la opci¢n de b£squeda
endcase
year_i:=val(substr(dtoc(fecha_i),7)) // Variable a¤o de comienzo
mes_i:=val(substr(dtoc(fecha_i),4,2)) // Variable mes de comienzo
dia_i:=val(substr(dtoc(fecha_i),1,2)) // Variable dia de comienzo
seg_i=86400-(val(substr(hora_i,1,2))*3600+;
val(substr(hora_i,4,2))*60+val(substr(hora_i,7)))
// Segundos que faltan para terminar el d¡a de comienzo
total_s=seg_i%60 // Resto de dividir por 60 los segundo que quedan del d¡a
total_mi=int(seg_i/60)%60 // Resto de horas (para terminar el d¡a) en minutos
total_h=int(seg_i/3600) // Horas para terminar el d¡a inicial
FOR y:=year_i TO year_final // Recorrido desde el a¤o inicial
// hasta el a¤o final
**** Resto de d¡as para termimar el mes inicial *****************+++****
* *
c_mes_sig=iif(mes_i+1<10, "0"+str(mes_i+1,1), ; //*
iif(mes_i+1=13, "01", str(mes_i+1,2))) //*
y_sig=iif(mes_i=12,year_i+1,year_i) //*
* //*
total_d=iif(dia_i>13, ; //*
ctod("01-"+c_mes_sig+"-"+str(y_sig,4))-fecha_i+11,13-dia_i-1) //*
* // D¡as para terminar el mes incial + los 12 primeros del £ltimo //+
* *
************************************************************************
mes0=iif(y=year_i,mes_i+iif(dia_i>13,1,0),1)
FOR m:= mes0 TO 12 // Recorrido desde el mes 1 al 12,
// excepto para el mes inicial
c_mes:=iif(m<10,"0"+str(m,1),str(m,2)) // _ para el mes
fecha13:=ctod("13-"+c_mes+"-"+str(y,4)) // Los dias TRECE del a¤o
if DiaSemana(fecha13)="Martes" // Si es un MARTES y TRECE
resultado:=iif(total_a<1.and.total_m<1.and.total_d<1 .and. dia_i=13,;
"E S L A F E C H A P U E S T A",;
iif(total_a>0,alltrim(str(total_a))+" a¤o"+;
iif(total_a=1,", ","s, "),"")+;
iif(total_m>0,alltrim(str(total_m,2,0))+" mes"+;
iif(total_m=1,", ","es, "),"")+;
iif(total_d>0,alltrim(str(total_d))+" d¡a"+;
iif(total_d=1,", ","s, "),"")+;
iif(total_h>0,alltrim(str(total_h))+" hora"+;
iif(total_h=1,", ","s, "),"")+;
iif(total_mi>0,alltrim(str(total_mi,2,0))+" minuto"+;
iif(total_mi=1,", ","s, "),"")+;
iif(total_s>0,alltrim(str(total_s,5,2))+" seg.","") )
@ 22,3 say padc("Preparando lista hasta "+str(year_final,4),74)
aadd(MMartesTrece,dtoc(fecha13)+" -> "+resultado)
// A¤ade los datos de los MARTES y TRECE encontrado entre los a¤os
// iniciales y finales, para usar con la opcion [T]
if opcion#'T'
NotaResultado(fecha13) // Informaci¢n antes del resultado
@ 14,3 clear to 16,76
setcolor(ColorResultado)
@ 15,3 say padc(resultado,74) // Muestra los a¤os, meses, d¡as, ...
setcolor(ColorPantalla)
m_ancho=len(alltrim(resultado))/2 // Recuadro doble para
@ 14,39-m_ancho-2 to 16,39+m_ancho+2 double // el resultado
//Hasta el primer MARTES y TRECE:
dias=fecha13-fecha_i-1+seg_i/86400 // D¡as transcurridos
semanas=dias/7 // Semanas transcurridas
horas=dias*24 // Horas trascurridas
minutos=dias*1440 // Minutos trascurridos
segundos=dias*86400 // Segundos trascurridas
@ 17,3 clear to 19,76 // Muestra los datos anteriores:
if total_a>0 .or. total_m>0 .or. total_d>0
@ 18,3 say padl(str(dias),20)+" d¡as"
@ 19,3 say padl(horas,20)+" horas"
@ 18,35 say padl(minutos,20)+" minutos"
@ 19,35 say padl(segundos,20)+" segundos"
endif
ope=" " // Cancelar la opci¢n predeterminada
salir=.t. // Salir del recorrido de los meses del a¤o,
exit // si se encontr¢ un MARTES y TRECE
endif
endif
total_m++ // Incrementar los meses en una unidad
total_a=total_a+int(total_m/12) // Incrementa a¤os transcurridos
total_m=total_m%12 // Resto de meses m¢dulo 12
NEXT // Para los meses de cada a¤o
if salir // Si se encontr¢ un MARTES y TRECE,
exit // salir del recorrido de los a¤os
endif
NEXT // Para los a¤os
if opcion='T' // Opci¢n, todos los MARTES y TRECE encontrados
@ 14,3 clear to 19,76
NotaResultado("13-##-####") // Informaci¢n antes del resultado
@ 22,3 say padc("Esc, para DEJAR EL LISTADO y elegir otra opci¢n",74)
@ 14,3 to 19,76
achoice(15,4,18,75,MMartesTrece) // Mostrar en una ventana los MARTES 13
setcolor(ColorResultado)
@ 15,4 say iif(len(MMartesTrece)=0, NoHay(fecha_i),"")
// Si NO se ha encontrado MARTES 13
setcolor(ColorPantalla)
endif
if salir=.f. .and. opcion#'T' //Si NO encuentra MARTES 13 en el resto de opc.
NotaResultado(fecha13) // Informaci¢n antes del resultado
@ 14,3 clear to 19,76
setcolor(ColorResultado)
@ 15,4 say NoHay(fecha_i)
setcolor(ColorPantalla)
endif
END
**************************************************************************
//*
PROCEDURE VENTANA // Procedimiento: Ventana de presentaci¢n //*
//*
@ 0,0 clear to 24,79 //*
@ 1,0 to 24,79 double //*
@ 3,2 to 10,77 //*
@ 2,5 say "Programa para determinar cu nto falta hasta el pr¢ximo "+; //*
"MARTES y TRECE" //*
@ 11,2 to 20,77 //*
@ 21,2 to 23,77 //*
@ 4,10 say "[M]omento actual" //*
@ 5,9 to 9,26 //*
@ 6,14 say padc(DiaSemana(fecha_i),10) //*
@ 7,14 say dtoc(date()) //*
@ 8,14 say SegTime() //*
//*
@ 4,32 say "[O]tro momento inicial" //*
@ 5,31 to 9,53 //*
@ 7,38 say "##-##-####" //*
@ 8,38 say "##:##:##.##" //*
//*
@ 4,60 say "A¤o [F]inal " //*
@ 5,59 to 7,70 //*
@ 6,63 say str(year_final,4) //*
//*
@ 8,58 say "Ver [T]odos los" //*
@ 9,59 say "MARTES y TRECE" //*
//*
//*
NotaResultado(fecha13) // Informaci¢n antes del resultado //*
//*
RETURN //*
*========== Fin de VENTANA ==========================================
**************************************************************************
FUNCTION DiaSemana(dia) //*
dd=dow(dia) //*
dd_semana:=iif(dd=1,'Domingo',iif(dd=2,'Lunes',; //*
iif(dd=3,'Martes',iif(dd=4,'Mi‚rcoles',; //*
iif(dd=5,'Jueves',iif(dd=6,'Viernes','S bado')))))) //*
RETURN dd_semana //*
//*
*======== Fin de DiaSemana ============================================
**************************************************************************
FUNCTION NoHay(fecha) //*
MensajeN:= padc("Ning£n MARTES y TRECE desde "+; //*
dtoc(fecha)+" al final del "+str(year_final,4),72) //*
RETURN MensajeN //*
//*
*======== Fin de NoHay ===============================================
**************************************************************************
FUNCTION MuestrFH(xx,yy) // Muestra fecha y hora //*
@ xx,yy say padc(DiaSemana(fecha_i),10) // Muestra: el d¡a de semana //*
@ xx+1,yy say fecha_i // la fecha actual //*
@ xx+2,yy say hora_i // la hora actual //*
RETURN //*
//*
*======== Fin de MuestraFH ===========================================
**************************************************************************
//*
FUNCTION SegTime() // Convierte los segundos trnscurridos //*
// en el d¡a en horas, minutos y segundos //*
ss=seconds() //*
s_hor=int(ss/3600) //*
s_min=int((ss%3600)/60) //*
s_seg=(ss%3600)%60 //*
hora=iif(s_hor<10,"0"+str(s_hor,1,0),str(s_hor,2,0))+":"+; //*
iif(s_min<10,"0"+str(s_min,1,0),str(s_min,2,0))+":"+; //*
iif(s_seg<10,"0"+str(s_seg,4,2),str(s_seg,5,2)) //*
//*
RETURN hora //*
*============== Fin de SegTime ===========================================
***************************************************************************
PROCEDURE NotaResultado(ff) // Infomaci¢n sobre el intervalo de b£squeda***
//*
@ 12,13 say "Tiempo que falta desde las "+ hora_i+; //*
" del "+ dtoc(fecha_i) //*
@ 13,19 say "hasta las 00:00:00 del MARTES " //*
@ 13,49 say ff //*
//*
RETURN //*
//*
*======== Fin de NotaResultado =========================================