• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

trane

[ajuda] Ficheiros Binarios - Ordenar

2 mensagens neste tópico

boas pessoal !

tenho novamente outra duvida colocada por uns colegas meus , como fazo o ordenar neste projecto que vou postar a seguir.

nos ainda não descobrimos e não conseguimos fazer o ORDENAR em ficheiros binários.

program registos;
uses crt, Dos;
type registo =record
    nome:string[30];
    cartao:integer;
    pedido:string;

    activo:boolean;
end;

var fich1:file of registo;
   aluno:registo;
   op:char;
   var Year,Month,Day,Weekday : word;
   Hour,Minute,Second,Hundredths : word;

procedure menu;

begin
  clrscr;
  GetTime(Hour, Minute, Second, Hundredths);
  GetDate(Year, Month, Day, Weekday);
  Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
  Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
  writeln(' ');
  writeln(':---------------------------------------------------------------------------: ');
  writeln('                                    MENU');
  writeln('                     Introduzir dados(apaga os ficheiros anteriores)  -> 1 ');
  writeln('                     Pedidos Existentes Nesta Escola-------------------> 2 ');
  writeln('                     Adicionar dados  ---------------------------------> 3 ');
  writeln('                     Consultar e alterar dados ------------------------> 4 ');
  writeln('                     Eliminar dados -----------------------------------> 5 ');
  writeln('                     Mostrar todos ------------------------------------> 6 ');
  Writeln('                     Listar Todos -------------------------------------> 7 ');
  writeln('                     Ordenar Dados ------------------------------------> 8 ');
  writeln('                     Alterar Dados ------------------------------------> 9 ');
  writeln('                     Terminar com o programa --------------------------> 0');
  write('                     Qual ‚ a sua op‡Æo -> ');
  repeat
    op:= readKey
  until op in ['0'..'9'];
end;
function ExisteFicheiro : boolean;

begin
 assign(fich1,'e:\alunos4ever.dat');
 {$I-};
 reset (fich1);
 close(fich1);
 {$I+};
 ExisteFicheiro := (IoResult=0);
end;

procedure introduzir;
var c,n:integer;

begin
 clrscr;
 GetTime(Hour, Minute, Second, Hundredths);
 GetDate(Year, Month, Day, Weekday);
 Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
 Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
 writeln('introduzir os dados');
 writeln(':---------------------------------------------------------------------------:');
 if ExisteFicheiro then
    reset (fich1)
 else
   rewrite (fich1);
 write('quantos registo vais introduzir?');
 readln(n);
 for c:=1 to n do
 begin
    write('nome: ');
    readln(aluno.nome);
    write('N£mero do cartÆo: ');
    readln(aluno.cartao);
    write('Pedido: ');
    readln(aluno.pedido);
    aluno.activo:=true;
    write(fich1, aluno);
 end;
 close(fich1);
end;

procedure adicionar;
var c,n:integer;

begin
 clrscr;
 GetTime(Hour, Minute, Second, Hundredths);
 GetDate(Year, Month, Day, Weekday);
 Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
 Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
 writeln(':---------------------------------------------------------------------------:');
 writeln('introduzir os dados');
 assign(fich1,'e:\alunos4ever.dat');
 rewrite (fich1);
 write('quantos registo vais introduzir?');
 readln(n);
 for c:=1 to n do
 begin
    write('Nome: ');
    readln(aluno.nome);
    write('N§ CartÆo: ');
    readln(aluno.cartao);
    write('Pedido: ');
    readln(aluno.pedido);
    aluno.activo:=true;
    write(fich1, aluno);
 end;
 close(fich1);
end;


procedure consultar;
var n:integer; k:char;

begin
clrscr;
GetTime(Hour, Minute, Second, Hundredths);
GetDate(Year, Month, Day, Weekday);
Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
writeln(':---------------------------------------------------------------------------:');
if not ExisteFicheiro then
begin
  writeln('ficheiro Nao Existe');
  write('Clique Enter para continuar (menu)');
  repeat
  until ReadKey = #13
end
else
begin
  reset(fich1);
  Writeln('Consultar e alterar dados do seu ficheiro ');
  repeat
    write('N§ do registo a consultar ');
    writeln('Entre 1 e ', filesize(fich1));
    read(n);
  until (n>0) and (n<=filesize(fich1));
  seek (fich1, n-1);
  read(fich1,aluno);
  writeln('Nome: ',aluno.nome:10,' N§ CARTÇO: ',aluno.cartao:10,' PEDIDO: ',aluno.pedido:10 );
  write('Alterar os dados S/N -> ');
  repeat
    k:= upcase(readkey)
  until k in ['S','N'];
  writeln;
  if k = 'S' then
  begin
    writeln('Escreva o novo nome: ');
    readln(aluno.nome);
    readln(aluno.nome);
    writeln('escreva a novo numero cartao: ');
    readln(aluno.cartao);
    writeln('escreve o novo pedido: ');
    readln(aluno.pedido);
    seek (fich1, n-1);
    write(fich1,aluno);
  end;
  close(fich1);
 end;
end;


procedure eliminar;
var n :integer; activo:boolean;

begin
  clrscr;
  GetTime(Hour, Minute, Second, Hundredths);
  GetDate(Year, Month, Day, Weekday);
  Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
  Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
  writeln(':---------------------------------------------------------------------------:');
  if not ExisteFicheiro then
   begin
     writeln('ficheiro Nao Existe');
     write('Clique Enter para continuar (menu)');
     repeat
     until ReadKey = #13
   end
  else
   begin
     clrscr;
     GetTime(Hour, Minute, Second, Hundredths);
     GetDate(Year, Month, Day, Weekday);
     Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
     Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
     reset(fich1);
     writeln(' Quer Eliminar qual dado ? : ');
     read(n);
     read(fich1,aluno);
     seek(fich1,n-1);
     aluno.activo:=false;
     write(fich1,aluno);
  end;

