简易万年历

Code
*&---------------------------------------------------------------------*
*& Report  ZQSWNL
*& 简易万年历
*&---------------------------------------------------------------------*
*&
*& 由于个人能力有限，暂时还没有研究明白农历和公历的换算方法，
*& 因此大量农历节庆现在无法加入，谁有兴趣可以帮忙写一下。
*&
*& 我也没搞明白开源 GNU 协议到底是个甚，反正大家自觉遵守就是了。
*&
*& 程序中调用了几个函数，一般系统中都应该存在，万一不存在的话，
*& 请跟我联系说明，我继续寻找更通用的函数。
*&
*& 本人联系方式：
*& E-mail/MSN：[email protected]
*& QQ：1011370
*& Blog：http://qiangsheng.cnblogs.com
*&---------------------------------------------------------------------*

REPORT zqswnl NO STANDARD PAGE HEADING LINE-SIZE 123.

TYPE-POOLS: icon.

CONSTANTS: ccellwidth TYPE i VALUE 17,          "单元格宽度
           cpagewidth TYPE i VALUE 123,         "页宽度
           clenyear TYPE i VALUE 10,            "年度提示长度
           clenmonth TYPE i VALUE 11,           "月度提示长度
           clentoday TYPE i VALUE 14,           "当天提示长度
           clencurmon TYPE i VALUE 16,          "当月提示长度
           clenmydate TYPE i VALUE 15,          "我的纪念日长度
           cgap TYPE i VALUE 5.                 "间隔长度

TYPES: BEGIN OF tpspeday,
       mtype  TYPE i,          "纪念类型，0 我的纪念日，1 公共假日，2 节日，3 约会，4 其他日期
       day    TYPE d,          "日期，年为 0000 则表示每年。
       dtext(10) TYPE c,       "日期描述
       END OF tpspeday.

DATA: gcdate TYPE d,                "参照日期，当月 1 日
      gsun TYPE d,                  "根据参照日期获得当周周日，第一天
      gweek TYPE p08_weekno,        "参照日期所在年的第几周
      gnday TYPE d,                 "日期临时变量
      gweeks TYPE i,                "当月总共跨周数
      gcweek TYPE i,                "当前周
      gselmon LIKE isellist-month,  "选中的月度
      gspeday TYPE d,

      gposb TYPE i,
      gpose TYPE i,

      itspeday TYPE TABLE OF tpspeday,
      waspeday LIKE LINE OF itspeday,
      itweekday TYPE TABLE OF t246,
      waweekday LIKE LINE OF itweekday.



INITIALIZATION.
  gcdate = sy-datum.
  gcdate+6(2) = '01'.

START-OF-SELECTION.
* 获取周名称
  CALL FUNCTION 'WEEKDAY_GET'
    EXPORTING
      language = sy-langu
    TABLES
      weekday  = itweekday.
* 创建特殊日期清单
  PERFORM create_speday.

END-OF-SELECTION.
* 获取月度信息
  PERFORM get_month.
* 显示文本标题
  PERFORM show_title.
* 显示网格
  PERFORM show_grid.
* 显示日历内容
  PERFORM show_calendar.


AT LINE-SELECTION.
* 在第二行处理年月切换
  IF sy-lilli EQ 2.
*   上一年
    gposb = 4.
    gpose = gposb + clenyear + 1.
    IF ( sy-cucol GE gposb ) AND ( sy-cucol LE gpose ).
      gcdate+0(4) = gcdate+0(4) - 1.
    ENDIF.
*   上一月
    gposb = gpose + cgap - 1.
    gpose = gposb + clenmonth + 1.
    IF ( sy-cucol GE gposb ) AND ( sy-cucol LE gpose ).
      IF gcdate+4(2) EQ '01'.
        gcdate+0(4) = gcdate+0(4) - 1.
        gcdate+4(2) = '12'.
      ELSE.
        gcdate+4(2) = gcdate+4(2) - 1.
      ENDIF.
    ENDIF.
