|
|
The DDS for a Pop-up Calendar
****************************************************************
* ___ _ _ __ __ _ _ *
* | . > ___ ___ _| |_ | |_ | \ \ ___ _ _ _| |_ <_>._ _ *
* | . \/ . \/ . \ | | | . | | |<_> || '_> | | | || ' | *
* |___/\___/\___/ |_| |_|_| |_|_|_|<___||_| |_| |_||_|_| *
* *
* booth@martinvt.com *
****************************************************************
* A program to show a pop-up calendar *
* 7/02 Booth M. Rewritten 2/10 *
* (Uses mouse button click) *
*************************************************************
DSPSIZ(24 80 *DS3)
ENTFLDATR((*COLOR RED) (*DSPATR RI))
R FMT001
CA03
CA12
PAGEUP(84)
PAGEDOWN(85)
KEEP
RTNCSRLOC(&CSRRCD &CSRFLD &CSRPOS)
CSRLOC(ROW COL)
OVERLAY
WINDOW(*DFT 9 21 *NOMSGLIN)
WDWTITLE((*TEXT ' F3=Cancel,PgUp/D-
own ') *BOTTOM)
MOUBTN(*ULD ENTER)
@DAY01 1A P
@DAY02 1A P
@DAY03 1A P
@DAY04 1A P
@DAY05 1A P
@DAY06 1A P
@DAY07 1A P
@DAY08 1A P
@DAY09 1A P
@DAY10 1A P
@DAY11 1A P
@DAY12 1A P
@DAY13 1A P
@DAY14 1A P
@DAY15 1A P
@DAY16 1A P
@DAY17 1A P
@DAY18 1A P
@DAY19 1A P
@DAY20 1A P
@DAY21 1A P
@DAY22 1A P
@DAY23 1A P
@DAY24 1A P
@DAY25 1A P
@DAY26 1A P
@DAY27 1A P
@DAY28 1A P
@DAY29 1A P
@DAY30 1A P
@DAY31 1A P
@DAY32 1A P
@DAY33 1A P
@DAY34 1A P
@DAY35 1A P
@DAY36 1A P
@DAY37 1A P
@DAY38 1A P
@DAY39 1A P
@DAY40 1A P
@DAY41 1A P
@DAY42 1A P
CSRRCD 10A H
CSRFLD 10A H
CSRPOS 4S 0H
ROW 3S 0H
COL 3S 0H
MTHNAME 10A O 1 1DSPATR(HI)
CURYEAR 4S 0O 1 17DSPATR(HI)
3 2'S'
COLOR(RED)
3 5'M'
COLOR(BLU)
3 8'T'
COLOR(BLU)
3 11'W'
COLOR(BLU)
3 14'T'
COLOR(BLU)
3 17'F'
COLOR(BLU)
3 20'S'
COLOR(RED)
DAY01 2Y 0B 4 1DSPATR(&@DAY01) EDTCDE(Z)
DAY02 2Y 0B 4 4DSPATR(&@DAY02) EDTCDE(Z)
DAY03 2Y 0B 4 7DSPATR(&@DAY03) EDTCDE(Z)
DAY04 2Y 0B 4 10DSPATR(&@DAY04) EDTCDE(Z)
DAY05 2Y 0B 4 13DSPATR(&@DAY05) EDTCDE(Z)
DAY06 2Y 0B 4 16DSPATR(&@DAY06) EDTCDE(Z)
DAY07 2Y 0B 4 19DSPATR(&@DAY07) EDTCDE(Z)
DAY08 2Y 0B 5 1DSPATR(&@DAY08) EDTCDE(Z)
DAY09 2Y 0B 5 4DSPATR(&@DAY09) EDTCDE(Z)
DAY10 2Y 0B 5 7DSPATR(&@DAY10) EDTCDE(Z)
DAY11 2Y 0B 5 10DSPATR(&@DAY11) EDTCDE(Z)
DAY12 2Y 0B 5 13DSPATR(&@DAY12) EDTCDE(Z)
DAY13 2Y 0B 5 16DSPATR(&@DAY13) EDTCDE(Z)
DAY14 2Y 0B 5 19DSPATR(&@DAY14) EDTCDE(Z)
DAY15 2Y 0B 6 1DSPATR(&@DAY15) EDTCDE(Z)
DAY16 2Y 0B 6 4DSPATR(&@DAY16) EDTCDE(Z)
DAY17 2Y 0B 6 7DSPATR(&@DAY17) EDTCDE(Z)
DAY18 2Y 0B 6 10DSPATR(&@DAY18) EDTCDE(Z)
DAY19 2Y 0B 6 13DSPATR(&@DAY19) EDTCDE(Z)
DAY20 2Y 0B 6 16DSPATR(&@DAY20) EDTCDE(Z)
DAY21 2Y 0B 6 19DSPATR(&@DAY21) EDTCDE(Z)
DAY22 2Y 0B 7 1DSPATR(&@DAY22) EDTCDE(Z)
DAY23 2Y 0B 7 4DSPATR(&@DAY23) EDTCDE(Z)
DAY24 2Y 0B 7 7DSPATR(&@DAY24) EDTCDE(Z)
DAY25 2Y 0B 7 10DSPATR(&@DAY25) EDTCDE(Z)
DAY26 2Y 0B 7 13DSPATR(&@DAY26) EDTCDE(Z)
DAY27 2Y 0B 7 16DSPATR(&@DAY27) EDTCDE(Z)
DAY28 2Y 0B 7 19DSPATR(&@DAY28) EDTCDE(Z)
DAY29 2Y 0B 8 1DSPATR(&@DAY29) EDTCDE(Z)
DAY30 2Y 0B 8 4DSPATR(&@DAY30) EDTCDE(Z)
DAY31 2Y 0B 8 7DSPATR(&@DAY31) EDTCDE(Z)
DAY32 2Y 0B 8 10DSPATR(&@DAY32) EDTCDE(Z)
DAY33 2Y 0B 8 13DSPATR(&@DAY33) EDTCDE(Z)
DAY34 2Y 0B 8 16DSPATR(&@DAY34) EDTCDE(Z)
DAY35 2Y 0B 8 19DSPATR(&@DAY35) EDTCDE(Z)
DAY36 2Y 0B 9 1DSPATR(&@DAY36) EDTCDE(Z)
DAY37 2Y 0B 9 4DSPATR(&@DAY37) EDTCDE(Z)
DAY38 2Y 0B 9 7DSPATR(&@DAY38) EDTCDE(Z)
DAY39 2Y 0B 9 10DSPATR(&@DAY39) EDTCDE(Z)
DAY40 2Y 0B 9 13DSPATR(&@DAY40) EDTCDE(Z)
DAY41 2Y 0B 9 16DSPATR(&@DAY41) EDTCDE(Z)
DAY42 2Y 0B 9 19DSPATR(&@DAY42) EDTCDE(Z)
R DUMMY
KEEP
ASSUME
1 3' '
|
The RPG for the Pop-Up Calendar
//***************************************************************
// ___ _ _ __ __ _ _ *
// | . > ___ ___ _| |_ | |_ | \ \ ___ _ _ _| |_ <_>._ _ *
// | . \/ . \/ . \ | | | . | | |<_> || '_> | | | || ' | *
// |___/\___/\___/ |_| |_|_| |_|_|_|<___||_| |_| |_||_|_| *
// *
// booth@martinvt.com *
//***************************************************************
// A program to show a pop-up calendar *
// 7/02 Booth M. Rewritten 2/10 *
// *
// Notes on use: *
// 1 - This calendar also works if no parm is used. *
// 2 - The parm is defined as a date field: *
// (not numeric, not alpha, but as a date field) *
// 3 - If *loval is passed in then the calendar is set *
// at today's date. *
// 4 - When F3 or F12 is pressed the job ends with the *
// parm unchanged. *
// 5 - A mouse button click selects a date if your mouse *
// hotspots has been set: *
// for ENTER at cursor position, *
// and "nn" is unselected *
// *
// Original source came from: *
// http://www.400times.com/FrameData/Pop-up_Calendar.htm *
//************************************************************
H COPYRIGHT('(C) CopyrightBooth Martin, 2010 All rights reserved.')
H option(*nodebugio) dftactgrp(*no) actgrp(*caller)
FPC1010D cf e workstn INFDS(InFds)
d StartDate s d
d BegOfMonth s d
// Needs this date to figure first day-of-month
d firstdate s d datfmt(*iso) inz(d'1900-01-05')
d day# s 2s 0
d wNdx s 10i 0
d CurYear s 4s 0
d CurMonth s 2s 0
d CurDay s 2s 0
d InFds ds
d cursor 370 371b 0
// Array of slots on calendar (6 rows of 7 days)
d Arr s 2 0 dim(42)
// Number of days in the month:
d PdmDS ds
d 2 0 inz(31)
d 2 0 inz(28)
d 2 0 inz(31)
d 2 0 inz(30)
d 2 0 inz(31)
d 2 0 inz(30)
d 2 0 inz(31)
d 2 0 inz(31)
d 2 0 inz(30)
d 2 0 inz(31)
d 2 0 inz(30)
d 2 0 inz(31)
d 2 0 inz(01)
d pdm 2 0 dim(13) overlay(PdmDS)
d MonthNames ds
d 9 inz('January ')
d 9 inz('February ')
d 9 inz('March ')
d 9 inz('April ')
d 9 inz('May ')
d 9 inz('June ')
d 9 inz('July ')
d 9 inz('August ')
d 9 inz('September')
d 9 inz('October ')
d 9 inz('November ')
d 9 inz('December ')
d MthNam 9 dim(12) overlay(MonthNames)
d DspAtribs ds
d @DAY01 1 inz(Normal)
d @DAY02 1 inz(Normal)
d @DAY03 1 inz(Normal)
d @DAY04 1 inz(Normal)
d @DAY05 1 inz(Normal)
d @DAY06 1 inz(Normal)
d @DAY07 1 inz(Normal)
d @DAY08 1 inz(Normal)
d @DAY09 1 inz(Normal)
d @DAY10 1 inz(Normal)
d @DAY11 1 inz(Normal)
d @DAY12 1 inz(Normal)
d @DAY13 1 inz(Normal)
d @DAY14 1 inz(Normal)
d @DAY15 1 inz(Normal)
d @DAY16 1 inz(Normal)
d @DAY17 1 inz(Normal)
d @DAY18 1 inz(Normal)
d @DAY19 1 inz(Normal)
d @DAY20 1 inz(Normal)
d @DAY21 1 inz(Normal)
d @DAY22 1 inz(Normal)
d @DAY23 1 inz(Normal)
d @DAY24 1 inz(Normal)
d @DAY25 1 inz(Normal)
d @DAY26 1 inz(Normal)
d @DAY27 1 inz(Normal)
d @DAY28 1 inz(Normal)
d @DAY29 1 inz(Normal)
d @DAY30 1 inz(Normal)
d @DAY31 1 inz(Normal)
d @DAY32 1 inz(Normal)
d @DAY33 1 inz(Normal)
d @DAY34 1 inz(Normal)
d @DAY35 1 inz(Normal)
d @DAY36 1 inz(Normal)
d @DAY37 1 inz(Normal)
d @DAY38 1 inz(Normal)
d @DAY39 1 inz(Normal)
d @DAY40 1 inz(Normal)
d @DAY41 1 inz(Normal)
d @DAY42 1 inz(Normal)
d DayAtr 1 dim(42) overlay(DspAtribs)
// RI=Reverse Image, HI=Hi Intensity, BL=blink, UL=Underline
// ND=Non Display
// NON Protect fields
d Normal c const(x'20')
d RI c const(x'21')
d HI c const(x'22')
d HIRI c const(x'23')
d UL c const(x'24')
d ULRI c const(x'25')
d ULHI c const(x'26')
d ND c const(x'27')
d BL c const(x'28')
d BLRI c const(x'29')
d BLHI c const(x'2A')
d BLHIRI c const(x'2B')
d BLUL c const(x'2C')
d BLULRI c const(x'2D')
d BLULHI c const(x'2E')
// Protect field
d PRNormal c const(x'A0')
d PRRI c const(x'A1')
d PRHI c const(x'A2')
d PRHIRI c const(x'A3')
d PRUL c const(x'A4')
d PRULRI c const(x'A5')
d PRULHI c const(x'A6')
d PRND c const(x'A7')
d PRBL c const(x'A8')
d PRBLRI c const(x'A9')
d PRBLHI c const(x'AA')
d PRBLHIRI c const(x'AB')
d PRBLUL c const(x'AC')
d PRBLULRI c const(x'AD')
d PRBLULHI c const(x'AE')
d PC1010R pr
d pDate d
d PC1010R pi
d pDate d
// ===============================================================
// == Mainline ==
// ===============================================================
/free
exsr FillCalendar;
dow not *inlr;
exfmt fmt001;
select;
// Go forward one month
when *in84;
startdate = startdate + %months(1);
exsr FillCalendar;
// Go back one month
when *in85;
startdate = startdate - %months(1);
exsr FillCalendar;
// end of job - Either a command key or Enter key:
other;
exsr ExitPgm;
endsl;
enddo;
// End of routine:
exsr ExitPgm;
// ===============================================================
// == Sub Routines ==
// ===============================================================
//-------------------------------------------------------------------
//-- Initializing routine --
//-------------------------------------------------------------------
begsr *inzsr;
if (%parms = 1) and (pdate <> *loval);
StartDate = pDate;
else;
StartDate = %date();
endif;
endsr;
//-------------------------------------------------------------------
//-- Exit routine --
//-------------------------------------------------------------------
begsr ExitPgm;
if (%parms = 1) and (not *inkc) and not (*inkl);
exsr FillParm;
endif;
*inlr = *on;
endsr;
//-------------------------------------------------------------------
//-- Fill the calendar fields. --
//-------------------------------------------------------------------
begsr FillCalendar;
// Set the display attributes to normal
reset DspAtribs;
// Get fields to fill calendar
CurYear = %subdt(StartDate: *y);
CurMonth = %subdt(StartDate: *m);
CurDay = %subdt(StartDate: *d);
MTHNAME = mthnam(CurMonth);
// is this a leap year?
if %rem(CurYear: 4) = 0 and CurYear <> 2000;
pdm(2) = 29;
else;
pdm(2) = 28;
endif;
// Fill array with date numbers
clear arr;
// Find day of the week for first day on the calendar
BegOfMonth = StartDate - %days(CurDay + 1);
day# = %rem((%diff(BegOfMonth: firstdate: *days)): 7) + 1;
// Fill the calandar's 42 slots with days of the month, beginning @ day#
for wNdx = 1 to pdm(CurMonth);
arr(day#) = wNdx;
// Reverse image if current day
if CurDay = wNdx;
DayAtr(day#) = RI;
endif;
day# = day# +1;
endfor;
// Fill the screen's 42 slots from the array.
day01 = arr(01);
day02 = arr(02);
day03 = arr(03);
day04 = arr(04);
day05 = arr(05);
day06 = arr(06);
day07 = arr(07);
day08 = arr(08);
day09 = arr(09);
day10 = arr(10);
day11 = arr(11);
day12 = arr(12);
day13 = arr(13);
day14 = arr(14);
day15 = arr(15);
day16 = arr(16);
day17 = arr(17);
day18 = arr(18);
day19 = arr(19);
day20 = arr(20);
day21 = arr(21);
day22 = arr(22);
day23 = arr(23);
day24 = arr(24);
day25 = arr(25);
day26 = arr(26);
day27 = arr(27);
day28 = arr(28);
day29 = arr(29);
day30 = arr(30);
day31 = arr(31);
day32 = arr(32);
day33 = arr(33);
day34 = arr(34);
day35 = arr(35);
day36 = arr(36);
day37 = arr(37);
day38 = arr(38);
day39 = arr(39);
day40 = arr(40);
day41 = arr(41);
day42 = arr(42);
// Protect Blank fields
if day01 = *zeros;
@DAY01 = PRNormal;
endif;
if day02 = *zeros;
@DAY02 = PRNormal;
endif;
if day03 = *zeros;
@DAY03 = PRNormal;
endif;
if day04 = *zeros;
@DAY04 = PRNormal;
endif;
if day05 = *zeros;
@DAY05 = PRNormal;
endif;
if day06 = *zeros;
@DAY06 = PRNormal;
endif;
if day07 = *zeros;
@DAY07 = PRNormal;
endif;
if day29 = *zeros;
@DAY29 = PRNormal;
endif;
if day30 = *zeros;
@DAY30 = PRNormal;
endif;
if day31 = *zeros;
@DAY31 = PRNormal;
endif;
if day32 = *zeros;
@DAY32 = PRNormal;
endif;
if day33 = *zeros;
@DAY33 = PRNormal;
endif;
if day34 = *zeros;
@DAY34 = PRNormal;
endif;
if day35 = *zeros;
@DAY35 = PRNormal;
endif;
if day36 = *zeros;
@DAY36 = PRNormal;
endif;
if day37 = *zeros;
@DAY37 = PRNormal;
endif;
if day38 = *zeros;
@DAY38 = PRNormal;
endif;
if day39 = *zeros;
@DAY39 = PRNormal;
endif;
if day40 = *zeros;
@DAY40 = PRNormal;
endif;
if day41 = *zeros;
@DAY41 = PRNormal;
endif;
if day42 = *zeros;
@DAY42 = PRNormal;
endif;
endsr;
//-------------------------------------------------------------------
//-- Fill return parm --
//-------------------------------------------------------------------
begsr FillParm;
// Fill return fields
select;
when csrfld = 'DAY01';
CurDay = arr(01);
when csrfld = 'DAY02';
CurDay = arr(02);
when csrfld = 'DAY03';
CurDay = arr(03);
when csrfld = 'DAY04';
CurDay = arr(04);
when csrfld = 'DAY05';
CurDay = arr(05);
when csrfld = 'DAY06';
CurDay = arr(06);
when csrfld = 'DAY07';
CurDay = arr(07);
when csrfld = 'DAY08';
CurDay = arr(08);
when csrfld = 'DAY09';
CurDay = arr(09);
when csrfld = 'DAY10';
CurDay = arr(10);
when csrfld = 'DAY11';
CurDay = arr(11);
when csrfld = 'DAY12';
CurDay = arr(12);
when csrfld = 'DAY13';
CurDay = arr(13);
when csrfld = 'DAY14';
CurDay = arr(14);
when csrfld = 'DAY15';
CurDay = arr(15);
when csrfld = 'DAY16';
CurDay = arr(16);
when csrfld = 'DAY17';
CurDay = arr(17);
when csrfld = 'DAY18';
CurDay = arr(18);
when csrfld = 'DAY19';
CurDay = arr(19);
when csrfld = 'DAY20';
CurDay = arr(20);
when csrfld = 'DAY21';
CurDay = arr(21);
when csrfld = 'DAY22';
CurDay = arr(22);
when csrfld = 'DAY23';
CurDay = arr(23);
when csrfld = 'DAY24';
CurDay = arr(24);
when csrfld = 'DAY25';
CurDay = arr(25);
when csrfld = 'DAY26';
CurDay = arr(26);
when csrfld = 'DAY27';
CurDay = arr(27);
when csrfld = 'DAY28';
CurDay = arr(28);
when csrfld = 'DAY29';
CurDay = arr(29);
when csrfld = 'DAY30';
CurDay = arr(30);
when csrfld = 'DAY31';
CurDay = arr(31);
when csrfld = 'DAY32';
CurDay = arr(32);
when csrfld = 'DAY33';
CurDay = arr(33);
when csrfld = 'DAY34';
CurDay = arr(34);
when csrfld = 'DAY35';
CurDay = arr(35);
when csrfld = 'DAY36';
CurDay = arr(36);
when csrfld = 'DAY37';
CurDay = arr(37);
when csrfld = 'DAY38';
CurDay = arr(38);
when csrfld = 'DAY39';
CurDay = arr(39);
when csrfld = 'DAY40';
CurDay = arr(40);
when csrfld = 'DAY41';
CurDay = arr(41);
when csrfld = 'DAY42';
CurDay = arr(42);
endsl;
pDate = %date(CurYear * 10000
+ CurMonth * 100
+ CurDay: *iso);
endsr;
//-------------------------------------------------------------------
//-- End-of subroutines --
//-------------------------------------------------------------------
|
|
|
|
|
|
