Baixe o app para aproveitar ainda mais
Prévia do material em texto
Programas em Pascal Todos os programas que se seguem foram implementados usando o compilador Turbo Pascal. Neste programa o computador mostra na tela todos os caracteres do código ASCII. PROGRAM Ascii(INPUT,OUTPUT); VAR i,n,val:INTEGER; c:CHAR; BEGIN n:=0; FOR i:=0 TO 256 DO BEGIN n:=n+1; WRITELN(i,' -> ',CHR(i),' '); IF n=22 THEN BEGIN WRITELN('c para continuar'); REPEAT READLN(c); UNTIL c='c'; n:=0; END; END; READLN END. Neste programa indicando o número de lados de um polígono o computador indica de que tipo de polígono se trata. No caso do polígono ter mais de 3 lados tem que se indicar ainda se os ângulos internos são iguais. PROGRAM OutrosPoligonos(INPUT,OUTPUT); VAR lados:INTEGER; SimNao:CHAR; BEGIN WRITE('Qual o numero de lados ? '); READLN(lados); CASE lados OF 1,2: ; 3:WRITE('E um triangulo'); 4:BEGIN WRITE('Os angulos internos sao iguais ? '); READLN(SimNao); IF SimNao='S' THEN WRITE('E quadrado') ELSE WRITE('E losango') END; 5:WRITE('E um pentagono') END; READLN END. � Neste programa dado um número n de alunos o computador pede a nota de cada aluno e conta quantos têm nota positiva. PROGRAM NotasPositivas(INPUT,OUTPUT); VAR n,conta,i,nota:INTEGER; BEGIN WRITE('Quantos estudantes obtiveram classificao na frequencia ? '); READLN(n); conta:=0; FOR i:=1 TO n DO BEGIN WRITE('Qual a nota que o estudante obteve ? ( 0 a 10 ) '); READLN(nota); IF nota>=6 THEN conta:=conta+1 END; WRITELN('Existem ',conta,' estudantes com nota positiva') END. Nos dois programas que se seguem pode ver-se como ler valores de vários tipos de variáveis. PROGRAM Leimp1(INPUT,OUTPUT); { Le e imprime valores } VAR a,b,pi:REAL; e,f,g:INTEGER; h,i,j,k:CHAR; BEGIN READLN(a,e,h,h,i,j,k); READLN(f,k,k,b,j,j); READLN(pi,g); WRITELN(a,b,e,f,g,h,i,j,k,pi); READLN END. PROGRAM Leimp2(INPUT,OUTPUT); CONST pi=3; VAR a,b,c,d:REAL; e,f:INTEGER; h,i,j,k:CHAR; BEGIN READ(a);READ(e);READLN(i,j,h,k); READLN(f,k,a,h); READ(d);READLN(j); WRITELN(a);WRITELN(d); WRITELN(h,i,j,k); WRITELN(pi); READLN END. � Nos 4 seguintes programas são exemplos da utilização de procedimentos na linguagem Pascal. PROGRAM Arvore1(INPUT,OUTPUT); PROCEDURE Ramo; BEGIN WRITELN('X'); WRITELN('XX'); WRITELN('XXX'); WRITELN('XXXX') END; PROCEDURE Tronco; BEGIN WRITELN('I') END; BEGIN { Bloco Principal } Ramo; Tronco; Ramo; Tronco; ramo; WRITELN('T'); WRITE('T') END. PROGRAM Arvore2(INPUT,OUTPUT); PROCEDURE Ramo(n:INTEGER); VAR i,j:INTEGER; BEGIN FOR i:=1 TO n DO BEGIN FOR j:=1 TO i DO WRITE('X'); WRITELN END; END; PROCEDURE Tronco; BEGIN WRITELN('I') END; BEGIN { Bloco Principal } Ramo(3); Tronco; Ramo(4); Tronco; ramo(5); WRITELN('T'); WRITE('T') END. � PROGRAM Arvore3(INPUT,OUTPUT); VAR t1,t2,t3:INTEGER; PROCEDURE Ramo(n:INTEGER); VAR i,j:INTEGER; BEGIN FOR i:=1 TO n DO BEGIN FOR j:=1 TO i DO WRITE('X'); WRITELN END; END; PROCEDURE Tronco; BEGIN WRITELN('I') END; BEGIN { Bloco Principal } WRITE('Qual o tamanho para o 1§ ramo ? '); READLN(t1); WRITE('Qual o tamanho para o 2§ ramo ? '); READLN(t2); WRITE('Qual o tamanho para o 3§ ramo ? '); READLN(t3); Ramo(t1); Tronco; Ramo(t2); Tronco; ramo(t3); WRITELN('T'); WRITE('T') END. PROGRAM Arvore4(INPUT,OUTPUT); VAR t1,t2,t3,conta1,conta2,conta3,tconta:INTEGER; PROCEDURE Ramo(n:INTEGER; VAR c:INTEGER); VAR i,j:INTEGER; BEGIN c:=0; FOR i:=1 TO n DO BEGIN FOR j:=1 TO i DO BEGIN WRITE('X'); c:=c+1; END; WRITELN END; END; PROCEDURE Tronco; BEGIN WRITELN('I') END; � BEGIN { Bloco Principal } WRITE('Qual o tamanho para o 1§ ramo ? '); READLN(t1); WRITE('Qual o tamanho para o 2§ ramo ? '); READLN(t2); WRITE('Qual o tamanho para o 3§ ramo ? '); READLN(t3); Ramo(t1,conta1); Tronco; Ramo(t2,conta2); Tronco; ramo(t3,conta3); tconta:=conta1+conta2+conta3; WRITELN('T'); WRITELN('T'); WRITELN('Existem ',tconta,' folhas'); END. O seguinte programa é um bom exemplo do uso de funcões e procedimentos em Pascal. PROGRAM PotenciaExp5_de_4_valores(INPUT,OUTPUT); VAR valor1,valor2,valor3,valor4:INTEGER; PROCEDURE Leitura(n:INTEGER;VAR num:INTEGER); BEGIN REPEAT WRITE('Escreva o ',n,'§ valor -> '); READLN(num); UNTIL (num>0) AND (num<51); END; FUNCTION Potenciaexp5(x:INTEGER):INTEGER; BEGIN potenciaexp5:=SQR(x)*SQR(x)*x END; PROCEDURE Escrita(n,auxresult:INTEGER); BEGIN WRITELN('A Potˆncia de expoente 5 de ',n,' ‚ ',auxresult) END; BEGIN { bloco principal } Leitura(1,valor1); Leitura(2,valor2); Leitura(3,valor3); Leitura(4,valor4); Escrita(valor1,potenciaexp5(valor1)); Escrita(valor2,potenciaexp5(valor2)); Escrita(valor3,potenciaexp5(valor3)); Escrita(valor4,potenciaexp5(valor4)); END. � Outro exemplo do uso de funções e procedimentos em Pascal. PROGRAM NumDigitos(INPUT,OUTPUT); VAR valor1,valor2,valor3,valor4:INTEGER; PROCEDURE Leitura(n:INTEGER;VAR num:INTEGER); BEGIN REPEAT WRITE('Escreva o ',n,'§ valor -> '); READLN(num); UNTIL (num>=0) AND (num<10000); END; FUNCTION Contadigitos(num:INTEGER):INTEGER; VAR c,quoc:INTEGER; BEGIN c:=0; REPEAT quoc:=num DIV 10; c:=c+1; num:=quoc; UNTIL quoc=0; Contadigitos:=c; END; PROCEDURE Escrita(num,conta:INTEGER); BEGIN WRITELN('O valor ',num,' tem ',conta,' d¡gitos'); END; BEGIN { bloco principal } Leitura(1,valor1); Leitura(2,valor2); Leitura(3,valor3); Leitura(4,valor4); Escrita(valor1,Contadigitos(valor1)); Escrita(valor2,Contadigitos(valor2)); Escrita(valor3,Contadigitos(valor3)); Escrita(valor4,Contadigitos(valor4)); END. Ainda outro exemplo do uso de funcões e procedimentos em Pascal. PROGRAM Divisores_de_4_valores(INPUT,OUTPUT); VAR valor1,valor2,valor3,valor4:INTEGER; PROCEDURE Leitura(n:INTEGER;VAR num:INTEGER); BEGIN REPEAT WRITE('Escreva o ',n,'§ valor -> '); READLN(num); UNTIL (num>0) AND (num<1001); END; FUNCTION Contadivisores(num:INTEGER):INTEGER; VAR divisor,c:INTEGER; � BEGIN c:=0; FOR divisor:=num DOWNTO 1 DO IF num MOD divisor=0 THEN c:=c+1;Contadivisores:=c; END; PROCEDURE Escrita(num,conta:INTEGER); BEGIN WRITELN('O valor ',num,' tem ',conta,' divisores'); END; BEGIN { bloco principal } Leitura(1,valor1); Leitura(2,valor2); Leitura(3,valor3); Leitura(4,valor4); Escrita(valor1,Contadivisores(valor1)); Escrita(valor2,Contadivisores(valor2)); Escrita(valor3,Contadivisores(valor3)); Escrita(valor4,Contadivisores(valor4)); END. O seguinte programa mostra os divisores inteiros de um dado número. PROGRAM DivisoresInteiros(INPUT,OUTPUT); VAR n,divisor,resto:INTEGER; BEGIN WRITE('Qual o numero de que quer saber os divisores inteiros ? '); READLN(n); FOR divisor:=n DOWNTO 1 DO BEGIN resto:=n MOD divisor; IF resto=0 THEN WRITELN('Divisor -> ',divisor) END; END. O seguinte programa calcula a raíz quadrada de um dado número. PROGRAM RaizQuadrada(INPUT,OUTPUT); VAR n,raiz,erro:REAL; BEGIN WRITE('Qual o n£mero de que quer calcular a raiz quadrada ? '); READLN(n); raiz:=SQRT(n); raiz:=(n/raiz+raiz)/2; erro:=(n/SQR(raiz))-1; IF erro<1E-06 THEN WRITELN('A raiz de ',n,' ‚ ',raiz,' ',erro) ELSE WRITELN('Existe um erro > 10E-06') END. O seguinte programa calcula a soma dos dígitos de um dado numero. PROGRAM SomaDigitos(INPUT,OUTPUT); VAR num,resto,restotal:INTEGER; BEGIN restotal:=0; WRITE('Escreva o n£mero de que quer somar os digitos -> '); READLN(num); REPEAT resto:=num MOD 10; num:=num DIV 10; restotal:=restotal+resto UNTIL num<resto; WRITELN('A soma ‚ ',restotal+num) END. O seguinte programa calcula a média de um numero n de números inteiros. PROGRAM MediaInteiros(INPUT,OUTPUT); VAR n,soma,num,media,aux:INTEGER; BEGIN soma:=0; WRITE('De quantos numeros quer calcular a media ? '); READLN(n); aux:=n; WHILE n>0 DO BEGIN WRITE('Qual o n£mero ? '); READLN(num); soma:=soma+num; n:=n-1 END; media:=soma DIV aux; WRITELN('A m‚dia dos ',n,' numeros ‚ ',media) END. O seguinte programa conta quantos dos números introduzidos são divisíveis por 5. PROGRAM NumerosDiv5(INPUT,OUTPUT); VAR n,num,conta,result:INTEGER; BEGIN conta:=0; result:=0; WRITE('Quantos n£meros quer dar entrada ? '); READLN(n); REPEAT conta:=conta+1; WRITE('Qual o n£mero ? '); READLN(num); IF num MOD 5 = 0 THEN result:=result+1 UNTIL conta=n; WRITE('Existem ',result,' n£meros divisiveis por 5') END. � O programa seguinte conta quantas vezes o caracter a foi digitado. PROGRAM Caracter_a(INPUT,OUTPUT); VAR n,conta:INTEGER; car:CHAR; BEGIN conta:=0; FOR n:=1 TO 10 DO BEGIN WRITE('Escreva o ',n,'§ caracter -> '); READLN(car); IF car='a' THEN conta:=conta+1 END; WRITE('O caracter a foi digitado ',conta,' vezes') END. O seguinte programa guarda o maior numero de um numero n de numeros introduzidos. PROGRAM MaiorNumero(INPUT,OUTPUT); VAR n,maior,conta,num:INTEGER; BEGIN maior:=0; conta:=0; WRITE('Quantos numeros quer dar entrada ? '); READLN(n); REPEAT conta:=conta+1; WRITE('Qual o ',conta,'§ numero ? '); READLN(num); IF maior<num THEN maior:=num UNTIL conta=n; WRITELN('O numero maior ‚ ',maior) END. O seguinte programa e um exemplo da instrucao CASE ... OF. O programa calcula o vencimento de um funcionario consoante as horas extraordinarias que este trabalhou. PROGRAM HorasExtra(INPUT,OUTPUT); VAR horas:INTEGER; venc,quantia:REAL; BEGIN REPEAT WRITE('Qual o vencimento base do funcion rio ? '); READLN(venc) UNTIL venc>=0; REPEAT WRITE('Quantas horas extra fez o funcion rio ? '); READLN(horas) UNTIL horas>0; CASE horas OF 1..10:quantia:=(venc*(1/50))*horas; 11..20:quantia:=(venc*(1/45))*horas; 21..30:quantia:=(venc*(1/35))*horas; 31..40:quantia:=(venc*(1/25))*horas ELSE quantia:=(venc*(1/10))*horas END; WRITELN('O vencimento total ‚ ',venc+quantia:8:4) END. O seguinte programa coloca no lugar das letras curvas introduzidas um asterisco. PROGRAM LetrasCurvas(INPUT,OUTPUT); VAR n,numletras:INTEGER; car:CHAR; BEGIN WRITE('Qual o n£mero de letras que a linha de texto vai ter ? '); READLN(numletras); FOR n:=1 TO numletras DO BEGIN READ(car); CASE car OF 'B'..'D':car:='*'; 'G':car:='*'; 'J':car:='*'; 'O'..'S':car:='*'; 'U':car:='*'; END; WRITE(car); END; END. O seguinte programa mostra os multiplos de 3 e de 5 entre 10 e 1000. PROGRAM Multiplosde3e5(INPUT,OUTPUT); VAR c,n,mult3,mult5:INTEGER; car:CHAR; BEGIN c:=0; WRITELN('NUM MULT.3 MULT.5'); FOR n:=10 TO 1000 DO BEGIN mult3:=n MOD 3; mult5:=n MOD 5; IF (mult3=0) AND (mult5<>0) THEN WRITELN(n,' X'); IF (mult5=0) AND (mult3<>0) THEN WRITELN(n,' X'); IF (mult3=0) AND (mult5=0) THEN WRITELN(n,' X X'); IF ((mult3=0) AND (mult5=0)) OR (mult3=0) OR (mult5=0) THEN c:=c+1; IF c=23 THEN BEGIN WRITE('c para continuar '); REPEAT READLN(car) UNTIL car='c'; c:=0; WRITELN('NUM MULT.3 MULT.5') END; END; READLN END. � O seguinte programa desenha um losango conforme o tamanho escolhido para o lado. PROGRAM Losango(INPUT,OUTPUT); VAR lado,m,a,y:INTEGER; BEGIN REPEAT WRITE('Qual o valor do lado do losango (entre 1 e 12) ? '); READLN(lado) UNTIL (lado>0) AND (lado<13); IF lado>1 THEN BEGIN m:=0; a:=lado; WRITELN('*':lado); FOR lado:=lado-1 DOWNTO 1 DO BEGIN m:=m+2; WRITELN('*':lado,'*':m); END; lado:=lado+1; m:=m-2; FOR y:=lado TO a-1 DO BEGIN WRITELN('*':y,'*':m); m:=m-2; END; WRITELN('*':a); END ELSE WRITELN('*'); END. O programa seguinte mostra uma pirâmide de números. PROGRAM Piramide_de_Numeros(INPUT,OUTPUT); VAR numlinhas,aux,coluna,conta,contacontra:INTEGER; BEGIN REPEAT WRITE('Qual o n£mero de linhas que a pirƒmide vai ter (entre 1 e 9) ? '); READLN(numlinhas); UNTIL (numlinhas>0) AND (numlinhas<10); aux:=numlinhas-2; WRITELN('1':numlinhas);FOR coluna:=2 TO numlinhas DO BEGIN IF aux>0 THEN WRITE(' ':aux); aux:=aux-1; FOR conta:=1 TO coluna DO WRITE(conta); FOR contacontra:=coluna-1 DOWNTO 1 DO WRITE(contacontra); WRITELN END END. O programa que se segue desenha uma recta de asteriscos consoante as coordenadas introduzidas. PROGRAM Linha_de_Asteriscos(INPUT,OUTPUT); USES crt; VAR xaler,yaler,compaler:INTEGER; direcaler:CHAR; PROCEDURE Linha(x,y,comp:INTEGER;direc:CHAR); VAR i,j:INTEGER; BEGIN CASE direc OF 'H','h':BEGIN FOR i:=x TO comp+x-1 DO BEGIN GOTOXY(i,y); WRITE('*') END; END; 'V','v':BEGIN FOR j:=y TO comp+y-1 DO BEGIN GOTOXY(x,j); WRITE('*') END; END; END; END; BEGIN { bloco principal } CLRSCR; REPEAT WRITE('Escreva o valor de x da origem (x>=1) -> '); READLN(xaler) UNTIL xaler>0; REPEAT WRITE('Escreva o valor de y da origem (y>=1) -> '); READLN(yaler) UNTIL yaler>0; WRITE('Escreva o comprimento da linha -> '); READLN(compaler); WRITE('Escreva a direc‡Æo ( h-horizontal, v-vertical ) -> '); READLN(direcaler); Linha(xaler,yaler,compaler,direcaler) END. � O programa seguinte desenha um rectangulo formado por asteriscos. PROGRAM Rectangulo_de_Asteriscos(INPUT,OUTPUT); USES crt; VAR xaler,yaler,compaler,ladoaler:INTEGER; PROCEDURE Rectangulo(x,y,comprect,ladorect:INTEGER); PROCEDURE Linha(x1,y1,comp:INTEGER;direc:CHAR); VAR i,j:INTEGER; BEGIN CASE direc OF 'H','h':BEGIN FOR i:=x1 TO comp+x1-1 DO BEGIN GOTOXY(i,y1); WRITE('*') END; END; 'V','v':BEGIN FOR j:=y1 TO comp+y1-1 DO BEGIN GOTOXY(x1,j); WRITE('*') END; END; END; END; BEGIN { Desenho do Rectƒngulo } Linha(x,y,comprect,'h'); Linha(x,y,ladorect,'v'); Linha(x+comprect-1,y,ladorect,'v'); Linha(x,y+ladorect-1,comprect,'h'); END; BEGIN { bloco principal } CLRSCR; REPEAT WRITE('Escreva a coordenada x do canto superior esquerdo do Rectƒngulo (x>=1) -> '); READLN(xaler) UNTIL xaler>0; REPEAT WRITE('Escreva a coordenada y do canto superior esquerdo do Rectƒngulo (x>=1) -> '); READLN(yaler) UNTIL yaler>0; REPEAT WRITE('Escreva o valor do comprimento do Rectƒngulo ( comprimento>0 ) -> '); READLN(compaler) UNTIL compaler>0; REPEAT WRITE('Escreva o valor do lado do Rectƒngulo ( lado>0 ) -> '); READLN(ladoaler) UNTIL ladoaler>0; CLRSCR; Rectangulo(xaler,yaler,compaler,ladoaler) END. O programa seguinte desenha um triangulo. PROGRAM Triangulo(INPUT,OUTPUT); VAR b:INTEGER; PROCEDURE Desenhatriangulo(base:INTEGER); VAR i,j,e:INTEGER; BEGIN FOR i:=1 TO base DO WRITE('x'); WRITELN; e:=1; REPEAT base:=base-2; WRITE(' ':e); FOR j:=1 TO base DO WRITE('x'); WRITELN; e:=e+1 UNTIL base=1; END; BEGIN { programa principal } REPEAT WRITELN; WRITE('Qual a base do triƒngulo ( base entre 1 e 80 e de n£mero ¡mpar) ? '); READLN(b) UNTIL (b>0) AND (b<81) AND (ODD(b)=true); Desenhatriangulo(b); READLN END. Com o seguinte programa pode simular-se as operacões de uma calculadora. PROGRAM Calculadora(INPUT,OUTPUT); VAR totaloper,membro2:REAL; varifict,operador:CHAR; BEGIN WRITE('Escreva a sua opera‡Æo -> '); READ(totaloper); READ(varifict); READ(operador); REPEAT READ(membro2); CASE operador OF '+':totaloper:=totaloper+membro2; '-':totaloper:=totaloper-membro2; '/':totaloper:=totaloper/membro2; '*':totaloper:=totaloper*membro2 END; READ(varifict); READ(operador) UNTIL operador='='; WRITE(totaloper) END. O seguinte programa calcula o maximo divisor comum entre dois numeros. PROGRAM MaximoDivisorComum(INPUT,OUTPUT); VAR n1,n2,divisor,resto1,resto2,mdc:INTEGER; BEGIN REPEAT WRITE('Escreva o 1§ n£mero -> '); READLN(n1) UNTIL n1>0; REPEAT WRITE('Escreva o 2§ n£mero -> '); READLN(n2) UNTIL n2>0; IF n2>n1 THEN divisor:=n1 ELSE divisor:=n2; REPEAT resto1:=n1 MOD divisor; resto2:=n2 MOD divisor; IF (resto1=0) AND (resto2=0) THEN BEGIN mdc:=divisor; divisor:=1 END; divisor:=divisor-1 UNTIL divisor=0; WRITELN('O M ximo Divisor Comum entre ',n1,' e ',n2,' ‚ ',mdc) END. O seguinte programa diz-nos se o numero introduzido e capicua ou nao. Exemplos de numeros que sao capicuas : 424, 3113, 747. PROGRAM Capicua(INPUT,OUTPUT); VAR n,potencias,i,num,auxnum,totalnumcont,quoc,resto,numerocont:WORD; BEGIN WRITE('Quantos dígitos tem o seu número ? '); READLN(n); potencias:=1; FOR i:=1 TO n-1 DO BEGIN potencias:=potencias*10 END; WRITE('Escreva o n£mero -> '); READLN(num); auxnum:=num; totalnumcont:=0; REPEAT quoc:=num DIV 10; resto:=num MOD 10; numerocont:=resto*potencias; totalnumcont:=totalnumcont+numerocont; potencias:=potencias DIV 10; num:=quoc; UNTIL quoc=0; IF totalnumcont=auxnum THEN WRITELN('O número ‚ Capicua') ELSE WRITELN('O número nÆo ‚ Capicua'); END. Os três seguintes programas são exemplo da utilização de variáveis booleanas. PROGRAM Boolean1(INPUT,OUTPUT); VAR intei:INTEGER; continua:BOOLEAN; BEGIN REPEAT WRITE('Escreva um número inteiro ');READLN(intei); IF (intei<=10) OR (intei>20) THEN continua:=FALSE ELSE continua:=TRUE; WHILE continua DO BEGIN WRITELN(intei);intei:=intei+1; continua:=intei<=20 END; UNTIL NOT continua END. PROGRAM Boolean2(INPUT,OUTPUT); VAR valorlog:BOOLEAN; car:CHAR; BEGIN valorlog:=TRUE; WHILE valorlog DO BEGIN WRITELN('Uma cão tem 4 patas (s/n) ?'); READLN(car); CASE car OF 's','S':BEGIN WRITELN('Muito bem.  verdade'); valorlog:=FALSE END; 'n','N':BEGIN WRITELN('Est mal.  mentira'); WRITELN('Tem que responder outravez') END; ELSE BEGINWRITELN('Não conheço esse caracter'); WRITELN('Tem que responder outravez') END; END; END; END. � PROGRAM Boolean3(INPUT,OUTPUT); VAR valorlog:BOOLEAN; car:CHAR; BEGIN valorlog:=TRUE; REPEAT BEGIN WRITELN('Uma cão tem 4 patas (s/n) ?'); READLN(car); CASE car OF 's','S':BEGIN WRITELN('Muito bem.  verdade'); valorlog:=FALSE END; 'n','N':BEGIN WRITELN('Est mal.  mentira'); WRITELN('Tem que responder outravez') END; ELSE BEGIN WRITELN('NÆo conhe‡o esse caracter'); WRITELN('Tem que responder outravez') END; END; END; UNTIL NOT valorlog; END. O programa que se segue indica o maior e o menor numeros num vector com numeros introduzidos pelo utilizador. PROGRAM Probl35(input,output); VAR i,n,maior,menor:INTEGER; vector:ARRAY[1..100] OF REAL; BEGIN WRITE('N§ de elementos do vector: '); READLN(n); FOR i:=1 TO n DO BEGIN WRITE('Elemento ',i,' : '); READLN(vector[i]) END; maior:=1; menor:=1; FOR i:=2 TO n DO BEGIN IF vector[i]>vector[maior] THEN maior:=i; IF vector[i]<vector[menor] THEN menor:=i; END; WRITELN('O maior elemento ‚ o ',maior,' e vale ',vector[maior]); WRITELN('O menor elemento ‚ o ',menor,' e vale ',vector[menor]); END. � O programa seguinte mostra como se somam dois vectores. PROGRAM Probl36(input,output); TYPE vector=ARRAY[1..1000] OF REAL; VAR dim:INTEGER; a,b,c:vector; PROCEDURE Dimensao(VAR d:INTEGER); BEGIN WRITE('Qual a dimensao do vector ? '); READLN(d) END; PROCEDURE Levector(n:INTEGER;VAR v:vector); VAR i:INTEGER; BEGIN FOR i:=1 TO n DO BEGIN WRITE('Valor ',i,' do vector : '); READLN(v[i]) END END; PROCEDURE Soma_2_vectores(n:INTEGER;v1,v2:vector;VAR vr:vector); VAR i:INTEGER; BEGIN FOR i:=1 TO n DO vr[i]:=v1[i]+v2[i] END; PROCEDURE Mostra_vector_resul(n:INTEGER;v:vector); VAR i:INTEGER; BEGIN WRITELN('O vector resultante da soma ‚ : '); FOR i:=1 TO n DO WRITELN(v[i],' ') END; BEGIN { programa principal } Dimensao(dim); Levector(dim,a); Levector(dim,b); Soma_2_vectores(dim,a,b,c); Mostra_vector_resul(dim,c) END. O programa seguinte mostra como se somam duas matrizes. PROGRAM Probl37a(input,output); TYPE matriz=ARRAY[1..20,1..20] OF REAL; VAR a,b,c:matriz; n:INTEGER; PROCEDURE Dimensao(VAR zz:INTEGER); BEGIN WRITE('Indique a dimensÆo das matrizes -> '); READLN(n) END; PROCEDURE Lematriz(n:INTEGER;VAR qqmatriz:matriz); VAR i,j:INTEGER; BEGIN FOR i:=1 TO n DO BEGIN FOR j:=1 TO n DO BEGIN WRITE('Valor ',i,j,': '); READLN(qqmatriz[i,j]) END END END; PROCEDURE Soma_2_matrizes(n:INTEGER;a,b:matriz;VAR c:matriz); VAR i,j:INTEGER; BEGIN FOR i:=1 TO n DO FOR j:=1 TO n DO c[i,j]:=a[i,j]+b[i,j] END; PROCEDURE Mostra_matriz_resul(n:INTEGER;c:matriz); VAR i,j:INTEGER; BEGIN WRITELN('A soma das matrizes ‚ : '); FOR i:=1 TO n DO BEGIN FOR j:=1 TO n DO BEGIN WRITE(i,j,' ',c[i,j],' ') END; WRITELN END END; BEGIN { programa principal } Dimensao(n); Lematriz(n,a); Lematriz(n,b); Soma_2_matrizes(n,a,b,c); Mostra_matriz_resul(n,c) END. O programa seguinte mostra como se multiplicam duas matrizes. PROGRAM Probl37b(input,output); VAR matrizA:ARRAY[1..50,1..50] OF REAL; matrizB:ARRAY[1..50,1..50] OF REAL; matrizR:ARRAY[1..50,1..50] OF REAL; n,i,j,k:INTEGER; BEGIN WRITELN('Programa para calcular o resultado da multiplica‡Æo de 2 matrizes quadradas'); WRITE('Qual a dimensÆo das matrizes ? '); READLN(n); WRITELN('Escreva os elementos da matriz A: '); FOR i:=1 TO n DO BEGIN FOR j:=1 TO n DO BEGIN WRITE('a',i,j,': '); READLN(matrizA[i,j]) END END; WRITELN('Escreva os elementos da matriz B: '); FOR i:=1 TO n DO BEGIN FOR j:=1 TO n DO BEGIN WRITE('b',i,j,': '); READLN(matrizB[i,j]) END END; { Multiplica‡Æo das matrizes A e B } FOR i:=1 TO n DO BEGIN FOR j:=1 TO n DO BEGIN matrizR[i,j]:=0; FOR k:=1 TO n DO matrizR[i,j]:=matrizR[i,j]+matrizA[i,k]*matrizB[k,j] END END; WRITELN('A matriz resultado da multiplica‡Æo das matrizes A e B ‚ :'); FOR i:=1 TO n DO BEGIN FOR j:=1 TO n DO WRITE('r',i,j,matrizR[i,j],' '); WRITELN END; END. � O programa seguinte passa as letras minusculas de uma string a maiusculas. PROGRAM Uppercase; {$P+} USES crt; VAR s:STRING[80]; FUNCTION UpCaseStr(s:STRING):STRING; VAR i:INTEGER; BEGIN FOR i:=1 TO LENGTH(s) DO s[i]:=UPCASE(s[i]); UpCaseStr:=s; END; BEGIN CLRSCR; s:='abc'; WRITELN(s); WRITELN('Change to uppercase'); WRITELN(UpCaseStr(s)); WRITELN; WRITE('Press ENTER...'); READLN END. O programa seguinte conta quantas palavras uma string contém. PROGRAM Probl46(input,output); VAR s:STRING; i,conta:INTEGER; BEGIN WRITE('Escreva uma STRING: '); READLN(s); conta:=0; IF (s[1]=' ') AND (s[2]<>' ') THEN conta:=1; IF s[1]<>' ' THEN conta:=1; FOR i:=2 TO LENGTH(s) DO IF (s[i]=' ') AND (UPCASE(s[i+1])IN['A'..'Z']) THEN conta:=conta+1; {IF (s[1]= ' ') AND (s[2]<>' ') THEN conta:=1;} WRITELN('A STRING cont‚m ',conta,' palavras'); END. � O programa que se segue reduz para um espaco entre duas palavras sempre que aí encontra dois ou mais espacos. PROGRAM Problema47(input,output); USES crt; VAR s:STRING; i,j:INTEGER; BEGIN WRITELN('Este programa tira os espacos a mais de uma STRING'); WRITELN; WRITE('Escreva uma STRING: '); READLN(s); j:=0; FOR i:=1 TO LENGTH(s) DO BEGIN j:=j+1; IF s[i]=' ' THEN BEGIN s[j]:=' '; WHILE s[i]=' ' DO i:=i+1; j:=j+1 END; s[j]:=s[i]; END; WRITE('Nova STRING: '); FOR i:=1 TO j DO WRITE(s[i]) END. O programa que se segue cria um ficheiro de texto e guarda neste alguns dados. PROGRAM Probl50A(input,output); VAR fich:TEXT; s:STRING; BEGIN ASSIGN(fich,'texto.txt'); REWRITE(fich); s:='ab de?gz 2!vl 345 aaa';WRITE(fich,s); CLOSE(fich) END. No programa que se segue o computador lê o ficheiro criado no programa anterior e conta todos os espaços em branco que lá existem. PROGRAM Probl50B(input,output); VAR fich:TEXT; s:STRING; conta,i:INTEGER; BEGIN ASSIGN(fich,'texto.txt'); RESET(fich); READLN(fich,s); conta:=0; FOR i:=1 TO LENGTH(s) DO IF s[i]=' ' THEN conta:=conta+1; WRITELN('Existem ',conta,' espa‡os em branco'); END. Os dois programas que se seguem exemplificam como se podem manipular ficheiros de texto em Pascal. PROGRAM Probl51A(input,output); VAR ficheiro:TEXT; BEGIN ASSIGN(ficheiro,'prob51.txt'); REWRITE(ficheiro); WRITELN(ficheiro,'jdfhsakjdhksajdsa1995fgjfdkgjd'); WRITELN(ficheiro,'ndfskahfjskdahfkjdshfkjshdfkjhdsfjkshdkjf'); WRITELN(ficheiro,'1995kdfjkldsjflksdjfklsdjfklfdjksdfjkdsf'); WRITELN(ficheiro,'sdkfjslkdjflksfjlksafdjlksdjflksdjf‡lksdjflkd1995'); CLOSE(ficheiro); END. PROGRAM Probl51B(input,output); VAR ficheiro1,ficheiro2:TEXT; s,f:STRING; n:BYTE; BEGIN WRITE('Escreva o nome do ficheiro -> '); READLN(f); ASSIGN(ficheiro1,f); RESET(ficheiro1); ASSIGN(ficheiro2,'apoio.txt'); REWRITE(ficheiro2); WHILE NOT EOF(ficheiro1) DO BEGIN READLN(ficheiro1,s); n:=0; n:=POS('1995',s); IF n>0 THEN BEGIN DELETE(s,n+3,1); INSERT('6',s,n+3); END; WRITELN(ficheiro2,s); END; CLOSE(ficheiro1); CLOSE(ficheiro2); ASSIGN(ficheiro1,f); REWRITE(ficheiro1); ASSIGN(ficheiro2,'apoio.txt'); RESET(ficheiro2); WHILE NOT EOF(ficheiro2) DO BEGIN READLN(ficheiro2,s); WRITELN(ficheiro1,s); END; CLOSE(ficheiro1); CLOSE(ficheiro2); END. O programa seguinte é exemplo da utilização de fichas e tabelas. PROGRAM Notas(input,output); CONST maxalunos=5; TYPE aluno=RECORD nome:STRING[60]; nota:INTEGER END; tabela=ARRAY[1..maxalunos] OF aluno; VAR ta,a,r:tabela; i:INTEGER; PROCEDURE TabAlunos(VAR todosalunos:tabela); BEGIN WITH todosalunos[1] DO BEGIN todosalunos[1].nome:='Marcelo'; todosalunos[1].nota:=20 END; WITH todosalunos[2] DO BEGIN todosalunos[2].nome:='Pedro'; todosalunos[2].nota:=10; END; WITH todosalunos[3] DO BEGIN todosalunos[3].nome:='Engra‡adinho'; todosalunos[3].nota:=0 END; WITH todosalunos[4] DO BEGIN todosalunos[4].nome:='Gordo'; todosalunos[4].nota:=5 END; WITH todosalunos[5] DO BEGIN todosalunos[5].nome:='C¢c¢'; todosalunos[5].nota:=9 END; END; PROCEDURE Aprovados_Reprovados(alunos:tabela;VAR aprovados,reprovados:tabela); VAR i,conta1,conta2:INTEGER; BEGIN conta1:=0; conta2:=0; FOR i:=1 TO maxalunos DO WITH alunos[i] DO IF alunos[i].nota>=10 THEN BEGIN conta1:=succ(conta1); aprovados[conta1].nome:=alunos[i].nome; aprovados[conta1].nota:=alunos[i].nota END ELSE BEGIN conta2:=succ(conta2); reprovados[conta2].nome:=alunos[i].nome; reprovados[conta2].nota:=alunos[i].nota END; END; BEGIN { Programa Principal } TabAlunos(ta); Aprovados_Reprovados(ta,a,r); WRITELN('Alunos Aprovados'); FOR i:=1 TO maxalunos DO WRITELN(a[i].nome,' ',a[i].nota); WRITELN('Alunos Reprovados'); FOR i:=1 TO maxalunos DO WRITELN(r[i].nome,' ',r[i].nota); END. O programa seguinte é exemplo da utilização de fichas e ficheiros. PROGRAM Probl53(input,output); TYPE ficha=RECORD nome:STRING[40]; altura:INTEGER; peso:INTEGER; END; VAR criminoso:ARRAY[1..100] OF ficha; i,n_criminosos:INTEGER; suspeito:ficha; ficheiro:TEXT; PROCEDURE lista_criminosos; VAR i,j:INTEGER; BEGIN WRITELN('Criminosos Suspeitos:'); FOR i:=1 TO n_criminosos DO IF (ABS(suspeito.peso-criminoso[i].peso)<=6) AND (ABS(suspeito.altura-criminoso[i].altura)<=5) THEN WRITELN(criminoso[i].nome); END; BEGIN { Programa Principal } { Lˆ ficheiro } ASSIGN(ficheiro,'bandidos.txt'); RESET(ficheiro); READLN(ficheiro); i:=0; WHILE NOT EOF(ficheiro) DO BEGIN i:=i+1; READLN(ficheiro,criminoso[i].nome,criminoso[i].altura, criminoso[i].peso); n_criminosos:=i; END; { Lˆ Suspeito } WRITE('Qual a altura do suspeito ? '); READLN(suspeito.altura); WRITE('Qual o peso do suspeito ? '); READLN(suspeito.peso); { Compara e Lista criminosos suspeitos } lista_criminosos; CLOSE(ficheiro); END. Os dois programas seguintes são novo exemplo da utilização de fichas e ficheiros. PROGRAM Probl54(input,output); TYPE tipoficha=RECORD matricula:STRING[6]; ano:INTEGER; nome_propr:STRING[65] END; VAR ficha:tipoficha; ficheiro:FILE OF tipoficha; sn:CHAR; BEGIN ASSIGN(ficheiro,'dados.dat'); REWRITE(ficheiro); REPEAT WITH ficha DO BEGIN WRITE('Escreva a matr¡cula do autom¢vel -> '); READLN(ficha.matricula); WRITE('Escreva o ano de matr¡cula -> '); READLN(ficha.ano); WRITE('Escreva o nome do proprietario do automovel -> '); READLN(ficha.nome_propr); END; WRITE(ficheiro,ficha); WRITE('Quer introduzir mais dados (s/n) ? '); READLN(sn); UNTIL (sn='n') OR (sn='N'); CLOSE(ficheiro); END. PROGRAM Probl55(input,output); TYPE tipoficha=RECORD matricula:STRING[6]; ano:INTEGER; nome_propr:STRING[65]; END; VAR m:STRING[6]; PROCEDURE Procura(matric:STRING); VAR ficheiro:FILE OF tipoficha; ficha:tipoficha; BEGIN ASSIGN(ficheiro,'dados.dat'); RESET(ficheiro); WHILE NOT EOF(ficheiro) DO BEGIN READ(ficheiro,ficha); WITH ficha DO IF matric=ficha.matricula THEN WRITELN(ficha.matricula,' ',ficha.ano,' ',ficha.nome_propr); END; CLOSE(ficheiro); END; BEGIN WRITE('Escreva a matricula -> '); READLN(m); Procura(m); END. Os 3 programas seguintes são exemplo do uso de variáveis dinâmicas. PROGRAM Circulo(input,output); VAR praio:^REAL; BEGIN NEW(praio); WRITE('Qual o raio do c¡rculo ? '); READLN(praio^); WRITELN('Diametro: ',praio^*2); WRITELN('Area:',PI*SQR(praio^)); WRITELN('Perimetro: ',2*PI*praio^); DISPOSE(praio) END. PROGRAM Probl12(input,output); VAR n1,n2,n3:^INTEGER; result:^REAL; BEGIN WRITELN('Este programa calcula a media de 3 valores inteiros'); WRITELN('Usa so variaveis dinamicas'); WRITE('Indique o 1 valor inteiro -> '); NEW(n1); READLN(n1^); WRITE('Indique o 2 valor inteiro -> '); NEW(n2); READLN(n2^); WRITE('Indique o 3 valor inteiro -> '); NEW(n3) READLN(n3^); NEW(result); result^:=(n1^+n2^+n3^)/3; DISPOSE(n1); DISPOSE(n2); DISPOSE(n3); WRITELN('A media dos 3 valores inteiros ‚ ',result^); DISPOSE(result); READLN END. � PROGRAM Probl13(input,output); VAR a,b,temp:^INTEGER; BEGIN WRITELN('Este programa passa o valor de A para B e vice-versa'); NEW(a); NEW(b); a^:=3; b^:=4; WRITELN('A ‚ ',a^); WRITELN('B ‚ ',b^); temp:=a; a:=b; b:=temp; WRITELN('A agora ‚ ',a^); WRITELN('B agora ‚ ',b^); DISPOSE(a); DISPOSE(b); READLN END. O programa seguinte serve para determinar quais o menor e o maior elementos de um vector em que o vector é uma variável dinâmica. PROGRAM Vector(input,output); TYPE vector=ARRAY[1..2000] OF REAL; VAR pvector:^vector; i,n:INTEGER; menor,maior:REAL; BEGIN NEW(pvector); WRITE('Qual o n§ de elementos do vector ? '); READLN(n); FOR i:=1 TO n DO BEGIN WRITE('Escreva o ',i,'§ elemento -> '); READLN(pvector^[i]); END; menor:=pvector^[1]; maior:=pvector^[1]; FOR i:=1 TO n DO BEGIN IF pvector^[i]<menor THEN menor:=pvector^[i]; IF pvector^[i]>maior THEN maior:=pvector^[i]; END; DISPOSE(pvector); WRITELN('Maior: ',maior); WRITELN('Menor: ',menor); END. O programa seguinte soma dois vetores usando variáveis dinâmicas. PROGRAM Soma_de_2_Vectores(input,output); TYPE vector=ARRAY[1..2000] OF REAL; pvector=^vector; VAR pvect1,pvect2:pvector; i,n:INTEGER; PROCEDURE Le_vector(vector:pvector;n:INTEGER); VAR i:INTEGER; BEGIN FOR i:=1 TO n DO BEGIN WRITE('Escreva o ',i,'. elemento do vector -> '); READLN(vector^[i]); END; END; BEGIN WRITE('Qual o n. de elementos de cada vector ? '); READLN(n); NEW(pvect1); WRITELN('Vector 1:'); Le_vector(pvect1,n); NEW(pvect2); WRITELN('Vector 2:'); Le_vector(pvect2,n); WRITELN('Vector Soma:'); FOR i:=1 TO n DO WRITELN(pvect1^[i]+pvect2^[i]); DISPOSE(pvect1); DISPOSE(pvect2) END. O programa seguinte serve para contruir uma lista ligada com 5 elementos inteiros introduzidos pelo utilizador. Neste programa encontram-se dois procedimentos, um para acrescentar um elemento a uma lista ligada e ainda outro procedimento para eliminar o último elemento da lista ligada. PROGRAM Probl19(input,output); TYPE pont_int=^comp_lista; comp_lista=RECORD int:INTEGER; seg:pont_int; END; VAR lista,plista:pont_int; i,j:INTEGER; PROCEDURE Acrescenta_lista(dado:INTEGER;VAR lista:pont_int); VAR pAux:pont_int; BEGIN NEW(pAux); pAux^.int:=dado; pAux^.seg:=lista; lista:=pAux; END; PROCEDURE Elimina_ultimo_lista(lista:pont_int); { Probl21 } VAR pAux:pont_int; BEGIN pAux:=lista; IF pAux<>NIL THEN IF pAux^.seg=NIL THEN BEGIN DISPOSE(pAux); lista:=NIL; END ELSE BEGIN WHILE pAux^.seg^.seg<>NIL DO pAux:=pAux^.seg; DISPOSE(pAux^.seg); pAux^.seg:=NIL; END; END; BEGIN plista:=NIL; FOR i:=1 TO 5 DO BEGIN WRITE('Introduza o ',i,'. inteiro -> '); READLN(j); Acrescenta_lista(j,plista); END; Elimina_ultimo_lista(plista); { Probl21 } WRITELN('Lista: '); lista:=plista; WHILE NOT(lista=NIL) DO BEGIN WRITELN(lista^.int); lista:=lista^.seg; END; END. � Com o programa que se segue podemos inserir elementos no fim de uma lista ligada. PROGRAM Insere_Cauda(input,output); TYPE pont_int=^comp_lista; comp_lista=RECORD int:INTEGER; seg:pont_int; END; VAR lista,plista:pont_int; i,j:INTEGER; PROCEDURE Inserir_na_Cauda(dado:INTEGER;VAR lista:pont_int); VAR pAux,pAux2:pont_int; BEGIN NEW(pAux); NEW(pAux2); pAux2:=lista; pAux^.int:=dado; pAux^.seg:=NIL; IF lista=NIL THEN lista:=pAux ELSE BEGIN WHILE pAux2^.seg<>NIL DO pAux2:=pAux2^.seg; pAux2^.seg:=pAux; END; END; BEGIN plista:=NIL; FOR i:=1 TO 5 DO BEGIN WRITE('Introduza o ',i,'§ inteiro -> '); READLN(j); Inserir_na_Cauda(j,plista); END; WRITELN('Lista: '); lista:=plista; WHILE NOT(lista=NIL) DO BEGIN WRITELN(lista^.int); lista:=lista^.seg; END; READLN; END. O programa seguinte contém um procedimento para inserir um elemento na n-esima posição da lista ligada. Contém ainda uma função para se saber quantos elementos tem uma lista ligada. PROGRAM Probl22(input,output); TYPE pont_int=^comp_lista; comp_lista=RECORD int:INTEGER; seg:pont_int; END; VAR lista,plista:pont_int; i,j,posic:INTEGER; FUNCTION Compr_lista(lista:pont_int):INTEGER; VAR n:INTEGER; pAux:pont_int; BEGIN n:=0; pAux:=lista; WHILE pAux<>NIL DO BEGIN pAux:=pAux^.seg; n:=n+1; END; Compr_lista:=n; END; PROCEDURE Inserir_n_esima_posicao(n:INTEGER;dado:INTEGER;VAR lista:pont_int); VAR pAux,pAux2:pont_int; i:INTEGER; BEGIN NEW(pAux); pAux^.int:=dado; pAux2:=lista; IF lista=NIL THEN BEGIN pAux^.seg:=NIL; lista:=pAux; END ELSE BEGIN IF n=1 THEN BEGIN pAux^.seg:=lista; lista:=pAux; END; IF n>1 THEN BEGIN i:=2; WHILE i<n DO BEGIN i:=i+1; pAux2:=pAux2^.seg; END; pAux^.seg:=pAux2^.seg; pAux2^.seg:=pAux; END END END; BEGIN plista:=NIL; FOR i:=1 TO 5 DO BEGIN WRITE('Introduza o ',i,'. inteiro -> '); READLN(j); WRITE('Qual a posicao em que o quer inserir na lista ? '); READLN(posic); Inserir_n_esima_posicao(posic,j,plista); END; WRITELN('Lista: '); lista:=plista; WHILE NOT(lista=NIL) DO BEGIN WRITELN(lista^.int); lista:=lista^.seg;END; READLN; END.
Compartilhar