*   当前月
    gposb = gpose + cgap - 1.
    gpose = gposb + clentoday + 1.
    IF ( sy-cucol GE gposb ) AND ( sy-cucol LE gpose ).
      gcdate = sy-datum.
      gcdate+6(2) = '01'.
    ENDIF.
*   选择月
    gposb = gpose + cgap - 1.
    gpose = gposb + clencurmon + 1.
    IF ( sy-cucol GE gposb ) AND ( sy-cucol LE gpose ).
      CALL FUNCTION 'POPUP_TO_SELECT_MONTH'
        EXPORTING
          actual_month   = gcdate+0(6)
        IMPORTING
          selected_month = gselmon.
      IF gselmon IS NOT INITIAL.
        gcdate+0(6) = gselmon.
      ENDIF.
    ENDIF.
*   选择纪念日
    gposb = gpose + cgap - 1.
    gpose = gposb + clenmydate + 1.
    IF ( sy-cucol GE gposb ) AND ( sy-cucol LE gpose ).
      MESSAGE '本功能尚待开发！'(041) TYPE 'I'.
    ENDIF.
*   下一月
    gposb = gpose + cgap - 1.
    gpose = gposb + clenmonth + 1.
    IF ( sy-cucol GE gposb ) AND ( sy-cucol LE gpose ).
      IF gcdate+4(2) EQ '12'.
        gcdate+0(4) = gcdate+0(4) + 1.
        gcdate+4(2) = '01'.
      ELSE.
        gcdate+4(2) = gcdate+4(2) + 1.
      ENDIF.
    ENDIF.
*   下一年
    gposb = gpose + cgap - 1.
    gpose = gposb + clenyear + 1.
    IF ( sy-cucol GE gposb ) AND ( sy-cucol LE gpose ).
      gcdate+0(4) = gcdate+0(4) + 1.
    ENDIF.

*   获取月度信息
    PERFORM get_month.
*   显示文本标题
    PERFORM show_title.
*   显示网格
    PERFORM show_grid.
*   显示日历内容
    PERFORM show_calendar.

    sy-lsind = 0.
  ELSEIF sy-lilli GT 4.
    PERFORM show_speday USING gspeday.
  ENDIF.

*&---------------------------------------------------------------------*
*&      Form  show_date
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->P_WAMONTH_SUN  text
*      -->P_3      text
*      -->P_GROW  text
*      -->P_6      text
*----------------------------------------------------------------------*
FORM show_date  USING    udate TYPE d
                         ucol TYPE i
                         urow TYPE i
                         ucolor TYPE i.
  DATA: fdigi TYPE i,
        fday TYPE i,
        fcol TYPE i.
* 获取日期
  fday = udate+6(2).
* 获取并显示十位
  fdigi = fday DIV 10.
  fcol = ucol.
  PERFORM show_digital USING fdigi fcol urow ucolor.
* 获取并显示个位
  fdigi = fday - 10 * fdigi.
  fcol = fcol + 6.
  PERFORM show_digital USING fdigi fcol urow ucolor.
* 显示特殊日期图标
  fcol = fcol + 6.
  PERFORM show_icon USING udate fcol urow ucolor.
ENDFORM.                    " show_date

*&---------------------------------------------------------------------*
*&      Form  show_digital
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->UDIGI      text
*      -->UCOL       text
*      -->UROW       text
*      -->UCOLOR     text
*----------------------------------------------------------------------*
FORM show_digital USING udigi TYPE i
                        ucol TYPE i
                        urow TYPE i
                        ucolor TYPE i.
  DATA: frow TYPE i,
        fcol TYPE i,
        fdot TYPE c,
        cline TYPE i,      "当前行
        ftlay(5) TYPE c,   "数字的总体布局
        fllay TYPE c.      "数字的当前行布局

* 处理数字显示布局
  CASE udigi.
    WHEN 0.
      ftlay = 'UBBBU'.
    WHEN 1.
      ftlay = 'RRRRR'.
    WHEN 2.
      ftlay = 'URULU'.
    WHEN 3.
      ftlay = 'URURU'.
    WHEN 4.
      ftlay = 'BBURR'.
    WHEN 5.
      ftlay = 'ULURU'.
    WHEN 6.
      ftlay = 'ULUBU'.
    WHEN 7.
      ftlay = 'URRRR'.
    WHEN 8.
      ftlay = 'UBUBU'.
    WHEN 9.
      ftlay = 'UBURU'.
  ENDCASE.

