Programando com Pascal: janeiro 2011

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.

Calculadora

PROGRAM CALCULADORA;
USES CRT;
VAR OPCAO: CHAR;

PROCEDURE ROT_ADICAO;
VAR X, A, B: REAL;

BEGIN
  CLRSCR;
  GOTOXY (32, 1); WRITE('ROTINA DE ADICAO');
  GOTOXY (5, 6); WRITE ('ENTRE UM VALOR PARA A: ');READLN (A);
  GOTOXY (5, 7); WRITE ('ENTRE UM VALOR PARA B: ');READLN (B);
  X:=A+B;
  GOTOXY (5, 10); WRITE('O RESULTADO EQUIVALE A? ', X:6:2);
  GOTOXY (25, 24); WRITELN('PRESSIONE PARA VOLTAR PARA O MENU ');
  READLN;
END;

  PROCEDURE ROT_SUBTRACAO;
  VAR X, A, B: REAL;

  BEGIN
   CLRSCR;
   GOTOXY (32, 1); WRITE('ROTINA DE SUBTRACAO');
   GOTOXY (5, 6); WRITE ('ENTRE UM VALOR PARA A: ');READLN (A);
   GOTOXY (5, 7); WRITE ('ENTRE UM VALOR PARA B: ');READLN (B);
   X:=A-B;
   GOTOXY (5, 10); WRITE('O RESULTADO EQUIVALE A? ', X:6:2);
   GOTOXY (25, 24); WRITELN('PRESSIONE PARA VOLTAR PARA O MENU ');
   READLN;
  END;

  PROCEDURE ROT_MULTIPLICACAO;
  VAR X, A, B: REAL;

  BEGIN
   CLRSCR;
   GOTOXY (32, 1); WRITE('ROTINA DE MULTIPLICACAO');
   GOTOXY (5, 6); WRITE ('ENTRE UM VALOR PARA A: ');READLN (A);
   GOTOXY (5, 7); WRITE ('ENTRE UM VALOR PARA B: ');READLN (B);
   X:=A*B;
   GOTOXY (5, 10); WRITE('O RESULTADO EQUIVALE A? ', X:6:2);
   GOTOXY (25, 24); WRITELN('PRESSIONE PARA VOLTAR PARA O MENU ');
   READLN;
  END;

  PROCEDURE ROT_DIVISAO;
  VAR X, A, B: REAL;

  BEGIN
   CLRSCR;
   GOTOXY (32, 1); WRITE('ROTINA DE DIVISAO');
   GOTOXY (5, 6); WRITE ('ENTRE UM VALOR PARA A: ');READLN (A);
   GOTOXY (5, 7); WRITE ('ENTRE UM VALOR PARA B: ');READLN (B);
   X:=A/B;
   GOTOXY (5, 10); WRITE('O RESULTADO EQUIVALE A? ', X:6:2);
   GOTOXY (25, 24); WRITELN('PRESSIONE PARA VOLTAR PARA O MENU ');
   READLN;
  END;

  BEGIN
   TEXTCOLOR (YELLOW + BLINK);
   TEXTBACKGROUND (BLUE);
   CLRSCR;
   OPCAO:= '0';
   WHILE (OPCAO <> '5') DO
   BEGIN
   CLRSCR;
   GOTOXY (33, 1); WRITE('MENU PRINCIPAL');
   GOTOXY (22, 6); WRITE('1 SOMA');
   GOTOXY (22, 8); WRITE('2 SUBTRACAO');
   GOTOXY (22, 10); WRITE('3 MULTIPLICACAO');
   GOTOXY (22, 12); WRITE('4 DIVISAO');
   GOTOXY (22, 14); WRITE('5 FIM DE PROGRAMA');
   GOTOXY (22, 18); WRITE(' ESCOLHA UMA OPCAO....: ');
   READLN (OPCAO);
   CASE OPCAO OF
   '1': ROT_ADICAO;
   '2': ROT_SUBTRACAO;
   '3': ROT_MULTIPLICACAO;
   '4': ROT_DIVISAO;
   ELSE
   WRITELN ('BYEEEE');
   END;
  END;
END.

Efeito Matrix

Program MATRIX;

Uses Crt;
Var
col,lin,ql,cont,aux:integer;
letra:char;
Begin
Clrscr;
Repeat
col:=1+Random(79);
lin:=1+Random(23);
ql:= Random(10);
   for cont:= lin to lin+ql do
   Begin
   if cont<24 then
   Begin
   letra:= chr(Random(255));
   for aux:=1 to 2 do
   Begin
   if aux= 1 Then
   Textcolor(10)
   else
   Textcolor(2);
   gotoxy(col,cont);
   write(letra);
   delay(50);
   end;
   end;
   end;
   until keypressed;
end.

Como aplicar comando "read"

Existem diversos tipos de read no pascal: Read, readln, readkey….

Vamos ver alguns, e ver para o que servem e quando devem ser usados:

Read - O Cursor ficará na mesma linha, sendo para receber variável, ou tanto para aguardar o usuário dar [enter]

