去年空闲时候写的一个ABAP的万年历，但是一直没能把农历做好，哪位朋友有兴趣可以帮忙扩充一下。
Code*&---------------------------------------------------------------------*
*& Report ZQSWNL
*& 简易万年历
*&---------------------------------------------------------------------*
*&
*& 由于个人能力有限，暂时还没有研究明白农历和公历的换算方法，
*& 因此大量农历节庆现在无法加入，谁有兴趣可以帮忙写一下。
*&
*& 我也没搞明白开源 GNU 协议到底是个甚，反正大家自觉遵守就是了。
*&
*& 程序中调用了几个函数，一般系统中都应该存在，万一不存在的话，
*& 请跟我联系说明，我继续寻找更通用的函数。
*&
*& 本人联系方式：
*& E-mail/MSN：qiangsheng@hotmail.com
*& 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
