home *** CD-ROM | disk | FTP | other *** search
/ RUN Flagazine: Run 2 / run2.zip / KLENDER.BAS < prev    next >
BASIC Source File  |  2014-09-03  |  3KB  |  51 lines
  1. 100 REM KALENDERMANIPULATIES GWBASIC MONO (C) HANS STAVLEU
  2. 110 CLS:KEY OFF:DIM M$(12):FOR I=1 TO 12:READ M$(I):NEXT:Y=2
  3. 120 DATA "JANUARI","FEBRUARI","MAART","APRIL","MEI","JUNI","JULI"
  4. 130 DATA "AUGUSTUS","SEPTEMBER","OKTOBER","NOVEMBER","DECEMBER
  5. 140 D$=DATE$:M1=VAL(MID$(D$,1,2)):D1=VAL(MID$(D$,4,2)):J1=VAL(MID$(D$,7,4))
  6. 150 D=D1:M=M1:J=J1:X=1:GOSUB 460:DF1=XDF:F1=XF
  7. 160 D2=1:M2=M1+1:IF M2=13 THEN M2=1:J2=J1+1 ELSE J2=J1
  8. 170 D=D2:M=M2:J=J2:X=44:GOSUB 460:DF2=XDF:F2=XF
  9. 180 DDF=ABS(F2-F1):LOCATE 19,24:PRINT "Aantal dagen tussen data is:";DDF;
  10. 190 PRINT STRING$(10,32):COLOR 10,0:LOCATE 23,1:PRINT STRING$(80,196);
  11. 200 LOCATE 24,5:PRINT "1 = Eerste datum aanpassen   ";
  12. 210 PRINT "2 = Tweede datum aanpassen    Esc = Einde";
  13. 220 FOR I=20 TO 22:LOCATE I,1: PRINT SPC(79);: NEXT
  14. 230 B$="":WHILE B$="":B$=INKEY$:WEND
  15. 240 IF B$<>"1" AND B$<>"2" AND B$<>CHR$(27) THEN 230
  16. 250 IF B$=CHR$(27) THEN CLS:END
  17. 260 LOCATE 20,35:INPUT "Jaar: ";J:IF J=0 THEN J=VAL(MID$(D$,7,4))
  18. 270 LOCATE 21,35:INPUT "Maand: ";M:IF M=0 THEN M=VAL(MID$(D$,1,2))
  19. 280 LOCATE 22,35:INPUT "Dag: ";D:IF D=0 THEN D=VAL(MID$(D$,4,2))
  20. 290 IF B$="1" THEN D1=D:M1=M:J1=J:X=1 ELSE D2=D:M2=M:J2=J:X=44
  21. 300 GOSUB 460:IF B$="1" THEN DF1=XDF:F1=XF ELSE DF2=XDF:F2=XF
  22. 310 GOTO 180
  23. 320 A$=STRING$(4,205)+CHR$(209):COLOR 14,0:LOCATE Y,X
  24. 330 PRINT CHR$(201);A$;A$;A$;A$;A$;A$; STRING$(4,205);CHR$(187);
  25. 340 FOR I=1 TO 5:A$=STRING$(4,32)+CHR$(179):LOCATE Y+I*2-1,X
  26. 350 PRINT CHR$(186);A$;A$;A$;A$;A$;A$;STRING$(4,32);CHR$(186);
  27. 360 A$=STRING$(4,196)+CHR$(197):LOCATE Y+I*2,X
  28. 370 PRINT CHR$(199);A$;A$;A$;A$;A$;A$;STRING$(4,196);CHR$(182);:NEXT
  29. 380 A$=STRING$(4,32)+CHR$(179):LOCATE Y+11,X
  30. 390 PRINT CHR$(186);A$;A$;A$;A$;A$;A$;STRING$(4,32);CHR$(186);
  31. 400 A$=STRING$(4,205)+CHR$(207):LOCATE Y+12,X
  32. 410 PRINT CHR$(200);A$;A$;A$;A$;A$;A$;STRING$(4,205);CHR$(188);
  33. 420 LOCATE Y-1,X: PRINT"  ZO   MA   DI   WO   DO   VR   ZA";:RETURN
  34. 430 JJ=J:F=365*JJ+D+31*M-31:IF M>2 THEN F=F-INT(.4*M+2.3) ELSE JJ=JJ-1
  35. 440 F=F+INT(JJ/4)-INT(.75*INT(JJ/100)+1):DF=F-7*INT(F/7):IF DF=0 THEN DF=7
  36. 450 RETURN
  37. 460 GOSUB 320:XM=M:XD=D:D=1:GOSUB 430:XDF=DF:XF=F:D=0:M=XM+1:GOSUB 430
  38. 470 YDF=DF:D=31:M=XM:GOSUB 430:WHILE DF<>YDF:D=D-1:GOSUB 430:WEND
  39. 480 FOR I=0 TO D-1:LOCATE Y+2*INT((XDF+I-1)\7)+1,((XDF+I-1) MOD 7)*5+X+2
  40. 500 PRINT USING "##";I+1;:NEXT
  41. 510 LOCATE Y+2*INT((XDF+XD-2)\7)+1,((XDF+XD-2) MOD 7)*5+X+2
  42. 520 COLOR 31,0:PRINT USING "##";XD;:COLOR 7,0
  43. 530 LOCATE Y+13,X+12-LEN(M$)/2:PRINT M$(XM);J;STRING$(10,32);
  44. 540 D=XD:M=XM:GOSUB 430:XDF=DF:XF=F:RETURN
  45. 550 REM /* 43/.3283,3722,3791,4023,2664,2784,2724,4909,3959,3440
  46. 560 REM /*/....3563,2704,1898,2367,1551,3549,3650,3414,3361,3361
  47. 570 REM /*/....0466,2886,3352,3198,3313,2475,3749,2349,3313,2392
  48. 580 REM /*/....3352,2963,3748,4074,0480,4177,3891,3772,1585,3144
  49. 590 REM /*/....2420,3400,2607
  50. 600 REM Checksum...............:  131823
  51.