Sintaxe:

Write(’Digite um número’);

Read(numero);

Readln - O Cursor ficará na linha abaixo da qual estava antes, sendo para receber variável, ou tanto para aguardar o usuário dar [enter]

Sintaxe:

Write(’Digite um número’);

Readln(numero);

ReadKey - É usado para quando houver a necessidade de digitar apenas um dígito

Write(’Digite um algarismo’);

Readkey(algarismo);

Pesquisa população

{Foi realizada uma pesquisa entre 05 habitantes de uma cidade. De
Cada habitante foram coletados os dados: idade, sexo, renda familiar e numero
de filhos. Faca um programa que leia esses dados, armazene-os em um vetor.
Calcule e mostre a media de salario entre os habitantes, a menor e a maior
idade do grupo e a quantidade de mulheres com mais de dois filhos e com renda
familiar inferior a 600.}

Program Pesquisa;
Uses CRT;
Const Max = 05;

Type Coleta = Record
   Nome: string;
   Idade: integer;
   Sexo: char;
   RendaFam: real;
   NumFilhos: Integer;
   end;
   matrizColeta = array [ 1..Max] of Coleta;

  Procedure LeColeta (Var dados: MatrizColeta; i: integer);
  Begin
   Writeln ('Digite os dados do Habitante');
   with dados[i] do
   begin
   write ('Nome: '); readln (Nome);
   write ('Idade: '); readln (Idade);
   write ('Sexo: Digite m - Masculino e f - Feminino: '); readln (Sexo);
   while (Sexo <> 'm') and (Sexo <> 'f') do
   Begin
   write ('Sexo: Digite m - Masculino e f - Feminino: '); readln (Sexo);
   end;
   write ('Renda Familiar: '); readln (RendaFam);
   write ('Numero de Filhos: '); readln (NumFilhos);
   writeln ('');
   End;
  end;

  Procedure EscreveColeta (Var dados: MatrizColeta; i: integer);
  Begin
   Writeln ('Os Dados do habitante sao:');
   with dados[i] do
   Begin
   writeln ('Nome:',Nome);
   writeln ('Idade:',Idade);
   writeln ('sexo:',Sexo);
   writeln ('Renda Familiar:',rendaFam:2:2);
   writeln ('Numero de Filhos:',NumFilhos);
   writeln ('');
   End;
  End;

  {Programa Principal}

   Var Cont, Aux, Aux2, MenorIdade, MaiorIdade,QdMRendaInf: integer;
   Coletar : MatrizColeta;
   MediaSal, SomaSal, AcumSal: real;
   begin
   Clrscr;
   Aux:= 0;
   Aux2:=0;
   For Cont := 1 to Max do
   Begin
   LeColeta (Coletar, Cont);
   end;
   For Cont := 1 to Max do
   Begin
   EscreveColeta (Coletar, Cont);
   end;
   for Cont:= 1 to Max do
   begin
   SomaSal:= SomaSal + Coletar[Cont].RendaFam;
   AcumSal:= AcumSal + 1;
   end;
   for Cont:= 1 to Max do
   begin
   if (Coletar[Cont].Idade > MaiorIdade) then
   begin
   Aux:= MaiorIdade;
   MaiorIdade:= Coletar[Cont].Idade;
   coletar[Cont].Idade := Aux;
   End
   else begin
   Aux2:= MenorIdade;
   MenorIdade := Coletar[Cont].Idade;
   Coletar[Cont].Idade := Aux2;
   End;
   End;
   For Cont:= 1 to Max do
   Begin
   if (Coletar[Cont].Sexo = 'f' ) and (Coletar[Cont].RendaFam < 600)
   Then QdMRendaInf := QdMRendaInf + 1;
   End;
MediaSal := SomaSal/AcumSal;
writeln ('A media do salario entre os habitantes e:',MediaSal:2:2);
writeln ('A maior idade do Grupo e:', MaiorIdade);
writeln ('A Menor idade do Grupo e:', MenorIdade);
writeln ('Quant. Mulheres c/ mais de 2 filhos e renda < R$ 600,e:',QdMRendaInf);
Readkey;
End.

Mostra a categoria de nadador

program categoria;
uses crt;
  procedure idade (id:integer; var msg:string);
   begin
   if (id >= 5) and (id <= 7) then msg := 'INFANTIL A'
   else
   if (id >= 8) and (id <= 10) then msg := 'INFANTIL B'
   else
   if (id >= 11) and (id <= 13) then msg := 'JUVENIL A'
   else
   if (id >= 14) and (id <= 17) then msg := 'JUVENIL B'
   else
   if (id >= 18) then msg := 'ADULTO';
   end;
   var id: integer;
   msg: string;
   begin
   clrscr;
   writeln ('Digite a idade do nadador');
   readln (id);
   while id > 0 do
   begin
   idade (id,msg);
   writeln ('A categoria do nadador e:', msg);
   writeln;
   writeln ('Digite a idade do nadador');
   readln (id);
   end;
   readkey;
   end.

