{ The following macro is not supported. } { The program "ACTIVE" may not be resold or included in other packages. } { Copying and subsequent distribution to a third party is forbidden. } { Darren Litherland takes no responsibility for errors resulting from the} { use or misuse of the software. } { All use of this software is the responsiblity of the recipient. } { CATEGORY: TABLES } { COMPANY: Engineer Darren Litherland } { AUTHOR: Darren Litherland } { CONTACT OPTION: me10@nethut.net } { VIDEO MODE: Native ME10. The visual impression is best without PELOOK } { MONITOR RESOLUTION: n/a } { MACRO TITLE: ACTIVE } { DESC: Demonstrates the use of active graphical icons in ME10. } { MACRO VERSION: 1.0 } { DATE: 2000.08.01 } { APPLICATION: ME10 8.7/9.0/10.0 } { OPSYS: HP-UX 9.x/10.x Windows95/98/NT } { UI: ALL } { MOUSE: YES } { TABLET: YES } { KEYWORDS: CHR DISPLAY TABLE } { DOCUMENTATION: Available at: http://www.nethut.net/me10 } {*************************************************************************} TRAP_ERROR ADD_TO_SUPPORT_MACRO_TABLE 'DYNAMIC_VIEWPORTS' 'ALL' 'WINDOWS' 'VIEWPORTS' 'FILE' 'ALL' END LET C (CHECK_ERROR) LET MP_MACRO_NAME "Active Graphical Icons 1.0" LET MP_OWNER_NAME "Everyone!" LET MP_START_MACRO "ACTIVE" STORE_IN_RECALL_BUFFER MP_START_MACRO CREATE_LTAB 'Install_ltab' DEFINE ALGHTYEL RGB_COLOR 1 1 .55555 END_DEFINE DEFINE ATABDDEY RGB_COLOR .2222 .2222 .2222 END_DEFINE DEFINE ATABDREY RGB_COLOR .3333 .3333 .3333 END_DEFINE DEFINE ATABFREY RGB_COLOR .6666 .6666 .6666 END_DEFINE DEFINE ATABGREY RGB_COLOR .7777 .7777 .7777 END_DEFINE DEFINE ATABLLEY RGB_COLOR .8555 .8555 .8555 END_DEFINE DEFINE ATABLREY RGB_COLOR .95 .95 .95 END_DEFINE DEFINE ATABBLUE RGB_COLOR 0 0 .5 END_DEFINE DEFINE ATABLBLU RGB_COLOR .4 .4 .6 END_DEFINE DEFINE CREATE_INSTALL_TABLE LOCAL X LOCAL Y LOCAL FW LET FW FONT_WIDTH TABLE_LAYOUT 'Install_dtab' 'Install_ltab' ATABFREY ATABFREY WIDTH 40 ROWS 0 FRAME_WIDTH 3 TITLE_LAYOUT 20 '1 ' 30 '2 ' 50 '3 ' 20 '4 ' END COLUMN_LAYOUT ' ' END TABLE_TITLE 'Install_dtab' WHITE ATABBLUE LEFT '@s1' 'DELETE_TABLE "Install_dtab"' 1 1 BLACK ATABGREY CENTER '@s2' '' 2 1 ATABBLUE ATABGREY CENTER '@s3' '' 3 1 BLACK ATABGREY CENTER '@s4' '' 4 1 END WRITE_LTAB 'Install_ltab' TITLE 1 (MP_MACRO_NAME+" installation") WRITE_LTAB 'Install_ltab' TITLE 2 ("Who can use this macro: "+MP_OWNER_NAME) WRITE_LTAB 'Install_ltab' TITLE 3 "P L E A S E W A I T . . . . . " WRITE_LTAB 'Install_ltab' TITLE 4 ("Start with: "+MP_START_MACRO+" or PageUp") LET X (((X_OF Graphic_area_up_right)/2)-(FW*20)) LET Y ((Y_OF Graphic_area_up_right)/2) TABLE_STATUS 'Install_dtab' MOVE (PNT_XY X Y) TABLE_STATUS 'Install_dtab' MAP END_DEFINE CREATE_INSTALL_TABLE DEFINE ACTIVE TABLE_STATUS 'Active_dtab' MAP END_DEFINE DEFINE CREATE_ACTIVE_ICON_TABLE LOCAL FW LOCAL TSL LET Source_file 'activeicon.mac' LET TSL (FONT_HEIGHT+1) LET FW FONT_WIDTH CREATE_LTAB 'Active_ltab' TABLE_LAYOUT 'Active_dtab' 'Active_ltab' ATABFREY ATABFREY WIDTH 43 ROWS 10 FRAME_WIDTH 3 HORIZONTAL ATABFREY SOLID VERTICAL ATABGREY SOLID SCROLL_BAR ATABFREY ATABBLUE (FW*3) TITLE_LAYOUT 20 '1 | ' 180 '2 ' TSL ' | ' TSL ' | ' TSL ' | ' TSL ' | ' TSL ' | | | | | ' END COLUMN_LAYOUT TSL '20000830 | | | | ' END TABLE_TITLE 'Active_dtab' WHITE ATABBLUE LEFT "Litherland childrens' height chart" 'MOVE_ACTIVE_TABLE' 1 1 BLACK ATABGREY CENTER 'X' 'TABLE_STATUS "Active_dtab" UNMAP' 1 2 GREEN ATABDDEY '@s1' 'ACTIVE_ICON_MACRO' 2 1 WHITE ATABDDEY '@s2' '' 3 1 WHITE ATABDDEY '@s6 b.@s10' '' 3 2 YELLOW ATABDDEY '@s3' '' 4 1 YELLOW ATABDDEY '@s7 b.@s11' '' 4 2 RED ATABDDEY '@s4' '' 5 1 RED ATABDDEY '@s8 b.@s12' '' 5 2 CYAN ATABDDEY '@s5' '' 6 1 CYAN ATABDDEY '@s9 b.@s13' '' 6 2 GREEN ATABGREY '@s14' 7 1 BLACK GREEN 'Abs/rel' 'TOGGLE_ABS_REL' 7 2 WHITE ATABDDEY CENTER '---' '' 7 3 YELLOW ATABDDEY CENTER '---' '' 7 4 RED ATABDDEY CENTER '---' '' 7 5 CYAN ATABDDEY CENTER '---' '' 7 6 END TABLE_COLUMN 'Active_dtab' COLUMN 1 BLACK ATABGREY 1 FORMAT 50 LEFT 'ACTIVE_AT_DATE @q1' COLUMN 2 WHITE ATABDDEY 2 FORMAT 50 RIGHT '@q2' COLUMN 3 YELLOW ATABDDEY 3 FORMAT 50 RIGHT '@q3' COLUMN 4 RED ATABDDEY 4 FORMAT 50 RIGHT '@q4' COLUMN 5 CYAN ATABDDEY 5 FORMAT 50 RIGHT '@q5' END LET X (((X_OF Graphic_area_up_right)/2)-(FW*20)) LET Y ((Y_OF Graphic_area_up_right)/3) TABLE_STATUS 'Active_dtab' MOVE (PNT_XY X Y) TABLE_STATUS 'Active_dtab' MAP TABLE_STATUS 'Y_dtab' UNMAP DISPLAY_DATA END_DEFINE LET FD 32 DEFINE TOGGLE_ABS_REL IF (ACTIVE_RELATIVE=1) LET ACTIVE_RELATIVE 0 ELSE LET ACTIVE_RELATIVE 1 END_IF DISPLAY_DATA UPDATE_SCREEN END_DEFINE DEFINE MOVE_ACTIVE_TABLE TABLE_STATUS 'Y_dtab' UNMAP TABLE_STATUS 'Active_dtab' MOVE END_DEFINE DEFINE DISPLAY_DATA LOCAL N LOCAL NN LOCAL DATA LOCAL DATO LOCAL NAME_DATA LOCAL X LOCAL Y LOCAL FW LOCAL TSL LET Source_file 'activeicon.mac' LET TSL (FONT_HEIGHT+1) LET FW FONT_WIDTH LET N 1 LET NN 1 IF (((VAL ACTIVE_DATE_X)=0) AND (ACTIVE_Y=-1)) CREATE_LTAB 'Active_ltab' LOOP OPEN_INFILE 1 'active.dat' READ_FILE 1 NAME_DATA LET NAME_DATA (SUBSTR NAME_DATA ((N*10)+1) 8) WRITE_LTAB 'Active_ltab' TITLE (N+5) NAME_DATA READ_FILE 1 BIRTH_DATE LET BIRTH_DATE (SUBSTR BIRTH_DATE ((N*10)+1) 8) WRITE_LTAB 'Active_ltab' TITLE (N+9) BIRTH_DATE LET BIRTH_DATE ((VAL (SUBSTR BIRTH_DATE 1 4))+(((VAL (SUBSTR BIRTH_DATE 5 2))-1)/12)+((VAL (SUBSTR BIRTH_DATE 7 2))/365)) WRITE_LTAB 'Active_ltab' TITLE (N+13) BIRTH_DATE READ_FILE 1 DATA EXIT_IF (DATA='END-OF-FILE') LET FIRST_DATO (SUBSTR DATA 1 8) LET FIRST_DATO ((VAL (SUBSTR FIRST_DATO 1 4))+(((VAL (SUBSTR FIRST_DATO 5 2))-1)/12)+((VAL (SUBSTR FIRST_DATO 7 2))/365)) LOOP READ_FILE 1 DATA EXIT_IF (DATA='END-OF-FILE') LET LAST_DATO (SUBSTR DATA 1 8) END_LOOP LET LAST_DATO ((VAL (SUBSTR LAST_DATO 1 4))+(((VAL (SUBSTR LAST_DATO 5 2))-1)/12)+((VAL (SUBSTR LAST_DATO 7 2))/365)) LET FIRST_BORN (READ_LTAB 'Active_ltab' TITLE 14) IF (ACTIVE_RELATIVE=1) LET DD (LAST_DATO-FIRST_DATO) ELSE LET DD (LAST_DATO-FIRST_BORN) END_IF LET DD ((FW*FD-6)/DD) IF (N=1) LET ST "WRITE_LTAB 'Active_ltab' TITLE 2 (CHR 255" {Dummy )} ELSE_IF (N=2) LET ST "WRITE_LTAB 'Active_ltab' TITLE 3 (CHR 255" {Dummy )} ELSE_IF (N=3) LET ST "WRITE_LTAB 'Active_ltab' TITLE 4 (CHR 255" {Dummy )} ELSE_IF (N=4) LET ST "WRITE_LTAB 'Active_ltab' TITLE 5 (CHR 255" {Dummy )} END_IF CLOSE_FILE 1 OPEN_INFILE 1 'active.dat' READ_FILE 1 DATA READ_FILE 1 DATA LOOP READ_FILE 1 DATA EXIT_IF (DATA='END-OF-FILE') LET DATO (SUBSTR DATA 1 8) LET DATO ((VAL (SUBSTR DATO 1 4))+(((VAL (SUBSTR DATO 5 2))-1)/12)+((VAL (SUBSTR DATO 7 2))/365)) IF (ACTIVE_RELATIVE=1) LET DATO (DATO-FIRST_DATO) ELSE LET THIS_BORN (READ_LTAB 'Active_ltab' TITLE (N+13)) LET DATO (DATO-THIS_BORN) END_IF LET X (STR ((ROUND (DATO*DD)+1))) LET Y (SUBSTR DATA ((10*N)+1) 3) IF ((TRIM Y)<>'') SELECT_FROM_LTAB 'Active_ltab' 1 = DATA END LET NR (READ_LTAB 'sys_select' 1 1) IF (NR='') WRITE_LTAB 'Active_ltab' NN 1 DATA WRITE_LTAB 'Active_ltab' NN (N+1) (VAL Y) LET NN (NN+1) ELSE WRITE_LTAB 'Active_ltab' NR (N+1) (VAL Y) END_IF LET DDY (180/(182-48)) LET Y (STR ((((VAL Y)-48)*DDY)+(TSL*N))) LET ST (ST+'+CHR '+X+'+CHR '+Y) END_IF END_LOOP LET ST (ST+")") EXECUTE_STRING IMMEDIATE ST EXIT_IF (N=4) LET N (N+1) END_LOOP SORT_LTAB 'Active_ltab' 1 CONFIRM END_IF LET ST "WRITE_LTAB 'Active_ltab' TITLE 14 (CHR 255" LET N 0 LOOP LET X (STR (ROUND ((DD*N+1)))) EXIT_IF ((VAL X)>(FW*FD-6)) LET Y (STR (TSL*5)) LET YY (STR (TSL*5.5)) LET ST (ST+'+CHR 255+CHR '+X+'+CHR '+Y) LET ST (ST+'+CHR '+X+'+CHR '+YY) LET N (N+1) END_LOOP IF ((VAL ACTIVE_DATE_X)>0) LET Y (STR (TSL*5)) LET YY (STR ((TSL*5)+175)) LET ST (ST+'+CHR 255+CHR '+ACTIVE_DATE_X+'+CHR '+Y) LET ST (ST+'+CHR '+ACTIVE_DATE_X+'+CHR '+YY) END_IF LET ST (ST+")") EXECUTE_STRING IMMEDIATE ST LET ST "WRITE_LTAB 'Active_ltab' TITLE 1 (CHR 255" LET N 0 LOOP LET Y (STR (ROUND ((DDY*N+1)))) EXIT_IF ((VAL Y)>180) LET X "1" IF (N=50) LET XX (STR (FW*2)) ELSE LET XX (STR FW) END_IF LET ST (ST+'+CHR 255+CHR '+X+'+CHR '+Y) LET ST (ST+'+CHR '+XX+'+CHR '+Y) LET N (N+10) END_LOOP IF (ACTIVE_Y>-1) LET Y (STR (ROUND ((DDY*ACTIVE_Y)-66))) LET X "1" LET XX (STR ((FW*FD)-6)) LET ST (ST+'+CHR 255+CHR '+X+'+CHR '+Y) LET ST (ST+'+CHR '+XX+'+CHR '+Y) END_IF LET ST (ST+")") EXECUTE_STRING IMMEDIATE ST LET ACTIVE_DATE_X "0" LET ACTIVE_Y -1 END_DEFINE LET ACTIVE_Y -1 LET ACTIVE_DATE_X "0" LET ACTIVE_RELATIVE 1 DISPLAY_DATA DEFINE ACTIVE_AT_DATE PARAMETER DATO LOCAL NR IF (ACTIVE_RELATIVE=1) SELECT_FROM_LTAB 'Active_ltab' 1 = DATO END LET NR (READ_LTAB 'sys_select' 1 1) HIGHLIGHT_LTAB 'Active_ltab' ALL OFF HIGHLIGHT_LTAB 'Active_ltab' ROW NR ON LET DATO (SUBSTR DATO 1 8) LET DATO ((VAL (SUBSTR DATO 1 4))+(((VAL (SUBSTR DATO 5 2))-1)/12)+((VAL (SUBSTR DATO 7 2))/365)) LET DATO (DATO-FIRST_DATO) LET ACTIVE_DATE_X (STR ((ROUND (DATO*DD)+1))) DISPLAY_DATA NEW_SCREEN END_IF END_DEFINE DEFINE ACTIVE_ICON_MACRO LOCAL P1 LOCAL X1 LOCAL Y1 LOCAL X LOCAL X2 LOCAL NR LOCAL NR2 LOCAL N LOCAL N2 LOCAL EXIT_TEST LOCAL FRACT_DATO LOCAL FRACT_DATO2 LOCAL FRACT_MONTH LOCAL FRACT_MONTH2 LOCAL DATO LOCAL DATO2 LOCAL TSL LET TSL (FONT_HEIGHT+1) UPDATE_SCREEN INQ_TABLE 'Active_dtab' LET P1 (INQ 103) LET X1 (X_OF P1) LET Y1 (Y_OF P1) INQ_ENV 1 LET N 0 IF (ACTIVE_RELATIVE=1) LOOP LET X ((X_OF (INQ 103))-X1-4+N) LET X2 ((X_OF (INQ 103))-X1-4-N) LET DATO (((X+2)/DD)+FIRST_DATO) LET DATO2 (((X2+2)/DD)+FIRST_DATO) LET FRACT_DATO (FRACT DATO) LET FRACT_DATO2 (FRACT DATO2) LET FRACT_MONTH (INT ((FRACT_DATO*12))) LET FRACT_MONTH2 (INT ((FRACT_DATO2*12))) IF (FRACT_MONTH<10) LET FRACT_MONTH ("0"+(STR FRACT_MONTH)) ELSE LET FRACT_MONTH (STR FRACT_MONTH) END_IF IF (FRACT_MONTH2<10) LET FRACT_MONTH2 ("0"+(STR FRACT_MONTH2)) ELSE LET FRACT_MONTH2 (STR FRACT_MONTH2) END_IF LET DATO (STR DATO) LET DATO2 (STR DATO2) LET DATO ((SUBSTR DATO 1 4)+FRACT_MONTH) LET DATO2 ((SUBSTR DATO2 1 4)+FRACT_MONTH2) SELECT_FROM_LTAB 'Active_ltab' 1 = (DATO+'*') END LET NR (READ_LTAB 'sys_select' 1 1) SELECT_FROM_LTAB 'Active_ltab' 1 = (DATO2+'*') END LET NR2 (READ_LTAB 'sys_select' 1 1) HIGHLIGHT_LTAB 'Active_ltab' ALL OFF IF (NR<>'') HIGHLIGHT_LTAB 'Active_ltab' ROW NR ON IF (NR>10) SCROLL_LTAB 'Active_ltab' (NR-5) ELSE SCROLL_LTAB 'Active_ltab' 1 END_IF LET DATO (READ_LTAB 'Active_ltab' NR 1) LET EXIT_TEST 1 ELSE_IF (NR2<>'') IF (NR2>10) SCROLL_LTAB 'Active_ltab' (NR2-5) ELSE SCROLL_LTAB 'Active_ltab' 1 END_IF LET DATO (READ_LTAB 'Active_ltab' NR2 1) LET EXIT_TEST 1 ELSE LET N (N+1) LET EXIT_TEST 0 END_IF EXIT_IF (EXIT_TEST=1) END_LOOP WRITE_LTAB 'Y_ltab' TITLE 1 (SUBSTR DATO 1 6) TABLE_STATUS 'Y_dtab' MOVE (PNT_XY ((X_OF (INQ 103))+4) (Y_OF (INQ 103))) TABLE_STATUS 'Y_dtab' MAP ACTIVE_AT_DATE DATO ELSE TABLE_STATUS 'Y_dtab' MOVE (PNT_XY (X1+15) ((Y_OF (INQ 103)+2))) TABLE_STATUS 'Y_dtab' MOVE (PNT_XY (X_OF (INQ 103)) ((Y_OF (INQ 103)+2))) TABLE_STATUS 'Y_dtab' MAP LET Y ((Y_OF (INQ 103))-Y1-(TSL*15)-2) LET Y (ROUND ((Y/DDY)+48)) IF ((FRACT (Y/2))=.5) LET Y (Y+1) END_IF WRITE_LTAB 'Y_ltab' TITLE 1 ((STR Y)+'cm') LET ACTIVE_Y Y DISPLAY_DATA NEW_SCREEN END_IF END_DEFINE DEFINE Y_TABLE LOCAL X LOCAL Y LOCAL FW LET FW FONT_WIDTH CREATE_LTAB 'Y_ltab' TABLE_LAYOUT 'Y_dtab' 'Y_ltab' ATABDDEY ATABDDEY WIDTH 7 ROWS 0 TITLE_LAYOUT (FONT_HEIGHT+1) '1234567' END COLUMN_LAYOUT ' ' END TABLE_TITLE 'Y_dtab' YELLOW ATABDDEY CENTER '@s1' 'ACTIVE_ICON_MACRO' 1 1 END END_DEFINE Y_TABLE CREATE_ACTIVE_ICON_TABLE WAIT 1 TABLE_STATUS "Install_dtab" UNMAP DELETE_MACRO CREATE_INSTALL_TABLE DELETE_TABLE "Install_dtab" DELETE_LTAB "Install_ltab"