Programas que utilizam procedures e functions - Pascal

{[pascal] Procedures – Exemplo de subrotina – Calculadora
 Esse exemplo faz uma calculadora simples usando um procedimento
 para cada operação. Também faz uso do Case, uma alternativas a
 if (s) aninhados. }

Program CALCULADORA;

uses CRT;

var
  opcao: char;

{ Sub-rotinas de  calculos - Adição }

Procedure rot_adicao;

var
  x, a, b: real;

Begin
   clrscr;
   gotoxy(32,01); write('Rotina de adição');
   gotoxy(05,06); write('Entre um valor para   A: '); readln(a);
   gotoxy(05,07); write('Entre um valor para   b: '); readln(b);
   x:=a+b;
   gotoxy(05,10); write('O resultado equivale a: ', x:6:2);
   gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
   readln;
end;

{---------------------------------------------------------------}

{ Sub-rotinas de calculos - Subtração }

Procedure rot_subtracao;

var
   x, a, b: real;

Begin
   clrscr;
   gotoxy(32,01); write('Rotina de adição');
   gotoxy(05,06); write('Entre um valor para  A: '); readln(a);
   gotoxy(05,07); write('Entre um valor para   b: '); readln(b);
   x:=a-b;
   gotoxy(05,10); write('O resultado equivale a:   ', x:6:2);
   gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
   readln;
end;

{----------------------------------------------------------------}

{ Sub-rotinas de calculos - Multiplicação}

Procedure rot_multiplicacao;

var
  x, a, b: real;

Begin
   clrscr;
   gotoxy(32,01); write('Rotina de adição');
   gotoxy(05,06); write('Entre um valor para  A:   '); readln(a);
   gotoxy(05,07); write('Entre um valor para   b:   '); readln(b);
   x:=a*b;
   gotoxy(05,10); write('O resultado equivale a: ', x:6:2);
   gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
   readln;
End;

{----------------------------------------------------------------}


{ Sub-rotinas dee calculos - Divisão }

Procedure rot_divisao;

var
   x, a, b: real;

Begin
   clrscr;
   gotoxy(32,01); write('Rotina de adição');
   gotoxy(5, 6); write('Entre um valor para  A:   '); readln(a);
   gotoxy(5, 7); write('Entre um valor para  b:   '); readln(b);
   x:=a/b;
   gotoxy(5,10); write('O resultado equivale a:   ', x:6:2);
   gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
   readln;
end;

{----------------------------------------------------------------}


BEGIN { PROGRAMA PRINCIPAL}
   textColor(yellow + blink); { altero a cor da fonte }
   textBackground(BLUE); { altero a cor do plano de fundo }

   clrscr;
   opcao:='0';
   while (opcao  < '5') do
      Begin
         clrscr;
         gotoxy(33,01); write('Menu principal');
         gotoxy(22,06); write('1 Soma');
         gotoxy(22,08); write('2 Subtracao');
         gotoxy(22,10); write('3 Multiplicacao');
         gotoxy(22,12); write('4 Divisao');
         gotoxy(22,14); write('5 Fim de programa');
         gotoxy(22,18); write('Escolha uma opcao ......: ');
         readln(opcao);
         Case opcao of
            '1': rot_subtracao;
            '2': rot_subtracao;
            '3': rot_multiplicacao;
            '4': rot_divisao
         Else
            Writeln('Byeee');
         end;
      end;
END.


{[pascal] Units São rotinas prontas para seremusadas pelo programador.
 Unidades foram incorporadas com o intuirto deagrupar diversas rotinas básicas.
 Uma unit é uma biblioteca de funções, procedimentose constantes. Em seguida
 estão relacionadas as unidades compilador Free Pascal }

•CRT – variáveis de geração de som, controle de video e teclado
•DOS – permitem controles de baixo nivel, utilizando recursos do
       sistema operacional DOS.
•GRAPH – manipulaçõa de capacidade gráfica de um PC
•OVERLAY – Gerencia atividades de um programa. (memória)
•PRINTER – usa a impressora como saída de informação
•SYSTEM – Rotinas padrão do Pascal. Não precisa ser declarada.
Como utilizar: Uses <unidade>

