カレンダー(一部バグあり)

;hsp3.21
;
#include "anthspex3.as"

 ;↓added by hsp2to3
 dim br,16
 sdim s,64
 sdim t,64
 sdim u,64
 ;↑added by hsp2to3

;このカレンダーは、以下のことを事実と考えて作られています
;・紀元前46年からユリウス暦（したがって、それ以前の動作は未定義）
;・紀元前44年から紀元前8年まで、誤って3年ごとに13の閏年が設けられた
;・上記の誤りを正すため、紀元前5年、紀元前1年、西暦4年は閏年にしなかった
;・紀元前1年の翌年は西暦1年
;・1582年10月4日の翌日は10月15日で、この日からグレゴリオ暦
;　（実際の採用は国によって異なる）
;※日本については1873年１月１日から有効

 fsize=16
 hw=fsize+4  ;１日分の高さ
 bday=fsize+8 ;１日分の横幅
 bmon=bday*7+8 ;１月分の横幅
 ;各月の日数
 dim mday,13
 ;mday.2（２月の日数）は後で書き換える
 mday=0,31,28,31,30,31,30,31,31,30,31,30,31
 ;国民の祝日
 nholiday=15
 dim holidaym,nholiday
 dim holidayd,nholiday
 dim holidayw,nholiday
 dim holidayy,nholiday
 ;↓後で年による修正が行なわれる
 ;        0 1  2 3  4 5 6 7 8 9 10 11 12 13 14
 holidaym=1,1, 2,3, 4,5,5,5,7,9, 9,10,11,11,12
 holidayd=1,0,11,0,29,3,4,5,0,0, 0, 0, 3,23,23
 holidayw=0,2, 0,0, 0,0,0,0,3,3, 0, 2, 0, 0, 0
 ;holidayd=0 は春分・秋分・第n月曜
 ;holidaywは第何月曜か
 ;有効開始年
 ;        正月 成人 建国 春分 昭和 憲法 みど 子供 海   敬老 秋分 体育 文化 勤労 天皇
 ;        0    1    2    3    4    5    6    7    8    9    10   11   12   13   14
 holidayy=1873,1948,1873,1948,1912,1948,1985,1948,1996,1966,1948,1966,1873,1948,1989
 ;画面
 wid=bmon*4+16: heit=(8*3+3)*hw
 screen 0,wid,heit,,(ginfo_dispx-wid)/2,(ginfo_dispy-heit)/2
 title "-46年（日本では1873年）から有効なカレンダー"
 getsyscolor br,15: if br==192 {
  br--
 }
 dup bg,br.1: if bg==192 {
  bg--
 }
 dup bb,br.2: if bb==192 {
  bb--
 }
 color br,bg,bb: boxf
 font "ＭＳ ゴシック",fsize: color
 year=gettime(0)
 wyear=fsize*2+10: hyear=fsize
 objh=fsize+8
 btw=fsize+8: objsize btw
 x=(wid-(btw*2+wyear+44))/2: y=8
 pos x,y: button "←", *l_back: x+=btw+4: btleft=oid: oid++
 inyear=""+year
 xyear=x: yyear=y+4
 pos x,y: input inyear,wyear,objh,4: x+=wyear: inid=oid: oid++
 pos x,y+4: mes "年": x+=fsize+4
 pos x,y: button "→", *l_forw: x+=btw+4: btrit=oid: oid++
 begy=y+32