* 处理显示
  FORMAT RESET.
* 设置显示格式
  FORMAT COLOR = ucolor INTENSIFIED ON.
* 处理布局
  DO 5 TIMES.
*   取指定行的布局，并跳转到相应的行
    cline = sy-index - 1.
    fllay = ftlay+cline(1).
    frow = urow + cline.
    SKIP TO LINE frow.
*   处理各种类型的行
    CASE fllay.
      WHEN 'U'.            "横线
        DO 5 TIMES.
          fcol = ucol + sy-index - 1.     POSITION fcol. WRITE: fdot NO-GAP.
        ENDDO.
      WHEN 'B'.            "双竖线
        fcol = ucol.          POSITION fcol. WRITE: fdot NO-GAP.
        fcol = ucol + 4.      POSITION fcol. WRITE: fdot NO-GAP.
      WHEN 'R'.            "右竖线
        fcol = ucol + 4.      POSITION fcol. WRITE: fdot NO-GAP.
      WHEN 'L'.            "左竖线
        fcol = ucol.          POSITION fcol. WRITE: fdot NO-GAP.
    ENDCASE.
  ENDDO.
  FORMAT RESET.
ENDFORM.                    "show_digital

*&---------------------------------------------------------------------*
*&      Form  get_month
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*
FORM get_month .
* 获取当前月度数据
  CALL FUNCTION 'DATE_GET_WEEK'
    EXPORTING
      date = gcdate
    IMPORTING
      week = gweek.

  CALL FUNCTION 'WEEK_GET_FIRST_DAY'
    EXPORTING
      week = gweek
    IMPORTING
      date = gsun.
  gsun = gsun - 1.

* 计算当月共跨几周
  gweeks = 1.
  gnday = gsun + gweeks * 7.
  WHILE gnday+4(2) EQ gcdate+4(2).
    gweeks = gweeks + 1.
    gnday = gsun + gweeks * 7.
  ENDWHILE.
ENDFORM.                    " get_month

*&---------------------------------------------------------------------*
*&      Form  show_grid
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*
FORM show_grid .
  DATA: fpos TYPE i.
  SKIP TO LINE 1.

  ULINE.
* 显示标题框线
  WRITE:/1 sy-vline.
  fpos = 1 + clenyear + cgap.         POSITION fpos.    WRITE: sy-vline.
  fpos = fpos + clenmonth + cgap.     POSITION fpos.    WRITE: sy-vline.
  fpos = fpos + clentoday + cgap.     POSITION fpos.    WRITE: sy-vline.
  fpos = fpos + clencurmon + cgap.    POSITION fpos.    WRITE: sy-vline.
  fpos = fpos + clenmydate + cgap.    POSITION fpos.    WRITE: sy-vline.
  fpos = fpos + clenmonth + cgap.     POSITION fpos.    WRITE: sy-vline.
  POSITION cpagewidth. WRITE: sy-vline.

* 显示周名称框线
  ULINE.
  WRITE:/1 sy-vline.
  DO 7 TIMES.
    fpos = ccellwidth * sy-index + 1.
    POSITION fpos.
    WRITE: sy-vline.
  ENDDO.
  POSITION cpagewidth.
  WRITE: sy-vline.

* 显示日历框线
  DO gweeks TIMES.
    ULINE.
    DO 5 TIMES.
      WRITE:/1 sy-vline.
      DO 7 TIMES.
        fpos = ccellwidth * sy-index + 1.
        POSITION fpos.
        WRITE: sy-vline.
      ENDDO.
      POSITION cpagewidth.
      WRITE: sy-vline.
    ENDDO.
  ENDDO.
  ULINE.

ENDFORM.                    " show_grid