Procedimentos e Funções muito utilizadas em CRT
clrscr – (procedimento) – limpa a tela
gotoxy(coluna, lina) – (procedimento) – posiciona o cursosr em um ponto da tela.
Coluna de 1 a 80, linha de 1 a 25.
readkey – (função) – retorna o valor da tecla pressionada. Faz leiturade apenas
 um caractere (e não é necessário pressionar <ENTER>)



{[pascal] Tipo Registro / type record Um exemplo de aplicações prática do tipo registro.
Esse exemplo lê o nome e as 4 notas de 8 alunos. Ordena em crescente pelo o nome e exibe um a um.}

program LEITURA_ORDENACaO_ESCRITA;

type
   bimestre = array[1..4] of real;
   cad_aluno = record
                  nome: string;
         nota: bimestre;
      end;

var
   aluno : array[1..8] of cad_aluno;
   i, j, atual, proximo : byte;
   x : cad_aluno;

BEGIN
   {Rotima de entrada de dados}
   writeln('CADASTRO DE ALUNOS');
   writeln;
   for j:= 1 to 8 do
      Begin
write('Informe o nome do ', j:2, 'o. aluno   :');  readln(aluno[j].nome);
writeln;
for i:=1 to 4 do
          Begin
    write(' Informe a ', i:2, 'a. nota   :'); readln(aluno[j].nota[i]);
 end;
writeln;
      end;
   writeln;

   {Rotina de ordenação}

   for atual:=1 to 7 do
     Begin
for proximo:= atual+1 to 8 do
          Begin
   if (aluno[atual].nome > aluno[proximo].nome) then
               Begin
         x:= aluno[atual];
 aluno[atual] := aluno[proximo];
 aluno[proximo] := x;
      end;
          end;
     end;


  {Rotina de saída  }
  writeln;
  for j:= 1 to 8 do
     Begin
writeln('Nome aluno: ', j:2, '  :  ', aluno[j].nome);
writeln;
for i:= 1 to 4 do
          Begin
    writeln('Nota ', i, '  :  ', aluno[j].nota[i]:5:2);
 end;
Writeln;
writeln('Tecle  para ver o proximo: '); readln;
     end;
  writeln;
  writeln('Tecle  para encerrar: '); readln;
END.


{[free pascal] Estruturas de dados heterogêneas 1}

program LEITURA_ESCRITA;
type
    Bimestre=array[1..4] of real;
    cadaluno = record
                  nome: string;
                  nota: bimestre;
               end;

var
   aluno: cadaluno;
   i: byte;

BEGIN
   writeln(‘Cadastro de aluno’);
   writeln;
   write(‘Informe o nome … : ‘); readln(aluno.nome);
   writeln;
   for i:= 1 to 4 do
     Begin
       write(‘Informe a ‘, i:2, ‘a. nota .. : ‘);
       readln(aluno.nota[i]);
     end;
   writeln;
   writeln;
   writeln(‘Nome …: ‘, aluno.nome);
   writeln;
   for i:= 1 to 4 do
     Begin
        writeln(‘Nota ‘, i, ‘   :  ‘, aluno.nota[i]:5:2);
     end;
   writeln;
   writeln(‘Tecle <ENTER> para encerrar: ‘); readln;
END.

{[free pascal] Matriz com duas dimensões ex.2 O exemplo abaixo
 é um programa de agenda. Possui uma tabela com 5 colunas com
 os dados (nome, endereco, cepo, bairro e telefone) e 10 linhas
 (com os nomes dos cadastrados).}

program AGENDA;

var
   dado                 : array[1..10, 1..5] of string;
   i, j, atual, proximo : integer;
   x                    : string;