Calculadora

Banco de dados

PROGRAM BANCODADOS;
USES CRT;
TYPE pessoa = RECORD
nome : string[40];
fone : integer;
endereco : string[40];
rg : integer;
ativo : integer;
END;
pesso = FILE Of pessoa;

VAR LISTA, AUXILIAR : pesso;
PESSOAS, AUX : pessoa;
NOME1 : STRING[40];
FONE1 : INTEGER;
ENDERECO1 : STRING[40];
RG1 : INTEGER;
P,K,I,POSICAO : INTEGER;
ACHOU : BOOLEAN;
SAIR : BOOLEAN;
OPCAO : INTEGER;
RGPRO : INTEGER;
ACHOURG : BOOLEAN;
RGALT : INTEGER;
NOMEALT : STRING[40];
FONEALT : INTEGER;
ENDALT : STRING[40];
ACHOURGALT : BOOLEAN;

PROCEDURE EXCLUSAO;
BEGIN

CLRSCR;
ASSIGN (LISTA,'PESSOAS.DAT');
RESET (LISTA);
ASSIGN (AUXILIAR,'AUXILIO.DAT');
REWRITE (AUXILIAR);
K := FILESIZE(LISTA);
WRITELN ('DIGITE O RG A SER EXCLUIDO');
READLN(RG1);
ACHOU := FALSE;
READ (LISTA,PESSOAS);
WHILE (ACHOU = FALSE) AND (NOT EOF (LISTA)) DO
BEGIN
IF PESSOAS.RG = RG1
THEN BEGIN
ACHOU := TRUE;
POSICAO := FILEPOS(LISTA) -1;
END;
READ (LISTA,PESSOAS);
END;
IF ACHOU = TRUE
THEN BEGIN
K := 0;
SEEK(LISTA,K);
WHILE K < POSICAO DO
BEGIN
SEEK(LISTA,K);
READ(LISTA,PESSOAS);
AUX.NOME := PESSOAS.NOME;
AUX.FONE := PESSOAS.FONE;
AUX.ENDERECO := PESSOAS.ENDERECO;
AUX.RG := PESSOAS.RG;
WRITE(AUXILIAR,AUX);
K := K + 1;
END;
K := POSICAO + 1;
WHILE K <= FILESIZE(LISTA) - 1 DO
BEGIN
SEEK(LISTA,K);
READ(LISTA,PESSOAS);
AUX.NOME := PESSOAS.NOME;
AUX.FONE := PESSOAS.FONE;
AUX.ENDERECO := PESSOAS.ENDERECO;
AUX.RG := PESSOAS.RG;
WRITE(AUXILIAR,AUX);
K := K + 1;
END;
REWRITE(LISTA);
RESET(AUXILIAR);
WHILE NOT EOF(AUXILIAR) DO
BEGIN
READ(AUXILIAR, AUX);
PESSOAS.NOME := AUX.NOME;
PESSOAS.FONE := AUX.FONE;
PESSOAS.ENDERECO := AUX.ENDERECO;
PESSOAS.RG := AUX.RG;
WRITE(LISTA,PESSOAS);
END;
WRITELN ('DADO EXCLUIDO');
READLN;
END
ELSE WRITELN ('ESTE RG NAO ESTA CADASTRADO');READLN;
CLOSE(LISTA);
CLOSE(AUXILIAR);
END;{fim procedure exclusao fisica}

PROCEDURE INCLUSAO;
BEGIN
CLRSCR;
ASSIGN (LISTA,'PESSOAS.DAT');
RESET (LISTA);
K := FILESIZE (LISTA);
WRITELN ('DIGITE O NOME A SER INCLUIDO ');
READLN (NOME1);
WRITELN ('DIGITE O FONE A SER INCLUIDO');
READLN (FONE1);
WRITELN ('DIGITE ENDERECO A SER INCLUIDO');
READLN (ENDERECO1);
WRITELN ('DIGITE O RG A SER INCLUIDO');
READLN (RG1);

IF K = 0
THEN BEGIN
PESSOAS.NOME := NOME1;
PESSOAS.FONE := FONE1;
PESSOAS.ENDERECO := ENDERECO1;
PESSOAS.RG := RG1;
WRITE (LISTA,PESSOAS);

WRITELN ('DADOS INCLUIDOS');
READLN;
CLRSCR;

