Buscar

Programas em Pascal para estudo

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você viu 3, do total de 32 páginas

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você viu 6, do total de 32 páginas

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

Você viu 9, do total de 32 páginas

Faça como milhares de estudantes: teste grátis o Passei Direto

Esse e outros conteúdos desbloqueados

16 milhões de materiais de várias disciplinas

Impressão de materiais

Agora você pode testar o

Passei Direto grátis

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. &#144; verdade');
                         valorlog:=FALSE
                    END;
            'n','N':BEGIN
                         WRITELN('Est  mal. &#144; 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. &#144; verdade');
                               valorlog:=FALSE
                          END;
                  'n','N':BEGIN
                               WRITELN('Est  mal. &#144; 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.

Outros materiais