Programas em Pascal

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.

Posted in: Aulas Tutorias