Mostrando postagens com marcador Função se. Mostrar todas as postagens
Mostrando postagens com marcador Função se. Mostrar todas as postagens

domingo, 6 de fevereiro de 2011

Positivo e primo

program positivo;
uses crt;
var i, cont:integer;
  function posit(num: integer):boolean;
  begin
    for i:= 1 to num do
    begin
      if ( num mod i = 0) then cont:= cont + 1;
      if (cont = 2 ) then posit:= true
       else posit := false;
    end;
   end;
   var num:integer;
    begin
      clrscr;
      writeln ('Digite o numero');
      readln (num);
      writeln ('O numero digitado foi:',num);
      writeln ('ele e primo?  ' , posit(num));
      readkey;
    end.

Positivo e negativo

program posit_negat;
uses crt;
  function verif(num: integer):boolean;
  begin
    if (num>0) then verif:=true
    else verif:=false;
  end;
  var num: integer;
      msg: string;
  begin
    clrscr;
    writeln ('digite um numero');
    readln (num);
    if (verif(num)=true) then msg:='positivo'
    else
      if (verif(num)=false) then msg:='negativo';
    writeln ('O numero digitado foi:', num ,', ele e: ', msg);
    readkey;
  end.

programa par e impar

Program par_impar;
uses crt;
  function ver(num:integer):boolean;
  begin
    if (num mod 2 = 0) then ver:= true
    else ver:= false;
  end;
  var num: integer;
      msg : string;
  begin
    clrscr;
    writeln ('Digite numero');
    readln (num);
    while num <> 0 do
    begin
      if ver(num)= true then msg:='PAR'
      else
        if ver(num)= false then msg := 'ÖMPAR';
      writeln ('O numero digitado foi:', num, ', ele e:', msg);
      writeln;
      writeln ('Digite numero');
     readln (num);
   end;
   readkey;
end.

Programa Opinião

program opiniao;
uses crt;
var QtdP,Id, Sx, ContQ, ContOp: Integer;
    Op, A, B, C, D , E :Char;

Begin
clrscr;
writeln ('Digite a quantidade de pesquisados');
readln (QtdP);
for contQ := 1 to QtdP do
  begin
     writeln ('Digite a idade doe pesquisado');
     readln (Id);
     writeln ('Digite o sexo do(a) pesquisado(a)');
     readln (Sx);
     for ContOp := 1 to 5 do
       Begin
          writeln ('Digite a opini o do','ContOp', 'pesquisado');
          readln (Op);
            If  op <>'A' and 'B' and 'C' and 'D' and 'E'
              Then Writeln ('Opiniao Errada')
                 Else
                    Begin
                       If (Op<>'A') then OpA := Op + 1;
                       If (Op<>'B') then OpB := Op + 1;
                       If (Op<>'C') then OpC := Op + 1;
                       If (Op<>'D') then OpD := Op + 1;
                       If (Op<>'E') then OpE := Op + 1;
                    End;
        End;
    If (sexo = 'M') and (Id > 21) then QtdH := QtdH + 1;
    If (sexo = 'H') and (id < 18) Then QtdM := QtdM + 1;
    SomaId := SomaId + Id;
    End;
MedId := SomaId / QtdP;
TotOp := OpA + OpB + OpC + OpD + OpE;
writeln;
End.

domingo, 30 de janeiro de 2011

Mostra o valor lido e o total de notas R$.

{15 - Escrever um algoritmo que le um valor em reais e calcula qual o menor
numero possivel de notas de 100, 50, 10, 5 e 1 em que o valor lido pode ser
decomposto. Escrever o valor lido e a relacao de notas necessarias.}

Program decompornotas;
uses crt;
var valor, relac100, relac50, relac10, relac5, resto,
    resto1, resto2, resto3: integer;

Begin
  Clrscr;
  writeln ('Digite o valor em reais');
  readln (valor);
  if (valor >= 100) then Begin
                           relac100 := valor div 100;
                           resto := valor mod 100;
                           relac50 := resto div 50;
                           resto1 := resto mod 50;
                           relac10 := resto1 div 10;
                           resto2 := resto1 mod 10;
                           relac5 := resto2 div 5;
                           resto3 := resto2 mod 5;
                         end;
  writeln;
  writeln ('Valor lido: ', valor ,',',' decomposto nas seguintes cedulas:');
  writeln;
  writeln (relac100 ,' cedulas de 100 reais');
  writeln (relac50 ,' cedulas de 50 reais');
  writeln (relac10 ,' cedulas de 10 reais');
  writeln (relac5 ,' cedulas de 5 reais');
  writeln (resto3 ,' cedulas de 1 real');
  readkey;
end.