Pesquisa de Audiencia de tv

program pesquisaaudiencia;
var
c4tvs:integer;{quantidade de tvs ligadas no canal 4}
c12tvs:integer;{quantidade de tvs ligadas no canal 12}
c71tvs:integer; {quantidade de tvs ligadas no canal 71}
c33tvs:integer; {quantidade de tvs ligadas no canal 33}

c4pessoas:integer;{quantidade de pessoas assistindo o canal 4}

c12pessoas:integer;{quantidade de pessoas assistindo o canal 12}
c71pessoas:integer;{quantidade de pessoas assistindo o canal 71}
c33pessoas:integer; {quantidade de pessoas assistindo o canal 33}

canaltv: integer; {canal assistido no local}
pessoas:integer; {numero de pessoas assistindo tv no local}
Somatvs:integer;{soma das tvs ligadas no canal 4 e canal 12}
Somapessoas:integer;{soma das pessoas assistindo canal 4 e canal 12}

Porcpessoasc4, Porctvsc4, Porcpessoasc12, Porctvsc12, Porcpessoasc33, Porctvsc33, Porcpessoasc71, Porctvsc71 : real; {porcentagens canal 4,12,33,71}

begin
c4tvs:= 0; {quantidade de tvs ligadas no canal 4}
c12tvs:= 0; {quantidade de tvs ligadas no canal 12}

c71tvs:=0; {quantidade de tvs ligadas no canal 71}
c33tvs:=0; {quantidade de tvs ligadas no canal 33}

c4pessoas:= 0; {quantidade de pessoas assistindo o canal 4}

c12pessoas:= 0; {quantidade de pessoas assistindo o canal 12}
c71pessoas:=0; {quantidade de pessoas assistindo o canal 71}
c33pessoas:=0; {quantidade de pessoas assistindo o canal 33}

write ('forneça o numero do canal');
readln(canaltv); {obtem o canal}

while (canaltv <> 0) do
begin
write ('forneça o numero de pessoas assistindo o canal');
readln(pessoas);{obtem o numero de pessoas que assistem o canal}

if (canaltv = 4) {é canal 4?}

then
begin
c4tvs:=c4tvs+1; {acumula tvs canal 4}
c4pessoas:=c4pessoas+pessoas;{acumula pessoas canal 4}
end
else

begin
if (canaltv=12) {é canal 12?}

then
begin
c12tvs:=c12tvs+1; {acumula tvs canal 12}
c12pessoas:=c12pessoas+pessoas;{acumula pessoas canal 12}
end

else
begin
if (canaltv=71) {é canal 71?}
then
begin
c71tvs:=c71tvs +1;
c71pessoas:=c71pessoas + pessoas;
end
else
begin
if (canaltv=33){é canal 33?}
then
begin
c33tvs:=c33tvs +1;
c33pessoas:=c33pessoas +pessoas;
end
else
begin
writeln('Os canais da pesquisa sao 4,12,71 e 33'); {Se não for algum dos canais em questão}
end
end
end

end;
writeln('forneça outro numero do canal(0 para encerrar)');
readln(canaltv); {obtem outro canal}
end;

{Calcula as porcentagens}

if ((c4tvs=0) and (c12tvs=0) and (c71tvs=0) and (c33tvs=0)) or ((c4pessoas=0) and (c12pessoas=0) and (c71pessoas=0) and (c33pessoas=0))

then
begin
writeln('Erro: não faz divisão por zero');
end
else

if (canaltv = 4) or (canaltv = 12) or (canaltv = 71) or (canaltv =33) or (canaltv=0)
then
begin
Somapessoas:= c4pessoas+c12pessoas+

c71pessoas+c33pessoas;
Somatvs:= c4tvs+c12tvs+c71tvs+c33tvs;

Porcpessoasc4:= (c4pessoas/Somapessoas)*100;
Porcpessoasc12:= (c12pessoas/Somapessoas)*100;

Porcpessoasc71:=(c71pessoas/Somapessoas)*100;
Porcpessoasc33:=(c33pessoas/Somapessoas)*100;

Porctvsc4:= (c4tvs/Somatvs)*100;
Porctvsc12:= (c12tvs/Somatvs)*100;

Porctvsc71:=(c71tvs/Somatvs)*100;
Porctvsc33:=(c33tvs/Somatvs)*100;

{Mostra as porcentagens}
writeln('% de tvs ligadas no canal 4',Porctvsc4);
writeln('% de pessoas assistindo o canal 4',Porcpessoasc4);
writeln('% de tvs ligadas no canal 12',Porctvsc12);
writeln('% de pessoas assistindo o canal 12',Porcpessoasc12);

writeln('% de tvs ligadas no canal 71',Porctvsc71);
writeln('% de pessoas assistindo o canal 71',Porcpessoasc71);
writeln('% de tvs ligadas no canal 33',Porctvsc33);
writeln('% de pessoas assistindo o canal 33',Porcpessoasc33);
end
end.

