1 REM Ins{nd av Lars Gj|rling <6825> 1986-08-01 00.01.10, med SEND 10 ! *************************************************************************** 20 ! Program KALENDER.BAC 1986-07-31 30 ! av Lars Gj|rling <6825> 35 ! Ins{nt av L.Gj. med anledning av MSG-inl{gg nr 4045, m|te ABC800, fr}n med- lem <1121> Curt Rehnborg. 40 ! TestaT p} ABC 806 50 ! *************************************************************************** 60 ! KALENDER.BAC Ett antal funktioner f|r hantering av kalenderv{rden. 70 ! Kan anv{ndas f|r alla datum fr o m 1960-01-01 t o m }r 2048. 80 ! I funktionen FNDatnum(]r,M}n,Dag) tilldelas varje datum ett datumnummer, 90 ! d{r 1960-01-01 f}r nr 1, 1960-01-02 nr 2 etc. 1986-07-31 f}r nr 9709. 100 ! 110 ! Detta blir mycket anv{ndbart. Antalet dagar mellan tv} givna datum blir helt enkelt Datnum2 - Datnum1. 120 ! 130 ! Veckodag f}r enkelt ur funktionen FNVdag(Datnum)=1+MOD(Datnum+3,7) som ger 1 f|r m}ndag, 2 f|r tisdag ...... 7 f|r s|ndag 140 ! 150 ! Funktionen FNDatum(Datnum) {r omv{ndningen som ur ett datumnummer kan ge ]r, m}nad och dag. 160 ! 170 ! Andra funktioner behandlar veckonummer. 180 ! 190 ! Dagens nummer i }ret ber{knas l{tt som 1 + Datnum - Datnum0, d{r Datnum0 {r datumnumret f|r 1:a januari, aktuellt }r. 200 ! 210 ! ************************************************************************** 220 ! Satserna 260-390 utg|r ett demoprogram och kan tas bort. 230 ! ************************************************************************** 240 ! 250 INTEGER : EXTEND : ; CHR$(12); 260 Flag1=0 : Flag2=0 : ON ERROR GOTO 280 270 INPUT "Ange ]r, M}n, Dag (eller tryck RETURN) ? "]r,M}n,Dag : Flag1=1 280 ; FNSudd$; : ON ERROR GOTO 300 290 IF Flag1=0 INPUT "Ange Datumnummer (eller tryck RETURN) ? "Datnum : Flag2=1 300 ; FNSudd$; : ON ERROR GOTO 320 : IF Flag1=0 AND Flag2=0 GOTO 260 310 IF Flag1 Datnum=FNDatnum(]r,M}n,Dag) : ; "Datumnummer = " Datnum 320 ; FNSudd$; : ON ERROR GOTO 340 330 IF Flag2 THEN IF NOT FNDatum(Datnum) ; "FEL!" ELSE ; "]r M}n Dag = " NUM$(]r) "-" NUM$(M}n) "-" NUM$(Dag) 340 ; FNSudd$; : ON ERROR GOTO 390 350 ; "Dagens nummer i }ret {r" 1+FNDatnum(]r,M}n,Dag)-FNDatnum(]r,1,1) 360 Z=FNVdag(Datnum) : ; "Veckodag = " FNVdag$(Z) 370 Vnr=FNVnr(]r,M}n,Dag) : ; "Ing}r i vecka " NUM$(ABS(Vnr)); : IF Vnr=-1 ; " av }r " NUM$(]r+1) ELSE IF Vnr<-51 ; " av }r " NUM$(]r-1) ELSE ; 380 Vstartdatnum=FNStartvecka(]r,Vnr) : Z=FNDatum(Vstartdatnum) : ; "Vecka " NUM$(ABS(Vnr)) " startar " NUM$(]r) "-" NUM$(M}n) "-" NUM$(Dag) 390 ; STRING$(80,45) : ; : GOTO 260 900 ! ************************************************************************** 910 DEF FNSudd$=CUR(PEEK(65363),0)+SPACE$(80)+CUR(PEEK(65363),0) 1000 ! ************************************************************************* 1010 DEF FNDatumtest(]r,M}n,Dag) 1015 ! UTPARAMETER: 0 --> Datum felaktigt. -1 --> Datum {r O.K. 1016 ! 1020 IF ]r<1960 OR ]r>2048 OR M}n<1 OR M}n>12 OR Dag<1 OR Dag>31 RETURN 0 1030 IF INSTR(1,CHR$(2,4,6,9,11),CHR$(M}n)) AND Dag=31 RETURN 0 ELSE IF M}n<>2 OR Dag<29 RETURN -1 1040 IF MOD(]r,4)=0 AND Dag=29 RETURN -1 ELSE RETURN 0 1050 FNEND 1100 ! ************************************************************************* 1110 DEF FNDatnum(]r,M}n,Dag) LOCAL X,Datnum,I 1115 ! UTPARAMETER: Datumnummer (d{r 1960-01-01 tilldelats nummer 1). 1116 ! 1120 IF NOT FNDatumtest(]r,M}n,Dag) RETURN 0 1130 DATA 0,31,28,31,30,31,30,31,31,30,31,30 1140 Datnum=INT(365.25*(]r-1960))+1 : I=0 1150 RESTORE 1130 : WHILE I FEL. -1 --> OK. 1216 ! ! Datum l{ggs i variablerna ]r, M}n och Dag! 1217 ! 1220 ]r=1960+Datnum/365.25 : M}n=1 : Dag=1 1230 Z=FNDatnum(]r,M}n,Dag) : IF Z=Datnum GOTO 1270 ELSE IF Z>0 AND Z0 AND Z0 AND Z Datnum resp Vdag f|r 1:a januari. 1470 Datnum0=FNDatnum(]r,1,1) : Vdag0=FNVdag(Datnum0) 1480 Datnum1=Datnum0+1-7*(Vdag0>4)-Vdag0 : RETURN Datnum1 1490 FNEND 1500 ! ************************************************************************* 1510 DEF FNVnr(]r,M}n,Dag) LOCAL Vnr,Datnum0,Datnum1 1515 ! UTPARAMETER: Veckonummer som inparametern (]r-m}n-dag) tillh|r. 1516 ! -1 --> vecka 1 n{sta }r. -52 och -53 --> veckonr tillh|r f|reg. }r. 1517 ! 1520 IF NOT FNDatumtest(]r,M}n,Dag) RETURN 0 1530 Datnum=FNDatnum(]r,M}n,Dag) : Datnum1=FNStartvecka1(]r) 1550 Vnr=(7+Datnum-Datnum1)/7 : IF Vnr>0 AND Vnr<53 RETURN Vnr 1560 IF Vnr=0 THEN IF Vdag0=5 RETURN -53 ELSE IF Vdag0=6 AND MOD(]r-1,4)=0 RETURN -53 ELSE RETURN -52 1570 IF Vnr=53 THEN IF Vdag0=4 RETURN 53 ELSE IF Vdag0=3 AND MOD(]r,4)=0 RETURN 53 ELSE RETURN -1 1580 FNEND 1600 ! ************************************************************************* 1610 DEF FNStartvecka(]r,Vnr) 1620 ! UTPARAMETER: Datnum f|r start av vecka nr Vnr under }ret ]r. 1630 Datnum1=FNStartvecka1(]r) : IF Vnr>0 AND Vnr<54 Datnum=Datnum1+7*(Vnr-1) 1640 IF Vnr=-52 OR Vnr=-53 Datnum=FNStartvecka(]r-1,ABS(Vnr)) 1650 IF Vnr=-1 Datnum=FNStartvecka(]r+1,1) 1660 RETURN Datnum 1670 FNEND 1700 ! *************************************************************************