ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

Pop Up Calendar In Free Format

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Pop Up Calendar In Free Format

    I saw a post about a popup calendar a week or so ago. I had one, but wanted to convert it to free format before I posted it.


    Some of the features of this pop up calendar are:
    • It will auto-detect the current screen mode and display correctly in either 24/80 or 27/132 modes
    • You can use a mouse to select a date, or to change the month / year of the calendar
    • Without a mouse, you can use the rollup / rolldown keys to change the month, use the tab keys to position on a date, and use the enter key to select a date.
    • You can pass a starting date for the calendar
    • The calendar will auto-position to the passed date in the calendar
    • The calendar will highlight the current date if it is displayed on the calendar
    • The calendar can return the selected date
    • You can pass the calendar window starting positions (line number, column number)



    CalendarD Display File
    Code:
         A*%%TS  SD  20090401  202532  QPGMR       REL-V6R1M0  5761-WDS
         A*%%EC
         A                                      DSPSIZ(24 80 *DS3                  -
         A                                             27 132 *DS4)
         A                                      CHGINPDFT
         A                                      INDARA
         A                                      ENTFLDATR
         A*                                     (*DSPATR RI))
         A          R POPUP
         A*%%TS  SD  20090401  202532  QPGMR       REL-V6R1M0  5761-WDS
         A                                      CF03(03 'Exit')
         A                                      PAGEUP(90)
         A                                      PAGEDOWN(91)
         A                                      KEEP
         A                                      RTNCSRLOC(&CSRRCD &CSRFLD &CSRPOS)
         A  20                                  DSPMOD(*DS4)
         A                                      UNLOCK
         A                                      OVERLAY
         A  *DS3                                WINDOW(&WINDOWLINE &WINDOWPOS 9 22 -
         A                                      *NOMSGLIN)
         A  *DS4                                WINDOW(&WINDOWLINE &WINDOWPOS 9 22 -
         A                                      *NOMSGLIN)
         A                                      WDWTITLE((*TEXT ' F3-Cancel ') *BOT-
         A                                      TOM)
         A                                      MOUBTN(*ULP ENTER)
         A            ATTR01         1A  P
         A            ATTR02         1A  P
         A            ATTR03         1A  P
         A            ATTR04         1A  P
         A            ATTR05         1A  P
         A            ATTR06         1A  P
         A            ATTR07         1A  P
         A            ATTR08         1A  P
         A            ATTR09         1A  P
         A            ATTR10         1A  P
         A            ATTR11         1A  P
         A            ATTR12         1A  P
         A            ATTR13         1A  P
         A            ATTR14         1A  P
         A            ATTR15         1A  P
         A            ATTR16         1A  P
         A            ATTR17         1A  P
         A            ATTR18         1A  P
         A            ATTR19         1A  P
         A            ATTR20         1A  P
         A            ATTR21         1A  P
         A            ATTR22         1A  P
         A            ATTR23         1A  P
         A            ATTR24         1A  P
         A            ATTR25         1A  P
         A            ATTR26         1A  P
         A            ATTR27         1A  P
         A            ATTR28         1A  P
         A            ATTR29         1A  P
         A            ATTR30         1A  P
         A            ATTR31         1A  P
         A            ATTR32         1A  P
         A            ATTR33         1A  P
         A            ATTR34         1A  P
         A            ATTR35         1A  P
         A            ATTR36         1A  P
         A            ATTR37         1A  P
         A            ATTR38         1A  P
         A            ATTR39         1A  P
         A            ATTR40         1A  P
         A            ATTR41         1A  P
         A            ATTR42         1A  P
         A            CSRRCD        10A  H
         A            CSRFLD        10A  H
         A            WINDOWLINE     2S 0P
         A            WINDOWPOS      3S 0P
         A            CSRPOS         4S 0H
         A            ROW            3S 0H
         A            COL            3S 0H
         A            YEARHDG        4S 0O  1 17DSPATR(HI)
         A                                  3  2'Su'
         A                                      COLOR(BLU)
         A                                      DSPATR(UL)
         A                                  3  5'Mo'
         A                                      COLOR(BLU)
         A                                      DSPATR(UL)
         A                                  3  8'Tu'
         A                                      COLOR(BLU)
         A                                      DSPATR(UL)
         A                                  3 11'We'
         A                                      COLOR(BLU)
         A                                      DSPATR(UL)
         A                                  3 14'Th'
         A                                      COLOR(BLU)
         A                                      DSPATR(UL)
         A                                  3 17'Fr'
         A                                      COLOR(BLU)
         A                                      DSPATR(UL)
         A                                  3 20'Sa'
         A                                      COLOR(BLU)
         A                                      DSPATR(UL)
         A            CALBLOCK01     2A  B  4  2DSPATR(&ATTR01)
         A  31                                  DSPATR(PC)
         A            CALBLOCK02     2A  B  4  5DSPATR(&ATTR02)
         A  32                                  DSPATR(PC)
         A            CALBLOCK03     2A  B  4  8DSPATR(&ATTR03)
         A  33                                  DSPATR(PC)
         A            CALBLOCK04     2A  B  4 11DSPATR(&ATTR04)
         A  34                                  DSPATR(PC)
         A            CALBLOCK05     2A  B  4 14DSPATR(&ATTR05)
         A  35                                  DSPATR(PC)
         A            CALBLOCK06     2A  B  4 17DSPATR(&ATTR06)
         A  36                                  DSPATR(PC)
         A            CALBLOCK07     2A  B  4 20DSPATR(&ATTR07)
         A  37                                  DSPATR(PC)
         A            CALBLOCK08     2A  B  5  2DSPATR(&ATTR08)
         A  38                                  DSPATR(PC)
         A            CALBLOCK09     2A  B  5  5DSPATR(&ATTR09)
         A  39                                  DSPATR(PC)
         A            CALBLOCK10     2A  B  5  8DSPATR(&ATTR10)
         A  40                                  DSPATR(PC)
         A            CALBLOCK11     2A  B  5 11DSPATR(&ATTR11)
         A  41                                  DSPATR(PC)
         A            CALBLOCK12     2A  B  5 14DSPATR(&ATTR12)
         A  42                                  DSPATR(PC)
         A            CALBLOCK13     2A  B  5 17DSPATR(&ATTR13)
         A  43                                  DSPATR(PC)
         A            CALBLOCK14     2A  B  5 20DSPATR(&ATTR14)
         A  44                                  DSPATR(PC)
         A            CALBLOCK15     2A  B  6  2DSPATR(&ATTR15)
         A  45                                  DSPATR(PC)
         A            CALBLOCK16     2A  B  6  5DSPATR(&ATTR16)
         A  46                                  DSPATR(PC)
         A            CALBLOCK17     2A  B  6  8DSPATR(&ATTR17)
         A  47                                  DSPATR(PC)
         A            CALBLOCK18     2A  B  6 11DSPATR(&ATTR18)
         A  48                                  DSPATR(PC)
         A            CALBLOCK19     2A  B  6 14DSPATR(&ATTR19)
         A  49                                  DSPATR(PC)
         A            CALBLOCK20     2A  B  6 17DSPATR(&ATTR20)
         A  50                                  DSPATR(PC)
         A            CALBLOCK21     2A  B  6 20DSPATR(&ATTR21)
         A  51                                  DSPATR(PC)
         A            CALBLOCK22     2A  B  7  2DSPATR(&ATTR22)
         A  52                                  DSPATR(PC)
         A            CALBLOCK23     2A  B  7  5DSPATR(&ATTR23)
         A  53                                  DSPATR(PC)
         A            CALBLOCK24     2A  B  7  8DSPATR(&ATTR24)
         A  54                                  DSPATR(PC)
         A            CALBLOCK25     2A  B  7 11DSPATR(&ATTR25)
         A  55                                  DSPATR(PC)
         A            CALBLOCK26     2A  B  7 14DSPATR(&ATTR26)
         A  56                                  DSPATR(PC)
         A            CALBLOCK27     2A  B  7 17DSPATR(&ATTR27)
         A  57                                  DSPATR(PC)
         A            CALBLOCK28     2A  B  7 20DSPATR(&ATTR28)
         A  58                                  DSPATR(PC)
         A            CALBLOCK29     2A  B  8  2DSPATR(&ATTR29)
         A  59                                  DSPATR(PC)
         A            CALBLOCK30     2A  B  8  5DSPATR(&ATTR30)
         A  60                                  DSPATR(PC)
         A            CALBLOCK31     2A  B  8  8DSPATR(&ATTR31)
         A  61                                  DSPATR(PC)
         A            CALBLOCK32     2A  B  8 11DSPATR(&ATTR32)
         A  62                                  DSPATR(PC)
         A            CALBLOCK33     2A  B  8 14DSPATR(&ATTR33)
         A  63                                  DSPATR(PC)
         A            CALBLOCK34     2A  B  8 17DSPATR(&ATTR34)
         A  64                                  DSPATR(PC)
         A            CALBLOCK35     2A  B  8 20DSPATR(&ATTR35)
         A  65                                  DSPATR(PC)
         A            CALBLOCK36     2A  B  9  2DSPATR(&ATTR36)
         A  66                                  DSPATR(PC)
         A            CALBLOCK37     2A  B  9  5DSPATR(&ATTR37)
         A  67                                  DSPATR(PC)
         A            CALBLOCK38     2A  B  9  8DSPATR(&ATTR38)
         A  68                                  DSPATR(PC)
         A            CALBLOCK39     2A  B  9 11DSPATR(&ATTR39)
         A  69                                  DSPATR(PC)
         A            CALBLOCK40     2A  B  9 14DSPATR(&ATTR40)
         A  70                                  DSPATR(PC)
         A            CALBLOCK41     2A  B  9 17DSPATR(&ATTR41)
         A  71                                  DSPATR(PC)
         A            CALBLOCK42     2A  B  9 20DSPATR(&ATTR42)
         A  72                                  DSPATR(PC)
         A            PMONTH         1A  O  1  1COLOR(WHT)
         A            NMONTH         1A  O  1 13COLOR(WHT)
         A            MONTHHDG       9A  O  1  3COLOR(WHT)
         A            PYEAR          1A  O  1 15COLOR(WHT)
         A            NYEAR          1A  O  1 22COLOR(WHT)
         A          R ASSUME
         A                                      KEEP
         A                                      ASSUME
         A                                  1  3' '
    I will put the source code for the program in the next message due to space limitations.
    Michael Catalani
    IS Director, eCommerce & Web Development
    Acceptance Insurance Corporation
    www.AcceptanceInsurance.com
    www.ProvatoSys.com

  • #2
    Re: Pop Up Calendar In Free Format

    Calendar Program Source
    Code:
     
          * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
          *
          *  C a l e n d a r  - Popup Calendar With Selection
          *
          *          @copyrite 1997, 2009 Michael Catalani
          *           ProvatoSys  www.ProvatoSys.com
          *           mcatalani@aol.com
          *           901.581.8791
          *
          *  Display a popup calendar and allow date selection
          *
          *
          * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
         h dftactgrp( *no )  bnddir( 'QSNAPI' )
     
         fCalendard cf   e             workstn
         f                                     indds( IndicatorDS  )
         f                                     usropn
     
         d EarliestDate    s               d   Inz( d'1900-01-01' )
         d BlockPointer    s              2  0
         d TodayPointer    s              3  0
         d Looper          s              2  0
         d DayOfMonth      s              2  0
         d SelectedDate    s               d
         d InitialDate     s               d   Inz( d'0001-01-01' )
         d WorkingDate     s               d
         d Mode            s              1A
         d errDS           s             16A   Inz( *AllX'00' )
     
         d CellBlock       s              2s 0 Dim( 42 )
     
          * Array Of Month Names
         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  MonthName                     9    Dim( 12 ) OverLay( MonthNames )
     
          * Calendar Block Fields Display Attributes Array
         d Attributes      ds
         d  Attr01                        1    Inz( NormalImage )
         d  Attr02                        1    Inz( NormalImage )
         d  Attr03                        1    Inz( NormalImage )
         d  Attr04                        1    Inz( NormalImage )
         d  Attr05                        1    Inz( NormalImage )
         d  Attr06                        1    Inz( NormalImage )
         d  Attr07                        1    Inz( NormalImage )
         d  Attr08                        1    Inz( NormalImage )
         d  Attr09                        1    Inz( NormalImage )
         d  Attr10                        1    Inz( NormalImage )
         d  Attr11                        1    Inz( NormalImage )
         d  Attr12                        1    Inz( NormalImage )
         d  Attr13                        1    Inz( NormalImage )
         d  Attr14                        1    Inz( NormalImage )
         d  Attr15                        1    Inz( NormalImage )
         d  Attr16                        1    Inz( NormalImage )
         d  Attr17                        1    Inz( NormalImage )
         d  Attr18                        1    Inz( NormalImage )
         d  Attr19                        1    Inz( NormalImage )
         d  Attr20                        1    Inz( NormalImage )
         d  Attr21                        1    Inz( NormalImage )
         d  Attr22                        1    Inz( NormalImage )
         d  Attr23                        1    Inz( NormalImage )
         d  Attr24                        1    Inz( NormalImage )
         d  Attr25                        1    Inz( NormalImage )
         d  Attr26                        1    Inz( NormalImage )
         d  Attr27                        1    Inz( NormalImage )
         d  Attr28                        1    Inz( NormalImage )
         d  Attr29                        1    Inz( NormalImage )
         d  Attr30                        1    Inz( NormalImage )
         d  Attr31                        1    Inz( NormalImage )
         d  Attr32                        1    Inz( NormalImage )
         d  Attr33                        1    Inz( NormalImage )
         d  Attr34                        1    Inz( NormalImage )
         d  Attr35                        1    Inz( NormalImage )
         d  Attr36                        1    Inz( NormalImage )
         d  Attr37                        1    Inz( NormalImage )
         d  Attr38                        1    Inz( NormalImage )
         d  Attr39                        1    Inz( NormalImage )
         d  Attr40                        1    Inz( NormalImage )
         d  Attr41                        1    Inz( NormalImage )
         d  Attr42                        1    Inz( NormalImage )
         d AttributeArray                 1    Dim( 42 ) OverLay( Attributes )
     
          * Calendar Block Day Numbers Array
         d CalBlock        ds
         d   CalBlock01                   2
         d   CalBlock02                   2
         d   CalBlock03                   2
         d   CalBlock04                   2
         d   CalBlock05                   2
         d   CalBlock06                   2
         d   CalBlock07                   2
         d   CalBlock08                   2
         d   CalBlock09                   2
         d   CalBlock10                   2
         d   CalBlock11                   2
         d   CalBlock12                   2
         d   CalBlock13                   2
         d   CalBlock14                   2
         d   CalBlock15                   2
         d   CalBlock16                   2
         d   CalBlock17                   2
         d   CalBlock18                   2
         d   CalBlock19                   2
         d   CalBlock20                   2
         d   CalBlock21                   2
         d   CalBlock22                   2
         d   CalBlock23                   2
         d   CalBlock24                   2
         d   CalBlock25                   2
         d   CalBlock26                   2
         d   CalBlock27                   2
         d   CalBlock28                   2
         d   CalBlock29                   2
         d   CalBlock30                   2
         d   CalBlock31                   2
         d   CalBlock32                   2
         d   CalBlock33                   2
         d   CalBlock34                   2
         d   CalBlock35                   2
         d   CalBlock36                   2
         d   CalBlock37                   2
         d   CalBlock38                   2
         d   CalBlock39                   2
         d   CalBlock40                   2
         d   CalBlock41                   2
         d   CalBlock42                   2
         d  CalendarBlock                 2    Dim( 42 ) OverLay( CalBlock )
     
     
          * Display File Indicators
         d IndicatorDS     ds                  Qualified
         d  ExitKeyPressed...
         d                         3      3n
         d  PageUpPressed         90     90n
         d  PageDownPressed...
         d                        91     91n
         d  LargeScreen           20     20n
         d  PC01                  31     31n
         d  PC02                  32     32n
         d  PC03                  33     33n
         d  PC04                  34     34n
         d  PC05                  35     35n
         d  PC06                  36     36n
         d  PC07                  37     37n
         d  PC08                  38     38n
         d  PC09                  39     39n
         d  PC10                  40     40n
         d  PC11                  41     41n
         d  PC12                  42     42n
         d  PC13                  43     43n
         d  PC14                  44     44n
         d  PC15                  45     45n
         d  PC16                  46     46n
         d  PC17                  47     47n
         d  PC18                  48     48n
         d  PC19                  49     49n
         d  PC20                  50     50n
         d  PC21                  51     51n
         d  PC22                  52     52n
         d  PC23                  53     53n
         d  PC24                  54     54n
         d  PC25                  55     55n
         d  PC26                  56     56n
         d  PC27                  57     57n
         d  PC28                  58     58n
         d  PC29                  59     59n
         d  PC30                  60     60n
         d  PC31                  61     61n
         d  PC32                  62     62n
         d  PC33                  63     63n
         d  PC34                  64     64n
         d  PC35                  65     65n
         d  PC36                  66     66n
         d  PC37                  67     67n
         d  PC38                  68     68n
         d  PC39                  69     69n
         d  PC40                  70     70n
         d  PC41                  71     71n
         d  PC42                  72     72n
     
          * Position Cursor Array
         d PC              ds                  Qualified
         d  PC01                          1n
         d  PC02                          1n
         d  PC03                          1n
         d  PC04                          1n
         d  PC05                          1n
         d  PC06                          1n
         d  PC07                          1n
         d  PC08                          1n
         d  PC09                          1n
         d  PC10                          1n
         d  PC11                          1n
         d  PC12                          1n
         d  PC13                          1n
         d  PC14                          1n
         d  PC15                          1n
         d  PC16                          1n
         d  PC17                          1n
         d  PC18                          1n
         d  PC19                          1n
         d  PC20                          1n
         d  PC21                          1n
         d  PC22                          1n
         d  PC23                          1n
         d  PC24                          1n
         d  PC25                          1n
         d  PC26                          1n
         d  PC27                          1n
         d  PC28                          1n
         d  PC29                          1n
         d  PC30                          1n
         d  PC31                          1n
         d  PC32                          1n
         d  PC33                          1n
         d  PC34                          1n
         d  PC35                          1n
         d  PC36                          1n
         d  PC37                          1n
         d  PC38                          1n
         d  PC39                          1n
         d  PC40                          1n
         d  PC41                          1n
         d  PC42                          1n
         d PositionCursor                 1n   Dim( 42 ) OverLay( PC )
     
          * Display Attribute Constants
         d NormalImage     c                   Const( x'20' )
         d ReverseImage    c                   Const( x'21' )
         d ProtectField    c                   Const( x'A0' )
     
         d SetScreenSize   pr
         d SelectedDateVerification...
         d                 pr
     
         d FirstofTheMonth...
         d                 pr              d
         d  PassedDate                     d   Const
     
         d EndOfTheMonth...
         d                 pr              d
         d  PassedDate                     d   Const
     
         d Main            pr                  ExtPgm( 'CALENDAR' )
         d  PassedDate                     d
         d  WindowLineNumber...
         d                                2p 0 Options( *NoPass ) Const
         d  WindowPositionNumber...
         d                                3p 0 Options( *NoPass ) Const
     
         d Main            pi
         d  PassedDate                     d
         d  WindowLineNumber...
         d                                2p 0 Options( *NoPass ) Const
         d  WindowPositionNumber...
         d                                3p 0 Options( *NoPass ) Const
     
         d RetrieveDisplaySize...
         d                 pr                  extProc( 'QsnRtvMod' )
         d   ScreenSize                   1A
         d   llHandle                    10I 0 Options( *Omit  ) Const
         d   error                       16A   Options( *VarSize )
     
          /free
     
           if %parms >= 2;
            WindowLine = WindowLineNumber;
           endif;
     
           if %parms >= 3;
             WindowPos = WindowPositionNumber;
           endif;
     
           SetScreenSize();
     
           // Main Calendar Display Loop
           dou IndicatorDS.ExitKeyPressed;
     
            clear Attributes;
            clear CellBlock;
            clear CalendarBlock;
     
            if WorkingDate < EarliestDate;
             WorkingDate = EarliestDate;
            endif;
     
            // Get The Calendar Block # For The 1st Day Of The Month
            BlockPointer =%abs( %rem( %diff(  %date( '1899-12-31' )
                                            : FirstOfTheMonth( WorkingDate )
                                            : *days )
                                                     :7 )) +1 ;
     
            // Fill In The Calendar Block Array With The Day Numbers
            for DayOfMonth = 1 to %subdt( EndOfTheMonth( WorkingDate ): *days );
              CellBlock( BlockPointer ) =  DayOfMonth ;
              BlockPointer += 1;
            endfor;
     
            // Set The Calendar Month And Year Headings
            MonthHdg = MonthName( %subdt( WorkingDate : *months ));
            YearHdg  = %subdt( WorkingDate : *years );
     
            // Fill In The Calendar Blocks With The Day Numbers
            For Looper = 1 to 42;
              CalendarBlock( Looper ) = %editc( CellBlock( Looper ) : 'Z' );
            endfor;
     
            // Reverse Image Todays Date If It Is Displayed On This Calendar
            if %subdt( WorkingDate : *years )  = %subdt( %date : *years ) AND
               %subdt( WorkingDate : *months ) = %subdt( %date : *months );
                 TodayPointer = %lookup( %subdt( %date : *days ) : CellBlock );
                 AttributeArray( TodayPointer ) = ReverseImage;
            endif;
     
            // Position The Cursor To The Passed Date If It Is On This Calendar
            if %subdt( WorkingDate : *years )  = %subdt( PassedDate : *years ) AND
               %subdt( WorkingDate : *months ) = %subdt( PassedDate : *months );
                 TodayPointer = %lookup( %subdt( PassedDate : *days ) : CellBlock );
                 PC.PositionCursor( TodayPointer ) = *on;
            endif;
     
            // Field Protect Any Calendar Block Which Does Not Contain A Day
            for Looper = 1 to 42;
              if CalendarBlock( Looper ) = *blanks;
                AttributeArray( Looper ) = ProtectField;
              endif;
            endfor;
     
            eval-corr IndicatorDS = PC;
            exfmt popup;
     
            reset PC;
     
            Select;
            when CsrFld = 'PMONTH' OR IndicatorDS.PageUpPressed;
                WorkingDate -= %months( 1 );
            when CsrFld = 'NMONTH' OR IndicatorDS.PageDownPressed;
              WorkingDate += %months( 1 );
            when CsrFld = 'PYEAR';
                WorkingDate -= %years( 1 );
            when CsrFld = 'NYEAR';
              WorkingDate += %years( 1 );
            other;
              SelectedDateVerification();
              if SelectedDate > InitialDate;
                PassedDate = SelectedDate;
                leave;
              endif;
            endsl;
     
           enddo;
     
           close CalendarD;
           *inlr = *on;
     
          /end-free
     
          * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
          *
          *  S e l e c t e d D a t e V e r i f i c a t i o n
          *
          *        Returns the day of the selected Calendar Block
          *
          * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     
         p SelectedDateVerification...
         p                 b
         d SelectedDateverification...
         d                 pi
          /free
     
            Select;
             when csrfld     = 'CALBLOCK01' AND
                  Attr01     <> ProtectField    AND
                  CalBlock01 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock01 ));
     
             when csrfld     = 'CALBLOCK02' AND
                  Attr02     <> ProtectField    AND
                  CalBlock02 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock02 ));
     
             when csrfld     = 'CALBLOCK03' AND
                  Attr03     <> ProtectField    AND
                  CalBlock03 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock03 ));
     
             when csrfld     = 'CALBLOCK04' AND
                  Attr04     <> ProtectField    AND
                  CalBlock04 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock04 ));
     
             when csrfld     = 'CALBLOCK05' AND
                  Attr05     <> ProtectField    AND
                  CalBlock05 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock05 ));
     
             when csrfld     = 'CALBLOCK06' AND
                  Attr06     <> ProtectField    AND
                  CalBlock06 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock06 ));
     
             when csrfld     = 'CALBLOCK07' AND
                  Attr07     <> ProtectField    AND
                  CalBlock07 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock07 ));
     
             when csrfld     = 'CALBLOCK08' AND
                  Attr08     <> ProtectField    AND
                  CalBlock08 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock08 ));
     
             when csrfld     = 'CALBLOCK09' AND
                  Attr09     <> ProtectField    AND
                  CalBlock09 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock09 ));
     
             when csrfld     = 'CALBLOCK10' AND
                  Attr10     <> ProtectField    AND
                  CalBlock10 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock10 ));
     
             when csrfld     = 'CALBLOCK11' AND
                  Attr11     <> ProtectField    AND
                  CalBlock11 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock11 ));
     
             when csrfld     = 'CALBLOCK12' AND
                  Attr12     <> ProtectField    AND
                  CalBlock12 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock12 ));
     
             when csrfld     = 'CALBLOCK13' AND
                  Attr13     <> ProtectField    AND
                  CalBlock13 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock13 ));
     
             when csrfld     = 'CALBLOCK14' AND
                  Attr14     <> ProtectField    AND
                  CalBlock14 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock14 ));
     
             when csrfld     = 'CALBLOCK15' AND
                  Attr15     <> ProtectField    AND
                  CalBlock15 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock15 ));
     
             when csrfld     = 'CALBLOCK16' AND
                  Attr16     <> ProtectField    AND
                  CalBlock16 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock16 ));
     
             when csrfld     = 'CALBLOCK17' AND
                  Attr17     <> ProtectField    AND
                  CalBlock17 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock17 ));
     
             when csrfld     = 'CALBLOCK18' AND
                  Attr18     <> ProtectField    AND
                  CalBlock18 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock18 ));
     
             when csrfld     = 'CALBLOCK19' AND
                  Attr19     <> ProtectField    AND
                  CalBlock19 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock19 ));
     
             when csrfld     = 'CALBLOCK20' AND
                  Attr20     <> ProtectField    AND
                  CalBlock20 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock20 ));
     
             when csrfld     = 'CALBLOCK21' AND
                  Attr21     <> ProtectField    AND
                  CalBlock21 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock21 ));
     
             when csrfld     = 'CALBLOCK22' AND
                  Attr22     <> ProtectField    AND
                  CalBlock22 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock22 ));
     
             when csrfld     = 'CALBLOCK23' AND
                  Attr23     <> ProtectField    AND
                  CalBlock23 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock23 ));
     
             when csrfld     = 'CALBLOCK24' AND
                  Attr24     <> ProtectField    AND
                  CalBlock24 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock24 ));
     
             when csrfld     = 'CALBLOCK25' AND
                  Attr25     <> ProtectField    AND
                  CalBlock25 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock25 ));
     
             when csrfld     = 'CALBLOCK26' AND
                  Attr26     <> ProtectField    AND
                  CalBlock26 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock26 ));
     
             when csrfld     = 'CALBLOCK27' AND
                  Attr27     <> ProtectField    AND
                  CalBlock27 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock27 ));
     
             when csrfld     = 'CALBLOCK28' AND
                  Attr28     <> ProtectField    AND
                  CalBlock28 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock28 ));
     
             when csrfld     = 'CALBLOCK29' AND
                  Attr29     <> ProtectField    AND
                  CalBlock29 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock29 ));
     
             when csrfld     = 'CALBLOCK30' AND
                  Attr30     <> ProtectField    AND
                  CalBlock30 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock30 ));
     
             when csrfld     = 'CALBLOCK31' AND
                  Attr31     <> ProtectField    AND
                  CalBlock31 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock31 ));
     
             when csrfld     = 'CALBLOCK32' AND
                  Attr32     <> ProtectField    AND
                  CalBlock32 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock32 ));
     
             when csrfld     = 'CALBLOCK33' AND
                  Attr33     <> ProtectField    AND
                  CalBlock33 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock33 ));
     
             when csrfld     = 'CALBLOCK34' AND
                  Attr34     <> ProtectField    AND
                  CalBlock34 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock34 ));
     
             when csrfld     = 'CALBLOCK35' AND
                  Attr35     <> ProtectField    AND
                  CalBlock35 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock35 ));
     
             when csrfld     = 'CALBLOCK36' AND
                  Attr36     <> ProtectField    AND
                  CalBlock36 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock36 ));
     
             when csrfld     = 'CALBLOCK37' AND
                  Attr37     <> ProtectField    AND
                  CalBlock37 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock37 ));
     
             when csrfld     = 'CALBLOCK38' AND
                  Attr38     <> ProtectField    AND
                  CalBlock38 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock38 ));
     
             when csrfld     = 'CALBLOCK39' AND
                  Attr39     <> ProtectField    AND
                  CalBlock39 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock39 ));
     
             when csrfld     = 'CALBLOCK40' AND
                  Attr40     <> ProtectField    AND
                  CalBlock40 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock40 ));
     
             when csrfld     = 'CALBLOCK41' AND
                  Attr41     <> ProtectField    AND
                  CalBlock41 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock41 ));
     
             when csrfld     = 'CALBLOCK42' AND
                  Attr42     <> ProtectField    AND
                  CalBlock42 <> *blanks;
                  SelectedDate = WorkingDate -
                                 %days( %subdt( WorkingDate : *days )) +
                                 %days( %int( CalBlock42 ));
     
             endsl;
          /end-free
         p                 e
     
          * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
          *
          *  S e t S c r e e n S i z e
          *
          *        Sets the Screen sie of the Calendar popup window to the current
          *        Screen Size Mode
          *
          * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     
     
         p SetScreenSize...
         p                 b
         d SetScreenSize...
         d                 pi
          /free
     
             if WindowLine = 0;
               WindowLine = 1;
             endif;
     
             if WindowPos = 0;
               WindowPos = 1;
             endif;
     
             if WindowLine = 1 AND WindowPos = 1;
               WindowPos = 2;
             endif;
     
             if WindowLine > 14;
               WindowLine = 14;
             endif;
     
             RetrieveDisplaySize( mode : *omit : errds );
             if Mode = '4';
               IndicatorDS.LargeScreen = *on;
               if WindowPos > 90;
                 WindowPos = 90;
               endif;
             else;
               if WindowPos > 54;
                 WindowPos = 54;
               endif;
             endif;
     
             open CalendarD;
     
             SelectedDate = PassedDate;
     
             pMonth = '&#171;';
             nMonth = '&#187;';
             pYear  = '&#171;';
             nYear  = '&#187;';
             WorkingDate = PassedDate;
     
          /end-free
         p                 e
     
     
          * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
          *
          *  F i r s t O f T h e M o n t h
          *
          *        Returns the 1st day of the month in date format for a given date
          *            ie  PassedDate = 2008-06-10
          *                Returns      2008-06-01
          *
          *
          *          Input Field - Input Date ( Date Field )
          *          Returns     - 1st Date For The Month of the passed Date
          *                        ( Date Field )
          * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
         p FirstOfTheMonth...
         p                 b                   export
         d FirstOfTheMonth...
         d                 pi              d
         d  PassedDate                     d   Const
     
         d FirstOfMonthDate...
         d                 s               d
     
          /free
     
           FirstOfMonthDate = PassedDate -
                              %days( %subdt( PassedDate : *d )) +
                              %days( 1 );
     
           return ( FirstOfMonthDate );
     
          /end-free
         p                 e
     
     
          * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
          *
          *  E n d O f T h e M o n t h
          *
          *        Returns the last day of the month in date format for a given date
          *            ie  PassedDate = 2008-06-10
          *                Returns      2008-06-01
          *
          *
          *          Input Field - Input Date ( Date Field )
          *          Returns     - 1st Date For The Month of the passed Date
          *                        ( Date Field )
          * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
         p EndOfTheMonth...
         p                 b
         d EndOfTheMonth...
         d                 pi              d
         d  PassedDate                     d   Const
     
         d  EndOfMonthDate...
         d                 s               d
     
          /free
     
             EndOfMonthDate = FirstOfTheMonth( PassedDate ) +
                              %months(1) -
                              %days(1);
     
            return ( EndOfMonthDate );
     
          /end-free
         p                 e


    I will also update my site with a popup calendar service program in a few days.


    The page to my site which has this code can be found at:


    Let me know if you find any bugs, as I have just completely revamped the program into free format.
    Michael Catalani
    IS Director, eCommerce & Web Development
    Acceptance Insurance Corporation
    www.AcceptanceInsurance.com
    www.ProvatoSys.com

    Comment


    • #3
      Re: Pop Up Calendar In Free Format

      very nice Michael

      I did this one a couple days ago... its not complete but you can use mouse and tab from date to date....It may be a bit hard to look at...but so am I

      I had big plans to finish it but .......... you know.
      Attached Files
      All my answers were extracted from the "Big Dummy's Guide to the As400"
      and I take no responsibility for any of them.

      www.code400.com

      Comment

      Working...
      X