*l_restart
 if year<0 {
  if year<-7 { ;-8年以前
   if year\3==-2 {
    mday.2=29
   } else {
    mday.2=28
   }
  } else {  ;～-1年
   mday.2=28
  }
 } else { if year\4!=0 {  ;４の倍数でない
  mday.2=28
 } else { if year\400==0 { ;４００の倍数
  mday.2=29
 } else { if year\100==0 { ;１００の倍数
  if year<1582 {
   mday.2=29
  } else {
   mday.2=28
  }
 } else { if year!=4 {  ;４年でない
  mday.2=29
 } else {     ;４年
  mday.2=28
 } } } } }
 if year>1872 {
  ;春分の日・秋分の日の計算
  d=year-2000
  e=d*2421904
  holidayd.3 =(e+6911500)/10000000-(d/4)+(d/100)-(d/400)+20
  holidayd.10=(e+ 900000)/10000000-(d/4)+(d/100)-(d/400)+23
  ;祝日
  repeat nholiday
   if holidayw.cnt>0 {
    ;第 n 月曜の祝日の日付確定
    getweek c,year,holidaym.cnt,1
    d=holidayw.cnt*7
    if c<2 { ;1日が日曜か月曜のとき
     holidayd.cnt=d-5-c
    } else { ;1日が火曜～土曜のとき
     holidayd.cnt=d+2-c
    }
   }
  loop
  if 1912<=year&(year<=1913) { holidaym.4=8: holidayd.4=31 } ;天長節（大正）
  else { if 1914<=year&(year<=1926) { holidaym.4=10: holidayd.4=31 } ;同上
  else { if 1927<=year { holidaym.4=4: holidayd.4=29 } } } ;昭和天皇誕生日
  if 1948<=year {
   if year<=1999 {
    holidayd.1=15 ;成人の日
   }
  }
  if 1948<=year&(year<1966) { holidayd.2=0 } ;建国記念の日
  else { holidayd.2=11 }
  if year>=1966 {
   if year<=1999 {
    holidayd.11=10 ;体育の日
   }
   if year<=2002 {
    holidayd.9=15: holidayd.8=20 ;敬老の日、海の日
   }
  }
 }
 ;１月１日の曜日
 if year>=1582 { ;1582年～
  getweek week,year,1,1
  if year==1582 {
   week=(week+3)\7
  }
 } else { if year>4 { ;5～1581
  week=(year*365+((year-1)/4)+5)\7
 } else { if year>0 { ;1～4
  week=(year*365+6)\7
 } else { if year>-8 { ;-7～-1
  week=(year+84)*365\7
 } else {    ;-44～-8
  week=((year+84)*365+((year+85)/3)+2)\7
 } } } }
 ;カレンダー表示
 by=begy: mon=1
 color br,bg,bb: boxf 16,by,wid,heit
 repeat 12
  ;月の表示
  bx=(mon-1)\4*bmon+16: y=by
  color: pos (bday*7-32)/2+bx,y: mes ""+mon+"月"
  ;曜日の表示
  x=bx: y+=hw
  digit s,""+year,'0',4: digit t,""+mon,'0',2
  s+=t
  if s!"187300">0&(s!"187603"<0) { color }
  else { color 255,0,0 }
  pos x,y: mes "日": x+=bday
  color: pos x,y: mes "月 火 水 木 金": x+=bday*5
  if year>=1873&(s!"187603"<0)|(year<1850) { ;～1850,1873/1～1876/2
   color
  } else { ;1872年以前と1876/3～
   if s!"199204">0 { color 255,0,0 } ;1992/5～
   else { color 0,0,255 }
  }
  pos x,y: mes "土"
  ;日付の表示
  day=1-week: y+=hw
  repeat 6
   x=bx
   w=0
   repeat 7
    if day>0 {
     ;祝日判定
     flg=0 ;祝日フラグ
     repeat nholiday
      if holidayd.cnt==day {
       if holidaym.cnt==mon {
        ;日本では1873年１月１日より太陽暦。
        ;それ以前の祝日は意味なし
        if year>1872 { if year>=holidayy.cnt {
         flg=1
         if year>2007 {
          ;祝日の間の日は休日（敬老と秋分の差が２日の場合）
          if cnt==9 {
           if day+2==holidayd.10 {
            furikae=1
           }
          }
         }
        } }
       }
      }
     loop
     r=0: b=0
     digit s,""+year,'0',4: digit t,""+mon,'0',2: digit u,""+day,'0',2
     s+=t+u
     if year>=1873&(s!"18760312"<0) { ;1873年～1876年３月11日
      if day\5==1 {
       if day!=31 {
        r=255
       }
      }
     } else {   ;1872年以前と1876年３月12日以降
      if (cnt==6) {   ;土曜
       if s!"19920500">0|flg { r=255 }
       else { if year>=1850 { b=255 } }
      } else { if cnt==0 { ;日曜
       r=255
       if flg {
        if s!"19730412">=0 {
         furikae=1
        }
       }
      } else { ;土日以外
       r=0
       if flg {
        r=255
       } else {
        if furikae {
         r=255: furikae=0
        }
       }
      } }
     }
     ;日付の表示
     color r,0,b
     pos x,y
     astr s,day,2,' '
     mes s
    }
    day++
    if year==1582 {
     if mon==10 {
      if day==5 {
       day=15
      }
     }
    }
    if day>mday.mon {
     week=(cnt+1)\7 ;翌月１日の曜日
     break
    }
    x+=bday
    w++
   loop
   if day>mday.mon {
    break
   }
   y+=hw
  loop
  mon++
  if (mon-1)\4==0 {
   by+=hw*8
  }
 loop
 objsel inid: objselstr inid,0,-1
 ;キー入力待ち
 repeat: wait 10
  stick key,,1
  if key&37 {
   break ;←,→,Enter
  }
  prmx=ginfo_act: prmy=ginfo_sel
  if act!=prmx {
   if prmx==0 {
    objsel inid: objselstr inid,0,-1
   }
   act=prmx
  }
 loop
 if key==1 {
  goto *l_back ;←
 }
 if key==4 {
  goto *l_forw ;→
 }
 ;Enter
 year=0+inyear
 if year==0 {
  year=1: goto *l_setyear
 }
 goto *l_restart

*l_back
 year--
 if year==0 {
  year=-1
 }
goto *l_setyear

*l_forw
 year++
 if year==0 {
  year=1
 }
*l_setyear
 s=""+year
 objprm inid,s
goto *l_restart

たまにバグあり。