end;

procedure mostrar;

begin
 GetTime(Hour, Minute, Second, Hundredths);
 GetDate(Year, Month, Day, Weekday);
 Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
 Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
 writeln(':---------------------------------------------------------------------------:');
 ExisteFicheiro;
 reset(fich1);
 while not eof(fich1) do
  begin
   clrscr;
    read(fich1,aluno);
    writeln('Nome: ',aluno.nome);
    writeln('N§ CartÆo: ',aluno.cartao);
    writeln('Pedido: ',aluno.pedido);
    writeln(aluno.activo);
    readln;
  end;
  close(fich1);
end;

procedure listar;

begin
 clrscr;
 GetTime(Hour, Minute, Second, Hundredths);
 GetDate(Year, Month, Day, Weekday);
 Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
 Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);

 if not ExisteFicheiro then
 begin
   writeln('ficheiro nao existe');
   write('tecle ENTER para ir ao menu');
   readln;
   repeat until readkey = #13
 end
 else
  begin
    reset(fich1);
    writeln('Listar Registos');
    write('Registos No Ficheiro: ');
    writeln(filesize(fich1));
    readln;
    while not eof (fich1) do
    begin
      read(fich1,aluno);
      write('NOME: ',aluno.nome:15);
      write('  N§ CARATÇO: ',aluno.cartao:10);
      write('   PEDIDO: ',aluno.pedido:10);
      readln;
    end;
    close(fich1);
    writeln('Prime Enter Para Continuar Para O Menu');
    repeat until readkey = #13
end;

end;


procedure ordenar;

begin
 clrscr;
 GetTime(Hour, Minute, Second, Hundredths);
 GetDate(Year, Month, Day, Weekday);
 Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
 Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
 writeln(':---------------------------------------------------------------------------:');
 writeln('  ');
 writeln('Ordenar Os Dados Por Ordem Dos N£meros Dos Cartäes');
 writeln(' ');
 writeln(' ');
 readln;

end;


procedure alterar;

begin
 clrscr;
 GetTime(Hour, Minute, Second, Hundredths);
 GetDate(Year, Month, Day, Weekday);
 Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
 Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
 writeln(':---------------------------------------------------------------------------:');
 writeln(' ');
 writeln('Alterar Dados');
 writeln(' ');
 readln;

end;


procedure pedidos;

begin
 clrscr;
 GetTime(Hour, Minute, Second, Hundredths);
 GetDate(Year, Month, Day, Weekday);
 Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
 Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
 writeln(':---------------------------------------------------------------------------:');
 Writeln(' ');
 writeln(' ');
 writeln('                 /-----------------------------------\ ');
 writeln('                | PEDIDOS EXISTENTES NESTA ESCOLA     | ');
 writeln('                |                                     | ');
 writeln('                |        1- bebidas                   |  ');
 writeln('                |                                     |');
 writeln('                |              a) sumos naturais      |');
 writeln('                |              b) agua                |');
 writeln('                |                                     |');
 writeln('                |        2- sandes                    |    ');
 writeln('                |                                     | ');
 writeln('                |              a) mistas              |');
 writeln('                |              b) queijo              | ');
 writeln('                |              c) fiambre             | ');
 writeln('                |                                     |');
 writeln('                |        3- Gloseimas                 |');
 writeln('                 \------------------------------------/  ');
 writeln(' ');
 writeln(' ');
 writeln('para introduzir estes dados no programa ter  de introduzir a letra e o n£mero.   exemplo: 1a');
 readln;


end;



begin
   clrscr;
 GetTime(Hour, Minute, Second, Hundredths);
 GetDate(Year, Month, Day, Weekday);
 Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
 Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
 writeln('  ');
 Writeln('                         PROGRAMA BUFFET DA ESCOLA SECUDARIA     ');
 writeln(' ');
 writeln('                                 PRIMA :-:ENTER:-:                    ');
 readln;
 clrscr;
 textbackground(1);
 repeat
   menu;
   case op of
     '1' : adicionar;
     '2' : pedidos;
     '3' : introduzir;
     '4' : consultar;
     '5' : eliminar;
     '6' : mostrar;
     '7' : listar;
     '8' : ordenar;
     '9' : alterar;
   end;
   until op = '0';
   clrscr;
   writeln(' ');
   GetTime(Hour, Minute, Second, Hundredths);
   GetDate(Year, Month, Day, Weekday);
   Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
   Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
   writeln(':---------------------------------------------------------------------------:');
   writeln('                     PROGRAMA REALIZADOR POR: Programas Da Quinta  ');
   Writeln('                               Grafico : Programas Da Quinta ');
   writeln(':---------------------------------------------------------------------------:');
   writeln(' ');
   writeln('                      Obrigado pela sua escolha  e volte sempre ');
   writeln(':---------------------------------------------------------------------------:');
   writeln(' ');
   writeln('By: filipe felisberto  ');
   readln;
end.

programa todo postado em cima

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Agora a parte do Ordenar

procedure ordenar;

begin
  clrscr;
  GetTime(Hour, Minute, Second, Hundredths);
  GetDate(Year, Month, Day, Weekday);
  Writeln('A Data : ',Day:2,'/',Month:2,'/',Year);
  Writeln('A Houra : ',Hour:2,':',Minute:2,':',Second:2);
  writeln(':---------------------------------------------------------------------------:');
  writeln('  ');
  writeln('Ordenar Os Dados Por Ordem Dos N£meros Dos Cartäes');
  writeln(' ');
  writeln(' ');
  readln;

end;

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora