Programando com Pascal

domingo, 6 de fevereiro de 2011

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, 30 de janeiro de 2011

Multiplicação de Matriz

PROGRAM MultMatriz;
USES CRT;
VAR MAT: ARRAY [1..2,1..2] OF INTEGER;
   RESULTADO: ARRAY [1..2,1..2] OF INTEGER;
   M,N, MAIOR : INTEGER;
BEGIN
CLRSCR;
FOR M:= 1 TO 2 DO
  BEGIN
   WRITELN ('DIGITE A LINHA ', M, ' DA MATRIZ');
   FOR N:= 1 TO 2 DO
   READLN (MAT[M,N]);
  END;
MAIOR := MAT [1,1];
FOR M:= 1 TO 2 DO
  BEGIN
   FOR N:= 1 TO 2 DO
   IF MAT [M,N] > MAIOR THEN MAIOR := MAT [M,N];
  END;
FOR M:= 1 TO 2 DO
  BEGIN
   FOR N:= 1 TO 2 DO
   BEGIN
   RESULTADO[M,N] := MAIOR * MAT[M,N];
   END;
  END;
WRITELN ('O RESULTADO DA MULTIPLICACAO DA MATRIZ FOI :',RESULTADO[M,N]);
READKEY;
END.

Relatório de notas de alunos

PROGRAM RelaórioNotas;
USES CRT;
VAR NOME: ARRAY [1..2] OF STRING;
   NOTA: ARRAY [1..2] OF REAL;
   I, J,CONTJ: INTEGER;

BEGIN
  CLRSCR;
  FOR I:= 1 TO 2 DO
  BEGIN
   WRITELN ('DIGITE O NOME DO ',I,' ALUNO');
   BEGIN
   READLN (NOME[I]);
   BEGIN
   WRITELN ('DIGITE A NOTA DO ',NOME[I]);
   BEGIN
   READLN (NOTA[J]);
   CONTJ:= J + 1;
   END;
   END;
   END;
  END;
WRITELN ('RELATORIO DE NOTAS');
WRITELN ('ALUNO ',' NOTA');
FOR I:= 1 TO 2 DO
BEGIN
   WRITELN (NOME [I] ,NOTA[J]:2:2);
   FOR I:= 1 TO CONTJ DO
   WRITELN (NOME[I] , NOTA[J]:2:2);

END;
READKEY;
END.

Mostra os números digitados

PROGRAM EP12;
USES CRT;
VAR A: ARRAY [1..5] OF INTEGER;
   I, ACUM: INTEGER;
   SOMA: STRING;
BEGIN
CLRSCR;
FOR I:= 1 TO 5 DO
BEGIN
   WRITELN ('DIGITE O',I,' NUMERO');
   BEGIN
   READLN (A[I]);
   END;
END;
ACUM:= 0;
FOR I:= 1 TO 5 DO
BEGIN
   ACUM:= ACUM + A[I];
END;
WRITELN ('OS NUMEROS DIGITADOS FORAM:');
BEGIN
WRITELN (ACUM);
END;
READKEY;
END.

Elementos de um vetor

PROGRAM EP1;
USES CRT;
VAR VETOR:ARRAY[1..6] OF INTEGER;
   PAR: ARRAY[1..6] OF INTEGER;
   IMPAR: ARRAY[1..6] OF INTEGER;
   I,J,AUX, QTDP, QTDI: INTEGER;

BEGIN
CLRSCR;
FOR I:= 1 TO 6 DO
BEGIN
   WRITELN ('DIGITE O ',I,' NUMERO DO VETOR');
   READLN (VETOR[I]);
   IF (VETOR[I] MOD 2 = 0) THEN (QTDP):= (QTDP + 1)
   ELSE (QTDI):= (QTDI + 1);
END;
WRITELN ('O VETOR POSSUI ',QTDP,' ELEMENTOS PARES QUE SAO:');
FOR I:= 1 TO 6 DO
BEGIN
   IF (VETOR[I] MOD 2 = 0) THEN WRITE (VETOR[I],',');
END;
WRITELN;
WRITELN ('O VETOR POSSUI ',QTDI,' ELEMENTOS IMPARES QUE SAO:');
FOR I:= 1 TO 6 DO
BEGIN
   IF (VETOR[I] MOD 2 <> 0) THEN WRITE (VETOR[I],',');
END;
READKEY;
END.

Determinante: Matrix de ordem 4

Program Determinante;
Uses CRT;
Var
  M: Array [0..4,0..4] OF Integer;
  Li, Co, Det, A11, A12, A13, A14: Integer;