Conversão de temperatura

program temperaturaluisacosta;
var
C,F,K,R:real; {variáveis para temperaturas}
  begin
{entrada de dados}
writeln('forneça a temperatura em farhenheit');
readln(F);
{ebulição da agua em kelvin = 373,15 K}
writeln('forneça a temperatura em kelvin');
readln(K);
{fusão do gelo em rankine = 491,7 R}
writeln('forneça a temperatura em rankine');
readln(R);

C:=(5/9)*(F-32);{conversão da temperatura de celsius para farhenheit}
{saída de dados}
writeln(F,'graus farhenheit,corresponde a');
writeln(C,'graus centigrados');

C:=(K-273.15);{conversão da temperatura de celsius para kelvin}
{saída de dados}
writeln(K,'graus kelvin,corresponde a');
writeln(C,'graus centigrados');

C:=((R/1.8)- 273.15);{conversão da temperatura de celsius para rankine}
{saída de dados}
writeln(R,'graus rankine,corresponde a');
writeln(C,'graus centigrados');

  end.

Soma dos numeros divisiveis por n entre a e b

program soma32a120;

  var
    soma: integer;
    i: integer;
  begin
    soma := 0;
    i := 35;
    while  i <= 120 do
      begin
        if(i mod 7 = 0) then
          begin
            soma := soma + i;
          end;
        i := i + 1;
      end;

    writeln('A soma dos números divisíveis por 7 entre 35 e 120 é: ', soma);
end.

Soma dos numeros divisiveis por 7 entre 32 a 120

program soma32a120;

  var
    soma: integer;
    i: integer;
  begin
    soma := 0;
    i := 35;
    while  i <= 120 do
      begin
        if(i mod 7 = 0) then
          begin
            soma := soma + i;
          end;
        i := i + 1;
      end;

    writeln('A soma dos números divisíveis por 7 entre 35 e 120 é: ', soma);
end.

Que dia é amanhã?

program quediaeamanha;

   var d, m, a, ds, ms, as: integer;
   function diasnestemes (dias:integer; mes:integer; ano:integer):integer;{retorna o número de dias de cada mes}
     begin
       if (mes=1) or (mes=3) or (mes=5) or (mes=7) or (mes=8) or (mes=10) or (mes=12) then {Meses com 31 dias}
          dias:=31;
       if (mes=4) or (mes=6) or (mes=9) or (mes=11) then {Meses com 30 dias}
          dias:=30;
       if (mes=2) then {mes com 28 ou 29 dias, dependendo se é ano bissexto ou não}
          begin
            if (ano mod 400=0) then
               dias:=29;
            if (ano mod 400<>0) then
               dias:=28;
          end;
      diasnestemes:= dias;
     end; {fim da função que retorna quantos dias tem cada mês}

begin
  writeln('forneca o dia');
  readln(d);
  writeln('forneca o mes');
  readln(m);
  writeln('forneca o ano');
  readln(a);
  writeln('O numero de dias do mes é:', diasnestemes(d,m,a));
  if (diasnestemes(d,m,a)=31) then
     begin
       if (d=31) then
          begin
            ds:=1;
            ms:=m+1;
            as:=a;
          end;
       if (d<>31) then
          begin
            ds:=d+1;
            ms:=m;
            as:=a;
          end;
     end;
  if (diasnestemes(d,m,a)=30) then
     begin
       if (d=30) then
          begin
            ds:=1;
            ms:=m+1;
            as:=a;
          end;
       if (d<>30) then
          begin
            ds:=d+1;
            ms:=m;
            as:=a;
          end;
     end;
  if (diasnestemes(d,a,m)=29) then
     begin
       if (d=29) then
          begin
            ds:=1;
            ms:=m+1;
            as:=a;
          end;
       if (d<>29) then
          begin
            ds:=d+1;
            ms:=m;
            as:=a;
          end;
     end;
  if (diasnestemes(d,m,a)=28) then
     begin
       if (d=28) then
          begin
            ds:=1;
            ms:=m+1;
            as:=a;
          end;
       if (d<>28) then
          begin
            ds:=d+1;
            ms:=m;
            as:=a;
          end;
     end;
  if (m=12) then
     begin
       ds:=1;
       ms:=1;
       as:=a+1;
     end;  
  writeln('Amanha é dia:', ds,'/',ms,'/',as);

end.
    

Poligono regular qualquer

program poligonoregularqualquer;

var
   n:integer;{numero de lados}
   l:integer;{tamanho do lado}
   Sai:real;{soma dos angulos internos}
   ai:real;{angulo interno}
   a:real;{angulo suplementar ao angulo interno}
   i: integer; {contador de repetição}

