Calendário
Este programa mostra na tela o calendário de qualquer mês, de qualquer ano compreendido entre 1583 e 2499.
Teste o programa no WebMSX – The Online MSX Emulator
Ele mostra também os feriados móveis, tais como Páscoa e Carnaval, e os feriados fixos, tais como Natal e Dia da Independência.
A utilização do programa Calendário é bastante simples. Após rodá-lo, você deve entrar o ano e o mês desejados.
O único cuidado é quanto à digitação do ano: deve conter os quatro algarismos e estar compreendido entre 1583 e 2499.
Após apresentado na tela o calendário do mês e ano pedidos, a pressão da tecla “1” permite o reinício do programa, para possibilitar a mudança do ano e a pressão da tecla “2” permite a escolha de outro mês do mesmo ano.
Fonte: Livro Coleção de Programas para MSX Volume 2
Editora: Aleph
Ano: 1986
Autor: Luiz Tarcísio de Carvalho Jr.
Código fonte
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
100 ' C A L E N D A R I O 110 ' LUIZ TARCISIO DE CARVALHO JR 120 ' 130 CLEAR:KEYOFF:COLOR 15,4:SCREEN0:WIDTH 35 140 DATAJANEIRO,FEVEREIRO,MAR€O,ABRIL,MAIO,JUNHO,JULHO,AGOSTO,SETEMBRO,OUTUBRO,NOVEMBRO,DEZEMBRO 150 DIMM$(12):FORU=1TO12:READM$(U):NEXT 160 DATATERCA-CARNAVAL,SEXTA-PAIX°O,QUINTA-CORPUS CHRISTI,1-ANO NOVO,21-TIRADENTES,1-DIA DO TRABALHO,7-INDEP.BRASIL,12-N.SRA.APARECIDA,2-FINADOS,15-PROCL.REP‹BLICA,25-NATAL 170 DIMF$(11):FORU=1TO11:READF$(U):NEXT 180 OPEN"GRP:"FOR OUTPUT AS #1 190 LOCATE 7,1: PRINT "CALEND„RIO PERMANENTE" 200 LOCATE 2,6:PRINT"(1583 A 2499) 210 LOCATE 3,5:INPUT"QUAL O ANO";AN 220 IF AN < 1583 OR AN > 2499 THEN COLOR 15,8:CLS:LOCATE 10,10:PRINT"DADO INV„LIDO":FORU=1TO1000:NEXT:RUN 230 BI=0:IFAN/4<>AN\4 THEN 260 240 IFAN/400=AN\400THEN BI=1:GOTO 260 250 IF AN/100<>AN\100 THEN BI=1 260 ND=365+BI:DIMD(ND),N(12),M(13) 270 IF AN>=1583 AND AN<1700 THEN X=22:Y=2:GOTO 380 280 FOR I=17 TO 24:IF AN>=I*100 ANDAN <(I+1)*100 THEN J=I-16:GOTO 300 290 NEXT I 300 ON J GOTO 310,320,330,330,340,350, 360,370 310 X=23:Y=3:GOTO 380 320 X=23:Y=4:GOTO 380 330 X=24:Y=5:GOTO 380 340 X=24:Y=6:GOTO 380 350 X=25:Y=0:GOTO 380 360 X=26:Y=1:GOTO 380 370 X=25:Y=1 380 A=ANMOD19:B=ANMOD4:C=ANMOD7:D=(19*A+X)MOD30:E=(2*B+4*C+6*D+Y)MOD7:P=22+D+E 390 IF P<=31 THEN P=59+BI+P:GOTO 420 400 P=D+E-9:IFP<=25THENP=P+BI+90:GOTO 420 410 P=P+83+BI 420 CA=P-47:PA=P-2:CC=P+60 430 D1=PMOD7:IFD1=0THEND1=7 440 N(1)=9-D1:IFN(1)=8THENN(1)=1 450 N(2)=N(1)+3:IFN(2)>7THENN(2)=N(2)-7 460 N(3)=N(2)+BI:IFN(3)>7THENN(3)=N(3)-7 470 N(4)=N(3)+3:IFN(4)>7THENN(4)=N(4)-7 480 N(5)=N(4)+2:IFN(5)>7THENN(5)=N(5)-7 490 N(6)=N(5)+3:IFN(6)>7THENN(6)=N(6)-7 500 N(7)=N(6)+2:IFN(7)>7THENN(7)=N(7)-7 510 N(8)=N(7)+3:IFN(8)>7THENN(8)=N(8)-7 520 N(9)=N(8)+3:IFN(9)>7THENN(9)=N(9)-7 530 N(10)=N(9)+2:IFN(10)>7THENN(10)=N(10)-7 540 N(11)=N(10)+3:IFN(11)>7THENN(11)=N(11)-7 550 N(12)=N(11)+2:IFN(12)>7THENN(12)=N(12)-7 560 FOR I=D1 TO ND STEP 7:D(I)=12:NEXT 570 D(CA)=1:D(PA)=2:D(CC)=3 580 D(1)=4:D(111+BI)=5:D(121+BI)=6:D(250+BI)=7:D(285+BI)=8:D(306+BI)=9:D(319+BI)=10:D(359+BI)=11 590 LOCATE 4,11:PRINT"(1 A 12)" 600 LOCATE 3,10:INPUT"QUAL O MES";ME 610 IFME<1ORME>12ORME<>INT(ME)THENCOLOR15,8:CLS:LOCATE10,10:PRINT"DADO INV„LIDO":FORU=1TO1000:NEXT:COLOR15,4:CLS:LOCATE7,1:PRINT"CALEND„RIO PERMANENTE":LOCATE 3,5:PRINT"ANO =";AN:GOTO 590 620 COLOR15,1,1:SCREEN2 630 COLOR3:PSET(INT(256-8*(LEN(M$(ME))+8))/2,8),1:PRINT#1,M$(ME);" DE";AN 640 COLOR7:PSET(0,24),1:PRINT#1," DOM SEG TER QUA QUI SEX SAB " 650 DATA 0,31,59,90,120,151,181,212,243,273,304,334,365 660 RESTORE 650 670 FORU=1TO13:READM(U):NEXT 680 Q=0:IF ME=2THEN Q=BI 690 S=0:IFME>2THENS=BI 700 COLOR14:PSET(0,40),1:FORU=1TON(ME)*4:PRINT#1," ";:NEXTU 710 FORI=M(ME)+1TOM(ME)+8-N(ME) 720 IFD(I+S)<>0THENCOLOR8:PRINT#1,I-M(ME);" ";:COLOR14:GOTO740 730 PRINT#1,I-M(ME);" "; 740 NEXTI 750 W=40:FORJ=ITOM(ME+1)+QSTEP7 760 W=W+16:PSET(0,W),1:PRINT#1," ";:IFJ-M(ME)<10THENPRINT#1," "; 770 FORK=JTOJ+6:IFK>M(ME+1)+QTHENGOTO800 780 IFD(K+S)<>0THENCOLOR8:PRINT#1,K-M(ME);:COLOR14:GOTO800 790 PRINT#1,K-M(ME); 800 IFK-M(ME)<9THENPRINT#1," "; 810 NEXTK 820 NEXTJ 830 W=W+16:PSET(0,W),1:COLOR3:PRINT#1,STRING$(32,223); 840 FORI=M(ME)+1TOM(ME+1)+Q 850 IFD(I)>0ANDD(I)<12THENW=W+10:PSET(30,W),1:COLOR13:PRINT#1,F$(D(I)) 860 NEXTI 870 W=W+8:PSET(0,W),1:COLOR3:PRINT#1,STRING$(32,220); 880 PSET(22,180),1:COLOR3:PRINT#1,"[1]OUTRO ANO / [2]OUTRO MES" 890 A$=INKEY$ 900 IFA$="1"THENRUN 910 IFA$="2"THENGOTO930 920 GOTO890 930 COLOR15,4:SCREEN0:LOCATE7,1:PRINT"CALEND„RIO PERMANENTE":LOCATE3,5:PRINT"ANO=";AN:GOTO590 |