BEGIN
   {Rotina de entrada}
   writeln(‘Programa agenda’);
   writeln;
   for i:=1 to 10 do
     Begin
        write(‘Nome …..:’); readln(dado[i,1]);
        write(‘Endereco..:’); readln(dado[i,2]);
        write(‘CEP… …..:’); readln(dado[i,3]);
        write(‘Bairro…..:’); readln(dado[i,4]);
        write(‘Telefone..:’); readln(dado[i,5]);
        writeln;
     end;

   {Ordenação e troca de elementos}
   for atual:=1 to 9 do
     Begin
       for proximo:=atual+1 to 10 do
         Begin
            {troca nome}
            x:=dado[atual,1];
            dado[atual, 1]:= dado[proximo,1];
            dado[proximo, 1]:=x;
 
            {troca endereco}
            x:=dado[atual,2];
            dado[atual, 2]:= dado[proximo,2];
            dado[proximo, 2]:=x;

            {troca CEP}
            x:=dado[atual,3];
            dado[atual, 3]:= dado[proximo,3];
            dado[proximo, 3]:=x;

            {troca Bairro}
            x:=dado[atual,4];
            dado[atual, 4]:= dado[proximo,4];
            dado[proximo, 4]:=x;

            {troca Telefone}
            x:=dado[atual,5];
            dado[atual, 5]:= dado[proximo,5];
            dado[proximo, 5]:=x;
        end;
     end;

   {Saida de dados}
   for i:=1 to 10 do
     Begin
       for j:=1 to 5 do
         Begin
           writeln(dado[i,j]);
         end;
       writeln;
    end;

   writeln(‘Tecle <ENTER> para encerrar: ‘); readln;
END.

{[free pascal] Exemplo de matriz com duas dimensões
 O exemplo abaixo se trata de uma tabela, onde são
 inseridas e exibidas 4 notas de 8 alunos.}

program NOTA_ALUNO;

var
  notas : array [1..8, 1..4] of real;
  i,j   : integer;

BEGIN
   writeln(‘Leitura e aporesentação de notas’);
   writeln;
   for i:=1 to 8 do
     Begin
        writeln;
        writeln(‘Entre as notas do ‘, i:2, ‘o. aluno’);
        for j:=1 to 4 do
          begin
            writeln(‘Nota ‘, j:2, ‘: ‘);
            readln(notas[i,j]);
          end;
     end;
   writeln;
   for i:=1 to 8 do
     Begin
        write(‘As notas do aluno ‘, i:2, ‘são:  ‘);
        for j:=1 to 4 do
          Begin
            write(notas[i,j]:5:2, ‘  ‘);
            writeln;
          end;
     end;
   writeln;
   writeln(‘Tecle <enter> para encerrar: ‘); readln;
END.

{[free pascal] Métodos de Pesquisa 2: Pesquisa binária
 Dividir e conquistar é o lema desse método. Ordena os
 dados para localiza-lo posteriormente usando o método
 de pesquisa binária.}

{
1. Iniciar um contador, pedir a leitura de dez nomes e colocalos em ordem alfabetica
2. Criar um looping que efetue a pesquisa enquanto o usuario desejar
Durante a fase de pesquisa, deve ser solicitada a informação a ser pesquisada.
Essa informação deve ser comparada, utilizando o método de pesquisa binária
Sendo igual, mostra; caso contrário, avança para o próximo. Senão achar em toda lista,
informar que não existe o lelemneto pesquisado; se existir, deve mostra-lo
3. Encerrar a pesquisa quando desejando
}

program PESQUISA_BINARIA;

var
   nome               : array [1..10] of string;
   i, j               : integer;
   comeco, final, meio: integer;
   pesq, resp, x: string;
   acha: boolean;

BEGIN
    writeln(‘Pesquisa binaria de nomes: ‘);
    writeln;
    for i:=1 to 10 do
    begin
    write(‘Digite o ‘, i:2, ‘o nome: ‘); readln(nome[i]);
end;

   {Ordenando os nomes }

for i:= 1 to 9 do
   for j:= i+1 to 10 do
     if (nome[i] > nome[j]) then
       begin
         x:= nome[i];
         nome[i]:=nome[j];
         nome[j]:=x;
       end;

   {Pesquisando..}

   resp:=’sim’;
   while (resp=’sim’) or (resp=’SIM’) do
     begin
       writeln;
       write(‘Entre o nome a ser pesquisado: ‘); readln(pesq);
       comeco:=1;
       final:=10;
       acha:=false;
       while (comeco <=final) and (acha=false) do
          begin
            meio:=(comeco+final) div 2;
            if (pesq=nome[meio]) then
              acha:=true
            else
              if (pesq < nome[meio]) then
                 final:=meio-1
              else
                 comeco:=meio+1;
          end;

      if (acha=true) then
        writeln(pesq, ‘ foi localizado na posicao ‘, meio:2)
      else
        writeln(pesq, ‘ não foi localizado’);
      writeln;
      write(‘Deseja continuar? sim/nao: ‘);
      readln(resp);
    end;

