Criptografia de Frases

program CRIPTOGRAFIAFUNCAO;

var

      nome : string;

      escolha : integer;

      denovo : string;

      i : integer;

      n : integer;

      function crip(frase : string) : string;

      var

            i : integer;

            num : integer;

                begin

                frase:=upcase(frase);

              num := 3;

              for i:= 1 to length(frase) do

              if frase[i] = 'Z' then

              frase[i] := 'C'

              else if (frase[i] = 'X') then

              frase[i] := 'A'

              else if (frase[i] = 'Y') then

              frase[i] := 'B'

              else

              frase[i] := chr(ord(frase[i])+ num);

              crip := frase;

                end;

      function descrip(frase : string) : string;

               var

               i : integer;

               num : integer;

                begin

                frase:=upcase(frase);

                num := -3;

                for i:= 1 to length(frase) do

                if frase[i] = 'C' then

                frase[i] := 'Z'

                else if (frase[i] = 'A') then

                frase[i] := 'X'

                else if (frase[i] = 'B') then

                frase[i] := 'Y'

                else

                frase[i] := chr(ord(frase[i])+ num);

                descrip := frase;

                end;

begin

  repeat

  writeln('Voce deseja criptografar ou descriptografar uma frase??');

  writeln('1 - Criptografar Digite');

  writeln('2 - Descriptografar Digite');

  readln(escolha);

  writeln();

  case escolha of

  1 : begin

    writeln('digite uma frase');

  readln(nome);

  writeln(crip(nome));

  writeln();

  end;

  2 :  begin

  writeln('digite uma frase');

  readln(nome);

  writeln(descrip(nome));

  writeln();

  end;

  else

    writeln('Digite uma Opcao valida');

    writeln();

 end;

  n :=1;

  while (n<=3) do

  begin

  writeln('Deseja Utilizar novamente?? (SIM/NAO)');

  readln(denovo);

  denovo := upcase(denovo);

  n := n + 1;

  if (denovo <> 'NAO') and (denovo <> 'SIM') then

  writeln('Voce tem 3 chances de digitar SIM OU NAO.. voce ja gastou ',n -1)

  else

  n := 4;

  end;

  if (denovo <> 'NAO') and (denovo <> 'SIM') then

  denovo :='NAO';

  until(denovo = 'NAO') ;

end.

Faça um procedimento que dadas duas variáveis faça a troca das mesmas

program ExercicioProcFunc04;
uses crt;
var num1 : integer;
    num2 : integer;

procedure troca(var n1, n2 : integer);
var aux : integer;
begin
    aux := n1;
    n1 := n2;
    n2 := aux;
end;

begin
    { Faça um procedimento que dadas duas
      variáveis faça a troca das mesmas }
    write('Digite o primeiro numero: ');
    readln(num1);
    write('Digite o segundo numero: ');
    readln(num2);

    writeln('Antes de chamar o procedimento');
    writeln('Primeiro numero: ', num1);
    writeln('Segundo numero: ', num2);

    troca(num1, num2);

    writeln('Depois de chamar o procedimento');
    writeln('Primeiro numero: ', num1);
    writeln('Segundo numero: ', num2);
    readkey;
end.
               

Faça uma função que dados 2 inteiros retorne o maior

program ExercicioProcFunc03;
uses crt;

var num1 : integer;
    num2 : integer;

function maior(n1, n2 : integer): integer;
begin
    if(n1 > n2) then
       maior := n1
    else
       maior := n2;
end;

begin
    { Faça uma função que dados 2 inteiros
      retorne o maior }
    write('Digite o primeiro numero: ');
    readln(num1);
    write('Digite o segundo numero: ');
    readln(num2);

    writeln('O maior eh: ', maior(num1, num2));
    readkey;
end.
               

Faça uma função que receba uma frase e coloque cada palavra iniciando com maiúsculas

program ExercicioProcFunc02;
uses crt;

var texto : string;