*&---------------------------------------------------------------------*
*&      Form  show_title
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*
FORM show_title .
  DATA: fpos TYPE i,
        flyear(4) TYPE n,
        flmonth(2) TYPE n,
        fnyear(4) TYPE n,
        fnmonth(2) TYPE n.

* 显示年月跳转和当前显示
* 设置显示格式
  SKIP TO LINE 2.
  FORMAT RESET.
  FORMAT HOTSPOT INTENSIFIED ON COLOR 3.
  fpos = 3.                        flyear = gcdate+0(4) - 1.
  POSITION fpos.                   WRITE: icon_page_left AS ICON NO-GAP,AT (clenyear) '上一年'(011) QUICKINFO flyear.
  fpos = fpos + clenyear + cgap.   flmonth = gcdate+4(2) - 1.
  IF flmonth EQ '00'.
    flmonth = '12'.
  ENDIF.
  POSITION fpos.                   WRITE: icon_column_left AS ICON NO-GAP,AT (clenmonth) '上一月'(012) QUICKINFO flmonth.
  fpos = fpos + clenmonth + cgap.
  POSITION fpos.                   WRITE:AT (6) '今天：'(016) NO-GAP, sy-datum QUICKINFO '返回今天所在月份'(017).
  fpos = fpos + clentoday + cgap.
  POSITION fpos.                   WRITE:AT (10) '当前月份：'(018) NO-GAP, gcdate+0(6) QUICKINFO '选择一个其他的月份'(019).
  fpos = fpos + clencurmon + cgap.
  POSITION fpos.                   WRITE:AT (10) '我的纪念日'(021) NO-GAP QUICKINFO '管理我的纪念日'(022).
  fpos = fpos + clenmydate + cgap. fnmonth = gcdate+4(2) + 1.
  IF fnmonth EQ '13'.
    fnmonth = '01'.
  ENDIF.
  POSITION fpos.                   WRITE:AT (clenmonth) '下一月'(013) QUICKINFO fnmonth NO-GAP RIGHT-JUSTIFIED, icon_column_right AS ICON.
  fpos = fpos + clenmonth + cgap.  fnyear = gcdate+0(4) + 1.
  POSITION fpos.                   WRITE:AT (clenyear) '下一年'(014) QUICKINFO fnyear NO-GAP RIGHT-JUSTIFIED, icon_page_right AS ICON.
  FORMAT RESET.

* 显示周名称
  SKIP TO LINE 4.
  LOOP AT itweekday INTO waweekday.
    fpos = ccellwidth * ( sy-tabix MOD 7 ) + 2.
    POSITION fpos.
    WRITE: (16) waweekday-langt CENTERED NO-GAP.
  ENDLOOP.
  fpos = cpagewidth - 2.
  POSITION fpos.
  WRITE: '周'(020).

ENDFORM.                    " show_title

*&---------------------------------------------------------------------*
*&      Form  show_calendar
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*
FORM show_calendar .
  DATA: fcol TYPE i,                  "显示内容左上角列
        frow TYPE i,                  "显示内容左上角行
        fcolor TYPE i.                "显示内容颜色

  gweek = gweek - 1.
* 显示日期
  DO gweeks TIMES.
    gcweek = sy-index.
    frow = gcweek * 6.
    DO 7 TIMES.
      gnday = gsun + gcweek * 7 + sy-index - 8.
      fcol = ( sy-index - 1 ) * ccellwidth + 3.
      fcolor = 1.
*     周日用红色
      IF ( sy-index EQ 1 ).
        fcolor = 6.
      ENDIF.
*     周六用绿色
      IF ( sy-index EQ 7 ).
        fcolor = 5.
      ENDIF.
*     当天用橙色
      IF ( gnday = sy-datum ).
        fcolor = 7.
      ENDIF.
*     非本周用灰色
      IF ( gnday+4(2) NE gcdate+4(2) ).
        fcolor = 2.
      ENDIF.
*     显示日期
      PERFORM show_date USING gnday fcol frow fcolor.
    ENDDO.
*   显示第几周，并记录该周最后一天。
    gweek = gweek + 1.
*   处理年度最后一周的问题。
    IF gweek+4(2) EQ '01' AND gnday+4(2) EQ '12'.
    ENDIF.
    frow = frow - 1.
    DO 5 TIMES.
      frow = frow + 1.
      SKIP TO LINE frow.
      fcol = cpagewidth - 2.
      POSITION fcol.
      IF sy-index EQ 3.
        WRITE: gweek+4(2).
      ENDIF.
      gspeday = gnday.
      HIDE: gspeday.
    ENDDO.
*   处理年度第一周的问题。
    IF gweek+4(2) GE '51' AND gnday+4(2) EQ '01'.
      gweek+0(4) = gweek+0(4) + 1.
      gweek+4(2) = '00'.
    ENDIF.
*    frow = frow + 2.
*    SKIP TO LINE frow.
*    fcol = cpagewidth - 2.
*    POSITION fcol.
*    WRITE: gweek+4(2).
*    gspeday = gnday.
*    HIDE: gspeday.
  ENDDO.

ENDFORM.                    " show_calendar
*&---------------------------------------------------------------------*
*&      Form  show_icon
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->P_UDATE  text
*      -->P_FCOL  text
*      -->P_UROW  text
*      -->P_UCOLOR  text
*----------------------------------------------------------------------*
FORM show_icon  USING    udate
                         ucol
                         urow
                         ucolor.
  DATA frow TYPE i.
  gspeday = udate.
  LOOP AT itspeday INTO waspeday WHERE day+4(4) = udate+4(4).
    IF waspeday-day+0(4) EQ '0000'.
      CASE waspeday-mtype.
        WHEN 0.
          frow = urow.
          SKIP TO LINE frow.
          POSITION ucol.
          WRITE icon_extra AS ICON HOTSPOT COLOR = ucolor QUICKINFO waspeday-dtext.

        WHEN 1.
          frow = urow + 1.
          SKIP TO LINE frow.
          POSITION ucol.
          WRITE icon_public AS ICON HOTSPOT COLOR = ucolor QUICKINFO waspeday-dtext.

        WHEN 2.
          frow = urow + 2.
          SKIP TO LINE frow.
          POSITION ucol.
          WRITE icon_date AS ICON HOTSPOT COLOR = ucolor QUICKINFO waspeday-dtext.

      ENDCASE.
    ELSE.
      CASE waspeday-mtype.
        WHEN 0.
          frow = urow.
          SKIP TO LINE frow.
          POSITION ucol.
          WRITE icon_extra AS ICON HOTSPOT COLOR = ucolor QUICKINFO waspeday-dtext.

        WHEN 3.
          frow = urow + 3.
          SKIP TO LINE frow.
          POSITION ucol.
          WRITE icon_call_consult AS ICON HOTSPOT COLOR = ucolor QUICKINFO waspeday-dtext.

        WHEN 4.
          frow = urow + 4.
          SKIP TO LINE frow.
          POSITION ucol.
          WRITE icon_date AS ICON HOTSPOT COLOR = ucolor QUICKINFO waspeday-dtext.

      ENDCASE.
    ENDIF.
  ENDLOOP.


