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