? fica uma procedure para cada função... fica facil e mais pratico veja abaixo...
Código:
program loja;
uses crt;
type registro=record
nome:string;
cod,quant:integer;
end;
mat=array[1..40] of registro;
var arq:file of registro;
reg:registro;
ch:char;
p:mat;
{Procedure que faz o cadastro}
procedure cad(a:registro);
var codc:char;
regcod,axou:integer;
xcod:integer;
b:registro;
begin
axou:=0;
writeln('Deseja cadastrar o produto? (S/N):');
readln(codc);
if (codc='s') or (codc='S') then
begin
{seek(arq,filesize(arq));}
writeln('Digite o codigo do produto:');
readln(xcod);
while not eof(arq) do
begin
read(arq,b);
if b.cod = xcod then
axou:=1;
end;
if axou = 1 then
begin
writeln('Produto ja cadastrado!!!');
readkey;
end
else
begin
seek(arq,filepos(arq)-1);
reg.cod:=xcod;
writeln('Digite o nome do produto');
readln(reg.nome);
writeln('Digite a quantidade do produto');
readln(reg.quant);
write(arq,reg);
end;
end;
end;
{Procedure que lista o conteudo do arquivo}
procedure listar(a:registro);
var codl:integer;
begin
writeln('Escolha uma opcao para listagem:');
writeln('1 - Listar todos os produtos');
writeln('2 - listar produtos com mais de 10 unidades');
readln(codl);
if codl=1 then
begin
while not eof(arq) do
begin
read(arq,a);
writeln(a.cod,' ',a.nome,' ',a.quant);
end;
end;
if codl=2 then
begin
while not eof(arq) do
begin
read(arq,a);
if a.quant > 10 then
writeln(a.cod,' ',a.nome,' ',a.quant);
end;
end;
readkey;
end;
{Procedure que procura o nome desejado}
procedure procura(a:registro);
var codigo,cod2:integer;
xnome:string;
begin
writeln('Deseja pesquisar pelo (1) Codigo ou (2) Nome:');
readln(codigo);
if codigo=1 then
begin
writeln('Informe o codigo:');
readln(cod2);
while not eof(arq) do
begin
read(arq,a);
if a.cod=codigo then
writeln(a.cod,' ',a.nome,' ',a.quant)
end;
end;
if codigo=2 then
begin
writeln('Informe o nome:');
readln;
readln(xnome);
while not eof(arq) do
begin
read(arq,a);
if a.nome=xnome then
writeln(a.cod,' ',a.nome)
end;
end;
readkey;
end;
{Procedura que altera o nome a paritir de um nome ja existente}
procedure alterar(a:registro);
var ynome:string;
begin
writeln('Digite o nome que deseja alterar:');
readln(ynome);
while not eof(arq) do
begin
read(arq,a);
if a.nome=ynome then
begin
writeln('Digite o novo nome:');
readln(a.nome);
seek(arq,filepos(arq)-1);
write(arq,a);
end;
end;
end;
{Procedure que ordena em ordem alfabetica}
procedure ordenar(b:mat);
var i,j,k:integer;
aux:registro;
begin
i:=1;
while not eof(arq) do
begin
read(arq,b[i]);
i:=i+1;
end;
for j:=1 to i-1 do
for k:=j+1 to i do
if b[j].nome > b[k].nome then
begin
aux:=b[j];
b[j]:=b[k];
b[k]:=aux;
end;
for j:=1 to i do
writeln(b[j].nome,' - ',b[j].cod);
readkey;
end;
{Inicio do programa principal}
begin
repeat
clrscr;
gotoxy(1,1);
writeln('Digite opcao:');
gotoxy(3,3);
writeln('1 - Cadastrar Produtos');
gotoxy(3,4);
writeln('2 - Listar Produtos');
gotoxy(3,5);
writeln('3 - Pesquisar Produtos');
gotoxy(3,6);
writeln('4 - Alterar Produtos');
gotoxy(3,7);
writeln('5 - Ordenar Produtos');
gotoxy(3,8);
writeln('0 - Sair');
assign(arq,'c:\temp\dbp.dat');
{$i-} reset(arq); {$i+}
if ioresult<>0 then
rewrite(arq);
gotoxy(14,1);
ch:=readkey;
case ch of
'1':cad(reg);
'2':listar(reg);
'3':procura(reg);
'4':alterar(reg);
'5':ordenar(p);
end;
until ch='0';
end.
Eu prefiro fazer esse programas maiores tudo na base do procedure e function, pra faciliar a vida depois...
Com esse exemplo ai de cima, vc pode fazer o que vc precisa, se ficou alguma duvida é só daum toque... Não sou expert no ramo, mesmo pq como vcs eu estou vendo pascal agora.. mas sempre tive gosto pela area, e to curtindo paca.... :wink:
Dúvida no pascal
. Nós temos 759.310 usuários, convidamos você fazer parte de nossa comunidade também! Se ainda não encontrou o que procura use nossa pesquisa. Esperamos que aprecie nosso trabalho.
Dúvida no pascal
² CCSI: □ 
| Conheça o 
