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.