Pascal - Lazarus

Link para Download IDE Lazarus Pascal

http://www.lazarus-ide.org

Vetor Função e Procedimento Materia Prova

program prova;

uses crt;

var vetor: array[1..10] of integer;
opcao: integer;
salvo: integer;


Procedure Menu ();
Begin
  writeln('Menu');
  writeln('1- Adicionar');
  writeln('2- Elemento');
  writeln('3- Media');
  writeln('4- Soma');
  writeln('5- Maior');
  writeln('6- Menor');
  writeln('7- Sair');
  Write('Sua opcao: ');
  readln(opcao);
end;


Procedure Adicionar();
var j : integer;
begin
for j :=1 to 10 do
begin
writeln('Digite um numero');
readln(vetor[j]);
end
end;

function elemento(salve : integer): integer;
var  j : integer;

begin
for j :=1 to 10 do
    elemento := vetor[salve]
end;

function media() : real;
var j : integer;
  soma : real;
  resultado : real;
begin
for j := 1 to 10 dobegin
soma := vetor[j] + soma;
end;
resultado := soma / 10;
media := resultado;
end;

function soma() : real;
var j:integer;
  somar : real;
  resultado : real;
begin
for j:= 1 to 10 do
somar:= (vetor[j]) + somar;
soma := somar;
end;

function maior() : integer;
var j : integer;
    maiores : integer;

begin
maiores := 0;
 for j := 1 to 10 do   begin
   if vetor[j] > maiores then
      maiores := vetor[j]
      else
        maiores := maiores;
   end;
end;

function menor() : integer;
var j : integer;
    menores : integer;
begin
 for j := 1 to 10 do   begin
      if vetor[j] < menores then
      menores := vetor[j]
      else
        menores := menores;
   end;
end;


begin
   repeat
   begin
     Menu;
     case opcao of
      1: adicionar;
      2:
        begin
          writeln('Digite um numero na faixa de 1 a 10');
          readln(salvo) ;
          writeln('o numero na opcao escolhida eh: ', elemento(salvo));
        end;
      3: writeln('A media do vetor eh: ', media:2:0);
      4: writeln('A soma do vetor eh: ', soma:2:0);
      5: writeln('O maior numero eh: ', maior);
      6: writeln('O menor numero eh: ', menor);
      7: writeln('sair');
      else
        writeln('digite uma opcao valida');
      end;
     end;
   until opcao = 7;

  readkey;
end.

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.