Programas em Pascal
Todos os programas que se seguem foram implementados usando o compilador Turbo Pascal.
Neste programa o computador mostra no ecrã 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 20 ) ');
READLN(nota);
IF nota>=10 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 num0 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=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 tres seguintes programas sao exemplo da utilizacão de variaveis 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 BEGIN
WRITELN('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] ');
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]maior THEN maior:=pvector^[i];
END;
DISPOSE(pvector);
WRITELN('Maior: ',maior);
WRITELN('Menor: ',menor);
END.
O programa seguinte soma dois vectores 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 ');
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.
05:45
Alex Calloni
Posted in: 