END.

Programa para obter o numero do I ching da personalidade do individuo em pascal

{programa numero I Ching Fiz esse programinha usando o método 2 do livro
 “Feng Shui e a Astrologia” de cálculo para obter o numero do I ching da
 personalidade do individuo. Funcionamento bem simples, o usuario digita
 o ano do seu nascimento e o programa retorna o numero.}

program anoIChing;

Uses CRT;

var
  cAno: Array [1..4] of char; {ano em caracter, pois readkey só funciona com este}
  iAno: Array [1..4] of integer; {vou converter o caracter para inteiro para fazer conta}
  iChing, iSoma, c: integer; {simples contador}

{Esse trecho somente PEGA e CONVERTE o que o ano que o usuario digita}

Procedure entraAno;

begin
  For c:=1 to 4 Do
    Begin
      cAno[c]:=readkey;
      Case cAno[c] of
'0': iAno[c]:=0;
'1': iAno[c]:=1;
'2': iAno[c]:=2;
'3': iAno[c]:=3;
'4': iAno[c]:=4;
'5': iAno[c]:=5;
'6': iAno[c]:=6;
'7': iAno[c]:=7;
'8': iAno[c]:=8;
'9': iAno[c]:=9;
      end;
      write(cAno[c]);
   end;
end;

{Esse trecho somente IMPRIME o que o ano que o usuario digita}

Procedure imprimeAno;

Begin
   For c:=1 to 4 Do
     Begin
write(iAno[c]);
     end;
end;

{Esse trecho somente SOMA todos os digitos de ano}

Procedure SomaAno;

Begin
   iSoma:=0;
   For c:=1 to 4 Do
     Begin
iSoma:=iAno[c]+iSoma;
     end;
end;

{Esse trecho somente SOMA a SOMA de todos os digitos de ano}

Procedure obtemIChing;

var
   d, u, s: integer;

Begin
   d:=ISoma div 10;
   u:=ISoma mod 10;
   s:=d+u;
   iChing:=11-s;
   write('I Ching   ', iChing, '  ');
end;


Procedure descreveIChing;

Begin
    Case iChing of
1: Begin{agua}
          write('Agua (yin)');
End;
2: Begin{Terra}
          write('Terra (yin)');
End;
3: Begin{Arvore}
  write('Arvore (yin)');
End;
4: Begin{Arvore}
  write('Terra (yin');
End;
5: Begin{Terra}
  write('Terra (yine yang)');
       End;
6: Begin{Metal}
  write('Metal (yiang)');
End;
7: Begin{Metal}
  write('Metal (yiang)');
End;
8: Begin{Terra}
  write('Terra (yaing)');
End;
9: Begin{Fogo}
      write('Fogo (yiang)');
End;
end;
end;


{  P R I N C I P A L  }

Begin
   writeln; writeln; writeln;
   Write('Digite o ano de seu nascimento   :  ');entraAno;
   writeln;
   write('o numero que vc digitou foi :   ' ); imprimeAno;
   writeln;
   writeln;
   somaAno;
   writeln;
   obtemIChing;
   descreveIChing;
   writeln;
   writeln;
   writeln;
   writeln;
   writeln;
End.

Montar uma calculadora somente com o uso de functions

{Calculadora com uso de funções}

program CalculadoraF;

USES CRT;

FUNCTION ADICAO (A, B: REAL) : REAL;
begin
   ADICAO:=A+B;
end;

FUNCTION SUBTRACAO (A, B: REAL) : REAL;
begin
SUBTRACAO:=A-B;
end;

FUNCTION MULTIPLICACAO (A, B: REAL) : REAL;
begin
   MULTIPLICACAO:=A*B;
end;

FUNCTION DIVISAO (A, B: REAL) : REAL;
begin
   DIVISAO:=A/B;
end;

VAR
   NUM1, NUM2: real;