Begin
clrscr;
Writeln ('Calcular o determinante de uma matriz de ordem n=4 e alertar quando essa ordem nao for cumprida');
writeln;
writeln;
   Writeln('Informe os termos da Matriz de orden n=4: ');
   For Li := 0 to 3 Do
   For Co := 0 to 3 Do
   Begin
   M[Li,Co] := 0;
   Writeln('Linha = ' , Li , ' Coluna = ' , Co);
   Readln(M[Li,Co]);
   End;
   ClrScr;
   A11 := M[0,0]*( (M[1,1]*M[2,2]*M[3,3]) + (M[1,2]*M[2,3]*M[3,1]) +
   (M[1,3]*M[2,1]*M[3,2]) - (M[1,3]*M[2,2]*M[3,1]) -
   (M[1,1]*M[2,3]*M[3,2]) - (M[1,2]*M[2,1]*M[3,3]) );

   A12 := M[0,1]*( (M[1,0]*M[2,2]*M[3,3]) + (M[1,2]*M[2,3]*M[3,0]) +
   (M[1,3]*M[2,0]*M[3,2]) - (M[1,3]*M[2,2]*M[3,0]) -
   (M[1,0]*M[2,3]*M[3,2]) - (M[1,2]*M[2,0]*M[3,3]) )*(-1);

   A13 := M[0,2]*( (M[1,0]*M[2,1]*M[3,3]) + (M[1,1]*M[2,3]*M[3,0]) +
   (M[1,3]*M[2,0]*M[3,1]) - (M[1,3]*M[2,1]*M[3,0]) -
   (M[1,0]*M[2,3]*M[3,1]) - (M[1,1]*M[2,0]*M[3,3]) );

   A14 := M[0,3]*( (M[1,0]*M[2,1]*M[3,2]) + (M[1,1]*M[2,2]*M[3,0]) +
   (M[1,2]*M[2,0]*M[3,1]) - (M[1,2]*M[2,1]*M[3,0]) -
   (M[1,0]*M[2,2]*M[3,1]) - (M[1,1]*M[2,0]*M[3,2]) )*(-1);
   Writeln('I11 = ', M[0,0] , ' I12 = ', M[0,1] , ' I13 = ', M[0,2] , ' I14 = ', M[0,3]);
   Writeln('A11 = ', A11, ' A12 = ', A12, ' A13 = ', A13, ' A14 = ', A14);
   Det := A11 + A12 + A13 + A14;
   writeln;
   Writeln('O determinante da matriz e:',Det);
   Readkey;
End.

Calculo de determinante

Program Determinante;
Uses CRT;
Var
  M: Array [0..4,0..4] OF Integer;
  Li, Co, Det, A11, A12, A13, A14: Integer;
Begin
   ClrScr;
   Writeln('Informe os termos da Matriz (4x4): ');
   For Li := 0 to 3 Do
   For Co := 0 to 3 Do
   Begin
   M[Li,Co] := 0;
   Writeln('Linha = ' , Li , ' Coluna = ' , Co);
   Readln(M[Li,Co]);
   End;
   ClrScr;
   A11 := M[0,0]*( (M[1,1]*M[2,2]*M[3,3]) + (M[1,2]*M[2,3]*M[3,1]) +
   (M[1,3]*M[2,1]*M[3,2]) - (M[1,3]*M[2,2]*M[3,1]) -
   (M[1,1]*M[2,3]*M[3,2]) - (M[1,2]*M[2,1]*M[3,3]) );

   A12 := M[0,1]*( (M[1,0]*M[2,2]*M[3,3]) + (M[1,2]*M[2,3]*M[3,0]) +
   (M[1,3]*M[2,0]*M[3,2]) - (M[1,3]*M[2,2]*M[3,0]) -
   (M[1,0]*M[2,3]*M[3,2]) - (M[1,2]*M[2,0]*M[3,3]) )*(-1);

   A13 := M[0,2]*( (M[1,0]*M[2,1]*M[3,3]) + (M[1,1]*M[2,3]*M[3,0]) +
   (M[1,3]*M[2,0]*M[3,1]) - (M[1,3]*M[2,1]*M[3,0]) -
   (M[1,0]*M[2,3]*M[3,1]) - (M[1,1]*M[2,0]*M[3,3]) );

   A14 := M[0,3]*( (M[1,0]*M[2,1]*M[3,2]) + (M[1,1]*M[2,2]*M[3,0]) +
   (M[1,2]*M[2,0]*M[3,1]) - (M[1,2]*M[2,1]*M[3,0]) -
   (M[1,0]*M[2,2]*M[3,1]) - (M[1,1]*M[2,0]*M[3,2]) )*(-1);
   Writeln('I11 = ', M[0,0] , ' I12 = ', M[0,1] , ' I13 = ', M[0,2] , ' I14 = ', M[0,3]);
   Writeln('A11 = ', A11, ' A12 = ', A12, ' A13 = ', A13, ' A14 = ', A14);
   Det := A11 + A12 + A13 + A14;
   Writeln(Det);
   Readkey;
End.

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.