END
ELSE BEGIN
I := 0;
ACHOU := FALSE;
POSICAO := 0;
RESET (LISTA);
WHILE (I <= (K-1)) DO
BEGIN
READ (LISTA,PESSOAS);
IF PESSOAS.RG = RG1
THEN BEGIN
ACHOU := TRUE;
I := K + 2;
END
ELSE BEGIN
IF RG1 < PESSOAS.RG
THEN BEGIN
POSICAO := FILEPOS(LISTA) - 1;
I := K + 2;
END
ELSE BEGIN
I := I + 1;
SEEK (LISTA,I);
END;
END;
END;
IF ACHOU = TRUE
THEN WRITELN ('ESTE RG JA ESTA CADASTRADO')
ELSE BEGIN
IF I = FILESIZE(LISTA)
THEN BEGIN
SEEK(LISTA, FILESIZE(LISTA));
PESSOAS.NOME := NOME1;
PESSOAS.FONE := FONE1;
PESSOAS.ENDERECO := ENDERECO1;
PESSOAS.RG := RG1;
WRITE(LISTA,PESSOAS);
WRITELN ('DADO INCLUIDO');
END
ELSE BEGIN
P := FILESIZE(LISTA) - 1;
WHILE P >= POSICAO DO
BEGIN
SEEK (LISTA,P);
READ(LISTA,PESSOAS);
WRITE(LISTA,PESSOAS);
P := P - 1;
END;
SEEK(LISTA,POSICAO);
PESSOAS.NOME := NOME1;
PESSOAS.FONE := FONE1;
PESSOAS.ENDERECO := ENDERECO1;
PESSOAS.RG := RG1;
WRITE (LISTA,PESSOAS);
WRITELN ('DADOS INCLUIDOS');
READLN;
CLRSCR;
END;
END;
END;
CLOSE(LISTA);
END;

PROCEDURE CONSULTA;
BEGIN
CLRSCR;
ASSIGN(LISTA,'PESSOAS.DAT');
RESET(LISTA);
WHILE NOT EOF(LISTA) DO
BEGIN
READ(LISTA,PESSOAS);
WRITELN('NOME = ',PESSOAS.NOME);
WRITELN('FONE = ',PESSOAS.FONE);
WRITELN('ENDERE€O = ',PESSOAS.ENDERECO);
WRITELN ('RG = ',PESSOAS.RG);
READLN;
END;
CLOSE (LISTA);
READLN;
END;

PROCEDURE CONSULTAFOR;
BEGIN
CLRSCR;
ASSIGN(LISTA,'PESSOAS.DAT');
RESET(LISTA);
ACHOURG := FALSE;
CLRSCR;
WRITELN ('DIGITE O RG PROCURADO:');
WRITELN;
READLN (RGPRO);
CLRSCR;

WHILE NOT EOF(LISTA) DO
BEGIN
READ(LISTA,PESSOAS);
IF PESSOAS.RG = RGPRO
THEN BEGIN
WRITELN('NOME = ',PESSOAS.NOME);
WRITELN('FONE = ',PESSOAS.FONE);
WRITELN('ENDERE€O = ',PESSOAS.ENDERECO);
WRITELN ('RG = ',PESSOAS.RG);
READLN;
ACHOURG := TRUE;
END;
END;

IF (ACHOURG = FALSE) THEN BEGIN
CLRSCR;
WRITELN ('ESTE RG NAO ESTA CADASTRADO.');
READLN;
END;

CLOSE(LISTA);
READLN;
END;

PROCEDURE ALTERACAO;
BEGIN
CLRSCR;
ASSIGN(LISTA,'PESSOAS.DAT');
RESET(LISTA);
K := FILESIZE(LISTA);
I := 0;
ACHOURGALT := FALSE;
WRITELN('DIGITE O RG QUE DESEJA ALTERAR');
READLN(RGALT);
WHILE (I <= K-1) DO
BEGIN
SEEK(LISTA,I);
READ(LISTA,PESSOAS);
IF (PESSOAS.RG = RGALT) THEN BEGIN
POSICAO := I;
I := K + 1;
ACHOURGALT := TRUE;
END
ELSE BEGIN
I := I + 1;
END;

IF (ACHOURGALT = TRUE) THEN BEGIN
WRITELN('DIGITE O NOVO NOME ');
READLN(NOMEALT);
WRITELN('DIGITE O NOVO TELEFONE');
READLN(FONEALT);
WRITELN ('DIGITE O NOVO ENDERE€O');
READLN (ENDALT);
PESSOAS.NOME := NOMEALT;
PESSOAS.FONE := FONEALT;
PESSOAS.ENDERECO := ENDALT;
SEEK(LISTA,POSICAO);
WRITE(LISTA,PESSOAS);
WRITELN('ALTERACAO EFETUADA');
READLN;
END;
END; {fim do while}

IF (ACHOURGALT = FALSE) THEN BEGIN
WRITELN('RG NAO CADASTRADO');
READLN;
END;

CLOSE (LISTA);
READLN;
END;

PROCEDURE CRIACAO;
BEGIN

ASSIGN (LISTA,'PESSOAS.DAT');
REWRITE (LISTA);
CLOSE (LISTA);
END;{fim procedure}

BEGIN {---------PROG PRINCIPAL--------}

CLRSCR;
SAIR := FALSE;

REPEAT {--------ENGINE DO PROGRAMA----}

OPCAO := 0;
CLRSCR;
WRITELN ('O ARQUIVO JA EXISTE 1-SIM, 2-NAO .');
READLN (OPCAO);
IF (OPCAO = 2) THEN BEGIN
CRIACAO;
END;
OPCAO := 0;
CLRSCR;

