A*------------------------------------------------------------------------- A* Rutina que visualiza un calendario en pantalla. A* José Coca Silva (c) A*------------------------------------------------------------------------- A DSPSIZ(24 80 *DS3) A PRINT A MSGALARM A CA03(03 'Salir') A CA12(12 'Cancelar') A*------------------------------------------------------------------------- A* No borrar la pantalla del programa llamador A*------------------------------------------------------------------------- A R IMG000 A TEXT('No borra la pantalla anterior- A ') A ASSUME A OVERLAY A 24 79' ' A*------------------------------------------------------------------------- A* Ventana para subfile A*------------------------------------------------------------------------- A R WINREF A TEXT('Ventana de referencia') A OVERLAY A PROTECT A WINDOW(&LIN &POS 10 20 *NOMSGLIN) A WDWBORDER((*COLOR BLU) (*DSPATR RI)- A (*CHAR ' ')) A WDWTITLE((*TEXT &TIT)) A LIN 3 0P A POS 3 0P A TIT 20 P A*------------------------------------------------------------------------- A* Subfile con calendario A*------------------------------------------------------------------------- A R SFL010 SFL A TEXT('Días') A D01 2 0O 3 1EDTCDE(Z) A N71 COLOR(RED) A 71 COLOR(WHT) A 71 DSPATR(HI) A D02 2 0O 3 4EDTCDE(Z) A 72 COLOR(WHT) A 72 DSPATR(HI) A D03 2 0O 3 7EDTCDE(Z) A 73 COLOR(WHT) A 73 DSPATR(HI) A D04 2 0O 3 10EDTCDE(Z) A 74 COLOR(WHT) A 74 DSPATR(HI) A D05 2 0O 3 13EDTCDE(Z) A 75 COLOR(WHT) A 75 DSPATR(HI) A D06 2 0O 3 16EDTCDE(Z) A 76 COLOR(WHT) A 76 DSPATR(HI) A D07 2 0O 3 19EDTCDE(Z) A 77 COLOR(WHT) A 77 DSPATR(HI) A*------------------------------------------------------------------------- A* Subfile con calendario A*------------------------------------------------------------------------- A R CTL010 SFLCTL(SFL010) A TEXT('Días') A ROLLDOWN(27 'Anterior') A ROLLUP(28 'Siguiente') A OVERLAY A SFLCSRRRN(&SFLCSR) A SFLMODE(&SFLMDE) A 40 SFLDSP A SFLDSPCTL A 41 SFLCLR A SFLSIZ(0006) A SFLPAG(0006) A WINDOW(WINREF) A SFLCSR 5S 0H A SFLMDE 1A H A 2 1'Do Lu Ma Mi Ju Vi Sa' A DSPATR(HI) A 1 1'Año:' A PAÑO 4Y 0B 1 6EDTCDE(Z) A DSPATR(UL) A COMP(GT 1900) A CHANGE(25 'Cambio') A 1 14'Mes:' A PMES 2Y 0B 1 19EDTCDE(Z) A DSPATR(UL) A RANGE(1 12) A CHANGE(25) A*------------------------------------------------------------------------- A* Visualiza mandatos y mensajes en ventana A*------------------------------------------------------------------------- A R MSG010 A WINDOW(WINREF) A TEXT('Mensajes') A WINMS1 20A O 9 1COLOR(BLU) A WINMS2 20A O 10 1COLOR(BLU) A*------------------------------------------------------------------------- Código RPG: *--------------------------------------------------------------------------------------------- * JCR0081 * Rutina que visualiza una ventana con un mes calendario para poder consultar y/o * seleccionar una fecha determinada. * Autor: José Coca Silva (C) * Fecha: 11-Sep-2003 *--------------------------------------------------------------------------------------------- * Se puede cambiar el array definido e inicializado en el programa para identificar los * días feriados de cada país, el modelo inicial define los feriados para Perú. *--------------------------------------------------------------------------------------------- H DatFmt(*ISO) DatEdit(*YMD) Debug FJCD0081 CF E WorkStn SFile(sfl010:nRegSfl) InfDs(dsf081) *------------------------------------------------------------------------- D dsf081 DS D Device 197 206 Device name D LstFmt 261 270 Last format displaye D CurPos 370 371B 0 Cursor position * D SDS D PgmNom *PROC D UsrPrf 254 263 * Subfile D DS Inz D Calendario 2 0 DIM(07) D d01 1 2 0 Domingo D d02 3 4 0 Lunes D d03 5 6 0 Martes D d04 7 8 0 Miércoles D d05 9 10 0 Jueves D d06 11 12 0 Viernes D d07 13 14 0 Sábado * Fecha actual D DS Inz D nFecCal 1 8 0 D nAÑoCal 1 4 0 D nMesCal 5 6 0 D nDiaCal 7 8 0 D nPerAct 1 6 0 Período actual * Búsqueda de días feriados D DS Inz D xDiaFer 1 4 D nMesFer 1 2 0 Mes D nDiaFer 3 4 0 Día * Período anterior D DS Inz D nPerAnt 1 6 0 D nAÑoAnt 1 4 0 D nMesAnt 5 6 0 * Arrays D aTabFer S 4 Dim(09) CtData PerRcd(1) Feriados * Variables D nCol S 3 0 Inz Columna D nDiaMes S 2 0 Inz Día actual D nDiaSem S 2 0 Inz Día de la semana D dFecCal S D Inz(*SYS) Fecha para cálculos D nFinMes S 2 0 Inz Ultimo día del mes D nLin S 3 0 Inz Fila D nRegSfl S 4 0 Inz Puntero subfile * Parámetros de entrada al programa D pTit S 20 Título de ventana D pFec S 8 0 Fecha a devolver D pLin S 3 0 Fila para ventana D pCol S 3 0 Columna para ventana *------------------------------------------------------------------------- * Principal *------------------------------------------------------------------------- /Free ExSr SflDsp; // Visualizar subfile Dow Not(*In03) And Not(*In12); Select; When (*In25); // Cambio de año/mes ExSr SflCam; When (*In27); // Mes anterior ExSr SflPrv; When (*In28); // Siguiente mes ExSr SflNxt; Other; ExSr SflPrc; // Intro - Seleccionar EndSl; If Not(*In03); ExSr SflDsp; // Visualizar subfile EndIf; EndDo; *InLr = *On; /End-Free *------------------------------------------------------------------------- * Cambio de año/mes *------------------------------------------------------------------------- /Free BegSr SflCam; nAÑoCal = pAÑo; nMesCal = pMes; nDiaCal = 01; ExSr SflCar; // Carga el subfile EndSr; /End-Free *------------------------------------------------------------------------- * Mes anterior *------------------------------------------------------------------------- /Free BegSr SflPrv; nMesCal = nMesCal - 1; // Mes anterior If (nMesCal < 01); nMesCal = 12; nAÑoCal = nAÑoCal - 1; EndIf; ExSr SflCar; // Carga el subfile EndSr; /End-Free *------------------------------------------------------------------------- * Siguiente mes *------------------------------------------------------------------------- /Free BegSr SflNxt; nMesCal = nMesCal + 1; If (nMesCal > 12); nMesCal = 01; nAÑoCal = nAÑoCal + 1; EndIf; ExSr SflCar; // Carga subfile EndSr; /End-Free *------------------------------------------------------------------------- * Visualiza calendario *------------------------------------------------------------------------- /Free BegSr SflDsp; *In41 = *Off; // SflClr If (nRegSfl > *Zeros); *In40 = *On; // SflDsp Else; *In40 = *Off; // SflDsp EndIf; pAÑo = nAÑoCal; pMes = nMesCal; sflmde = '1'; winms1 = 'PgUp/PgDn=Meses'; winms2 = 'F3=Salir'; Write Msg010; ExFmt Ctl010; EndSr; /End-Free *------------------------------------------------------------------------- * Carga un mes en calendario *------------------------------------------------------------------------- /Free BegSr SflCar; // Inicializa subfile: 40=SflDsp 41=SflClr *In41 = *On; Write Ctl010; *In41 = *Off; nRegSfl = *Zeros; // Calcula primer día de la semana y último día del mes actual ExSr SbrSem; Clear Calendario; // Carga el calendario For nDiaMes=1 To nFinMes; Calendario(nDiaSem) = nDiaMes; // Marca días feriados *In(70 + nDiaSem) = *Off; nMesFer = nMesCal; nDiaFer = nDiaMes; If (%LookUp(xDiaFer:aTabFer)>*Zeros); *In(70 + nDiaSem) = *On; EndIf; nDiaSem = nDiaSem + 1; // Siguiente día de la semana If (nDiaSem > 7); // Siguiente semana nRegSfl = nRegSfl + 1; Write Sfl010; nDiaSem = 01; Clear Calendario; EndIf; EndFor; If (Calendario(1)>*Zeros); // Si quedó algo por grabar en subfile nRegSfl = nRegSfl + 1; Write Sfl010; EndIf; EndSr; /End-Free *------------------------------------------------------------------------- * Intro *------------------------------------------------------------------------- /Free BegSr SflPrc; nAÑoCal = pAÑo; nMesCal = pMes; nDiaCal = 01; Chain sflcsr Sfl010; If (%Found); nLin = nRegSfl; nCol = %Rem(curpos:256)-1-pos; Select; // Domingo When (nCol>=1 And nCol<=2) And (Calendario(1)<>*Zeros); nDiaCal = Calendario(1); *In03 = *On; // Lunes When (nCol>=4 And nCol<=5) And (Calendario(2)<>*Zeros); nDiaCal = Calendario(2); *In03 = *On; // Martes When (nCol>=7 And nCol<=8) And (Calendario(3)<>*Zeros); nDiaCal = Calendario(3); *In03 = *On; // Miércoles When (nCol>=10 And nCol<=11) And (Calendario(4)<>*Zeros); nDiaCal = Calendario(4); *In03 = *On; // Jueves When (nCol>=13 And nCol<=14) And (Calendario(5)<>*Zeros); nDiaCal = Calendario(5); *In03 = *On; // Viernes When (nCol>=16 And nCol<=17) And (Calendario(6)<>*Zeros); nDiaCal = Calendario(6); *In03 = *On; // Sábado When (nCol>=19 And nCol<=20) And (Calendario(7)<>*Zeros); nDiaCal = Calendario(7); *In03 = *On; EndSl; EndIf; If Not(*In03); ExSr SflCar; Else; Eval pFec = nFecCal; EndIf; nPerAnt = nPerAct; EndSr; /End-Free *------------------------------------------------------------------------- * Calcula dia de la semana del primer día del mes *------------------------------------------------------------------------- C SbrSem BegSr * Fecha con primer día del mes C Eval nDiaCal=01 C Move nFecCal dFecCal C/Exec Sql C+ Set :nDiaSem = DayOfWeek(:dFecCal) C/End-Exec * Ultimo día del mes C Eval nMesCal=nMesCal+1 C If (nMesCal>12) B01 C Eval nMesCal=1 | C Eval nAÑoCal=nAÑoCal+1 | C EndIf E01 C Move nFecCal dFecCal C SubDur 1:*D dFecCal C Move dFecCal nFecCal C Eval nFinMes=nDiaCal * C EndSr *------------------------------------------------------------------------- * Inicialización *------------------------------------------------------------------------- C *InzSr BegSr * C *Entry PList C Parm pTit C Parm pFec C Parm pLin C Parm pCol /Free Clear pFec; lin = pLin; pos = pCol; tit = pTit; If (lin<2 Or lin>13); // Validación fila lin = 2; EndIf; If (pos<2 Or pos>56); // Validación columna pos = 2; EndIf; Write Img000; // No borra la pantalla anterior Write WinRef; // Ventana para subfile nFecCal = *Date; pAÑo = nAÑoCal; pMes = nMesCal; nPerAnt = nPerAct; // Carga un mes ExSr SflCar; /End-Free C EndSr *------------------------------------------------------------------------- ** CTDATA aTabFer 0101 0501 0728 0729 0830 1008 1101 1208 1225