ENDFORM.                    " show_icon
*&---------------------------------------------------------------------*
*&      Form  create_speday
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*  -->  p1        text
*  <--  p2        text
*----------------------------------------------------------------------*
FORM create_speday .
  waspeday-mtype = 1.
  waspeday-day = '00000101'. waspeday-dtext = '元旦'(h01). APPEND waspeday TO itspeday.
  waspeday-day = '00000102'. waspeday-dtext = '元旦第二天'(h02). APPEND waspeday TO itspeday.
  waspeday-day = '00000103'. waspeday-dtext = '元旦第三天'(h03). APPEND waspeday TO itspeday.
  waspeday-day = '00000501'. waspeday-dtext = '劳动节'(h04). APPEND waspeday TO itspeday.
  waspeday-day = '00000502'. waspeday-dtext = '劳动节第二天'(h05). APPEND waspeday TO itspeday.
  waspeday-day = '00000503'. waspeday-dtext = '劳动节第三天'(h06). APPEND waspeday TO itspeday.
  waspeday-day = '00001001'. waspeday-dtext = '国庆节'(h07). APPEND waspeday TO itspeday.
  waspeday-day = '00001002'. waspeday-dtext = '国庆节第二天'(h08). APPEND waspeday TO itspeday.
  waspeday-day = '00001003'. waspeday-dtext = '国庆节第三天'(h09). APPEND waspeday TO itspeday.
  waspeday-day = '00001004'. waspeday-dtext = '国庆节第四天'(h10). APPEND waspeday TO itspeday.
  waspeday-day = '00001005'. waspeday-dtext = '国庆节第五天'(h11). APPEND waspeday TO itspeday.
  waspeday-day = '00001006'. waspeday-dtext = '国庆节第六天'(h12). APPEND waspeday TO itspeday.
  waspeday-day = '00001007'. waspeday-dtext = '国庆节第七天'(h13). APPEND waspeday TO itspeday.

  waspeday-mtype = 2.
  waspeday-day = '00000101'. waspeday-dtext = '元旦节'(f01). APPEND waspeday TO itspeday.
  waspeday-day = '00000308'. waspeday-dtext = '妇女节'(f02). APPEND waspeday TO itspeday.
  waspeday-day = '00000312'. waspeday-dtext = '植树节'(f03). APPEND waspeday TO itspeday.
  waspeday-day = '00000315'. waspeday-dtext = '消费者权益日'(f04). APPEND waspeday TO itspeday.
  waspeday-day = '00000501'. waspeday-dtext = '劳动节'(f05). APPEND waspeday TO itspeday.
  waspeday-day = '00000504'. waspeday-dtext = '青年节'(f06). APPEND waspeday TO itspeday.
  waspeday-day = '00000601'. waspeday-dtext = '儿童节'(f07). APPEND waspeday TO itspeday.
  waspeday-day = '00000701'. waspeday-dtext = '建党节'(f08). APPEND waspeday TO itspeday.
  waspeday-day = '00000801'. waspeday-dtext = '建军节'(f09). APPEND waspeday TO itspeday.
  waspeday-day = '00000910'. waspeday-dtext = '教师节'(f10). APPEND waspeday TO itspeday.
  waspeday-day = '00001001'. waspeday-dtext = '国庆节'(f11). APPEND waspeday TO itspeday.
  waspeday-day = '00001225'. waspeday-dtext = '圣诞节'(f12). APPEND waspeday TO itspeday.
  waspeday-day = '00001226'. waspeday-dtext = '毛爷爷诞辰'(f13). APPEND waspeday TO itspeday.


  SORT itspeday BY mtype day.
ENDFORM.                    " create_speday
*&---------------------------------------------------------------------*
*&      Form  show_speday
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->P_GSPEDAY  text
*----------------------------------------------------------------------*
FORM show_speday  USING    uday.
  DATA: fspeday TYPE d.
  fspeday = uday + ( ( sy-cucol + ccellwidth - 3 ) DIV ccellwidth ) - 7.

  READ TABLE itspeday INTO waspeday WITH KEY day+4(4) = fspeday+4(4).
  IF sy-subrc EQ 0.
    WINDOW STARTING AT 10 5 ENDING AT 60 12.
    NEW-PAGE LINE-SIZE 50.
    WRITE:/3 fspeday.
    ULINE.
    LOOP AT itspeday INTO waspeday WHERE day+4(4) = fspeday+4(4).
      CASE waspeday-mtype.
        WHEN 0.
          WRITE:/3 '我的纪念日'(031).
        WHEN 1.
          WRITE:/3 '公共假日'(032).
        WHEN 2.
          WRITE:/3 '节日'(033).
        WHEN 3.
          WRITE:/3 '约会'(034).
        WHEN 4.
          WRITE:/3 '其他日期'(035).
      ENDCASE.
      WRITE: 20(30) waspeday-dtext.
    ENDLOOP.
  ENDIF.
*  LEAVE TO SCREEN 0.

ENDFORM.                    " show_speday