PREÇO DO PRODUTO

program preco_do_produto;
uses crt;
var pp,pp1,d:real;

begin
    clrscr;
    writeln ('Digite Preco do Produto');
    readln (pp);
    d:=(pp*10/100);
    writeln ('O valor do desconto e: ',d);
    pp1:=(pp-d);
    writeln ('O valor com desconto e: ',pp1);
    readkey;
end.

Potenciação

program potenciacao;
uses crt;
  function potencia(x,z:integer):integer;
  var cont, mult:integer;
  begin
    mult:= 1;
    for cont := 1 to z  do
    begin
      mult:= mult*x;
      potencia:=mult;
    end;
  end;
  var a,b,mult:integer;
  begin
    clrscr;
    writeln ('Digite os numeros');
    readln (a, b);
    while A<>0 do
    begin
      writeln ('Potencia:',potencia(a,b));
      writeln ('Digite os numeros');
      readln (a, b);
    end;
    readkey;
  end.

PESO IDEAL

program peso_ideal;
uses crt;
  function pideal(h:real;sexo:char):real;
  begin
    if (sexo = 'm') then pideal:= (62.1*h-44.7)
    else
      if (sexo = 'h') then pideal:= (72.7*h-58);
  end;
  var alt:real;
      s:char;
  begin
    clrscr;
    writeln ('Digite a Altura');
    readln (alt);
    writeln ('Digite o sexo: (M - mulher, H - Homem');
    readln (s);
    writeln ('O peso ideal e:', pideal(alt,s):2:2);
    readkey;
  end.

Peso em gramas

program peso_gramas;
uses crt;
var pk,pg:real;

begin
    clrscr;
    writeln ('digite o peso da pessoa em kilos');
    readln (pk);
    pg:=(pk*1000);
    writeln ('O peso da pessoa em gramas e: ',pg);
    readkey;
end.

Programa Peso

program peso;
uses crt;
var p, p1, p2:real;

begin
     clrscr;
     writeln ('digite o peso da pessoa');
     readln (p);
     p1:=p+(p*15/100);
     writeln ('o peso com 15% de aumento e: ',p1);
     p2:=p-(p*20/100);
     writeln ('o peso com 20% a menos e: ',p2);
     readkey;
end.

Quantidade de par e impar

{Escrever um programa que le 5 valores para NUM, um de cada vez, e conta
 quanto destes valores sao pares e quantos sao impares, escrevendo esta
 informacao.}

Program QuantParImpar
uses CRT;
Var
   Num, Cont,QPar, QImpar: Integer;
Begin
    Cont  := 1;
    Qpar   := 0;
    QImpar := 0;
    Clrscr;
    While Cont <= 5 Do
        Begin
           Writeln('Digite o N£mero: ', Cont);
           Read(Num);
           If (Num MOD 2) = 0 Then
           QPar := QPar + 1
                              Else
                              QImpar := QImpar + 1;
                              Cont := Cont + 1;
        End;
    Writeln('O Total de N£meros Pares   ‚: ', QPar);
    Writeln('O Total de N£meros Impares ‚: ', QImpar);
    Readkey;
End.

Notas de alunos com médias diferentes

program notas;
uses crt;
  procedure media(n1,n2,n3:real);
  var letra: char;
      med: real;
  begin
    if (letra = 'A') then med := (n1 + n2 + n3 / 3)
    else
      if (letra = 'P') then med := (n1*5) + (n2*3) + (n3*2) / 10;
  end;
  var nota1, nota2, nota3: real;
      letra: char;
  Begin
    clrscr;
    writeln ('digite as notas do aluno');
    readln (nota1,nota2,nota3);
    writeln ('Digite a letra para o calculo da media');
    readln (letra);
    media(nota1,nota2,nota3);
    readkey;
  end.

Efeito Matrix

  Program MATRIX;

Uses Crt;
Var
col,lin,ql,cont,aux:integer;
letra:char;
Begin
 Clrscr;
 Repeat
 col:=1+Random(79);
 lin:=1+Random(23);
 ql:= Random(10);
   for cont:= lin to lin+ql do
    Begin
     if cont<24 then
         Begin
           letra:= chr(Random(255));
             for aux:=1 to 2 do
               Begin
               if aux= 1 Then
              Textcolor(10)
              else
                Textcolor(2);
                gotoxy(col,cont);
                write(letra);
               delay(50);
             end;
         end;
     end;
     until keypressed;
end.

Custo de fábrica de um carro

{O custo ao consumidor de um carro novo e a soma do custo de fabrica
com a percentagem do distribuidor e dos impostos (aplicados ao custo de
fabrica). Supondo que a percentagem do distribuidor seja de 28% e os
impostos de 45%, escrever um programa que leia o custo de fabrica de um carro
e escreva o custo ao consumidor.}

Uses CRT;
Var CustoFab, PorcDist, Imposto, CustoCons: Real;

Begin
    Clrscr;
    Writeln('Informe o custo de fabrica, (Ex: R$ 15000.00): ');
    Read(CustoFab);
    Writeln('28% para o Distribuidor e de 45% de Imposto');
    CustoCons := CustoFab + (CustoFab*0.28) + (CustoFab*0.45);
    Writeln('O custo para o consumidor, R$ ', CustoCons:10:2);
    Readkey;
End.

Série de Fibonacci

{Faca um programa que imprima a serie de Fibonacci = (0,1,2,3,5,8,13,...)
 enquanto o termo a ser impresso for menor que 5000.}

Program Fibonacci;
Uses CRT;
Var
    VAuxF, VFib1, VFib2: Integer;
Begin
    VFib1 := 1;
    VFib2 := 0;
    VAuxF := 0;
    Clrscr;
    While VFib2 < 5000 Do
          Begin
              Writeln(VAuxF);
              VAuxF := VFib1 + VFib2;
              VFib1 := VFib2;
              VFib2 := VAuxF;
          End;
    Readkey;
End.