home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / utilsf / feiertag / FEIERTAG.OPL < prev    next >
Text File  |  1995-05-25  |  5KB  |  248 lines
  1. APP Feiertag : TYPE $1000 : ICON ".\FEIERTAG.PIC" : ENDA
  2.  
  3. PROC Feiertag:
  4.     GLOBAL dkf&,j&,mon$(12,9),c%,ft$(6,19)
  5.     GIPRINT "V3.0 (c) 1094 B. W. Breede"
  6.     TRAP CACHE 2048,2048
  7.     CALL($138b)  : REM unmark active
  8.     ESCAPE OFF
  9.     STATUSWIN ON :FONT 8,0
  10.     gBORDER $0
  11.     gFONT 8
  12.     gSTYLE 33
  13.     msg:("Kirchliche Feiertage:",1,1,300)
  14.     gAT 10,28
  15.     gBORDER 1,340,4
  16.     gSTYLE 0
  17.     ft$(1)="Karfreitag"
  18.     ft$(2)="Ostersonntag"
  19.     ft$(3)="Ostermontag"
  20.     ft$(4)="Christi Himmelfahrt"
  21.     ft$(5)="Pfingstsonntag"
  22.     ft$(6)="Pfingstmontag"
  23.     mon$(1)="Januar"
  24.     mon$(2)="Februar"
  25.     mon$(3)="M☓rz"
  26.     mon$(4)="April"
  27.     mon$(5)="Mai"
  28.     mon$(6)="Juni"
  29.     mon$(7)="Juli"
  30.     mon$(8)="August"
  31.     mon$(9)="September"
  32.     mon$(10)="Oktober"
  33.     mon$(11)="November"
  34.     mon$(12)="Dezember"
  35.     j&=YEAR
  36.     c%=1
  37.     WHILE c%<=6
  38.         msg:(ft$(c%)+":",1,c%+2,200)
  39.         c%=c%+1
  40.     ENDWH
  41.     EvHndler:
  42. ENDP
  43.  
  44. PROC EvHndler:
  45.     LOCAL a%(6),new%,d&
  46.     new%=1
  47.     DO
  48.         GETEVENT a%()
  49.         IF (a%(1)=$404) AND (LEFT$(GETCMD$,1)="X")
  50.             STOP
  51.         ELSEIF ((a%(1) AND $00FF)=%x) AND ((a%(2) AND 8)>0)
  52.             STOP
  53.         ELSEIF a%(1)=32
  54.             j&=YEAR
  55.             new%=1
  56.         ELSEIF a%(1)=259
  57.             IF j&>1980
  58.                 j&=j&-1
  59.                 new%=1
  60.             ELSE
  61.                 GIPRINT "Nicht m“glich.",3
  62.             ENDIF
  63.         ELSEIF a%(1)=258
  64.             IF j&<2030
  65.                 j&=j&+1
  66.                 new%=1
  67.             ELSE
  68.                 GIPRINT "Nicht m“glich.",3
  69.             ENDIF
  70.         ELSEIF a%(1)=291
  71.             HelpDlg:
  72.         ELSEIF a%(1)=290
  73.             new%=Menu%:
  74.         ELSEIF a%(1)=618
  75.             new%=YearDlg%:
  76.         ELSEIF a%(1)=609
  77.             Wr2Agn:
  78.             new%=0
  79.         ENDIF
  80.         IF new%=1
  81.             new%=0
  82.             gSTYLE 9
  83.             msg:(NUM$(j&,4),36,2,50)
  84.             gSTYLE 0
  85.             d&=KF&:
  86.             msg:(date$:(d&),22,3,180)
  87.             msg:(date$:(d&+2),22,4,180)
  88.             msg:(date$:(d&+3),22,5,180)
  89.             msg:(date$:(d&+41),22,6,180)
  90.             msg:(date$:(d&+51),22,7,180)
  91.             msg:(date$:(d&+52),22,8,180)
  92.         ENDIF
  93.     UNTIL 0
  94. ENDP
  95.  
  96. PROC HelpDlg:
  97.     dINIT "Spezielle Tasten:"
  98.     dTEXT "Leertaste:","aktuelles Jahr"
  99.     dTEXT CHR$(26)+":","n☓chstes Jahr"
  100.     dTEXT CHR$(27)+":","voriges Jahr"
  101.     DIALOG
  102. ENDP
  103.  
  104. PROC Menu%:
  105.     LOCAL m%
  106.     mINIT
  107.     mCARD "Programm","beenden",%x
  108.     mCARD "Extras","Jahr w☓hlen...",%j,"Agenda-Eintr☓ge schreiben...",%a
  109.     m%=MENU
  110.     IF m%=0
  111.         RETURN 0
  112.     ELSEIF m%=%x
  113.         STOP
  114.     ELSEIF m%=%j
  115.         RETURN YearDlg%:
  116.     ELSEIF m%=%a
  117.         Wr2Agn:
  118.         RETURN 0
  119.     ENDIF
  120. ENDP
  121.  
  122. PROC YearDlg%:
  123.     dINIT "Jahr w☓hlen:"
  124.     dLONG j&,"Jahr:",1980,2030
  125.     IF DIALOG
  126.         RETURN 1
  127.     ELSE
  128.         RETURN 0
  129.     ENDIF
  130. ENDP
  131.  
  132. PROC Wr2Agn:
  133.     LOCAL f$(128),sym$(1),sty%,err%,h%,attr%,von&,bis&,i&,aj&
  134.     f$="LOC::M:\AGN\*.AGN"
  135.     sym$="Å"
  136.     von&=j&
  137.     bis&=j&
  138.     aj&=j&
  139.     dINIT "Agenda-Eintr☓ge schreiben:"
  140.     dFILE f$,"Agenda-",16+64
  141.     dLONG von&,"von Jahr",1980,2030
  142.     dLONG bis&,"bis Jahr",1980,2030
  143.     dCHOICE sty%,"Textstil","normal,fett,unterstrichen,fett+unterstrichen,kursiv,kursiv+fett,kursiv+unterstrichen,kursiv+fett+unterstrichen"
  144.     dEDIT sym$,"Symbol in Jahresansicht",1
  145.     dCHOICE attr%,"in Jahresansicht anzeigen","ja,nein"
  146.     IF DIALOG
  147.         sty%=sty%-1
  148.         IF sty%>3
  149.             sty%=sty%+28
  150.         ENDIF
  151.         attr%=27+((attr%-2)*(-4))
  152.         err%=IOOPEN(h%,f$,$0103)
  153.         IF bis&<von&
  154.             bis&=von&
  155.         ENDIF
  156.         IF NOT err%
  157.             WHILE von&<=bis&
  158.                 j&=von&
  159.                 gIPRINT "schreibe "+NUM$(j&,4)+"..."
  160.                 kf&:
  161.                 WrItem:(h%,ft$(1),dkf&,sym$,sty%,attr%)
  162.                 WrItem:(h%,ft$(2),dkf&+2,sym$,sty%,attr%)
  163.                 WrItem:(h%,ft$(3),dkf&+3,sym$,sty%,attr%)
  164.                 WrItem:(h%,ft$(4),dkf&+41,sym$,sty%,attr%)
  165.                 WrItem:(h%,ft$(5),dkf&+51,sym$,sty%,attr%)
  166.                 WrItem:(h%,ft$(6),dkf&+52,sym$,sty%,attr%)
  167.                 von&=von&+1
  168.             ENDWH
  169.             IOCLOSE(h%)
  170.             j&=aj&
  171.             gIPRINT "Agenda-Eintr☓ge geschrieben."
  172.         ELSE
  173.             dINIT "Fehler:"
  174.             dTEXT "",ERR$(err%)
  175.             dBUTTONS "OK",-13
  176.             DIALOG
  177.         ENDIF
  178.     ENDIF
  179. ENDP
  180.  
  181. PROC WrItem:(h%,t$,d&,s$,y%,attr%)
  182.     LOCAL attrib%,len&,time&,day&,sym$(1),sty%,txt$(40),err%
  183.     day&=d&
  184.     sym$=s$
  185.     sty%=y%
  186.     time&=$FFFF
  187.     attrib%=attr%
  188.     txt$=t$
  189.     len&=LEN(txt$)+8
  190.     len&=len& OR $2000
  191.     IOWRITE(h%,ADDR(len&),2)
  192.     IOWRITE(h%,ADDR(day&),2)
  193.     IOWRITE(h%,ADDR(time&),2)
  194.     IOWRITE(h%,ADDR(attrib%),1)
  195.     IOWRITE(h%,UADD(ADDR(sym$),1),1)
  196.     IOWRITE(h%,ADDR(sty%),1)
  197.     IOWRITE(h%,ADDR(txt$),LEN(txt$)+1)
  198. ENDP
  199.  
  200. PROC KF&:
  201.     LOCAL a&,b&,c&,d&,e&,m&,n&,day&
  202.     a&=mod&:(j&,int(19))
  203.     b&=mod&:(j&,int(4))
  204.     c&=mod&:(j&,int(7))
  205.     m&=mod&:(j&/100-j&/400-j&/300+15,int(30))
  206.     n&=mod&:(j&/100-j&/400+4,int(7))
  207.     d&=mod&:(19*a&+m&,int(30))
  208.     e&=mod&:(2*b&+4*c&+6*d&+n&,int(7))
  209.     day&=d&+e&+15
  210.     IF (e&<>6) OR NOT ((d&=29) OR ((d&=28) AND (a&>10)))
  211.         day&=day&+7
  212.     ENDIF
  213.     dkf&=DAYS(1,3,j&)-25570+day&
  214.     RETURN dkf&
  215. ENDP
  216.  
  217. PROC date$:(s&)
  218.     LOCAL j%,m%,d%,a%,s$(20),dif&
  219.     dif&=s&-(DATETOSECS(YEAR,MONTH,DAY,0,0,0)/86400)
  220.     IF dif&=-2
  221.         s$="(vorgestern)"
  222.     ELSEIF dif&=-1
  223.         s$="(gestern)"
  224.     ELSEIF dif&=0
  225.         s$="(heute!)"
  226.     ELSEIF dif&=1
  227.         s$="(morgen)"
  228.     ELSEIF dif&=2
  229.         s$="(Ŵbermorgen)"
  230.     ELSE
  231.         SECSTODATE 86400*s&,j%,m%,d%,a%,a%,a%,a%
  232.         s$=NUM$(d%,2)+". "+mon$(m%)
  233.         IF d%<10
  234.             s$="0"+s$
  235.         ENDIF
  236.     ENDIF
  237.     RETURN s$
  238. ENDP
  239.  
  240. PROC mod&:(a&,b&)
  241.     RETURN a&-(a&/b&)*b&
  242. ENDP
  243.  
  244. PROC msg:(s$,s%,z%,b%)
  245.     gAT s%*10,z%*16+5
  246.     gPRINTB s$,b%
  247. ENDP
  248.