function iniciaisMaiusculas(txt : string) : string;
var i : integer;
    flag : boolean;
begin
    flag := true;
    for i:=1 to length(txt) do
    begin
        if(flag) then
            txt[i] := upcase(txt[i]);
        if(txt[i] = ' ') then
            flag := true
        else
            flag := false;
    end;

    iniciaisMaiusculas := txt;
end;

begin
    {Faça uma função que receba uma frase e coloque
    cada palavra iniciando com maiúsculas}
    write('Digite a frase: ');
    readln(texto);

    writeln(iniciaisMaiusculas(texto));
    readkey;
end.
                                       

Faça uma função que dada uma string ela a devolva toda em maiúsculas

program ExercicioProcFunc01;
uses crt;

var texto : string;

function maiusculas(txt : string) : string;
begin
    maiusculas := upcase(txt);
end;

begin
  {Faça uma função que dada uma string
   ela a devolva toda em maiúsculas}
  write('Digite um texto: ');
  readln(texto);

  writeln(maiusculas(texto));
  readkey;
end.
                               

Exemplo Funcao Fazer Fatorial

program ExemploFuncao;
uses crt;
var
  numero         :      integer;

function fatorial(n : integer): integer;
var
i : integer;
f : integer;
   begin
     f := 1;
     for i := 1 to n do
     f := f*i;
     fatorial := f;
   end;
begin
 writeln(' Digite um Numero ');
 readln(numero);
 writeln('O resultado he : ',fatorial(numero));
  readkey;
end.
                               

Calculadora Exemplo Procedimento

program CalculadoraProc;

var

    opcao : integer;

    n1 : integer;

    n2 : integer;

procedure menu();

begin

    writeln('Menu');

    writeln('1 - somar');

    writeln('2 - subtrair');

    writeln('3 - multiplicar');

    writeln('4 - dividir');

    writeln('5 - sair');

    readln(opcao);

end;

procedure somar(var numero1, numero2 : integer);

var resultado : integer;

begin

    resultado := numero1 + numero2;

    writeln(resultado);

end;

procedure subtrair();

var numero1 : integer;

    numero2 : integer;

    resultado : integer;

begin

    write('Digite o primeiro numero: ');

    readln(numero1);

    write('Digite o segundo numero: ');

    readln(numero2);

    resultado := numero1 - numero2;

    writeln(resultado);

end;

procedure multiplicar();

var numero1 : integer;

    numero2 : integer;

    resultado : integer;

begin

    write('Digite o primeiro numero: ');

    readln(numero1);

    write('Digite o segundo numero: ');

    readln(numero2);

    resultado := numero1 * numero2;

    writeln(resultado);

end;

procedure dividir();

var numero1 : integer;

    numero2 : integer;

    resultado : real;

begin

    write('Digite o primeiro numero: ');

    readln(numero1);

    write('Digite o segundo numero: ');

    readln(numero2);

    resultado := numero1 / numero2;

    writeln(resultado:0:2);

end;

begin

    while(opcao <> 5) do

    begin

      menu;

      case opcao of

          1: begin

                 write('Digite o primeiro numero: ');

                 readln(n1);

                 write('Digite o segundo numero: ');

                 readln(n2);

                 somar(n1,n2);

             end;

          2: subtrair;

          3: multiplicar;

          4: dividir;

          5: writeln('Tchau');

          else

              writeln('Digita certo aih, seu panaca!');

      end;

    end;

end.

Programa Tabuada Exercicio Prof Nava

program xadrez;
uses crt;
var tabuleiro : array[1..8,1..8] of integer;
    x : integer;
    y : integer;
    b : integer;
