Exemplo Funcao e Vetor - Fatorial

program funcao_fatorial_vetor;
uses crt;

var vetor : array[1..10] of integer;
    j : 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

  for j := 1 to 10 do
      vetor[j] := fatorial(j);

  for j := 1 to 10 do
        writeln ('Vetor[', j:2, '] = ', vetor[j]);

  readkey;
end.

Exercicio String

program ExercicioString;
uses crt;
 var
   nome : string;
   letra : string;
begin
 nome := 'Nava';
 writeln (nome);
 letra := nome[3] + nome[1];
 writeln (letra);
readkey;
end.
                       

Exemplo de Criar Funcao " Soma de dois Numero"

program Project1;
uses crt;
var
  numero1 : integer;
  numero2 : integer;
  function soma(n1,n2:integer):integer;
  var resultado : integer;
begin
   resultado := n1 + n2;

   soma := resultado;
end;
begin
write('Dgite o Primeiro Numero: ');
readln (numero1);
write('Dgite o Segundo Numero: ');
readln (numero2);
writeln(' A soma dos dois numeros digitados he : ',soma(numero1,numero2));
readkey;
end.                             

Criptografia de Texto Feito Professor Nava

program Criptografia1;
uses crt;
var
  texto : string;

function cripto(txt : string):string;
  var i : integer;
      c : integer;
  begin
    for i := 1 to length(txt) do
    begin
         c:= ord(txt[i]);
         if(c>=65)and(c<=90) then
         begin
           c:= c+3;
           if(c>90)then
           c := c - 26;
           txt[i] := chr(c);
           end;
         end;
    cripto := txt;
    end;
function decripto(txt : string):string;
var   i : integer;
      c : integer;
begin
    for i := 1 to length(txt) do
    begin
         c:= ord(txt[i]);
         if(c>=65)and(c<=90) then
         begin
           c:= c-3;
           if(c<65)then
           c := c + 26;
           txt[i] := chr(c);
           end;
         end;
    decripto := txt;
    end;



begin
write('Digite um Texto: ');
readln (texto);
texto := upcase(texto);
texto := cripto(texto);
writeln('Criptografia do Texto ',texto);
texto := decripto(texto);
writeln(' Normal ', texto);
readkey;
end.
                              

Exemplo de Recurcividade

program Recurcividade;
uses crt;
var
  numero : integer;

  function soma(n:integer):integer;
begin
   if (n>0) then
   soma := n + soma(n-1)
   else
   soma := 0;
end;

begin
  write('Digite um numero: ');
  readln(numero);
  writeln(soma(numero));
  readkey;
end.
                                        

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.