Introdução a Computação

Soluções da aula prática 5



1.
PROGRAM Calculator;

Var a, b, c: real;
    opcao: integer;

begin
  Write('numero 1: ');
  ReadLn(a);
  Write('numero 2: ');
  ReadLn(b);
  WriteLn('Escolhe uma opcao:');
  WriteLn('1) addicionar');
  WriteLn('2) mulitplicar');
  WriteLn('3) dividir');
  WriteLn('4) subtrair');
  ReadLn(opcao);
  Case opcao of
    1: begin
         c := a + b;
         WriteLn('A soma e ',c:0:1);
       end;
    2: begin
         c := a * b;
         WriteLn('O produto e ',c:0:1);
       end;
    3: begin
         c := a / b;
         WriteLn('A divisao da ',c:0:1);
       end;
    4: begin
         c := a - b;
         WriteLn('A diferenca e ',c:0:1);
       end;
  end;
end.

numero 1: -1
numero 2: 3
Escolhe uma opcao:
1) addicionar
2) multiplicar
3) dividir
4) subtrair
 1
A soma e 2.0 



2.
PROGRAM Combination;

Var a, b: integer;

begin
  Write('numero 1: ');
  ReadLn(a);
  Write('numero 2: ');
  ReadLn(b);
  if (a<0) AND (b<0) then
    WriteLn('Ambos negativos');
  if (a<0) OR (b<0) then
    WriteLn('No minimo um e negativo');
  if (a<0) XOR (b<0) then
    WriteLn('So um e negativo');
end.

numero 1: -1
numero 2: 3
No minimo um e negativo
So um e negativo



3.
 expressão   resultado 
 25 AND 49 
17
 37 OR 11
47
 39 XOR 17
54
 7 OR 14 
15

PROGRAM BooleanAlgebra;

Var a, b: byte;
    opcao: integer;

begin
  Write('numero a: ');
  ReadLn(a);
  Write('numero b: ');
  ReadLn(b);
  WriteLn('Escolhe uma opcao:');
  WriteLn('1) a AND b');
  WriteLn('2) a OR b');
  WriteLn('3) a XOR b');
  WriteLn('4) NOT a');
  ReadLn(opcao);
  Case opcao of
    1: WriteLn(a, ' AND ', b, ' = ', a AND b);
    2: WriteLn(a, ' OR ', b, ' = ', a OR b);
    3: WriteLn(a, ' XOR ', b, ' = ', a XOR b);
    4: WriteLn('NOT ', a, ' = ', NOT a);
  end;
end.

(Nota que o resultado do NOT a depende do tipo da variável)



4.
PROGRAM EstouFeliz;

Var i: integer;

begin
  for i := 1 to 1000 do
    WriteLn('Estou muito feliz');
end.
4b:
PROGRAM TextoAMostrar;

Var i, n: integer;
    s: string;

begin
  Write('texto a mostrar: ');
  ReadLn(s);
  Write('numero de vezes: ');
  ReadLn(n);
  for i := 1 to n do
    WriteLn(s);
end.

texto a mostrar: Benfica o glorioso
numero de vezes: 3
Benfica o glorioso
Benfica o glorioso
Benfica o glorioso



5.
PROGRAM Tabuada;

Var i, n: integer;

begin
  Write('Um numero: ');
  ReadLn(n);
  for i := 1 to 10 do
    WriteLn(i, ' x ', n, ' = ', i*n);
end.

Um numero: 8
1 x 8 = 8
2 x 8 = 16
3 x 8 = 24
4 x 8 = 32
5 x 8 = 40
6 x 8 = 48
7 x 8 = 56
8 x 8 = 64
9 x 8 = 72
10 x 8 = 80



6.
PROGRAM Binario;

Var a: byte;

begin
  Write('numero decimal: ');
  ReadLn(a);
  Write('binario: ');
  if (a AND 128)>0 then Write('1') else Write('0');
   (* 128 = 10000000 *)
  if (a AND 64)>0 then Write('1') else Write('0');
   (* 64 = 01000000 *)
  if (a AND 32)>0 then Write('1') else Write('0');
   (* 32 = 00100000 *)
  if (a AND 16)>0 then Write('1') else Write('0');
   (* 16 = 00010000 *)
  if (a AND 8)>0 then Write('1') else Write('0');
   (* 8 = 00001000 *)
  if (a AND 4)>0 then Write('1') else Write('0');
   (* 4 = 00000100 *)
  if (a AND 2)>0 then Write('1') else Write('0');
   (* 2 = 00000010 *)
  if (a AND 1)>0 then WriteLn('1') else WriteLn('0');
   (* 1 = 00000001 *)
end.

numero decimal: 33
binario: 00100001

ou uma solução com um ciclo Repeat-Until

PROGRAM Binario;

Var a, mask: byte;

begin
  Write('numero decimal: ');
  ReadLn(a);
  Write('binario: ');
  mask := 128     (* 128 = 10000000 *)
  repeat
    if (a AND mask)>0 then Write('1') else Write('0');
    mask := mask DIV 2;
      (* 128 -> 64 -> 32 -> 16 -> 8 -> 4 -> 2 -> 1 -> 0 *)
      (* 10000000 -> 01000000 -> 00100000 -> 00010000 -> *)
      (* 00001000 -> 00000100 -> 00000010 -> 00000001 -> *)
      (* 00000000 *)
  until mask < 1;
end.

agora com um ciclo For para mostrar todos os códigos binários entre 0 e 255:

PROGRAM Binario;

Var a, mask: byte;

begin
  For a := 0 To 255 Do
    begin
      Write('numero decimal: ');
      Write('binario: ');
        (* nao precisa pedir ao utilizador um numero *)
        (* 'a' vem do ciclo *)
      mask := 128
      repeat
        if (a AND mask)>0 then Write('1') else Write('0');
        mask := mask DIV 2;
      until mask < 1;
      WriteLn;           (* introduz nova linha *)
    end;
end.