WRITELN ('ESCOLHA A OPERACAO :');
WRITELN;
WRITELN ('1- SAIR.');
WRITELN ('2- INCLUSAO ORDENADA.');
WRITELN ('3- EXCLUSAO FISICA.');
WRITELN ('4- CONSULTA GERAL.');
WRITELN ('5- CONSULTA FORMULADA.');
WRITELN ('6- ALTERACAO.');
WRITELN;
READLN (OPCAO);

IF (OPCAO = 6) THEN BEGIN
ALTERACAO;
END;

IF (OPCAO = 5) THEN BEGIN
CONSULTAFOR;
END;

IF (OPCAO = 4) THEN BEGIN
CONSULTA;
END;

IF (OPCAO = 2) THEN BEGIN
INCLUSAO;
END;

IF (OPCAO = 3) THEN BEGIN
EXCLUSAO;
END;

IF (OPCAO = 1) THEN BEGIN
SAIR := TRUE;
END;

UNTIL SAIR = TRUE;

READLN;
END.

Avaliação de aluno:notas com peso.

Program avaliacao;
uses crt;
var mat:integer;
   nome:string;
   n1,n2,n3,n4,mp:real;
begin
clrscr;
writeln ('Digite a Matricula do aluno');
readln (mat);
writeln ('Digite o nome do aluno');
readln (nome);
writeln ('Digite as notas do aluno');
readln (n1,n2,n3,n4);

if (n1>n2) and (n1>n3) and (n1>n4) and (n2<n3) and (n2<n4)
   then mp:=((n1*1.5)+(n2*3.5)+(n3*2.5)+(n4*2.5))/10
else if (n1>n2) and (n1>n3) and (n1>n4) and (n3<n2) and (n3<n4)
   then mp:=((n1*1.5)+(n2*2.5)+(n3*3.5)+(n4*2.5))/10
   else if (n1>n2) and (n1>n3) and (n1>n4) and (n4<n2) and (n4<n3)
   then mp:=((n1*1.5)+(n2*2.5)+(n3*2.5)+(n4*3.5))/10

else if (n2>n1) and (n2>n3) and (n2>n4) and (n1<n3) and (n1<n4)
   then mp:=((n1*3.5)+(n2*1.5)+(n3*2.5)+(n4*2.5))/10
else if (n2>n1) and (n2>n3) and (n2>n4) and (n3<n2) and (n3<n4)
   then mp:=((n1*2.5)+(n2*1.5)+(n3*3.5)+(n4*2.5))/10
   else if (n2>n1) and (n2>n1) and (n2>n1) and (n4<n2) and (n4<n3)
   then mp:=((n1*2.5)+(n2*1.5)+(n3*2.5)+(n4*3.5))/10

else if (n3>n1) and (n3>n2) and (n3>n4) and (n1<n2) and (n1<n4)
   then mp:=((n1*3.5)+(n2*2.5)+(n3*3.5)+(n4*2.5))/10
else if (n3>n2) and (n3>n1) and (n3>n4) and (n2<n1) and (n2<n4)
   then mp:=((n1*2.5)+(n2*3.5)+(n3*2.5)+(n4*2.5))/10
   else if (n3>n4) and (n3>n1) and (n3>n2) and (n4<n1) and (n4<n2)
   then mp:=((n1*2.5)+(n2*2.5)+(n3*1.5)+(n4*3.5))/10

else if (n4>n1) and (n4>n2) and (n4>n3) and (n1<n2) and (n1<n3)
   then mp:=((n1*3.5)+(n2*2.5)+(n3*2.5)+(n4*1.5))/10
else if (n4>n2) and (n4>n3) and (n4>n1) and (n2<n1) and (n2<n3)
   then mp:=((n1*2.5)+(n2*3.5)+(n3*2.5)+(n4*1.5))/10
   else if (n4>n3) and (n4>n1) and (n4>n2) and (n3<n1) and (n3<n2)
   then mp:=((n1*2.5)+(n2*2.5)+(n3*3.5)+(n4*1.5))/10;

writeln ('A media do aluno e: ',mp:5:2);
if (mp>=7.0) then writeln ('Aprovado')
else if (mp>=4.0) then writeln ('Final')
  else writeln ('Reprovado');
readkey
end.

Custo de fábrica de um carro

{O custo ao consumidor de um carro novo e a soma do custo de fabrica
com a percentagem do distribuidor e dos impostos (aplicados ao custo de
fabrica). Supondo que a percentagem do distribuidor seja de 28% e os
impostos de 45%, escrever um programa que leia o custo de fabrica de um carro
e escreva o custo ao consumidor.}

Uses CRT;
Var CustoFab, PorcDist, Imposto, CustoCons: Real;

Begin
   Clrscr;
   Writeln('Informe o custo de fabrica, (Ex: R$ 15000.00): ');
   Read(CustoFab);
   Writeln('28% para o Distribuidor e de 45% de Imposto');
   CustoCons := CustoFab + (CustoFab*0.28) + (CustoFab*0.45);
   Writeln('O custo para o consumidor, R$ ', CustoCons:10:2);
   Readkey;