begin
    // montar casas
    for x:=1 to 8 do
    begin
        if (x mod 2 = 0)
        then
            b:=1
        else
            b:=-1;
        for y:=1 to 8 do
        begin
            tabuleiro[x,y] := b;
            b:=b * -1;
        end;
    end;

    // torres
    tabuleiro[1,1] := 16;
    tabuleiro[1,8] := 16;
    tabuleiro[8,1] :=-16;
    tabuleiro[8,8] :=-16;

    // cavalos
    tabuleiro[1,2] := 4;
    tabuleiro[1,7] := 4;
    tabuleiro[8,2] :=-4;
    tabuleiro[8,7] :=-4;

    // bispo
    tabuleiro[1,3] := 8;
    tabuleiro[1,6] := 8;
    tabuleiro[8,3] :=-8;
    tabuleiro[8,6] :=-8;

    // rainhas
    tabuleiro[1,5] := 32;
    tabuleiro[8,4] :=-32;

    // reis
    tabuleiro[1,4] := 64;
    tabuleiro[8,5] :=-64;

    // peoes
    for y:=1 to 8 do
    begin
        tabuleiro[2,y] := 2;
        tabuleiro[7,y] :=-2;
    end;

    // impressao
    writeln('+---+---+---+---+---+---+---+---+');
    for x:=1 to 8 do
    begin
        write('|');
        for y:=1 to 8 do
            write(tabuleiro[x,y]:3,'|');
        writeln();
        writeln('+---+---+---+---+---+---+---+---+');
    end;
    readkey;
end.
                               

Algoritmo com Matriz Armazenar RA, 2 Notas e Fazer a Media

program Project1;
uses crt;
var
 notas :  array [1..10,1..4] of real;
 i     :                 integer;

begin
   for i := 1 to 10 do
   begin
       writeln(' Digite o ',i,' o. RA : ');
       readln(notas[i,1]);
       write(' Digite a Primeira Nota : ');
       readln(notas[i,2]);
       write(' Digite a Segunda Nota : ');
       readln(notas[i,3]);
       notas[i,4] := (notas[i,2]+ notas[i,3])/2;
       writeln();
   end;

// Imprimir
   for i := 1 to 10 do
begin
   writeln('RA: ',notas[i,1]:6:0);
   writeln('Primeira nota ',notas[i,2]:2:2,' Segunda Nota ',notas[i,3]:2:2);
   writeln('Media = ',notas[i,4]:2:2);
   writeln();
end;

  readkey;
end.
                                       

Tabuada Vetor "Array"

program TabuadaVetorArray;
uses crt;
 const NUMERO = 10;
   var
     A :      array[1..NUMERO] of integer;
     i :      integer;
     n :      integer;
    sn :      string[3];
begin
  repeat
   write('Digite o numero Que Deseja Fazer a Tabuada: ');
   readln(n);
   writeln();
   writeln('Tabuada do ',n,' Sedundo Exemplo Atribuido a Variavel A[i]');
  for i:=1 to NUMERO do
   begin
    A[i] := n * i;
    writeln(n:3, ' x ',i:2,' = ',A[i]:3);
    end;

    write('Deseja continuar SIM/NAO? ');
    readln(sn);
    sn :=upcase(sn);
    until(sn = 'NAO');
    Writeln('Vai Curinthia Caraio!!!');
    writeln('fim');

readkey;
end.                   

Matriz Vetor

program MatrizVetor;
uses crt;
const NUMERO = 25;
var
    V :  array[1..NUMERO,1..NUMERO] of integer; //começa posicao 0
    l :  integer;
    c :  integer;
begin

     //Receber valores
     for l := 1 to Numero do
     begin
          for c := 1 to numero do
          begin
               if l = c then
                  V[l][c] := 1;

               if l < c then
                  V[l][c] := 0;

               if l > c Then
                  V[l][c] := 2;
          end;
     end;

     //Imprimir valores
     for l := 1 to Numero do
     begin
          for c := 1 to numero do
              write(V[l][c]);
          writeln('');
     end;
readkey;
end.
                                           

Algoritmo Formar Triangulo com "*" Nava

