Programando com Pascal

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.

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.

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.

Ordem crescente de 3 números

program ordem_crescente;
uses crt;
procedure crescente (var a, b, c: integer);
begin
   if (a<b) and (a<c) and (b<c) then writeln ('Ordem crescente:',a,',',b,',',c)
   else
   if (a<b) and (a<c) and (c<b) then writeln ('Ordem crescente:',a,',',c,',',b)
   else
   if (b<a) and (b<c) and (a<c) then writeln ('Ordem crescente:',b,',',a,',',c)
   else
   if (b<a) and (b<c) and (c<a) then writeln ('Ordem crescente:',b,',',c,',',a)
   else
   if (c<a) and (c<b) and (a<b) then writeln ('Ordem crescente:',c,',',a,',',b)
   else
   if (c<a) and (c<b) and (b<a) then writeln ('Ordem crescente:',c,',',b,',',a)
   end;
   var x, y, z: integer;
   begin
   clrscr;
   writeln ('Digite os numeros');
   readln (x, y, z);
   writeln ('Os numeros digitados sao:', x,',', y,',', z);
   crescente(x,y,z);
   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.

Médias diversas

PROGRAM NOTAS;
USES CRT;
  FUNCTION MEDIA (N1,N2,N3:REAL):REAL;
  VAR LETRA:CHAR;
  BEGIN
   IF (LETRA ='A') THEN MEDIA := N1+N2+N3/3
   ELSE IF (LETRA = 'P') THEN MEDIA := (N1*5)+(N2*3)+(N3*2)/10
   ELSE IF (LETRA = 'H') THEN MEDIA:=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');
   WRITELN ('A: ARITMETICA, P: PONDERADA, H: HARMONICA');
   READLN (LETRA);
   WRITELN ('MEDIA',MEDIA(NOTA1,NOTA2,NOTA3):5:2);
   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.

domingo, 6 de fevereiro de 2011