Form S_169FA1 - Calendar
* ===================================================================;
*;
* Component : S_169FA1;
* Type : Form;
* Ancestor : PRIM_FORM;
* ;
* Description : Calendar Form ;
* The following RDMLX form demonstrates a VL calendar ;
*;
* Disclaimer : The following material is supplied as sample material ;
* only. No warranty concerning this material or its use ;
* in any way whatsoever is expressed or implied. ;
* ;
* ===================================================================;
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM BORDERICONS(SystemMenu) FRAMESTYLE(Dialog) HEIGHT(286) LAYOUTMANAGER(#ATLM_1) LEFT(313) TOP(119) WIDTH(299);
* Collection of buttons for the screen;
DEFINE_COM CLASS(#PRIM_KCOL) NAME(#BUTTON) COLLECTS(#PRIM_PHBN) KEYEDBY(#STD_NUM);
* Collection of flow manager to control button position;
DEFINE_COM CLASS(#PRIM_KCOL) NAME(#BUTTONMGR) COLLECTS(#PRIM_FWLI) KEYEDBY(#STD_NUM);
* Flow manager to layout the buttons;
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_1) ITEMSPERDIVISION(7) MARGINBOTTOM(2) MARGINLEFT(2) MARGINRIGHT(2) MARGINTOP(2) SPACING(1) SPACINGITEMS(1);
* Month drop down;
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#DD_MONTH) DISPLAYPOSITION(1) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(1) TOP(8) VALUE('ABCDEFGHIJ') WIDTH(169);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_2) DISPLAYPOSITION(1) PARENT(#DD_MONTH) SOURCE(#STD_OBJ) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_3) PARENT(#DD_MONTH) SOURCE(#MONTH) VISIBLE(False) WIDTH(20);
* Year drop down;
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#DD_YEAR) DISPLAYPOSITION(2) LEFT(184) PARENT(#COM_OWNER) TABPOSITION(2) TOP(8) VALUE('1234') WIDTH(97);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_1) DISPLAYPOSITION(1) PARENT(#DD_YEAR) SOURCE(#YYYY) WIDTH(20);
* Labels;
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_1) CAPTION('Sun') DISPLAYPOSITION(3) HEIGHT(17) LEFT(16) PARENT(#COM_OWNER) TABPOSITION(3) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_2) CAPTION('Mon') DISPLAYPOSITION(4) HEIGHT(16) LEFT(56) PARENT(#COM_OWNER) TABPOSITION(4) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_3) CAPTION('Tue') DISPLAYPOSITION(5) HEIGHT(16) LEFT(96) PARENT(#COM_OWNER) TABPOSITION(5) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_4) CAPTION('Wed') DISPLAYPOSITION(6) HEIGHT(16) LEFT(136) PARENT(#COM_OWNER) TABPOSITION(6) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_5) CAPTION('Thu') DISPLAYPOSITION(7) HEIGHT(16) LEFT(176) PARENT(#COM_OWNER) TABPOSITION(7) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_6) CAPTION('Fri') DISPLAYPOSITION(8) HEIGHT(17) LEFT(216) PARENT(#COM_OWNER) TABPOSITION(8) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_7) CAPTION('Sat') DISPLAYPOSITION(9) HEIGHT(16) LEFT(256) PARENT(#COM_OWNER) TABPOSITION(9) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_1);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_1) DISPLAYPOSITION(10) HEIGHT(193) LAYOUTMANAGER(#FWLM_1) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(10) TABSTOP(False) TOP(64) VISUALSTYLE(#VS_NORM) WIDTH(291);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_2) DISPLAYPOSITION(11) HEIGHT(33) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(11) TABSTOP(False) TOP(0) WIDTH(291);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_2) ATTACHMENT(Top) MANAGE(#GPBX_2) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_3) DISPLAYPOSITION(12) HEIGHT(32) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(12) TABSTOP(False) TOP(33) WIDTH(291);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_3) ATTACHMENT(Top) MANAGE(#GPBX_3) PARENT(#ATLM_1);
* Defined fields;
DEFINE FIELD(#S_169DAY1) LENGTH(2) TYPE(*DEC) DECIMALS(0) DESC('Week day of the first day of the month') ;
DEFINE FIELD(#S_169DATE) LENGTH(8) TYPE(*DEC) DECIMALS(0) DESC('Date used to check leap year') ;
DEFINE FIELD(#S_169DDW) LENGTH(2) TYPE(*CHAR) DESC('Day number (displayed on button)');
DEFINE FIELD(#S_169DD) LENGTH(2) TYPE(*DEC) DECIMALS(0) DESC('Day number');
DEFINE FIELD(#S_169YYYY) LENGTH(4) TYPE(*DEC) DECIMALS(0) ;
DEFINE FIELD(#S_169MTH) LENGTH(2) TYPE(*DEC) DECIMALS(0);
DEFINE FIELD(#S_169DOW) LENGTH(10) TYPE(*CHAR) DESC('Day of week - Monday, Tuesday...') ;
DEFINE FIELD(#S_169DMTH) LENGTH(2) TYPE(*DEC) DECIMALS(0) DESC('Day of the month');
DEFINE FIELD(#S_169DAYD) TYPE(*CHAR) LENGTH(20) DESC('(Hint) Day of week - Monday, Tuesday...') INPUT_ATR(LC);
DEFINE FIELD(#S_169DATD) TYPE(*CHAR) LENGTH(30) DESC('(Hint) Date description') INPUT_ATR(LC);
DEFINE FIELD(#S_169DAT8) REFFLD(#DDMMYYYY) DESC('Selected Date');
DEFINE #S_FORMAT *CHAR 20 DESC('Long date format');
DEFINE #S_FMT *CHAR 1 DESC('Short date format') ;
* Events;
DEFINE_EVT NAME(Date_Selected) HELP('Signalled when a date is to be passed to the parent form');
DEFINE_MAP FOR(*INPUT) CLASS(#DDMMYYYY) NAME(#O_DATE) HELP('This component will cater for both 6 digit and 8 digit date. If the input date is eight long, the returned value will also be eight long. For example, EvtRoutine Handling(#CALENDAR.Date8_Selected) O8_DATE(#X)');
;
MTHROUTINE NAME(Show_Calendar) desc('Displays calendar window') help('The calendar requires two parameters - a numeric date, and a date format. See parameter help for further details');
DEFINE_MAP FOR(*INPUT) CLASS(#DDMMYYYY) NAME(#I_DATE8) desc('Received date and format') help('Set this property to position the calendar to the required date, or leave as zero to use todays date.');
DEFINE_MAP FOR(*INPUT) CLASS(#S_FMTLONG) NAME(#I_FORMAT) help('Allowable values are: A - system format B - DDMMYY D - YYMMDD F -MMDDYY H - DDMMYYYY J - YYYYMMDD L - MMDDYYYY');
* Received values;
CHANGE FIELD(#S_FORMAT) TO(#I_FORMAT);
* Translate the long date format to the short date format if necessary (YYYYMMDD -> J);
EXECUTE TRANSLATE (#S_FORMAT #S_FMT);
CHANGE FIELD(#S_169DAT8) TO(#I_DATE8);
If cond('#S_169DAT8 *NE *ZERO');
* Convert date to DDMMYYYY format;
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#S_169DAT8 #S_FMT H) TO_GET(#S_169DAT8);
ENDIF;
* Setup current day month and year values;
SUBSTRING FIELD(#S_169DAT8 5 4) INTO_FIELD(#YYYY);
SUBSTRING FIELD(#S_169DAT8 3 2) INTO_FIELD(#MONTH);
SUBSTRING FIELD(#S_169DAT8 1 2) INTO_FIELD(#S_169DD);
* Position year and months drop down;
EXECUTE SUBROUTINE(INZ_YEAR);
EXECUTE SUBROUTINE(INZ_MONTH) ;
INVOKE METHOD(#Com_owner.ShowModalForm);
ENDROUTINE;
* ;
EVTROUTINE handling(#com_owner.Initialize);
SET #com_owner caption(*component_desc);
* Position year and months drop down;
EXECUTE SUBROUTINE(INZ_YEAR);
EXECUTE SUBROUTINE(INZ_MONTH);
;
;
ENDROUTINE;
* Initialize month drop down ;
SUBROUTINE NAME(INZ_YEAR);
* If received date is zero, set to todays date;
IF COND('#S_169DAT8 = *ZERO');
CHANGE FIELD(#YYYY) TO(*DEFAULT);
ENDIF;
CHANGE FIELD(#S_169YYYY) TO(#YYYY);
* Build list of Years;
CLR_LIST NAMED(#DD_YEAR);
BEGIN_LOOP USING(#YYYY) FROM(1960) TO(2100);
ADD_ENTRY TO_LIST(#DD_YEAR);
* Set list to current year;
IF COND('#YYYY = #S_169YYYY');
SET COM(#DD_YEAR.CURRENTITEM) FOCUS(TRUE);
ENDIF;
END_LOOP;
CHANGE FIELD(#YYYY) TO(#S_169YYYY);
* Create buttons;
BEGIN_LOOP USING(#STD_NUM) TO(42);
SET COM(#BUTTON<#STD_NUM>) HEIGHT(28) WIDTH(39) PARENT(#GPBX_1) VISIBLE(TRUE);
SET COM(#BUTTONMGR<#STD_NUM>) PARENT(#FWLM_1) MANAGE(#BUTTON<#STD_NUM>);
END_LOOP;
ENDROUTINE;
* Initialize month drop down;
SUBROUTINE NAME(INZ_MONTH);
* Build list of months;
* Store current month;
IF COND('#S_169DAT8 = *ZERO');
CHANGE FIELD(#MONTH) TO(*DEFAULT);
ENDIF;
CHANGE FIELD(#S_169MTH) TO(#MONTH);
CLR_LIST NAMED(#DD_MONTH);
CHANGE FIELD(#YYYYMMDDC) TO('''19990001''');
BEGIN_LOOP FROM(1) TO(12) USING(#MONTH);
SUBSTRING FIELD(#MONTH) INTO_FIELD(#YYYYMMDDC 5 2);
* Get month description;
USE BUILTIN(CONVERTDATE) WITH_ARGS(#YYYYMMDDC J U) TO_GET(#STD_OBJ);
ADD_ENTRY TO_LIST(#DD_MONTH);
END_LOOP;
* Set drop down to current month;
GET_ENTRY NUMBER(#S_169MTH);
SET COM(#DD_MONTH.CURRENTITEM) FOCUS(TRUE);
* Calculate start of month;
EXECUTE SUBROUTINE(SET_DAYS);
* Find number of days in the month;
EXECUTE SUBROUTINE(DAYSINMTH);
* Set captions;
EXECUTE SUBROUTINE(SET_CAPT);
ENDROUTINE;
* First day of month;
SUBROUTINE NAME(SET_DAYS);
* Find first day of the month;
CHANGE FIELD(#YYYYMMDDC) TO('''00000001''');
SUBSTRING FIELD(#YYYY) INTO_FIELD(#YYYYMMDDC 1 4);
SUBSTRING FIELD(#MONTH) INTO_FIELD(#YYYYMMDDC 5 2);
USE BUILTIN(CONVERTDATE) WITH_ARGS(#YYYYMMDDC J S) TO_GET(#S_169DOW);
* Position first day of month;
CASE OF_FIELD(#S_169DOW);
WHEN VALUE_IS('= SUNDAY');
CHANGE FIELD(#S_169DAY1) TO(1);
WHEN VALUE_IS('= MONDAY');
CHANGE FIELD(#S_169DAY1) TO(2);
WHEN VALUE_IS('= TUESDAY');
CHANGE FIELD(#S_169DAY1) TO(3);
WHEN VALUE_IS('= WEDNESDAY');
CHANGE FIELD(#S_169DAY1) TO(4);
WHEN VALUE_IS('= THURSDAY');
CHANGE FIELD(#S_169DAY1) TO(5);
WHEN VALUE_IS('= FRIDAY');
CHANGE FIELD(#S_169DAY1) TO(6);
WHEN VALUE_IS('= SATURDAY');
CHANGE FIELD(#S_169DAY1) TO(7);
ENDCASE;
ENDROUTINE;
* Number of days in a month;
SUBROUTINE NAME(DAYSINMTH);
CASE OF_FIELD(#MONTH) ;
WHEN VALUE_IS('= 4' '= 6' '= 9' '= 11');
CHANGE FIELD(#S_169DMTH) TO('30 + #S_169DAY1 - 1');
WHEN VALUE_IS('= 1' '= 3' '= 5' '= 7' '= 8' '= 10' '= 12');
CHANGE FIELD(#S_169DMTH) TO('31 + #S_169DAY1 - 1');
WHEN VALUE_IS('= 2');
* Test for leap year;
CHANGE FIELD(#S_169DMTH) TO('29 + #S_169DAY1 - 1');
CHANGE FIELD(#S_169DATE) TO('(#YYYY * 10000) + (#MONTH * 100) + 29');
BEGINCHECK;
DATECHECK FIELD(#S_169DATE) IN_FORMAT(*YYYYMMDD);
IF_ERROR;
CHANGE FIELD(#S_169DMTH) TO('28 + #S_169DAY1 - 1');
ENDIF;
ENDCHECK IF_ERROR(*NEXT);
ENDCASE;
ENDROUTINE;
* If month or year selected;
EVTROUTINE HANDLING(#DD_MONTH.ItemGotFocus #DD_YEAR.ItemGotFocus);
* Calculate start of month;
EXECUTE SUBROUTINE(SET_DAYS);
* Find number of days in the month;
EXECUTE SUBROUTINE(DAYSINMTH);
* Set captions;
EXECUTE SUBROUTINE(SET_CAPT);
ENDROUTINE;
* Give buttons appropriate caption;
SUBROUTINE NAME(SET_CAPT);
* Reset all captions, visibility, enablement and hints;
SET COM(#BUTTON<>) CAPTION(*blanks) ENABLED(FALSE) VISUALSTYLEOFPARENT(TRUE) VISUALSTYLE() HINT() ;
* ;
CHANGE FIELD(#DAY) TO(*ZERO);
BEGIN_LOOP USING(#STD_NUM) FROM(#S_169DAY1) TO(#S_169DMTH);
CHANGE FIELD(#DAY) TO('#DAY + 1');
SUBSTRING FIELD(#DAY) INTO_FIELD(#S_169DDW);
EXECUTE SUBROUTINE(SET_HINT);
SET COM(#BUTTON<#STD_NUM>) CAPTION(#S_169DDW) HINT(#S_169DATD) ENABLED(TRUE);
END_LOOP;
* Highlight received date;
IF COND('(#MONTH = #S_169MTH) AND (#YYYY = #S_169YYYY)');
CHANGE FIELD(#DAY) TO('#S_169DD + #S_169DAY1 - 1');
SET COM(#BUTTON<#DAY>) VISUALSTYLEOFPARENT(FALSE) VISUALSTYLE(#VS_EMPH);
ENDIF;
IF COND('(#S_169DAT8 = *ZERO) AND (#MONTH = #S_169MTH) AND (#YYYY = #S_169YYYY)');
CHANGE FIELD(#DAY) TO('*DAY + #S_169DAY1 - 1') ;
SET COM(#BUTTON<#DAY>) VISUALSTYLEOFPARENT(FALSE) VISUALSTYLE(#VS_EMPH);
ENDIF;
ENDROUTINE;
SUBROUTINE NAME(SET_HINT);
* Build date string;
SUBSTRING FIELD(#YYYY) INTO_FIELD(#YYYYMMDDC 1 4);
SUBSTRING FIELD(#MONTH) INTO_FIELD(#YYYYMMDDC 5 2);
SUBSTRING FIELD(#S_169DDW) INTO_FIELD(#YYYYMMDDC 7 2);
* Day of week e.g Friday;
USE BUILTIN(CONVERTDATE) WITH_ARGS(#YYYYMMDDC J S) TO_GET(#S_169DOW);
* Description of date e.g 3rd December 1999;
USE BUILTIN(CONVERTDATE) WITH_ARGS(#YYYYMMDDC J Q) TO_GET(#S_169DAYD);
USE BUILTIN(BCONCAT) WITH_ARGS(#S_169DOW #S_169DAYD) TO_GET(#S_169DATD);
ENDROUTINE;
* Date button clicked;
EVTROUTINE handling(#BUTTON<>.CLICK) COM_SENDER(#CLICKED);
CHANGE FIELD(#S_169DDW) TO(#CLICKED.CAPTION);
SUBSTRING FIELD(#S_169DDW) INTO_FIELD(#S_169DD);
* Set up date;
CHANGE FIELD(#DDMMYYYY) TO('(#S_169DD * 1000000) + (#MONTH * 10000) + (#YYYY)');
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#DDMMYYYY H #S_FMT) TO_GET(#DDMMYYYY);
SIGNAL EVENT(Date_Selected) O_date(#ddmmyyyy);
Invoke method(#com_owner.closeform);
ENDROUTINE;
SUBROUTINE NAME(TRANSLATE) PARMS((#S_FORMAT *RECEIVED) (#S_FMT *RETURNED));
CASE OF_FIELD(#S_FORMAT);
WHEN VALUE_IS('= SYSTEM' '= SYSFMT' '= A');
CHANGE FIELD(#S_FMT) TO(A);
WHEN VALUE_IS('= DDMMYY' '= B');
CHANGE FIELD(#S_FMT) TO(B);
WHEN VALUE_IS('= YYMMDD' '= D');
CHANGE FIELD(#S_FMT) TO(D);
WHEN VALUE_IS('= MMDDYY' '= F');
CHANGE FIELD(#S_FMT) TO(F);
WHEN VALUE_IS('= DDMMYYYY' '= H');
CHANGE FIELD(#S_FMT) TO(H);
WHEN VALUE_IS('= YYYYMMDD' '= J');
CHANGE FIELD(#S_FMT) TO(J);
WHEN VALUE_IS('= MMDDYYYY' '= L');
CHANGE FIELD(#S_FMT) TO(L);
WHEN VALUE_IS('= SYSTEM8' '= SYSFMT8' '= V');
CHANGE FIELD(#S_FMT) TO(V);
WHEN VALUE_IS('= YYMM' '= W');
CHANGE FIELD(#S_FMT) TO(W);
WHEN VALUE_IS('= MMYY' '= X');
CHANGE FIELD(#S_FMT) TO(X);
WHEN VALUE_IS('= YYYYMM' '= Y');
CHANGE FIELD(#S_FMT) TO(Y);
WHEN VALUE_IS('= MMYYYY' '= Z');
CHANGE FIELD(#S_FMT) TO(Z);
OTHERWISE;
* CHANGE FIELD(#S_RETCDA2) TO(ER);
ENDCASE;
ENDROUTINE;
END_COM;
* ===================================================================;
*;
* Component : S_169FA1;
* Type : Form;
* Ancestor : PRIM_FORM;
* ;
* Description : Calendar Form ;
* The following RDMLX form demonstrates a VL calendar ;
*;
* Disclaimer : The following material is supplied as sample material ;
* only. No warranty concerning this material or its use ;
* in any way whatsoever is expressed or implied. ;
* ;
* ===================================================================;
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM BORDERICONS(SystemMenu) FRAMESTYLE(Dialog) HEIGHT(286) LAYOUTMANAGER(#ATLM_1) LEFT(313) TOP(119) WIDTH(299);
* Collection of buttons for the screen;
DEFINE_COM CLASS(#PRIM_KCOL) NAME(#BUTTON) COLLECTS(#PRIM_PHBN) KEYEDBY(#STD_NUM);
* Collection of flow manager to control button position;
DEFINE_COM CLASS(#PRIM_KCOL) NAME(#BUTTONMGR) COLLECTS(#PRIM_FWLI) KEYEDBY(#STD_NUM);
* Flow manager to layout the buttons;
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_1) ITEMSPERDIVISION(7) MARGINBOTTOM(2) MARGINLEFT(2) MARGINRIGHT(2) MARGINTOP(2) SPACING(1) SPACINGITEMS(1);
* Month drop down;
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#DD_MONTH) DISPLAYPOSITION(1) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(1) TOP(8) VALUE('ABCDEFGHIJ') WIDTH(169);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_2) DISPLAYPOSITION(1) PARENT(#DD_MONTH) SOURCE(#STD_OBJ) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_3) PARENT(#DD_MONTH) SOURCE(#MONTH) VISIBLE(False) WIDTH(20);
* Year drop down;
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#DD_YEAR) DISPLAYPOSITION(2) LEFT(184) PARENT(#COM_OWNER) TABPOSITION(2) TOP(8) VALUE('1234') WIDTH(97);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_1) DISPLAYPOSITION(1) PARENT(#DD_YEAR) SOURCE(#YYYY) WIDTH(20);
* Labels;
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_1) CAPTION('Sun') DISPLAYPOSITION(3) HEIGHT(17) LEFT(16) PARENT(#COM_OWNER) TABPOSITION(3) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_2) CAPTION('Mon') DISPLAYPOSITION(4) HEIGHT(16) LEFT(56) PARENT(#COM_OWNER) TABPOSITION(4) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_3) CAPTION('Tue') DISPLAYPOSITION(5) HEIGHT(16) LEFT(96) PARENT(#COM_OWNER) TABPOSITION(5) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_4) CAPTION('Wed') DISPLAYPOSITION(6) HEIGHT(16) LEFT(136) PARENT(#COM_OWNER) TABPOSITION(6) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_5) CAPTION('Thu') DISPLAYPOSITION(7) HEIGHT(16) LEFT(176) PARENT(#COM_OWNER) TABPOSITION(7) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_6) CAPTION('Fri') DISPLAYPOSITION(8) HEIGHT(17) LEFT(216) PARENT(#COM_OWNER) TABPOSITION(8) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_7) CAPTION('Sat') DISPLAYPOSITION(9) HEIGHT(16) LEFT(256) PARENT(#COM_OWNER) TABPOSITION(9) TABSTOP(False) TOP(40) WIDTH(25);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_1);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_1) DISPLAYPOSITION(10) HEIGHT(193) LAYOUTMANAGER(#FWLM_1) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(10) TABSTOP(False) TOP(64) VISUALSTYLE(#VS_NORM) WIDTH(291);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_2) DISPLAYPOSITION(11) HEIGHT(33) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(11) TABSTOP(False) TOP(0) WIDTH(291);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_2) ATTACHMENT(Top) MANAGE(#GPBX_2) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_3) DISPLAYPOSITION(12) HEIGHT(32) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(12) TABSTOP(False) TOP(33) WIDTH(291);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_3) ATTACHMENT(Top) MANAGE(#GPBX_3) PARENT(#ATLM_1);
* Defined fields;
DEFINE FIELD(#S_169DAY1) LENGTH(2) TYPE(*DEC) DECIMALS(0) DESC('Week day of the first day of the month') ;
DEFINE FIELD(#S_169DATE) LENGTH(8) TYPE(*DEC) DECIMALS(0) DESC('Date used to check leap year') ;
DEFINE FIELD(#S_169DDW) LENGTH(2) TYPE(*CHAR) DESC('Day number (displayed on button)');
DEFINE FIELD(#S_169DD) LENGTH(2) TYPE(*DEC) DECIMALS(0) DESC('Day number');
DEFINE FIELD(#S_169YYYY) LENGTH(4) TYPE(*DEC) DECIMALS(0) ;
DEFINE FIELD(#S_169MTH) LENGTH(2) TYPE(*DEC) DECIMALS(0);
DEFINE FIELD(#S_169DOW) LENGTH(10) TYPE(*CHAR) DESC('Day of week - Monday, Tuesday...') ;
DEFINE FIELD(#S_169DMTH) LENGTH(2) TYPE(*DEC) DECIMALS(0) DESC('Day of the month');
DEFINE FIELD(#S_169DAYD) TYPE(*CHAR) LENGTH(20) DESC('(Hint) Day of week - Monday, Tuesday...') INPUT_ATR(LC);
DEFINE FIELD(#S_169DATD) TYPE(*CHAR) LENGTH(30) DESC('(Hint) Date description') INPUT_ATR(LC);
DEFINE FIELD(#S_169DAT8) REFFLD(#DDMMYYYY) DESC('Selected Date');
DEFINE #S_FORMAT *CHAR 20 DESC('Long date format');
DEFINE #S_FMT *CHAR 1 DESC('Short date format') ;
* Events;
DEFINE_EVT NAME(Date_Selected) HELP('Signalled when a date is to be passed to the parent form');
DEFINE_MAP FOR(*INPUT) CLASS(#DDMMYYYY) NAME(#O_DATE) HELP('This component will cater for both 6 digit and 8 digit date. If the input date is eight long, the returned value will also be eight long. For example, EvtRoutine Handling(#CALENDAR.Date8_Selected) O8_DATE(#X)');
;
MTHROUTINE NAME(Show_Calendar) desc('Displays calendar window') help('The calendar requires two parameters - a numeric date, and a date format. See parameter help for further details');
DEFINE_MAP FOR(*INPUT) CLASS(#DDMMYYYY) NAME(#I_DATE8) desc('Received date and format') help('Set this property to position the calendar to the required date, or leave as zero to use todays date.');
DEFINE_MAP FOR(*INPUT) CLASS(#S_FMTLONG) NAME(#I_FORMAT) help('Allowable values are: A - system format B - DDMMYY D - YYMMDD F -MMDDYY H - DDMMYYYY J - YYYYMMDD L - MMDDYYYY');
* Received values;
CHANGE FIELD(#S_FORMAT) TO(#I_FORMAT);
* Translate the long date format to the short date format if necessary (YYYYMMDD -> J);
EXECUTE TRANSLATE (#S_FORMAT #S_FMT);
CHANGE FIELD(#S_169DAT8) TO(#I_DATE8);
If cond('#S_169DAT8 *NE *ZERO');
* Convert date to DDMMYYYY format;
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#S_169DAT8 #S_FMT H) TO_GET(#S_169DAT8);
ENDIF;
* Setup current day month and year values;
SUBSTRING FIELD(#S_169DAT8 5 4) INTO_FIELD(#YYYY);
SUBSTRING FIELD(#S_169DAT8 3 2) INTO_FIELD(#MONTH);
SUBSTRING FIELD(#S_169DAT8 1 2) INTO_FIELD(#S_169DD);
* Position year and months drop down;
EXECUTE SUBROUTINE(INZ_YEAR);
EXECUTE SUBROUTINE(INZ_MONTH) ;
INVOKE METHOD(#Com_owner.ShowModalForm);
ENDROUTINE;
* ;
EVTROUTINE handling(#com_owner.Initialize);
SET #com_owner caption(*component_desc);
* Position year and months drop down;
EXECUTE SUBROUTINE(INZ_YEAR);
EXECUTE SUBROUTINE(INZ_MONTH);
;
;
ENDROUTINE;
* Initialize month drop down ;
SUBROUTINE NAME(INZ_YEAR);
* If received date is zero, set to todays date;
IF COND('#S_169DAT8 = *ZERO');
CHANGE FIELD(#YYYY) TO(*DEFAULT);
ENDIF;
CHANGE FIELD(#S_169YYYY) TO(#YYYY);
* Build list of Years;
CLR_LIST NAMED(#DD_YEAR);
BEGIN_LOOP USING(#YYYY) FROM(1960) TO(2100);
ADD_ENTRY TO_LIST(#DD_YEAR);
* Set list to current year;
IF COND('#YYYY = #S_169YYYY');
SET COM(#DD_YEAR.CURRENTITEM) FOCUS(TRUE);
ENDIF;
END_LOOP;
CHANGE FIELD(#YYYY) TO(#S_169YYYY);
* Create buttons;
BEGIN_LOOP USING(#STD_NUM) TO(42);
SET COM(#BUTTON<#STD_NUM>) HEIGHT(28) WIDTH(39) PARENT(#GPBX_1) VISIBLE(TRUE);
SET COM(#BUTTONMGR<#STD_NUM>) PARENT(#FWLM_1) MANAGE(#BUTTON<#STD_NUM>);
END_LOOP;
ENDROUTINE;
* Initialize month drop down;
SUBROUTINE NAME(INZ_MONTH);
* Build list of months;
* Store current month;
IF COND('#S_169DAT8 = *ZERO');
CHANGE FIELD(#MONTH) TO(*DEFAULT);
ENDIF;
CHANGE FIELD(#S_169MTH) TO(#MONTH);
CLR_LIST NAMED(#DD_MONTH);
CHANGE FIELD(#YYYYMMDDC) TO('''19990001''');
BEGIN_LOOP FROM(1) TO(12) USING(#MONTH);
SUBSTRING FIELD(#MONTH) INTO_FIELD(#YYYYMMDDC 5 2);
* Get month description;
USE BUILTIN(CONVERTDATE) WITH_ARGS(#YYYYMMDDC J U) TO_GET(#STD_OBJ);
ADD_ENTRY TO_LIST(#DD_MONTH);
END_LOOP;
* Set drop down to current month;
GET_ENTRY NUMBER(#S_169MTH);
SET COM(#DD_MONTH.CURRENTITEM) FOCUS(TRUE);
* Calculate start of month;
EXECUTE SUBROUTINE(SET_DAYS);
* Find number of days in the month;
EXECUTE SUBROUTINE(DAYSINMTH);
* Set captions;
EXECUTE SUBROUTINE(SET_CAPT);
ENDROUTINE;
* First day of month;
SUBROUTINE NAME(SET_DAYS);
* Find first day of the month;
CHANGE FIELD(#YYYYMMDDC) TO('''00000001''');
SUBSTRING FIELD(#YYYY) INTO_FIELD(#YYYYMMDDC 1 4);
SUBSTRING FIELD(#MONTH) INTO_FIELD(#YYYYMMDDC 5 2);
USE BUILTIN(CONVERTDATE) WITH_ARGS(#YYYYMMDDC J S) TO_GET(#S_169DOW);
* Position first day of month;
CASE OF_FIELD(#S_169DOW);
WHEN VALUE_IS('= SUNDAY');
CHANGE FIELD(#S_169DAY1) TO(1);
WHEN VALUE_IS('= MONDAY');
CHANGE FIELD(#S_169DAY1) TO(2);
WHEN VALUE_IS('= TUESDAY');
CHANGE FIELD(#S_169DAY1) TO(3);
WHEN VALUE_IS('= WEDNESDAY');
CHANGE FIELD(#S_169DAY1) TO(4);
WHEN VALUE_IS('= THURSDAY');
CHANGE FIELD(#S_169DAY1) TO(5);
WHEN VALUE_IS('= FRIDAY');
CHANGE FIELD(#S_169DAY1) TO(6);
WHEN VALUE_IS('= SATURDAY');
CHANGE FIELD(#S_169DAY1) TO(7);
ENDCASE;
ENDROUTINE;
* Number of days in a month;
SUBROUTINE NAME(DAYSINMTH);
CASE OF_FIELD(#MONTH) ;
WHEN VALUE_IS('= 4' '= 6' '= 9' '= 11');
CHANGE FIELD(#S_169DMTH) TO('30 + #S_169DAY1 - 1');
WHEN VALUE_IS('= 1' '= 3' '= 5' '= 7' '= 8' '= 10' '= 12');
CHANGE FIELD(#S_169DMTH) TO('31 + #S_169DAY1 - 1');
WHEN VALUE_IS('= 2');
* Test for leap year;
CHANGE FIELD(#S_169DMTH) TO('29 + #S_169DAY1 - 1');
CHANGE FIELD(#S_169DATE) TO('(#YYYY * 10000) + (#MONTH * 100) + 29');
BEGINCHECK;
DATECHECK FIELD(#S_169DATE) IN_FORMAT(*YYYYMMDD);
IF_ERROR;
CHANGE FIELD(#S_169DMTH) TO('28 + #S_169DAY1 - 1');
ENDIF;
ENDCHECK IF_ERROR(*NEXT);
ENDCASE;
ENDROUTINE;
* If month or year selected;
EVTROUTINE HANDLING(#DD_MONTH.ItemGotFocus #DD_YEAR.ItemGotFocus);
* Calculate start of month;
EXECUTE SUBROUTINE(SET_DAYS);
* Find number of days in the month;
EXECUTE SUBROUTINE(DAYSINMTH);
* Set captions;
EXECUTE SUBROUTINE(SET_CAPT);
ENDROUTINE;
* Give buttons appropriate caption;
SUBROUTINE NAME(SET_CAPT);
* Reset all captions, visibility, enablement and hints;
SET COM(#BUTTON<>) CAPTION(*blanks) ENABLED(FALSE) VISUALSTYLEOFPARENT(TRUE) VISUALSTYLE() HINT() ;
* ;
CHANGE FIELD(#DAY) TO(*ZERO);
BEGIN_LOOP USING(#STD_NUM) FROM(#S_169DAY1) TO(#S_169DMTH);
CHANGE FIELD(#DAY) TO('#DAY + 1');
SUBSTRING FIELD(#DAY) INTO_FIELD(#S_169DDW);
EXECUTE SUBROUTINE(SET_HINT);
SET COM(#BUTTON<#STD_NUM>) CAPTION(#S_169DDW) HINT(#S_169DATD) ENABLED(TRUE);
END_LOOP;
* Highlight received date;
IF COND('(#MONTH = #S_169MTH) AND (#YYYY = #S_169YYYY)');
CHANGE FIELD(#DAY) TO('#S_169DD + #S_169DAY1 - 1');
SET COM(#BUTTON<#DAY>) VISUALSTYLEOFPARENT(FALSE) VISUALSTYLE(#VS_EMPH);
ENDIF;
IF COND('(#S_169DAT8 = *ZERO) AND (#MONTH = #S_169MTH) AND (#YYYY = #S_169YYYY)');
CHANGE FIELD(#DAY) TO('*DAY + #S_169DAY1 - 1') ;
SET COM(#BUTTON<#DAY>) VISUALSTYLEOFPARENT(FALSE) VISUALSTYLE(#VS_EMPH);
ENDIF;
ENDROUTINE;
SUBROUTINE NAME(SET_HINT);
* Build date string;
SUBSTRING FIELD(#YYYY) INTO_FIELD(#YYYYMMDDC 1 4);
SUBSTRING FIELD(#MONTH) INTO_FIELD(#YYYYMMDDC 5 2);
SUBSTRING FIELD(#S_169DDW) INTO_FIELD(#YYYYMMDDC 7 2);
* Day of week e.g Friday;
USE BUILTIN(CONVERTDATE) WITH_ARGS(#YYYYMMDDC J S) TO_GET(#S_169DOW);
* Description of date e.g 3rd December 1999;
USE BUILTIN(CONVERTDATE) WITH_ARGS(#YYYYMMDDC J Q) TO_GET(#S_169DAYD);
USE BUILTIN(BCONCAT) WITH_ARGS(#S_169DOW #S_169DAYD) TO_GET(#S_169DATD);
ENDROUTINE;
* Date button clicked;
EVTROUTINE handling(#BUTTON<>.CLICK) COM_SENDER(#CLICKED);
CHANGE FIELD(#S_169DDW) TO(#CLICKED.CAPTION);
SUBSTRING FIELD(#S_169DDW) INTO_FIELD(#S_169DD);
* Set up date;
CHANGE FIELD(#DDMMYYYY) TO('(#S_169DD * 1000000) + (#MONTH * 10000) + (#YYYY)');
USE BUILTIN(CONVERTDATE_NUMERIC) WITH_ARGS(#DDMMYYYY H #S_FMT) TO_GET(#DDMMYYYY);
SIGNAL EVENT(Date_Selected) O_date(#ddmmyyyy);
Invoke method(#com_owner.closeform);
ENDROUTINE;
SUBROUTINE NAME(TRANSLATE) PARMS((#S_FORMAT *RECEIVED) (#S_FMT *RETURNED));
CASE OF_FIELD(#S_FORMAT);
WHEN VALUE_IS('= SYSTEM' '= SYSFMT' '= A');
CHANGE FIELD(#S_FMT) TO(A);
WHEN VALUE_IS('= DDMMYY' '= B');
CHANGE FIELD(#S_FMT) TO(B);
WHEN VALUE_IS('= YYMMDD' '= D');
CHANGE FIELD(#S_FMT) TO(D);
WHEN VALUE_IS('= MMDDYY' '= F');
CHANGE FIELD(#S_FMT) TO(F);
WHEN VALUE_IS('= DDMMYYYY' '= H');
CHANGE FIELD(#S_FMT) TO(H);
WHEN VALUE_IS('= YYYYMMDD' '= J');
CHANGE FIELD(#S_FMT) TO(J);
WHEN VALUE_IS('= MMDDYYYY' '= L');
CHANGE FIELD(#S_FMT) TO(L);
WHEN VALUE_IS('= SYSTEM8' '= SYSFMT8' '= V');
CHANGE FIELD(#S_FMT) TO(V);
WHEN VALUE_IS('= YYMM' '= W');
CHANGE FIELD(#S_FMT) TO(W);
WHEN VALUE_IS('= MMYY' '= X');
CHANGE FIELD(#S_FMT) TO(X);
WHEN VALUE_IS('= YYYYMM' '= Y');
CHANGE FIELD(#S_FMT) TO(Y);
WHEN VALUE_IS('= MMYYYY' '= Z');
CHANGE FIELD(#S_FMT) TO(Z);
OTHERWISE;
* CHANGE FIELD(#S_RETCDA2) TO(ER);
ENDCASE;
ENDROUTINE;
END_COM;