begin
  writeln('digite o numero de lados n do poligono');
  readln(n);
  writeln('digite o tamanho l dos lados');
  readln(l);

  Sai:= 180*(n-2);
  ai:= Sai/n;
  a:= 180-ai;

  i:= 1;
  while i<= n do
     begin
       i:= i+1;
       pdireita(a);
       pfrente(l);
     end;
  end.

Notas de um aluno

program notasampliado;

  var
    av1: real;
    av2: real;
    av3: real;
    notaTotal: real;

  begin
    writeln('Entre com a nota do aluno na avaliação 1: ');
    readln(av1);  
       while (av1<0) or (av1>30) do
          begin {repete enquanto as notas forem menores que 0 ou maiores que 30}
            writeln('Notas inválidas! Digite notas de 0 a 30!');
            readln(av1);
          end;

    writeln('Entre com a nota do aluno na avaliação 2: ');
    readln(av2);
       while (av2<0) or (av2>30) do
          begin {repete enquanto as notas forem menores que 0 ou maiores que 30}
            writeln('Notas inválidas! Digite notas de 0 a 30!');
            readln(av2);
          end;

    writeln('Entre com a nota do aluno na avaliação 3: ');
    readln(av3);
       while (av3<0) or (av3>40) do
          begin {repete enquanto as notas forem menores que 0 ou maiores que 40}
            writeln('Notas inválidas! Digite notas de 0 a 40!');
            readln(av3);
          end;

   
    notaTotal := av1 + av2 + av3;
    writeln('A nota total do aluno é: ', notaTotal);

    if notaTotal < 60 then
      begin
        writeln('O aluno foi reprovado');
      end
    else
      begin
        writeln('O aluno foi aprovado');
      end
  end.

Maquina do tempo

program maquinadotempo;
  Var N,X,i,a:integer;

  begin
  writeln('forneça o ano de nascimento da pessoa');
  readln(N);
  writeln('forneça o ano atual');
  readln(X);
  i:=(X-N);
  writeln('a idade da pessoa é',i);
  a:=(2048-N);
  writeln('a idade da pessoa em 2048 é', a);
  end.

Calcula dia da semana

program diaSemana;
  var dia: integer;
  mes: integer;
  ano: integer;

  function calculaDiaSemana(dia: integer; mes: integer; ano: integer): String;
    var seculo: integer;
         semana: integer;
         MDS: integer;
        nomeDia: String;
    begin

      seculo := ano div 100;

      if (mes < 3) then
        begin
          mes := mes + 12;
          ano := ano - 1;
        end;

      ano := ano mod 100;

      semana := dia + (((mes+1)*26) div 10) + ano + (ano div 4) + (seculo div 4) + (5*seculo);

      MDS := semana mod 7;

      if MDS = 0 then
        nomeDia := 'Sábado'
      else if MDS = 1 then
        nomeDia := 'Domingo'
      else if MDS = 2 then
        nomeDia := 'Segunda-Feira'
      else if MDS = 3 then
        nomeDia := 'Terça-Feira'
      else if MDS = 4 then
        nomeDia := 'Quarta-Feira'
      else if MDS = 5 then
        nomeDia := 'Quinta-Feira'
      else if MDS = 6 then
        nomeDia := 'Sexta-Feira';

      calculaDiaSemana := nomeDia;
   end;

   begin
     writeln('Entre com o dia: ');
     readln(dia);
     writeln('Entre com o mes: ');
     readln(mes);
     writeln('Entre com o ano: ');
     readln(ano);

     if ((dia >= 1) and (dia <= 31) and (mes >= 1) and (mes <= 12) and (ano > 1582)) then
       writeln('O dia da semana é: ', calculaDiaSemana(dia, mes, ano))
     else
       writeln('Data inválida');

  end.

Desenha cubo

program cubo;
{Declarações}

  begin
pfrente(150);
pdireita(90);
pfrente(150);
pdireita(90);
pfrente(150);
pdireita(90);
pfrente(150);
pdireita(45);
pfrente(40);
pdireita(45);
pfrente(150);
pdireita(90);
pfrente(150);
pdireita(90);
pfrente(150);
pdireita(90);
pfrente(150);
pdireita(180);
un;
pfrente(150);
pdireita(45);
ul;
pfrente(40);
pesquerda(135);
un;
pfrente(150);
pesquerda(45);
ul;
pfrente(40);
un;
pesquerda(45);
pfrente(150);
pesquerda(135);
ul;
pfrente(40);
dr;
  end.

Desenha casinha (quadrado com triangulo em cima)

program desafio5fvmluisacosta;
{Declarações}

  begin
clrscr; 
ul;
pfrente(200);
pdireita(90);
pfrente(200);
pdireita(90);
pfrente(200);
pdireita(90);
pfrente(200);
un;
pdireita(90);
pfrente(200);
pdireita(30);
ul;
pfrente(200);
pdireita(120);
pfrente(200);
dr;

  end.

