Calendário

27 de julho de 201728 de julho de 2017 MSX-Basic 0 comentários Aplicativos, Didáticos

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

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

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

Compartilhe:

julho 2017
D	S	T	Q	Q	S	S
				ago »
						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