Boa Tarde !
Bem tenho de entregar um trabalho para o modulo 7 de Programação(10 ano) em Pascal, mas tenho aqui um grande problema, bloqueie mesmo :x
Neps, não venho para aqui pedir que me façam o trabalho apenas que me digam o que é que eu estou a fazer mal, porque já mexi em tudo e continua a bloquear ali.
Somebody help me? xD
Bem tenho de entregar um trabalho para o modulo 7 de Programação(10 ano) em Pascal, mas tenho aqui um grande problema, bloqueie mesmo :x
Neps, não venho para aqui pedir que me façam o trabalho apenas que me digam o que é que eu estou a fazer mal, porque já mexi em tudo e continua a bloquear ali.
Código:
Program morreu;
Uses crt;
type registo=record
apelido:string[15];
nascimento:integer;
personalidade:char;
end;
Var morte1 : file of registo;
pessoa:registo;
nascimento,l,x,y,z : integer;
op : char;
Procedure som;
begin
For x:=1000 downto 0 do
begin
sound(x);
delay(3);
end;
end;
Procedure Menu;
Begin
CLRSCR;
Writeln('Smells like death spirit');
Writeln('Um programa que prevˆ e regista o ano da sua MORTE');
Writeln;
Writeln('Para descobrir o seu futuro use a tecla P');
Writeln('Para listar os dados use a tecla 2');
Writeln('Para consultar/alterar use a tecla C');
Writeln('Para apagar todos os registos use a tecla E');
Writeln('Se quer sair carregue na tecla S');
Writeln;
Repeat
readln(op);
op:=readkey;
until op in['P','S','p','s','D','d','C','c','E','e'];
End;
Function existe:boolean;
Begin
Assign(morte1,'Morte.dat');
{$I-};
reset(morte1);close(morte1);
{$I+};
existe:=(IoResult=0);
end;
Procedure prog;
Var J,Q : Integer;
Begin
CLRSCR;
Writeln('Vamos a isto');
If existe then
Reset(morte1)
Else
Rewrite(morte1);
Writeln;
Writeln('Quer o programa advinhe quantas morte?');
Readln(Q);
For J:=1 to Q do
Begin
Writeln;
Writeln('Escreva o seu apelido');
Readln(pessoa.apelido);
Writeln('Escreva o ano em que nasceu');
Readln(pessoa.nascimento);
Writeln ('Seleciona de 0 a 9 o tipo de pessoa com a qual mais te identificas');
Writeln ('0 - Romantico');
Writeln('1 - Intelectual');
Writeln('2 - Moderno');
Writeln('3 - Natural');
Writeln('4 - Confuso');
Writeln('5 - EMOcional');
Writeln('6 - Bixo do Mato');
Writeln('7 - Ambicioso');
Writeln('8 - Mitra');
Writeln('9 - Outro');
Readln(l);
Begin
randomize;
repeat
y:=random(100);
z:=y+nascimento;
until z>=2008;
Case l of
0:Writeln(z);
1:Writeln(z);
2:Writeln(z);
3:Writeln(z);
4:Writeln(z);
5:Writeln(z);
6:Writeln(z);
7:Writeln(z);
8:Writeln(z);
9:Writeln(z)
end;
Readln(pessoa.personalidade);
Seek (morte1,filesize(morte1));
Write(morte1,pessoa);
End;
Close(morte1);
End;
Begin
CLRSCR;
If not existe then
Begin
Writeln('NÆo existem registos :|');
Writeln('Use a tecla R para retroceder');
Readln(op);
Repeat until op in['R','r'];
End
Else
Begin
Reset(morte1);
Writeln('Aqui est a lista com os registo :)');
Writeln('... E aqui estÆo os registos que existem neste ficheiro');
Writeln(filesize(morte1));
Writeln;
While not eof (morte1) do
Begin
Read(morte1,pessoa);
Writeln(pessoa.apelido);
Writeln(pessoa.nascimento);
Writeln(pessoa.personalidade);
Writeln;
Writeln('Use a tecla R para retroceder');
Readln(op);
Repeat until op in['R','r'];
end;
Close(morte1);
End;
Procedure listar;
Var G : Char;
K : Integer;
Begin
CLRSCR;
If not existe then
Begin
Writeln('NÆo existem registos :x');
Writeln('Use a tecla R para retroceder');
Readln(op);
Repeat until op in['R','r'];
End;
Else
Begin
Repeat
Reset(morte);
Writeln('Aqui pode consultar/alterar os registos :)');
Writeln;
Writeln('Quantos registos quer consultar/alterar');
Readln(K);
Until (K>0) and (K<=filesize(morte));
Seek(morte,k-1);
Writeln;
Writeln(pessoa.apelido);
Writeln(pessoa.nascimeno);
Writeln(pessoa.personalidade);
Writeln;
Writen('Pretende alterar alguma coisa? Y or N');
Repeat
G:=upcase(readkey);
Until G in ['Y','y','N','n'];
Writeln;
If G='Y' or 'y' then
Begin
Writeln('EntÆo escreve o novo apelido pretendido');
Repeat
Readln(pessoa.apelido);
Until pessoa.apelido <> ' ';
Writeln('EntÆo escreve o novo ano de nascimento pretendido');
Seek(morte,K-1);
Writeln('EntÆo escolhe a personalidade desejada');
Append (morte);
Writeln ('0 - Romantico');
Writeln('1 - Intelectual');
Writeln('2 - Moderno');
Writeln('3 - Natural');
Writeln('4 - Confuso');
Writeln('5 - EMOcional');
Writeln('6 - Bixo do Mato');
Writeln('7 - Ambicioso');
Writeln('8 - Mitra');
Writeln('9 - Outro');
Readln(pessoa.personalidade);
Writeln(morte,pessoa);
Writeln('Foi modificado com sucesso');
Writeln('Use a tecla R para retroceder');
End;
Close(morte);
End;
End;
Procedure apagar;
Begin
CLRSCR;
If not existe then
Begin
Writeln('NÆo existem registos :x');
Writeln('Use a tecla R para retroceder');
Readln(op)
Repeat until op in['R','r'];
End
Else
Begin
Repeat
CLRSCR;
Writeln('Tem a certeza que quer apagar tudo? Y or N');
Readln(op);
Until op in['Y','y','N','n'];
If op in['Y','y'] then
Begin
Assign(morte,'Morte.dat');
Rewrite(morte);
Repeat
CLRSCR;
Writeln('Foi tudo apagado');
Writeln('Use a tecla R para retroceder');
Readln(op);
Until op in['R','r'];
End;
If op in['n','N']; then
Begin
Assign (morte,'Morte.dat');
Reset(morte);
Repeat
CLRSCR;
Writeln('Cancelou a elemina‡Æo dos registo');
Writeln;
Writeln('Use a tecla R para retroceder');
Readln(op);
Until op in['R','r'];
End;
End;
End;
Begin
CLRSCR;
Repeat
som;
Menu;
lista;
Case op of
['P','p'] : Descobrir;
'2':listar;
['C','c']: Vizualizar;
['E','e'] : Apagar;
Else
Writeln('Opera‡Æo Inv lida');
End;
Until op in['S','s';
Readln;
End.Somebody help me? xD