BEGIN
   clrscr;
   write(‘Informe o primeiro numero: ‘); readln(NUM1);
   write(‘Informe o segundo numero: ‘); readln(NUM2);
   writeln(‘ o resultado da adicao = ‘ , ADICAO(NUM1, NUM2):5:2) ;
   writeln(‘ o resultado da subtracao = ‘, SUBTRACAO(NUM1, NUM2):5:2);
   writeln(‘ o resultado da multiplicacao = ‘, MULTIPLICACAO(NUM1, NUM2):5:2);
   writeln(‘ o resultado da divisao = ‘, DIVISAO(NUM1, NUM2):5:2);
   writeln(‘————————————————————–’);
END.

Exemplo Calculadora com procedure e function

{[pascal] Outra calculadora com uso de funções}

Program CALCULADORA;
uses crt;

var
OPCAO: char;
X, A, B: real;

PROCEDURE ENTRADA;

begin
gotoxy(05,06); write('Entre com um valor para A: '); readln(A);
gotoxy(05,07); write('Entre com um valor para B: '); readln(B);
end;

{**** Funcao para realizar a escolha do calculo que será realizado ****}

function CALCULO (R, T: REAL; OPERADOR: char):real;
begin
Case OPERADOR of
    '+' : CALCULO :=R+T;
    '-' : CALCULO :=R-T;
    '*' : CALCULO :=R*T;
    '/' : CALCULO :=R/T;
END;
end;

{**** Procedimento para mostrar o resultado do calculo ****}

Procedure SAIDA;

VAR
TECLA: char;

begin
gotoxy(05,10); write('O resultado equivale a ', X:5:2);
gotoxy(25,24); writeln('Tecle algo para voltar ao menu');
TECLA:= readkey;
end;

{Procedimento para realizar o calculo da Adicao entre o
 valores armazenados nas variáveis globais A e B ***}

procedure ROT_ADICAO;

begin
clrscr;
gotoxy(32,01); write('Rotina de Adicao');
ENTRADA;
x:= Calculo(A, B, '+');
SAIDA;
end;

{Procedimento para realizar o calculo da Subtracao entre o valores
 armazenados nas variáveis globais A e B ***}

procedure ROT_SUBTRACAO;

begin
clrscr;
gotoxy(30, 1); write('Rotina de Subtração');
ENTRADA;
x:= Calculo(A, B, '-');
SAIDA;
end;

{Procedimento para realizar o calculo da Multiplicacao entre o valores
 armazenados nas variáveis globais A e B ***}

procedure ROT_MULTIPLICACAO;

begin
clrscr;
gotoxy(28,01); write('Rotina de Subtração');
ENTRADA;
x:= Calculo(A, B, '*');
SAIDA;
end;

{Procedimento para realizar o calculo da Divisao entre o valores
 armazenados nas variáveis globais A e B}

procedure ROT_DIVISAO;

begin
clrscr;
gotoxy(32, 1); write('Rotina de Subtração');
ENTRADA;
x:= Calculo(A, B, '/');
SAIDA;
end;

{**** P R I N C I P A L ****}

BEGIN
OPCAO:='0';
while (OPCAO  '5') do begin
    begin
                   clrscr;
    gotoxy(33,01); write('Menu principal');
gotoxy(28,06); write('1.....................Soma');
gotoxy(28,08); write('2............Subtracao');
gotoxy(28,10); write('3......Multiplicacao');
gotoxy(28,12); write('4................Divisao');
gotoxy(28,14); write('5..Fim do programa');
gotoxy(28,18); write('Escolha uma opcao ..........: ');
readln(OPCAO);
IF (OPCAO < '5') THEN
case OPCAO OF
    '1': ROT_ADICAO;
    '2': ROT_SUBTRACAO;
    '3': ROT_MULTIPLICACAO;
    '4': ROT_DIVISAO;
ELSE
    gotoxy(27,25); writeln('Opcao invalida - tecle algo');
    OPCAO := readkey;
end;
end;

END.

Exemolo de Sub-Rotina - Calculadora feito com procedure

{Procedures – Exemplo de subrotina – Calculadora Esse exemplo faz uma calculadora
 simples usando um procedimento para cada operação.
 Também faz uso do Case, uma alternativas a if (s) aninhados.}

Program CALCULADORA;
uses CRT;

var
opcao: char;