program triangulos;
uses crt;
var opcao : integer;
    linhas : integer;
    i : integer;
    j : integer;
    c : integer;
begin
    repeat
        // menu de opções
        writeln('Menu:');
        writeln('1 - Esquerda');
        writeln('2 - Direita');
        writeln('3 - Centralizado');
        writeln('0 - Sair');
        readln(opcao);

        case opcao of
             1 : // processa Esquerda
               begin
                    writeln('Opcao Esquerda');
                    write('Digite o numero de linhas: ');
                    readln(linhas);
                    for i := 1 to linhas do
                    begin
                         for j := 1 to i do
                         begin
                             write('*');
                         end;
                         writeln();
                    end;
               end;
             2 : // processa direita
               begin
                    writeln('Opcao Direita');
                    write('Digite o numero de linhas: ');
                    readln(linhas);
                    for i := 1 to linhas do
                    begin
                         for j := i to (linhas - 1) do
                         begin
                             write(' ');
                         end;
                         for j := 1 to i do
                         begin
                             write('*');
                         end;
                         writeln();
                    end;
               end;
             3: // processa centralizado
               begin
                    writeln('Opcao Centralizado');
                    write('Digite o numero de linhas: ');
                    readln(linhas);
                    for i := 1 to linhas do
                    begin
                         for j := i to (linhas - 1) do
                         begin
                             write(' ');
                         end;
                         for j := 1 to (i * 2) - 1 do
                         begin
                             write('*');
                         end;
                         writeln();
                    end;
                    writeln('Asafe way');
                    c := 1;
                    // for das linhas
                    for i := 1 to linhas do
                    begin
                         // for de espacos
                         for j := i to (linhas - 1) do
                         begin
                             write(' ');
                         end;

                         // for de asteriscos
                         for j := 1 to c do
                         begin
                             write('*');
                         end;
                         c := c + 2;
                         writeln();
                    end;
               end;
             0: // sai do programa
               writeln('Tchau!');
             else
               writeln('Opcao invalida!');
        end;
    until opcao = 0 ;
    readkey;
end.
                                                   

Algoritmos "Vetor" Que o Professor Nava Fez em Aula

program ordenar;
uses crt;
const TAMANHO = 10;
var
    a : integer;
    b : integer;
    c : integer;
    x : integer;
    v : array [1..TAMANHO] of integer;
    i : integer;
    esq : integer;
    dir : integer;
begin
    write('Digite o valor de a: ');
    readln(a);
    write('Digite o valor de b: ');
    readln(b);
    write('Digite o valor de c: ');
    readln(c);

    if(a > b) then
    begin
        x := a;
        a := b;
        b := x;
    end;
    if(a > c) then
    begin
        x := a;
        a := c;
        c := x;
    end;
    if(b > c) then
    begin
        x := b;
        b := c;
        c := x;
    end;

    writeln(a, ' - ', b, ' - ', c);

    for i:=1 to TAMANHO do
    begin
        write('digite o elemento ', i, ': ');
        readln(v[i]);
    end;

    for esq := 1 to TAMANHO - 1 do
        for dir := esq + 1 to TAMANHO do
            if(v[esq] > v[dir]) then
            begin
                x := v[esq];
                v[esq] := v[dir];
                v[dir] := x;
            end;

    for i:=1 to TAMANHO do
        write(v[i], ' ');
    readkey;
end.
                    

Tabuada Com Vetor "ARRAY" Exemplo com 2 Métodos de Aplicaçã

program TabuadaVetorFinal;
uses crt;
const NUMERO = 10;
var
    A :  array[1..NUMERO] of integer;
    i :  integer;
    n :  integer;
    sn:  string[3];
