|
|
|
|
Popup Calendar SourceRPGLE - Display a Pop-up Calendar 5722WDS V5R2M0 020719 SEU SOURCE LISTING 10/30/06 20:57:08 SOURCE FILE . . . . . . . DEVNSK/QRPGLESRC MEMBER . . . . . . . . . CALENDAR SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 0100 ********************************************************************** 0200 * Program Name . . . . : CALENDAR * 0300 * Description. . . . . : Program to show a pop-up Calendar * 0400 *--------------------------------------------------------------------* 0500 * Copyright (c). . . . : XxxxxxX Xxxxxxxxxxx, Xxxxxxxxx. XXXXX * 0600 *--------------------------------------------------------------------* 0700 * Files Used . . . . . : *NONE * 0800 * : * 0900 * Display Files. . . . : CALEND1 - Screen for pop-up calendar * 1000 * Printer Files. . . . : *NONE * 1100 * Programs Called. . . : *NONE * 1200 *--------------------------------------------------------------------* 1300 * Created by . . . . . : KALPESH PATADIA * 1400 * Company. . . . . . . : XxxxxxX Xxxxxxxxxxx, Xxxxxxxxx. XXXXX * 1500 * Date . . . . . . . . : October 27, 2006 * 1600 * Purpose. . . . . . . : To Show a Pop-up Calendar with previous * 1700 * : and future dates as well. (Display Only) * 1800 *--------------------------------------------------------------------* 1900 ********************************************************************** 2000 HOPTION(*NODEBUGIO) 2100 ********************************************************************** 2200 F* Files Used 2300 FCALEND1 CF E WORKSTN 2301 ********************************************************************** 2302 D* Store Month Names 2303 DM@NAM S 9 DIM(12) CTDATA PERRCD(1) 2400 *--------------------------------------------------------------------* 2401 D* Store No of Days in a Month 2402 DD@AYS S 2 0 DIM(12) CTDATA PERRCD(12) 2403 *--------------------------------------------------------------------* 2404 D* Store the Dates for each day 2405 DD@ATE S 2 0 DIM(42) 2406 *--------------------------------------------------------------------* 2407 D* Store the Current Date 2408 D@CURDAT S D INZ(*SYS) DATFMT(*ISO) 2409 D@CURYER S 4 0 INZ(*ZEROS) 2410 D@CURMTH S 2 0 INZ(*ZEROS) 2411 D@CURDAY S 2 0 INZ(*ZEROS) 2412 *--------------------------------------------------------------------* 2413 D* Display Attributes of each day 2414 D@DSPATR DS 2415 D @DAY01 1 INZ(@NORML) 2416 D @DAY02 1 INZ(@NORML) 2417 D @DAY03 1 INZ(@NORML) 2418 D @DAY04 1 INZ(@NORML) 2419 D @DAY05 1 INZ(@NORML) 2420 D @DAY06 1 INZ(@NORML) 2421 D @DAY07 1 INZ(@NORML) 2422 D @DAY08 1 INZ(@NORML) 2423 D @DAY09 1 INZ(@NORML) 2424 D @DAY10 1 INZ(@NORML) 2425 D @DAY11 1 INZ(@NORML) 2426 D @DAY12 1 INZ(@NORML) 2427 D @DAY13 1 INZ(@NORML) 2428 D @DAY14 1 INZ(@NORML) 2429 D @DAY15 1 INZ(@NORML) 2430 D @DAY16 1 INZ(@NORML) 2431 D @DAY17 1 INZ(@NORML) 2432 D @DAY18 1 INZ(@NORML) 2433 D @DAY19 1 INZ(@NORML) 2434 D @DAY20 1 INZ(@NORML) 2435 D @DAY21 1 INZ(@NORML) 2436 D @DAY22 1 INZ(@NORML) 2437 D @DAY23 1 INZ(@NORML) 2438 D @DAY24 1 INZ(@NORML) 2439 D @DAY25 1 INZ(@NORML) 2440 D @DAY26 1 INZ(@NORML) 2441 D @DAY27 1 INZ(@NORML) 2442 D @DAY28 1 INZ(@NORML) 2443 D @DAY29 1 INZ(@NORML) 2444 D @DAY30 1 INZ(@NORML) 2445 D @DAY31 1 INZ(@NORML) 2446 D @DAY32 1 INZ(@NORML) 2447 D @DAY33 1 INZ(@NORML) 2448 D @DAY34 1 INZ(@NORML) 2449 D @DAY35 1 INZ(@NORML) 2450 D @DAY36 1 INZ(@NORML) 2451 D @DAY37 1 INZ(@NORML) 2452 D @DAY38 1 INZ(@NORML) 2453 D @DAY39 1 INZ(@NORML) 2454 D @DAY40 1 INZ(@NORML) 2455 D @DAY41 1 INZ(@NORML) 2456 D @DAY42 1 INZ(@NORML) 2457 D @DYATR 1 DIM(42) OVERLAY(@DSPATR) 2458 *--------------------------------------------------------------------* 2459 D* Display Attributes in the Screen 2460 D @NORML C CONST(x'20') 2461 D @RVIMG C CONST(x'21') 2462 *--------------------------------------------------------------------* 2500 D* Program Variables 2501 D@STRTDT DS 2503 D@STRYER 1 4 0 INZ(*ZEROS) 2504 D@STRMTH 5 6 0 INZ(*ZEROS) 2505 D@STRDAY 7 8 0 INZ(*ZEROS) 2506 D@STRDT1 1 8 0 INZ(*ZEROS) 2507 *--------------------------------------------------------------------* 2508 D* Program Variables 2509 D@STRDAT S D DATFMT(*ISO) 2510 D@BEGDAT S D DATFMT(*ISO) INZ(D'1905-12-31') 2511 D@DATE S 2 0 INZ(*ZEROS) 2512 D@TMPVR1 S 2 0 INZ(*ZEROS) 2513 D@TMPVR2 S 4 0 INZ(*ZEROS) 2514 D@TMPVR3 S 6 0 INZ(*ZEROS) 2600 ********************************************************************** 2700 C* MAIN LINE 2800 ********************************************************************** 2900 C EXSR SUBINIT 3000 C EXSR SUBPROC 3100 C EXSR SUBTERM 3200 ********************************************************************** 3201 C* Main Process Routine 3300 *--------------------------------------------------------------------* 3301 C SUBPROC BEGSR 3302 C* 3303 C DOW *IN03 = *OFF 3304 C* 3305 C EVAL #MTHNAM = M@NAM(@STRMTH) 3306 C EVAL #YERNUM = @STRYER 3307 C* Retrieve the 1st day of the Week 3308 C @STRDAT SUBDUR @BEGDAT @TMPVR3:*D 3309 C EVAL @TMPVR2 = %REM(@TMPVR3:7) 3310 C EVAL @TMPVR2 = @TMPVR2 + 1 3311 C* Store the Dates in the calendar 3312 C 01 DO D@AYS(@STRMTH)@DATE 3313 C EVAL D@ATE(@TMPVR2) = @DATE 3314 C EVAL @TMPVR2 = @TMPVR2 + 1 3315 C ENDDO 3316 C* Fill Dates for Display 3317 C EVAL #DAY01 = D@ATE(01) 3318 C EVAL #DAY02 = D@ATE(02) 3319 C EVAL #DAY03 = D@ATE(03) 3320 C EVAL #DAY04 = D@ATE(04) 3321 C EVAL #DAY05 = D@ATE(05) 3322 C EVAL #DAY06 = D@ATE(06) 3323 C EVAL #DAY07 = D@ATE(07) 3324 C EVAL #DAY08 = D@ATE(08) 3325 C EVAL #DAY09 = D@ATE(09) 3326 C EVAL #DAY10 = D@ATE(10) 3327 C EVAL #DAY11 = D@ATE(11) 3328 C EVAL #DAY12 = D@ATE(12) 3329 C EVAL #DAY13 = D@ATE(13) 3330 C EVAL #DAY14 = D@ATE(14) 3331 C EVAL #DAY15 = D@ATE(15) 3332 C EVAL #DAY16 = D@ATE(16) 3333 C EVAL #DAY17 = D@ATE(17) 3334 C EVAL #DAY18 = D@ATE(18) 3335 C EVAL #DAY19 = D@ATE(19) 3336 C EVAL #DAY20 = D@ATE(20) 3337 C EVAL #DAY21 = D@ATE(21) 3338 C EVAL #DAY22 = D@ATE(22) 3339 C EVAL #DAY23 = D@ATE(23) 3340 C EVAL #DAY24 = D@ATE(24) 3341 C EVAL #DAY25 = D@ATE(25) 3342 C EVAL #DAY26 = D@ATE(26) 3343 C EVAL #DAY27 = D@ATE(27) 3344 C EVAL #DAY28 = D@ATE(28) 3345 C EVAL #DAY29 = D@ATE(29) 3346 C EVAL #DAY30 = D@ATE(30) 3347 C EVAL #DAY31 = D@ATE(31) 3348 C EVAL #DAY32 = D@ATE(32) 3349 C EVAL #DAY33 = D@ATE(33) 3350 C EVAL #DAY34 = D@ATE(34) 3351 C EVAL #DAY35 = D@ATE(35) 3352 C EVAL #DAY36 = D@ATE(36) 3353 C EVAL #DAY37 = D@ATE(37) 3354 C EVAL #DAY38 = D@ATE(38) 3355 C EVAL #DAY39 = D@ATE(39) 3356 C EVAL #DAY40 = D@ATE(40) 3357 C EVAL #DAY41 = D@ATE(41) 3358 C EVAL #DAY42 = D@ATE(42) 3359 C* Display the Calendar 3360 C* (Mark the current date) 3361 C EVAL @TMPVR1 = %LOOKUP(@CURDAY:D@ATE) 3362 C IF @TMPVR1 > *ZEROS 3363 C EVAL @DYATR(@TMPVR1) = @RVIMG 3364 C ELSE 3365 C EVAL @DYATR(@TMPVR2 - 1) = @RVIMG 3366 C ENDIF 3367 C EXFMT CALENDAR 3368 C* 3369 C SELECT 3370 C WHEN *IN03 = *ON 3371 C LEAVE 3372 C* On Page Up - Previous Month 3373 C WHEN *IN84 = *ON 3374 C CLEAR D@ATE 3375 C CLEAR @DYATR 3376 C EVAL @STRMTH = @STRMTH - 1 3377 C IF @STRMTH <= 0 3378 C EVAL @STRMTH = 12 3379 C EVAL @STRYER = @STRYER - 1 3380 C ENDIF 3381 C EVAL @STRDAY = 01 3385 C MOVEL @STRDT1 @STRDAT 3386 C EXSR SUBLPYR 3387 C EVAL *IN84 = *OFF 3388 C* On Page Down - Next Month 3389 C WHEN *IN85 = *ON 3391 C CLEAR D@ATE 3392 C CLEAR @DYATR 3393 C EVAL @STRMTH = @STRMTH + 1 3394 C IF @STRMTH > 12 3395 C EVAL @STRMTH = 1 3396 C EVAL @STRYER = @STRYER + 1 3397 C ENDIF 3398 C EVAL @STRDAY = 01 3400 C MOVEL @STRDT1 @STRDAT 3401 C EXSR SUBLPYR 3402 C EVAL *IN85 = *OFF 3403 C ENDSL 3404 C* 3405 C ENDDO 3406 C* 3407 C ENDPROC ENDSR 3408 *--------------------------------------------------------------------* 3409 C* Check for Leap Year 3410 *--------------------------------------------------------------------* 3411 C SUBLPYR BEGSR 3412 C* 3413 C N84 3414 CANN85 MOVEL *YEAR @STRYER 3415 C EVAL @TMPVR2 = %REM(@STRYER:4) 3416 C IF @TMPVR2 = *ZEROS 3417 C EVAL D@AYS(2) = 29 3418 C ENDIF 3419 C* 3420 C ENDLPYR ENDSR 3421 *--------------------------------------------------------------------* 3422 C* Initial Routine 3423 *--------------------------------------------------------------------* 3424 C SUBINIT BEGSR 3425 C* 3426 C MOVEL *MONTH @CURMTH 3427 C Z-ADD @CURMTH @STRMTH 3428 C EXSR SUBLPYR 3429 C* Retrieve the 1st day of the Month 3430 C MOVEL *DAY @CURDAY 3431 C Z-ADD @CURDAY @STRDAY 3432 C IF @CURDAY > 1 3433 C @CURDAT SUBDUR @CURDAY:*D @STRDAT 3434 C ELSE 3435 C MOVEL @CURDAT @STRDAT 3436 C ENDIF 3437 C* 3438 C ENDINIT ENDSR 3439 *--------------------------------------------------------------------* 3500 C* Termination Routine 3600 *--------------------------------------------------------------------* 3700 C SUBTERM BEGSR 3800 C* 3801 C EVAL *INLR = *ON 3900 C* 4000 C ENDTERM ENDSR 4100 ********************************************************************** 4200 ** CTDATA M@NAM 4300 January 4400 February 4500 March 4600 April 4700 May 4800 June 4900 July 5000 August 5100 September 5200 October 5300 November 5400 December 5500 ** CTDATA D@AYS 5600 312831303130313130313031 * * * * E N D O F S O U R C E * * * * |
|