{*** Sub-rotinas de  calculos - Adição *** }

Procedure rot_adicao;

var
x, a, b: real;

Begin
clrscr;
gotoxy(32,01); write('Rotina de adição');
gotoxy(05,06); write('Entre um valor para   A: '); readln(a);
gotoxy(05,07); write('Entre um valor para   b: '); readln(b);
x:=a+b;
gotoxy(5,10); write('O resultado equivale a: ', x:6:2);
gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
readln;
end;

{----------------------------------------------------------------------------}

{*** Sub-rotinas de calculos - Subtração ***}

Procedure rot_subtracao;

var
x, a, b: real;
Begin
clrscr;
gotoxy(32,01); write('Rotina de adição');
gotoxy(05,06); write('Entre um valor para  A: '); readln(a);
gotoxy(05,07); write('Entre um valor para   b: '); readln(b);
x:=a-b;
gotoxy(05,10); write('O resultado equivale a:   ', x:6:2);
gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
readln;
end;

{-----------------------------------------------------------------------------}

{*** Sub-rotinas de calculos - Multiplicação***}

Procedure rot_multiplicacao;
var
x, a, b: real;

Begin
clrscr;
gotoxy(32, 1); write('Rotina de adição');
gotoxy(5, 6); write('Entre um valor para  A:   '); readln(a);
gotoxy(5, 7); write('Entre um valor para   b:   '); readln(b);
x:=a*b;
gotoxy(5,10); write('O resultado equivale a: ', x:6:2);
gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
readln;
end;

{-----------------------------------------------------------------------------}

{*** Sub-rotinas dee calculos - Divisão ***}

Procedure rot_divisao;
var
x, a, b: real;
Begin
clrscr;
gotoxy(32,01); write('Rotina de adição');
gotoxy(05,06); write('Entre um valor para  A:   '); readln(a);
gotoxy(05,07); write('Entre um valor para  b:   '); readln(b);
x:=a/b;
gotoxy(05,10); write('O resultado equivale a:   ', x:6:2);
gotoxy(25,24); writeln('Pressione  para voltar para o menu ');
readln;
end;

{-----------------------------------------------------------------------------}

BEGIN { PROGRAMA PRINCIPAL}

textColor(yellow + blink); { altero a cor da fonte }
textBackground(BLUE); { altero a cor do plano de fundo }

clrscr;
opcao:='0';
while (opcao  < '5') do
    Begin
        clrscr;
gotoxy(33,01);    write('Menu principal');
gotoxy(22,06);   write('1  Soma');
gotoxy(22,08);   write('2  Subtracao');
gotoxy(22,10); write('3 Multiplicacao');
gotoxy(22,12); write('4  Divisao');
gotoxy(22,14); write('5 Fim de programa');
gotoxy(22,18); write(' Escolha uma opcao ......: ');
readln(opcao);
Case opcao of
           '1': rot_adicao;
     '2': rot_subtracao;
     '3': rot_multiplicacao;
     '4': rot_divisao
Else
     Writeln('Byeee');
end;
    end;
END.

Exercício de Vetor - Nomes

program lista_nome;

uses crt;

var
   nome                 : array [1..10] of string;
   i                    : integer;

begin
     clrscr;
     writeln ('Listagem de nomes');
     writeln ('-------- -- -----');
     writeln;
     { --- Entrada dos dados --- }
     for i:= 1 to 10 do
         begin
              write ('Digite o ',i:2,'§. nome: '); readln(nome[i]);
         end;
     writeln;
     { --- Apresentacao dos nomes --- }
     for i:= 1 to 10 do
         writeln ('Nome: ',i,'§. ---> ',nome[i]);
     writeln;
     writeln ('Tecle <ENTER> para encerrar: '); readln;
end.

Exercícios - Vetor de 10 posições do tipo Inteiro

{ Crie um algoritmo que preencha um vetor de 10 posicoes de elementos inteiros.
   Calcule e mostre:

   a) os elementos pares;
   b) a soma dos elementos de indice impar;
   c) a media dos elementos;
   d) a quantidade de elementos iguais a 30;
   e) a quantidade de elementos maiores que a media
   f) os elementos do vetor ordenado (crescente)
   g) uma pesquisa sequencial de um elemento da lista, iniciando a posicao onde se encontra.                    }


