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.