begin
  repeat
  { Entrada- alimenta o vetor. }
  write('Digite o numero Que Deseja Fazer a Tabuada: ');
  readln(n);
  { Processamento }
  writeln('Tabuada do ', n,' Esse Primeiro Exemplo foi atribuido A[1]...A[10]');
  for i:= NUMERO downto 1 do
  begin
        A[1] := (n * i);
        A[2] := (n * i);
        A[3] := (n * i);
        A[4] := (n * i);
        A[5] := (n * i);
        A[6] := (n * i);
        A[7] := (n * i);
        A[8] := (n * i);
        A[9] := (n * i);
        A[10]:= (n * i);
        write(n:4,' X ',i:2, ' = ' , A[i]:4);
  if (A[i] mod 2 = 0) then
        writeln(' he Par  ')
  else
        writeln(' he Impar');
  end;
    writeln();
    writeln('Tabuada do ',n,' Sedundo Exemplo Atribuido a Variavel A[i]');
  for i:=1 to NUMERO do
  begin
    A[i] := n * i;
    writeln(n:3, ' x ',i:2,' = ',A[i]:3);
  end;

    write('Deseja continuar SIM/NAO? ');
    readln(sn);
    sn :=upcase(sn);
    until(sn = 'NAO');
    Writeln('Vai Curinthia Caraio!!!');
    writeln('fim');
  readkey;
end.
                             

Tabuada Com Vetor Dos Elementos De A Função Random

program TabuadaDosElementosDeA;
uses crt;
const n = 5;
var i, j: integer;
       A: array[1..n] of integer;
begin
  { Entrada- alimenta o vetor. }
  randomize;
  for i := 1 to n do A[i] := random(100);
 
  { Processamento }
  for i:=1 to n do
  begin
    clrscr;
    writeln('Tabuada do ', i, 'o. elemento do vetor A.');
    writeln;
    for j:=1 to 10 do writeln(A[i]:2, ' x ', j:2, ' = ', (A[i]*j):3);
    writeln;
    writeln('Pressione [Enter] para ver a proxima tabuada.');
    readln;
  end;
 
  writeln('Fim...');
  writeln;
  writeln('Pressione [Enter] para prosseguir.');
  readln;
end.

Algoritmo Desenho Feito Professor Nava ADS Fatec Manhã

program DesenhoNava;
uses crt;
    var
      opcao      :      integer;
      linhas     :      integer;
      i          :      integer;
      j          :      integer;
begin
   repeat
   writeln('Menu');
   writeln('1 Esquerda');
   writeln('2 Direita');
   writeln('3 Centralizado');
   writeln('0 "Sair"');
   readln(opcao);

   case opcao of
   1://Processa Esquerda

     begin
     writeln('1 Opcao Esquerda');
     writeln(' Digiete o Numero de Linha');
     readln(linhas);
     for i := 1 to linhas do
     begin
     for j:=1 to i do
     begin
     write('*');
     end;
     writeln();
     end;
     end;

   2: //Processa Direita
    begin
     writeln('2 Opcao Direita');
     writeln(' Digiete o Numero de Linha');
     readln(linhas);
     for i := 1 to linhas do
     begin
      for j:= i to linhas - 1 do
       begin
       write(' ');
       end;
      begin
     for j:=1 to i do
     begin
     write('*');
     end;

     end;
       writeln();
     end;
     end;

   3:// Processa Centralizado
     begin
     writeln('3 Opcao Direita');
     writeln(' Digiete o Numero de Linha');
     readln(linhas);
     for i := 1 to linhas do
     begin
      for j:= i to linhas - 1 do
       begin
       write(' ');
       end;
      begin
     for j:=1 to (2*i)-1 do
     begin
     write('*');
     end;

     end;
       writeln();
     end;
     end;



   0:// Sai do Programa
     writeln('Tchau!');

   else
     writeln('Opcao Invalida');
   end;
   until opcao = 0;
readkey;
end.
                                 

Desenho Com ' * ' Função For Matriz

// Exercicio Feito Por William Silva 1º ADS Fatec Mogi Mirim

program Project1;