program vetor_10_posicoes;

uses crt;

var
   x                              : array[1..10] of integer;
   i,j,aux,elem_par,soma_eleind_impar,quant_30,quant_elem_mmedia,num_pesq    : integer;
   soma,media_elementos                          : real;
   resp                                                                         : char;
   achou                                                                        : boolean;
begin
   soma:=0;
   clrscr;
   {**** CADASTRAMENTO DOS ELEMENTOS DE UM VETOR DE 10 POSICOES ****}
   writeln ('Cadastramento dos elementos em um vetor de 10 elementos: ');
   writeln;
   write ('Digite os elementos deste vetor: ');
   for i:= 1 to 10 do
    begin
      write (' '); readln (x[i]);
  soma:= soma + x[i]; {esta variável sera utilizada para calcular a media dos elementos da tabele (item c) }
    end;
   {**** c) a media dos elementos; ****}
   media_elementos:=soma/10;

   clrscr;
   {**** LISTAGEM DOS ELEMENTOS DE UM VETOR DE 10 POSICOES ****}
   writeln ('Elementos em um vetor de 10 elementos: ');
   writeln;
   writeln ('Elementos deste vetor: ');
   for i:= 1 to 10 do
    write (' ',x[i]);

   {**** Solucao dos itens de "a" ate a letra "g" ****}
   elem_par:= 0;
   soma_eleind_impar:=0;
   quant_30:= 0;
   quant_elem_mmedia:=0;
   for i:= 1 to 10 do
    begin
       {**** a) os elementos pares; ****}
     if (x[i] mod 2 = 0) then
    elem_par:= elem_par + 1;
       {**** b) a soma dos elementos de indice impar; ****}
       if (i mod 2 <> 0) then
    soma_eleind_impar:=soma_eleind_impar + x[i];
 {**** d) a quantidade de elementos iguais a 30; ****}
       if x[i] = 30 then
          quant_30:= quant_30 + 1;
 {**** e) a quantidade de elementos maiores que a media ****}
       if x[i] > media_elementos then
   quant_elem_mmedia:= quant_elem_mmedia + 1;
end;
   writeln;
   writeln;
   {**** Apresentacao do resultado obtido nas questoes : "a,b,d,e" ****}
   writeln ('a) os elementos pares                    : ',elem_par);
   writeln ('b) a soma dos elementos de indice impar  : ',soma_eleind_impar);
   writeln ('c) a media dos elementos                 : ',media_elementos);
   writeln ('d) a quantidade de elementos iguais a 30 : ',quant_30);
   writeln ('e) a quantidade de elementos maiores que a media: ',quant_elem_mmedia);
   writeln;
   writeln;
   {**** f) os elementos do vetor ordenado (crescente) ****}
 
   {**** rotina de troca dos elementos ****}
   for i:= 1 to 9 do
     for j:= i+1 to 10 do
       begin
          if x[i] > x[j] then
            begin
               aux:=x[i];
               x[i]:=x[j];
               x[j]:=aux;
            end;
       end;
   writeln;
   writeln;
   {*** rotina para listar os elementos da matriz ordenado (crescente) ****}
   writeln ('Listagem dos elementos ordenados (crescente): ');
   write ('Elementos: ');
   for i:= 1 to 10 do
    write (' ',x[i],' ');

   {*** g) uma pesquisa sequencial de um elemento da lista, iniciando a posicao onde se encontra. ***}

   resp:= 'S';
   while (resp = 'S') or (resp = 's') do
      begin
         {*** ROTINA DE PESQUISA ***}
         writeln;
         write ('Entre com o numero a ser pesquisado: '); readln (num_pesq);
         i:=1;
         achou:= false;
         while (i<=10) and (achou = false) do
           begin
              if (num_pesq = x[i]) then
                 achou := true
              else
                 i:= i+1;
              if (achou = true) then
                 writeln (num_pesq,' foi localizado na posicao ',i)
              else
                 writeln (num_pesq,' não foi localizado');
           end;
      end;
   {*** FIM DA ROTINA DE PESQUISA ***}
   writeln;
   write ('Tecle <ENTER> para continuar ');
   readln;
 
end.