End.

sexta-feira, 28 de janeiro de 2011

{Escrever um programa que leia um conjunto de 10 informacoes contendo,
cada uma delas, a altura e o sexo de uma pessoas (codigo = 1, Masculino;
codigo = 2, feminino), calcule e mostre o seguinte:
a) A maior e a menor altura da turma;
b) A media da altura das mulheres;
c) A media da altura da turma.}

Uses CRT;
Var Cont, Sexo, QtdM: Integer;
   Altura, MaAlt, MeAlt, MedAltM, MedAltT: Real;

Begin
   Cont := 1;
   Clrscr;
   While Cont <= 10 Do
   Begin
   Writeln('Digite a altura: ');
   Read(Altura);
   MedAltT := MedAltT + Altura;
   If Cont = 1 Then
   Begin
   MaAlt := Altura;
   MeAlt := Altura;
   End;
   If Altura > MaAlt Then
   MaAlt := Altura;
   If Altura < MeAlt Then
   MeAlt := Altura;
   Writeln('Digite o sexo (Cod: 1 - Homem, Cod: 2 - Mulher): ');
   Read(Sexo);
   If (Sexo = 2) Then
   Begin
   MedAltM := MedAltM + Altura;
   QtdM := QtdM + 1;
   End;
   Cont := Cont + 1;
   End;
   Writeln('Maior Altura da Turma ‚ ', MaAlt:10:2);
   Writeln('Menor Altura da Turma ‚ ', MeAlt:10:2);
   Writeln('M‚dia Altura das Mulheres ‚ ', (MedAltM/QtdM):10:2);
   Writeln('M‚dia da Altura da Turma ‚ ', (MedAltT/Cont):10:2);
   Readkey;
End.

Os primeiros 8 números primos

{Escrever um programa que gera e secreva os primeiros 8 numeros primos.}

Uses CRT;
Var Numero, VerP, Primo, Pr8Prim: Integer;

Begin
   Pr8Prim := 0;
   Clrscr;
   Writeln('Digite os numeros e o programa mostrara entre eles os 8 que sao primos');
   While True Do
   Begin
   Read(Numero);
   Primo := 0;
   If Numero > 0 Then
   Begin
   For VerP := 1 To Numero Do
   Begin
   If (numero MOD VerP) = 0 Then
   Primo := Primo + 1;
   End;
   If Primo = 2 Then
   Begin
   Writeln('O Numero, ', Numero, ' ‚ primo');
   Pr8Prim := Pr8Prim + 1;
   End;
   If Pr8Prim = 8 Then
   Break;
   End;
   End;
   Writeln('Estes foram os 8 Numeros primos encontrados');
   Readkey;
End.

Número Primo

{10 - Faca um programa que le um valor N inteiro e positivo e verifique se
ele e primo.}

Program Exercicio_10;

Uses CRT;
Var Valor, Cont, VerifPrimo: Integer;

Begin
   VerifPrimo := 0;
   Clrscr;
   Writeln('Digite um valor');
   Read(Valor);
   For Cont := 1 to Valor Do
   Begin
   If Valor > 0 Then
   If (Valor MOD Cont) = 0 Then
   VerifPrimo := VerifPrimo + 1;
   End;
   If VerifPrimo = 2 Then
   Writeln('O Numero, ', Valor, ' ‚ Primo')
   Else
   Writeln('O Numero, ', Valor, ' nao ‚ Primo');
   Readkey;
End.

Números impares entre 100 e 200

{Escrever um programa que gere e escreve os numeros impares entre 100 e  200.}

Uses CRT;
Var Cont: Integer;

Begin
   Cont := 100;
   Clrscr;
   Writeln ('Os numeros impares entre 100 e 200 sao: ');
   While Cont <= 100 Do
   Begin
   If (Cont MOD 2) <> 0 Then
   Writeln(Cont);
   Cont := Cont + 1;
   End;
   Readkey;
End.

Valor a ser lido e seu fatorial

{Escrever um programa que leia um numero N que indica quantos valores
devem ser lidos a seguir. Para cada, mostre uma tabela contendo o valor
lido e o fatorial deste valor.}

Uses CRT;
Var QtdVal, Numero, Cont, Valor, Fat: Integer;

Begin
   Clrscr;
   Writeln('Digite a Quantidade de numeros a serem lidos: ');
   Read(QtdVal);
   For Cont := 1 To QtdVal Do
   Begin
   Writeln('Digite o ', Cont, ' numero: ');
   Read(Numero);
   Valor:= 1;
   Fat := 1;
   While Valor <= Numero Do
   Begin
   Fat := Fat*Valor;
   Valor := Valor + 1;
   End;
   Writeln('O Fatorial de ', Numero, ' ‚: ', Fat);
   End;
   Readkey;
End.

Quantidade de valores negativos e positivos

