Jump to content

como faço ordenar pelo nome neste programa


simply
 Share

Recommended Posts

program projeto ;
uses crt;
type produtos=record
nome:string[15];
preco:real;
stock:integer;
end;
var fich1:file of produtos;
produto:produtos;
op:char;
verdade:boolean;


{Funçao exite ficheiro}

function existeficheiro:boolean;
begin
assign(fich1,'pessoas.dat');
{$I-}
reset(fich1); close(fich1);
{$I+}
existeficheiro:=(ioresult=0);
end;


{menu}

procedure menu;
begin
textbackground(blue);
textcolor(white);
clrscr;
writeln('GESTAO DE STOCKS');
writeln();
writeln('Introduzir registos -> 1');
writeln();
writeln('Listar registos -> 2');
writeln();
writeln('Consultar e alterar -> 3');
writeln();
writeln('Apagar Registos -> 4');
writeln();
writeln('Ordenar -> 5');
writeln();
writeln('Terminar o programa -> 0');
writeln();
write('Tecle a sua escolha ->');
repeat
read(op);
until (op='0') or (op='1') or (op='2') or (op='3') or (op='4') or (op='5');
end;

{procedimento introduzir}

procedure introduzir;
var c,n:integer;
begin
clrscr;
writeln('Introduzir registos');
if existeficheiro then reset(fich1) else rewrite(fich1);
write('Quantos registos?');
readln(n);
for c:=1 to N do
begin
writeln();
write('Nome do Produto: ');
readln(produto.nome);
if (produto.nome = '') then menu;
write('Preco: ');
readln(produto.preco);
write('Stock: ');
readln(produto.stock);
writeln();
seek(fich1,filesize(fich1));
write(fich1,produto);
end;
close(fich1);
end;

{procedimento para listar}

procedure listar;
begin
clrscr;
if not existeficheiro then
begin
writeln('Ficheiro inexistente');
write('Tecle entar para menu');
readln();
end
else
begin
reset(fich1);
writeln('Listar registos');
write('registos no ficheiro: ');
writeln(filesize(fich1));
writeln();

while not eof(fich1) do
begin
read(fich1, produto);

writeln('Nome do produto: ', produto.nome);
writeln('Preco: ', produto.preco:2:2);
writeln('Produtos em stock: ', produto.stock);
writeln;
end;
close(fich1);
writeln();
write('Tecle entar para menu');
readln();
end;
readln();
end;

{procedimento consultar}

procedure consultar;
var n:integer; k:char;
begin
clrscr;
if not existeficheiro then
begin
writeln('Ficheiro inexistente');
write('tecle enter para menu');
readln();
end
else
begin
reset(fich1);
writeln('Consultar e alterar registo');
end;
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,produto);
clrscr;
  writeln('Nome: ',produto.nome);
  Writeln('Preco: ',produto.preco:2:2);
  writeln('Stock: ',produto.stock);
writeln();
writeln('alterar os dados? s/n -> ');
repeat
read(k);
until (k='s') or (k='S') or (k='N') or (k='n');
writeln;
if (k='S') or (k='s') then
begin
write('Escreva o novo nome: ');
repeat
readln(produto.nome);
until produto.nome<>'';
write('escreva o novo preco : ');
Readln(produto.preco);
write('escreva o novo stock : ');
Readln(produto.stock);
seek(fich1,n-1);
write(fich1,produto);
end;
close(fich1);
end;

{procedure apagar}

procedure apagar;
var i,n:integer;
sim:char;
temp:file of produtos;
begin
clrscr;
if not existeficheiro then
begin
writeln('Ficheiro inexistente');
write('Tecle entar para menu');
readln();
end
else
begin
reset(fich1);
i:=1;
while not Eof(fich1) do
begin
write(i);
read(fich1, produto);
clrscr;
  writeln('Nome: ',produto.nome);
  Writeln('Preco: ',produto.preco:2:2);
  writeln('Stock: ',produto.stock);
writeln();
i:=i+1;
end;
repeat
write('N do registo a apagar');
writeln(' entre 1 e ',filesize(fich1));
read(n);
until (n>0) and (n<=filesize(fich1));
Assign(Temp, 'Temp.dat');
Rewrite(Temp);
Seek(fich1, 0);
i:=0;
while not Eof(fich1) do
begin
read(fich1, produto);
if i<>(n-1) then
begin

  writeln('Nome: ',produto.nome);
  Writeln('Preco: ',produto.preco:2:2);
  writeln('Stock: ',produto.stock);
writeln();
write(Temp, produto);
end;
i:=i+1;
end;
readln();
Close(fich1);
Close(Temp);
erase(fich1);
Rename(Temp, 'pessoas.dat');
end;
readln();
end;

{ordenar}



{Menu principal}
begin

repeat

menu;

case op of
'1':Introduzir;
'2':Listar;
'3':Consultar;
'4':Apagar;
end;

until op='0';

end.
Edited by thoga31
Tags code + GeSHi
Link to comment
Share on other sites

Em primeiro lugar, bem-vindo a P@P.

Em segundo lugar, convém descreveres o teu problema e quais as tuas dúvidas. Não basta simplesmente colocar algo vago no título e "despejar" um código com dezenhas de linhas de código à espera que 1) alguém as veja a todas (ninguém o vai fazer) e 2) perceber o que realmente pretendes.

Por favor, descreve as tuas dúvidas e qual a parte do programa na qual estás a ter problemas.

Em terceiro lugar, usa as tags code para colocar o código (já alterei o teu post para as contemplar).

Cumprimentos. 😉

  • Vote 1

Knowledge is free!

Link to comment
Share on other sites

Eu estou-te a perguntar o que já tentaste fazer e quais as tuas dúvidas específicas na implementação desse procedimento, e tu só me dizes que o queres fazer. Que o queres fazer sei eu desde o momento em que publicaste o tópico.

Estás à espera que te façamos o procedimento? Ninguém aqui to vai fazer.

Nós ajudamos os membros a chegar à resolução dos seus problemas por si mesmos. Nós damos dicas aos membros, apontamos os erros que estão a cometer e explicamos tudo o que for necessário para os resolver.

Portanto, enquanto não disseres o que já tentaste fazer para ordenar os nomes e não indicares em específico quais são as tuas dúvidas no respectivo algoritmo, lamento, mas não vais obter resposta de ninguém.

Faço notar que a falta de resposta não será por má vontade - basta navegar um pouco pelo quadro de Pascal para veres que eu e os meus colegas de Pascal e Delphi temos muito boa vontade de ajudar os membros. Só não fazemos os trabalhos por eles.

Cumprimentos.

Knowledge is free!

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.