Classifica multiplicidade de um número

program classificamultiplicidade;

  var numero: integer;

begin

  writeln('Digite um numero');

  readln(numero);

  while (numero>0) do

      begin

        if numero mod 3 =0 then

           begin

             if numero mod 5 =0 then

                begin

                  writeln('M35');

                  writeln('Digite um numero');

                  readln(numero);

                end

              else

                begin

                  writeln('M3');

                  writeln('Digite um numero');

                  readln(numero);

                 end

           end

        else

           begin

             if numero mod 5 =0 then

                begin

                  writeln('M5');

                  writeln('Digite um numero');

                  readln(numero);

                end

             else

                begin

                  writeln('Nao multiplo');

                  writeln('Digite um numero');

                  readln(numero);

                end

           end

      end

end.

Desenha uma circunferencia

program circunferencia;
{Declarações}
var C:integer;
  begin
  for C:= 1 to 360 do
     begin
       pfrente(1);
       pdireita(1);
     end;
dr;

  end.

Peso ideal de um homem e de uma mulher

program calculaPesoIdealHomemMulher;
 
  var alturaHomem: real; {altura de um homem que se queira saber o peso ideal}
      alturaMulher: real; {altura de uma mulher que se queira saber o peso ideal}
  function calculaPesoIdealHomem(altura: real): real;
    begin
      calculaPesoIdealHomem := 22*(altura*altura);
    end;
  function calculaPesoIdealMulher(alt: real): real;
    begin
      calculaPesoIdealMulher := (20.8)*(alt*alt);
    end;


begin
    writeln('Digite a altura de um homem: ');
    readln(alturaHomem);
    writeln('O peso ideal é: ', calculaPesoIdealHomem(alturaHomem));
    writeln('Digite a altura de uma mulher: ');
    readln(alturaMulher);
    writeln('O peso ideal é: ', calculaPesoIdealHomem(alturaMulher));
end.

Peso ideal de um homem

program calculaPesoIdealHomemAmpliado;

  var alturaHomem: real; {altura do homem que se quer saber o peso ideal}
      pesoHomem: real; {peso do real homem}
      porcentagem: real; {porcentagem acima ou abaixo do peso ideal}
  function calculaPesoIdealHomem(altura: real): real; {função que retorna o valor do peso ideal de um homem}
   
    begin
      calculaPesoIdealHomem := 22*(altura*altura);
    end;

begin
    writeln('Digite a altura de um homem: ');
    readln(alturaHomem);
    writeln('O peso ideal é: ', calculaPesoIdealHomem(alturaHomem)); {retorna o valor do peso ideal de um homem}
    writeln('Digite o peso de um homem: ');
    readln(pesoHomem);
    porcentagem := (((pesoHomem*100)/calculaPesoIdealHomem(alturaHomem)) - 100);
    if porcentagem < 0 then
       writeln('O homem está abaixo do peso ideal e a porcentagem é: ', porcentagem);
    if porcentagem > 0 then
       writeln('O homem está acima do peso ideal e a porcentagem é: ', porcentagem);
    if porcentagem = 0 then
       writeln('O homem está no peso ideal: ', porcentagem);

end.

Area de um triangulo

program areatriangulo;
{Declarações}
Var
    area, altura, base: real;
begin
  write ('Digite a altura do triangulo: ');
  Readln(altura);
  write ('Digite a base do triangulo: ');
  Readln(base);
  area := (altura*base)/2;
  writeln ('A área do triângulo é igual a: ',area);
end.

Area da circunferência

program areacircunferencia;
    var A, r:real;
  begin
    writeln('forneça o valor do raio');
    readln(r);
    A:=(PI*r*r);
    writeln('o valor da area da circunferencia é:', A);
  end.

Achar o menor e maior número

program achamaioremenor;

   var

     numero:integer;

     maior:integer;

     menor:integer;

begin

  write('Forneca um valor');

  readln(numero);

  writeln(numero);

  maior:=numero;

  menor:=numero;

  while (numero>0) do

     begin

       if numero>maior then

          maior:=numero;

       if numero

          menor:=numero;

       write('Forneca outro valor ou 0 para parar:');

       readln(numero);

     end;

  writeln('O maior valor e:', maior);

  writeln('O menor valor e:', menor);

end.

Achar o maior número

program achamaior;

var
    numero:integer;
    maior:integer;

begin
     write('Forneca um valor');
     readln(numero);
     writeln(numero);
     maior:=0;
     while (numero>0) do
            begin
                  if numero>maior then
                        maior:=numero;
                        write('Forneca outro valor ou 0 para parar:');
                        readln(numero);
            end;

     writeln('O maior valor e:', maior);

end.