{Escrever um programa que leia um numero nao determinado de valores e
calcule a media aritmetica dos valores lidos, a quantidade de valores
positivos, a quantidade de valores negativos e o percentual de valores
negativos e positivos. Mostre os resultados.}

Program Media_Classe;
Uses CRT;
Var
   Cont: Integer;
   Media, Numero, Soma, QtdVP, QtdVN: Real;
Begin
   Numero := 0;
   QtdVP := 0;
   QtdVN := 0;
   Media := 0;
   Cont := 0;
   Clrscr;
   Writeln ('OBS: para encerrar o programa e mostrar os calculos digite 0');
   Writeln('Digite os Valores:');
   While True Do
   Begin
   Read(Numero);
   If (Numero = 0) Then
   Break
   Else
   Begin
   Soma := Soma + Numero;
   If Numero > 0 Then
   QtdVP := QtdVP + 1;
   If Numero < 0 Then
   QtdVN := QtdVN + 1;
   Cont := Cont + 1;
   End;
   End;
   Media := (Soma)/Cont;
   Writeln('A M‚dia dos Numeros ‚,', Media:10:2);
   Writeln('A quantidade de Numeros Positivos ‚,', QtdVP:10:2);
   Writeln('O Percentual de Numeros Positivos ‚,', ((QtdVP*100)/Cont):10:2);
   Writeln('A quantidade de Numeros Negativos ‚,', QtdVN:10:2);
   Writeln('O Percentual de Numeros Negativos ‚,', ((QtdVN*100)/Cont):10:2);
   ReadKey;
End.

Série de Fibonacci

{Faca um programa que imprima a serie de Fibonacci = (0,1,2,3,5,8,13,...)
enquanto o termo a ser impresso for menor que 5000.}

Program Fibonacci;
Uses CRT;
Var
   VAuxF, VFib1, VFib2: Integer;
Begin
   VFib1 := 1;
   VFib2 := 0;
   VAuxF := 0;
   Clrscr;
   While VFib2 < 5000 Do
   Begin
   Writeln(VAuxF);
   VAuxF := VFib1 + VFib2;
   VFib1 := VFib2;
   VFib2 := VAuxF;
   End;
   Readkey;
End.

Fatorial

{Faca um programa que le um valor N inteiro e positivo e que calcula e
escreve o fatorial de N.}

Uses CRT;
Var
   ValorN, Cont, Fat: Integer;
Begin
   Cont := 1;
   Fat := 1;
   Clrscr;
   Writeln('Digite um numero: ');
   Read(ValorN);
   While Cont <= ValorN Do
   Begin
   Fat := Fat * Cont;
   Cont := Cont + 1;
   End;
   Writeln('O Fatorial do numero ', ValorN, ' ‚: ', Fat);
   Readkey;
End.

quinta-feira, 27 de janeiro de 2011

Cálculo de notas com peso

{Escreva um programa que leia o codigo de um aluno e suas tres notas.

Calcule a media ponderada do aluno, considerando que o peso para a maior

nota seja 4 e para as duas restantes 3. mostre o codigo do aluno, suas

tres notas, a media calculada uma uma mensagem "APROVADO" se a media for

maior ou igual a 5 e "REPROVADO" se a media for menor que 5. Repita a

Operacao ate que o codigo lido seja negativo}

Program Exercicio_4;

Uses CRT;

Var Codigo: Integer;

MedPond, Nota1, Nota2, Nota3: Real;

Begin

MedPond := 0;

Clrscr;

While True Do

Begin

Writeln('Digite o C¢digo do Aluno: ');

Read(Codigo);

