Projeto de persistencia de dados

programaalterado03++.pas

program programaalterado03;
 uses crt;
const N = 500;

type Pessoa = record
     num_form:integer;
     salario : real;
     idade : integer;
     filhos : integer;
     casa : char;
end;

var
   Registro : array[1..N] of Pessoa;
   qtd_pessoas, opcao, op, posi, achou, num_form: integer;
   mediafil: real;
   somasal, maior, salario: real;
   i, somafil, qtd, idade, filhos, somaperc : integer;
   casa: char;

   manipulador_arquivo: file of Pessoa;

// Manipulador de arquivo
procedure GravarRegistros;
begin

	assign(manipulador_arquivo, 'C:\pessoas.dat');
	rewrite(manipulador_arquivo);

	i:=1;
	while (i <= 500) and  (Registro[i].num_form <> 0)  do
	begin
		i:=i+1;
	end;
	qtd_pessoas:=i-1;
	for i:=1 to qtd_pessoas do
	   begin
		  write(manipulador_arquivo, Registro[i]);
	   end;

	writeln('Registros persistidos em arquivo DAT');

	close(manipulador_arquivo);
end;

procedure LerRegistros;
begin

	assign(manipulador_arquivo, 'C:\pessoas.dat');
	reset(manipulador_arquivo);

	i:=1;
	while not eof(manipulador_arquivo) do
	begin
             read(manipulador_arquivo, Registro[i]);
             i:=i+1;
	end;

	writeln('Registros carregados do arquivo DAT');

	close(manipulador_arquivo);
end;


//FUNÇAO DE INSERIR
procedure Inserir;
begin
   clrscr;
	achou := 0;
                 writeln('__________________________________');
                 writeln('| INSERIR NOVO CADASTRO |');
                 writeln('----------------------------------');
		WRITE('Digite o numero do formulario a ser incluido: ');
		READLN(num_form);
		FOR i := 1 TO 500 DO
		BEGIN
		IF num_form = Registro[i].num_form
		THEN achou := 1;
		END;
		IF achou = 1 THEN
                begin
                        WRITELN('Este formulario ja esta cadastrado'); readkey; end
		ELSE BEGIN
			    posi := 0;
			    i := 1;
			    WHILE i <= 500 DO
			    BEGIN
				IF Registro[i].num_form = 0
				THEN BEGIN
                                     posi := i;
				     i := 501;
	 			     END;
				i := i + 1;
				END;

			IF posi = 0
			THEN
                           WRITELN('Impossivel cadastrar novos formularios')
			ELSE
                          BEGIN
			       WRITE('Digite o valor do salario: R$ ');
 			       READLN(salario);
			       WRITE('Digite a idade: ');
			       READLN(idade);
                               write('Digite a quantidade de filhos:');
                               readln(filhos);
                               write('Digite S  ou s para sim e N  ou n para nao:');
                               readln(casa);
			       Registro[posi].num_form := num_form;
                               Registro[posi].salario := salario;
                               Registro[posi].idade := idade;
                               Registro[posi].filhos := filhos;
                               Registro[posi].casa := casa;

                               GravarRegistros;

                          end;

                        WRITELN('Formulario cadastrado com sucesso');
				writeln('_____________________________________________________');
				writeln('| Pos | Salario | Idade | Filhos | Casa |');
				writeln('-----------------------------------------------------');
				WRITELN('   ', Registro[posi].num_form , ' ' , Registro[posi].salario:10:2 , '     ' , Registro[posi].idade , '      ' , Registro[posi].filhos , '       ' , Registro[posi].casa);


				readkey;
				END;

end;



//FUNÇAO DE APRESENTAR
procedure Apresentar;
begin

   clrscr;

   LerRegistros;

   writeln('_____________________________________________________');
   writeln('| Pos | Salario | Idade | Filhos | Casa |');
   writeln('-----------------------------------------------------');
   i:=1;
   while (i <= 500) and  (Registro[i].num_form <> 0)  do
   begin
        i:=i+1;
   end;
   qtd_pessoas:=i-1;
   for i:=1 to qtd_pessoas do
         begin
						writeln('| ', Registro[i].num_form:3, ' | ', Registro[i].salario:8:2,
						   ' |  ', Registro[i].idade:3, '  |   ', Registro[i].filhos:2, '   |  ',
							 Registro[i].casa:2, '  |');
            writeln('-----------------------------------------------------');
         end;
      readkey;
   end;

//FUNÇAO DE ESTATISTICAS
procedure Estatisticas;
begin
      i:=1;
   while (i <= 500) and  (Registro[i].num_form <> 0)  do
   begin
        i:=i+1;
   end;
   qtd_pessoas:=i-1;
   writeln(qtd_pessoas, ' FORMULARIO(S) CADASTRADO(S)');


   //CÁLCULO DA MÉDIA DOS SÁLARIOS DAS PESSOAS CADASTRADAS
     writeln('MEDIA DE SALARIO DOS HABITANTES');
   somasal:=0;
   for i:= 1 to qtd_pessoas do
      begin
         somasal:= somasal + Registro[i].salario;
      end;
   writeln ('A media do salario dos habitantes e: R$ ' , somasal/qtd_pessoas:8:2);
   readkey;

   //CÁLCULO DA MÉDIA DO NÚMERO DE FILHOS
   writeln;
	 writeln('MEDIA DO NUMERO DE FILHOS ENTRE AS FAMILIAS QUE POSSUEM FILHOS');
   somafil:=0;
   qtd:=0;
   for i:= 1 to qtd_pessoas do
      begin
         if Registro[i].filhos > 0 then
         begin
         somafil:= somafil + Registro[i].filhos;
         qtd:= qtd + 1;
         end;
      end;
   mediafil:= (somafil/qtd);
   writeln ('A media do numero de filhos e: ' , mediafil:5:2);
   readkey;



   //CÁLCULO - MAIOR SALÁRIO
   writeln;
	 writeln('O MAIOR SALARIO');
   maior:= Registro[1].salario;
   for i:= 1 to qtd_pessoas do
      begin
         if Registro[i].salario > maior then
            begin
               maior:= Registro[i].salario;
            end;
			end;
   writeln ('O maior salario e: R$ ', maior:8:2);
   readkey;

	 //CÁLCULO DO PERCENTUAL DE FAMÍLIAS COM SALÁRIO MENOR QUE R$ 1500
   writeln;
   writeln('PERCENTUAL DE FAMILIAS COM SALARIO INFERIOR A R$1500');
   somaperc:= 0;
   for i:= 1 to qtd_pessoas do
      begin
         if Registro[i].salario < 1500 then
            begin
               somaperc:= somaperc + 1;
            end;
      end;
   writeln ('O percentual de familias com salario inferior a R$1500 e: ' , ((somaperc*100)/qtd_pessoas):5:2 , '%');
   readkey;

	 //CÁLCULO DO PERCENTUAL DE FAMILIAS COM CASA PROPRIA
   writeln;
	 writeln('PERCENTUAL DE FAMILIAS COM CASA PROPRIA');
   somaperc:= 0;
      for i:= 1 to qtd_pessoas do
         begin
            if (Registro[i].casa = 'S') or (Registro[i].casa = 's') then
				 		   begin
				 			    somaperc:= somaperc + 1;
				 				end;
         end;
    writeln ('O percentual de familias com casa propria e: ' , ((somaperc*100)/qtd_pessoas):5:2 , '%');
   readkey;



   //CÁLCULO DA QUANTIDADE DE FAMILIAS COM SALARIO ENTRE R$1500 E R$2380
   writeln;
   writeln('QUANTIDADE DE FAMILIAS COM SALARIO ENTRE R$1500 E R$2380');
   qtd:= 0;
      for i:= 1 to qtd_pessoas do
      begin
      if (Registro[i].salario >= 1500) and (Registro[i].salario <= 2380) then
			   begin
				    qtd:= qtd + 1;
         end;
      end;
      writeln ('A quantidade de familias com salario entre R$1500 E R$2380: ' , qtd);
   readkey;
end;

//FUNÇAO DE ALTERAR
procedure Alterar;
begin
WRITE('Digite o numero de formulario a ser alterado ');
	READLN(num_form);
        i:= 1;
        achou := 0;
        while i <= 500 do begin
        IF Registro[i].num_form = num_form
        THEN BEGIN
        achou := 1;
        posi:= i;
        i := 501;
        end
        else i:= i + 1;
        end;

        IF achou = 0
	THEN begin
        WRITELN('Nao existe formulario cadastrado com esse numero!');
        readkey;
        end
        ELSE BEGIN
        clrscr;
                 writeln('_____________________________________________________');
		writeln('| Pos | Salario | Idade | Filhos | Casa |');
		writeln('-----------------------------------------------------');
	 	WRITELN('   ',Registro[posi].num_form, '   ', Registro[posi].salario:8:2,'    ', Registro[posi].idade, '       ', Registro[posi].filhos, '       ', Registro[posi].casa);
         repeat
                writeln ('Digite o item que quer alterar:');
            writeln ('1 - salario');
            writeln ('2 - idade');
            writeln ('3 - filhos');
            writeln ('4 - Casa Propria');
            writeln ('Digite outro valor para cancelar alteracao');
            readln(op);
             if op = 1 then
         begin
      write('Novo valor para Salario R$:');
		  read(Registro[posi].salario);
         end;
       if op = 2 then
          begin
      write('Nova Idade:');
		  read(Registro[posi].idade);
          end;
       if op = 3 then
          begin
      write('Nova quantidade de Filhos:');
		  read(Registro[posi].filhos);
          end;
       if op = 4 then
          begin
      write('Possui casa: S para sim e N para nao:');
		  read(Registro[posi].casa);
          end;
		  writeln;

      until (op<1) or (op>4)
	end;

	end;
//FUNCAO PRINCIPAL
begin

        LerRegistros;

        for i:= 1 to 500 do begin
		Registro[i].num_form:=0;
		Registro[i].salario:=0;
		Registro[i].idade:=0;
		Registro[i].filhos:=0;
		Registro[i].casa:=' ';
	end;

	opcao := 1;

	while not (opcao = 0) do
	begin
		 clrscr;
		 writeln('#________________________#');
		 writeln('PROGRAMA DE PESQUISA');
		 writeln('#------------------------#');
		 writeln;
		 writeln('1 : INSERIR');
		 writeln;
		 writeln('2 : ALTERAR');
		 writeln;
		 writeln('3 : APRESENTAR');
		 writeln;
		 writeln('4 : ESTATISTICAS');
		 writeln;
		 writeln('0 : SAIR');
		 writeln;
		 writeln;
		 writeln('Digite uma Opcao : ');
		 readln(opcao);

	case opcao of
		1:Inserir;
		2:Alterar;
		3:Apresentar;
		4: Estatisticas;
		0:begin
			write('Pressione ENTER para sair...');
			readkey;
		end
	else
		begin
			writeln('A opcao especificada nao existe!');
			readkey;
		end;
	end;

end;
end.