var

  numero : integer;

  opcao : integer;

  f1 : integer;

  f2 : integer;

  f3 : integer;

  estrela : string[30];

  den : string[3];

  numero2 : integer;

begin

  repeat

  writeln('Digite uma opcao:');

  writeln('1-Esquerda:');

  writeln('2-Direita:');

  writeln('3-centro:');

  readln(opcao);

  estrela := '*';

  case opcao of //case1

  1 : begin//1

   writeln('Digite o numero de linhas');

   readln(numero);

    for f1:= 1 to numero do

             begin//2

             for f2:= f1 to numero -1 do

                 begin//3

                 write();

                 end;//3

                     for f2 := 1 to f1 do

                     begin//4

                     write(estrela);

                     end;//4

                     writeln();

             end;//2

    end;//1

  2 : begin//1

      writeln('Digite o numero de linhas');

      readln(numero);

                     for f1:= 0 to numero do

                     begin//2

                          for f2:= f1 to numero -1 do

                                 begin//3

                                 write(' ');

                                 end;//3

                                        for f2 := 1 to f1 do

                                            begin//4

                                            write(estrela);

                                            end;//4

                                            writeln();

                      end;//2

       end;//1

  3: Begin//1

     writeln('Digite o numero de linhas');

     readln(numero);

     numero2 := numero;

               for f1 :=1 to numero do

                   begin//2

                    for f2:=f1 to numero do

                        write(' ');

                         begin//3

                             if (f1 = 1) then

                             begin//4

                             for f3 := f2 to numero do

                                write(estrela);

                                end//4

                                      else

                                      begin//5

                                          for f3 := f2 to numero2 +2 do

                                          write(estrela);

                                          numero2 := numero2 +2;

                                      end;//5

                          end;//3

                         begin//6

                          for f2:=f1 to numero do

                        write(' ');

                          end;//6

                         writeln();

                    end;//2

                   end;//1

  else

writeln('Digite uma Operacao valida');

writeln();

end;

        writeln('Deseja continuar SIM/NAO? ');

        readln(den);

        den :=upcase(den);

        until(den = 'NAO');

        writeln('Acabou a Brincadeira');

  readln();

end.  

Exercicio Desenho com Matriz Função For

         *          *****             **
       **            ****           ****
     ***              ***          *****
   ****                **         ******
 *****                  *       ********

    1                   2               3


program  ExercicioDesenhoFinal;
uses crt;
var
  opcao  :   integer;
  i      :   integer;
  j      :   integer;
  n      :   integer;
  rep    :   string[5];
begin
  begin
  repeat
   begin
  writeln('Menu');
  writeln('1 - Opcao ');
  writeln('2 - Opcao ');
  writeln('3 - Opcao ');
  write('Digite Opcao de 1 a 3 : ');
  read(opcao);

  if (opcao < 1) or (opcao > 3) then
   begin
   writeln();
   Writeln('Atencao Escolha Opcao 1,2 ou 3');
    end;
   case opcao of

       2:
       begin
 write('digiete quantidade de linha: ');
 read(n);
 writeln();
 for i := 1 to n  do
            begin
            for j := i to n do
            begin
            write(' ');
            end;
  for j :=1  to i  do
           begin
           write('*');
           end;

  writeln();
  end;
end;

    1:
     begin
 write('digiete quantidade de linha: ');
 read(n);
 writeln();

 for i := 1 to n  do
  begin
  write(' ');
     for j :=1  to i do
     begin
          write('*');
     end;
  writeln();
  end;
end;

   3:
  begin
write('digiete quantidade de linha: ');
read(n);
writeln();
for i := 1 to n  do
           begin
   for j := i to n do
   begin
   write(' ');
   end;
        for j :=1  to (2*i)-1  do
          begin
          write('*');
          end;

 writeln();
 end;
end;
end;


   end;


    writeln();
    write('Deseja Continuar (SIM/NAO)');
    read(rep);
    writeln();

     until rep = 'NAO';
   end;

   readkey;
end.