If (Codigo <>

Break

Else

Begin

Writeln('Digite a 1¦ Nota: ');

Read(Nota1);

Writeln('Digite a 2¦ Nota: ');

Read(Nota2);

Writeln('Digite a 3¦ Nota: ');

Read(Nota3);

If (Nota1 > Nota2) AND (Nota1 > Nota3) Then

MedPond := (Nota1*4+Nota2*3+Nota3*3)/10;

If (Nota2 > Nota1) AND (Nota2 > Nota3) Then

MedPond := (Nota1*3+Nota2*4+Nota3*3)/10;

If (Nota3 > Nota1) AND (Nota3 > Nota2) Then

MedPond := (Nota1*3+Nota2*3+Nota3*4)/10;

If (Nota1 = Nota2) AND (Nota2 = Nota3) Then

MedPond := (Nota1*4+Nota2*3+Nota3*3)/(4+3+3);

Writeln('1§ Nota: ', Nota1:2:2);

Writeln('2§ Nota: ', Nota2:2:2);

Writeln('3§ Nota: ', Nota3:2:2);

Writeln('A M‚dia do Aluno,', Codigo, ' ‚: ', MedPond:2:2);

If (MedPond >= 5) Then

Writeln('Aprovado')

Else

Writeln('Reprovado');

End;

End.

encontrar o maior e o menor

{Escreva um programa que leia 50 valores e encontre o maior e o menor

deles. Mostre o resultado.}

Program Exercicio_3;

Uses CRT;

Var

Cont, Valor, Maior, Menor: Integer;

Begin

Cont := 1;

Clrscr;

While Cont <= 50 Do

Begin

Writeln('Digite o ','Valor ', Cont);

Read(Valor);

If Cont = 1 Then

Begin

Maior := Valor;

Menor := Valor;

End;

If Valor > Maior Then

Maior := Valor;

If Valor <>

Menor := Valor;

Cont := Cont + 1;

End;

Writeln('O Maior Valor ‚: ', Maior);

Writeln('O Menor Valor ‚: ', Menor);

Readkey;

End.

Média

{Escreva um programa que calcule a media aritmetica das tres notas dos

alunos de uma classe. O programa devera ler, alem das notas, o codigo do

aluno e devera ser encerrado quando o codigo for igual a zero}

Program Exercicio_2;

Uses CRT;

Var

Codigo: Integer;

Media, Nota1, Nota2, Nota3: Real;

Begin

Media := 0;

Clrscr;

While True Do

Begin

Writeln('Digite o C¢digo do Aluno: ');

Read(Codigo);

If (Codigo = 0) Then

Break

Else

Begin

Writeln('Digite a 1¦ Nota: ');

Read(Nota1);

Writeln('Digite a 2¦ Nota: ');

Read(Nota2);

Writeln('Digite a 3¦ Nota: ');

Read(Nota3);

Media := (Nota1+Nota2+Nota3)/3;

Writeln('A M‚dia do Aluno de codigo ', Codigo, ' ‚: ', Media:10:2);

End;

End.

Turbo Pascal 7.0

Link para download: http://ultradownloads.uol.com.br/download/Turbo-Pascal/

Utilizando o Turbo Pascal, você terá um compilador padrão eficiente que adiciona elementos de programação orientada a objetos para a linguagem de programação Pascal. Ele adiciona a simplicidade da linguagem Pascal orientada a objeto utilizada pela Apple, com o poder e a eficiência da programação C++ para criar este programa.

Turbo Pascal foi o último compilador da linguagem de programação Pascal, construído pela Borland, sendo o antecessor do Delphi.

O programa veio com duas versões, o Turbo Pascal (produto base) e o Turbo Pascal Professional (que inclui ferramentas de Assembler e um complexo debugger). A engine do programa é capaz de compilar até 34 mil linhas por minuto, garantindo eficiência e rapidez ao programa.

Principais características:

Herança
Objetos dinâmicos e estáticos
Constantes de objetos
Compilação em mais de 34.000 linhas por minuto
Novo tutorial integrado ao ambiente do programa
Ajuda a hipertexto com suporte a copiar e colar
Linker SMART melhorado
Gerenciador de overlays
Suporte para coprocessadores Intel 8087, 80287, 80387

Pascal Zim

Link para download: http://www.baixaki.com.br/site/dwnld54518.htm

Pascal Zim! é um ambiente de programação ideal para aqueles programadores que gostam de organização, facilidade e rapidez. Os diversos atalhos do teclado juntamente com a barra de ferramentas tornam o uso do compilador prático, com as principais opções ao alcance dos olhos

Pascal é uma linguagem estruturada criada em 1970 pelo suíço Niklaus Wirth. Recebeu este nome em homenagem ao matemático Blaise Pascal. A linguagem em questão é muito bem estruturada, ideal para o ensino de linguagens e lógica de programação.

A linguagem Pascal deu origem a uma enorme gama de “dialetos”, podendo também ser considerada uma família de linguagens de programação. Grande parte do seu sucesso se deve a criação do Turbo Pascal. O primeiro compilador para a linguagem foi desenvolvido em Zurique em 1970, mesmo ano em que o primeiro compilador americano de Pascal foi lançado.

A utilização do compilador Pascal Zim! é simplificada e sem complicações. Após baixar o arquivo ZIP, basta descompactar a pasta “pascalzim” para qualquer diretório do seu computador e executar o arquivo “PZIM”.

Duas janelas serão abertas: uma é o programa propriamente dito e a outra é uma janela de console do Windows na qual serão exibidos os resultados e impressões do programa por você desenvolvido.

A tela principal do programa, apesar de simples, é muito funcional. Conforme citado anteriormente, há uma barra de ferramentas com funções como recortar, colar, exibir janela em cascata ou lado a lado, etc. que, apesar de simples, ajudam muito na hora do sufoco.

Há ainda nessa barra atalhos para aplicativos do Windows como: calculadora, bloco de notas, navegador web, prompt do MS-DOS e Windows Explorer. Isso sem contar as funções de compilar e executar direto ou ainda executar o programa no debug, o que ajuda muito para encontrar algum problema ou erro que esteja ocorrendo com o programa desenvolvido.

Para deixar o ambiente com um toque mais pessoal, Pascal Zim! permite o uso de três “temas”: Clássico, Dark Pascal ou Moderno. A única alteração que estes temas proporcionam é na cor de fundo na tela de edição, que pode ficar azul, preta ou branca. Tais temas estão acessível no menu “Janela”.