home *** CD-ROM | disk | FTP | other *** search
/ M.u.C.S. Disc 2000 / MUCS2000.iso / sigisoft / kalender / kalender.bas next >
BASIC Source File  |  1997-10-09  |  4KB  |  92 lines
  1. 10 CLS:C$=CHR$(27)
  2. 50 COLOR 0,7
  3. 51 PRINT "          Dieses Programm ist frei kopierbar       (Public Domain)              ";
  4. 52 COLOR 7,0
  5. 60 LOCATE 6,23:PRINT "  K   A   L   E   N   D   E   R  "
  6. 80 LOCATE 10,27:PRINT "(C) By Siegfried Hübner"
  7. 90 LOCATE 11,35:PRINT "JAN. 1991"
  8. 110 LOCATE 14,24:PRINT"Hallo lieber Atari ST - Freund !"
  9. 120 LOCATE 16,2:PRINT"Wenn Ihnen dieses Programm gefällt, dann geben Sie es bitte an Ihre Freunde u."
  10. 130 LOCATE 17,3:PRINT"Bekannte weiter. Bitte bedenken Sie, daß es zum guten Ton gehört, dem Autor"
  11. 140 LOCATE 18,4:PRINT"dieses Programmes ein kleines Anerkennungshonorar von ca 10 DM zuzusenden."
  12. 150 LOCATE 20,4:PRINT"Meine Adresse :";:PRINT"  Siegfried Hübner, Obere Vorstadt 21 , 8812 Windsbach"
  13. 160 BEEP:LOCATE 22,22:PRINT" Bitte irgend eine Taste drücken ! "
  14. 170 U$=INKEY$:IF U$="" THEN 170
  15. 180 CLS:DEFINT A-Z
  16. 190 DIM BD(28),DA(12,7,6),DM(12),M$(12)
  17. 200 FOR T=1 TO 12: READ DM(T): NEXT
  18. 210 FOR T=1 TO 28: READ BD(T-1): NEXT
  19. 220 FOR T=1 TO 12: READ M$(T): NEXT
  20. 230 GOSUB 840
  21. 240 BEEP:LOCATE 8,31:INPUT "Welches Jahr ", Y
  22. 250 X=Y-14: IF X<0 THEN 240
  23. 260 GOSUB 960
  24. 270 BEEP:LOCATE 15,25:PRINT"Kalender auf Bildschirm  =  < B >"
  25. 280 LOCATE 17,25:PRINT"Kalender auf Drucker     =  < D >"
  26. 290 d$="":D$=INKEY$
  27. 300 IF D$="B" OR D$="b" THEN 330
  28. 310 IF D$="D" OR D$="d" THEN 580
  29. 320 GOTO 290
  30. 330 CLS:X= Y - (INT(X/28)*28 +14)
  31. 340 IF Y/4 = INT(Y/4) THEN DM(2)=29 ELSE DM(2)=28
  32. 350 C2=1:CO=BD(X)-1
  33. 360  FOR T=1 TO 12
  34. 370 C3=C3+1:CO=CO+1:DA(T,CO,C2)=C3:IF CO=7 THEN CO=0:C2=C2+1
  35. 380 IF C3<>DM(T) THEN 370 ELSE C3=0:C2=1
  36. 390   NEXT:  PRINT
  37. 400   FOR T=1 TO 12 STEP 3
  38. 410 PRINT M$(T) TAB(37) M$(T+1) TAB(63) M$(T+2): PRINT
  39. 420 PRINT "  So Mo Di Mi Do Fr Sa" TAB(28) " So Mo Di Mi Do Fr Sa" TAB(54)          " So Mo Di Mi Do Fr Sa"
  40. 430     FOR TR=1 TO 6
  41. 440       FOR TRR=1 TO 3
  42. 450  PRINT " ";
  43. 460         FOR TT=1 TO 7
  44. 470 D=DA(T+TRR-1,TT,TR)
  45. 480 IF D=0 THEN D$="   ": GOTO 500
  46. 490 D$=RIGHT$(" "+STR$(D),3)
  47. 500 PRINT D$;
  48. 510         NEXT:PRINT "    ";
  49. 520       NEXT:PRINT "  ";
  50. 530     NEXT
  51. 531 COLOR 0,7:PRINT " Return Taste drücken für weitere Monate ";:COLOR 7,0:INPUT " ",A$
  52. 540   NEXT:COLOR 7,0
  53. 550 CLS:GOTO 970
  54. 560 DATA 31,28,31,30,31,30,31,31,30,31,30,31,3,4,5,7,1,2,3,5,6,7,1,3,4,5,6,1,2,3,4,6,7,1,2,4,5,6,7,2," JANUAR ","FEBRUAR","  MAERZ  ","  APRIL  ","  MAY  ", "  JUNI  ","  JULI  "," AUGUST ","SEPTEMBER","OKTOBER","NOVEMBER"
  55. 570 DATA "DEZEMBER "
  56. 580 X= Y - (INT(X/28)*28 +14)
  57. 581 LPRINT CHR$(15);CHR$(27);CHR$(83);CHR$(49);CHR$(27);CHR$(51);CHR$(15);
  58. 590 IF Y/4 = INT(Y/4) THEN DM(2)=29 ELSE DM(2)=28
  59. 600 C2=1:CO=BD(X)-1
  60. 610   FOR T=1 TO 12
  61. 620 C3=C3+1:CO=CO+1:DA(T,CO,C2)=C3:IF CO=7 THEN CO=0:C2=C2+1
  62. 630 IF C3<>DM(T) THEN 620 ELSE C3=0:C2=1
  63. 640   NEXT:  LPRINT
  64. 650 LPRINT CHR$(27) "W1":LPRINT TAB(18)Y:LPRINT CHR$(27) "W0";
  65. 660   FOR T=1 TO 12 STEP 3
  66. 670 LPRINT:LPRINT TAB(12) M$(T) TAB(37) M$(T+1) TAB(62) M$(T+2): LPRINT
  67. 680 LPRINT "     So Mo Di Mi Do Fr Sa" TAB(29) "  So Mo Di Mi Do Fr Sa" TAB(54)        "  So Mo Di Mi Do Fr Sa"
  68. 690     FOR TR=1 TO 6
  69. 700       FOR TRR=1 TO 3
  70. 710  LPRINT "    ";
  71. 720         FOR TT=1 TO 7
  72. 730 D=DA(T+TRR-1,TT,TR)
  73. 740 IF D=0 THEN D$="   ": GOTO 760
  74. 750 D$=RIGHT$(" "+STR$(D),3)
  75. 760 LPRINT D$;
  76. 770         NEXT
  77. 780       NEXT:  LPRINT
  78. 790     NEXT
  79. 800   NEXT
  80. 810 CLS:LPRINT:LPRINT:LPRINT " by Siegfried Hübner, Obere Vorstadt 21, 8812 Windsbach":LPRINT CHR$(12);:GOTO 970
  81. 820 DATA 31,28,31,30,31,30,31,31,30,31,30,31,3,4,5,7,1,2,3,5,6,7,1,3,4,5,6,1,2,3,4,6,7,1,2,4,5,6,7,2," JANUAR ","FEBRUAR","  MAERZ  ","  APRIL  ","  MAY  ", "  JUNI  ","  JULI  "," AUGUST ","SEPTEMBER","OKTOBER","NOVEMBER"
  82. 830 DATA "DEZEMBER "
  83. 840 CLS
  84. 960 RETURN
  85. 970 BEEP:LOCATE 10,26:PRINT"Noch einmal Kalender < K >"
  86. 980 LOCATE 12,26:PRINT"Zurück  zum Desktop  < D >"
  87. 1000 D$=INKEY$
  88. 1010 IF D$="K" OR D$="k" THEN 230
  89. 1030 IF D$="D" OR D$="d" THEN CLS:END
  90. 1040 GOTO 1000
  91.  
  92.