CADASTRO DE ALUNO

1. CADASTRO DE ALUNO

wanderson costa correa
wandersonc

(usa Debian)

Enviado em 13/12/2007 - 07:06h

PESSOAL SE ALGUEM PUDER ME AJUDAR FICO MUITO AGRADECIDO, NAO ESTOU CONSEGUINDO TERMINAR ESTE PROGRAMA ONDE PRECISO AUMENTAR O NUMERO DE NOTAS PARA 12 E ADICIONAR AO CADASTRO UM CAMPO "ENDEREÇO:STRING[60]" , "DATA DE MATRICULA:STRING[10]" , E A MEDIA DO ALUNO, E UMA PROCEDURE DE RELATORIO.

Program GERENCIAMENTO_ESCOLAR;
USES CRT;
type
BIMESTRE = array[1..4] of real;
REG_ALUNO = record
FLAG : char;
MATRICULA : longint;
NOME : String[30];
NOTAS : bimestre;
end;
var
ALUNO : reg_aluno;
ARQALU : file of reg_aluno;
NR_MATRIC : longint;
SISTEMA : String;
RESP, TECLA : char;
I : longint;
OPCAO : char;
{--- Abaixo seguem Rotinas de Organizacao de Mensagens na Tela ---}
{Rotina que centraliza mensagem na tela}
procedure CENTER(MENSAGEM : string);
var
TAMANHO : integer;
begin
TAMANHO := 40 + length (MENSAGEM) div 2;
writeln (MENSAGEM: TAMANHO);
end;
{Rotina que mostra mensagem posicionada em alguma coordenada especifica na tela }
procedure WRITEXY(X, Y : byte; MENSAGEM : string);
begin
gotoxy(X, Y);
write(MENSAGEM);
end;
{Rotina que coloca linhas divisórias na tela }
procedure LINE;
var
I : LONGINT;
begin
for I := 1 to 80 do
write (#205);
end;
{Abre o Arquivo Existente e grava um registro}
Procedure ACESSA_ARQUIVO;

begin
assign(ARQALU, 'CADALU2.DAT');
{$I-}
reset(ARQALU);
{$I+}
if (IORESULT= 2) then
begin
rewrite(ARQALU);
write(ARQALU, ALUNO);
end;
end;
{Rotina que mostra dados para Cadastro organizados na tela}
procedure TELA;
begin
gotoxy(18, 10); clreol;
gotoxy(18,11); clreol;
gotoxy(18, 12); clreol;
gotoxy(18,13); clreol;
gotoxy(18, 14); clreol;
gotoxy(18,15); clreol;
writexy ( 1,10,'Matricula ...: ');
writexy ( 1,11,'Nome ........: ');
writexy ( 1,12,'la. Nota ....: ');
writexy ( 1,13,'2a. Nota ....: ');
writexy ( 1,14,'3a. Nota ....: ');
writexy ( 1,15,'4a. Nota ....: ');
end;
{Função que busca um aluno pelo numero de matricula e Retorna um valor lógico-True ou False}
function PESQUISA(NUMERO : integer) : boolean;
var
ACHOU : boolean;
begin
ACHOU := false;
seek(ARQALU, 1);
while (not eof (ARQALU)) and (not ACHOU) do
begin


read(ARQALU, ALUNO);
ACHOU := (NUMERO = ALUNO.MATRICULA) and (ALUNO.FLAG <> '*');
end;
seek (ARQALU,filepos(ARQALU)-1);
PESQUISA := ACHOU;
end;
{Rotina que cadastra um aluno no arquivo }
Procedure ROT_CADASTRAR;
begin
clrscr;

Line;
Center(SISTEMA);
Center('MODULO DE CADASTRAMENTO');
Line;
WriteXy( 1, 6,'Digite os dados abaixo:');
Repeat
WriteXy ( 1,24,'Digite [0] Para encerrar o Modulo Cadastro');
Tela;
gotoxy (18,10); readln (NR_MATRIC);
gotoxy ( 1,24); clreol;
if (NR_MATRIC<> 0) then
begin
if (Pesquisa(NR_MATRIC) = true) then
begin
{ Apresenta os dados caso exista no arquivo }
gotoxy (18,10); writeln(NR_MATRIC);
gotoxy (18,11); writeln(ALUNO.NOME);
for I := 1 to 4 do
begin
gotoxy(18,11 + I);
writeln (ALUNO.NOTAS[I]:8:2);
end;
WriteXy(1,23,'Este registro ja esta cadastrado');
gotoxy (1,24); write ('Pressione algo para continuar.');
TECLA := readkey;
gotoxy (1,23); clreol;
end
else
begin
{ Localiza posicao para gravar registro }
seek(ARQALU, 0);
repeat
read(ARQALU,ALUNO);
Until (ALUNO.FLAG = '*') Or (eof(ARQALU));
if (ALUNO.FLAG = '*') then
seek(ARQALU,filepos(ARQALU)-1)
else
seek(ARQALU,filesize(ARQALU) );
{ Grava registro }
ALUNO.FLAG := ' ';
gotoxy (18,11); readln (ALUNO.NOME);
for I:=1 to 4 do
begin
gotoxy(18,11 + I);
readln(ALUNO.NOTAS[I]);
end;
ALUNO.MATRICULA := NR_MATRIC;
write(ARQALU,ALUNO);
gotoxy (1,24); write('Pressione algo para continuar...');
TECLA := readkey;
end;
end;
until (NR_MATRIC = 0);
end;

{Rotina que remove um registro do arquivo }
Procedure ROT_REMOVER;
begin
clrscr;
Line;
Center (SISTEMA);
Center ('MODULO DE REMOCAO');
Line;
WriteXy (1, 6,'Digite o numero de matricula:');
repeat
WriteXy (1,24,'Digite (0) Para encerrar o modulo Remocao');
Tela;
gotoxy (18,10); readln (NR_MATRIC);
gotoxy (1,24); clreol;
if (NR_MATRIC<> 0) then
begin
if (Pesquisa(NR_MATRIC) = true) tHEN
begin
Tela;
gotoxy(18,10); writeln (NR_MATRIC);
gotoxy(18,11); writeln (ALUNO.NOME);
for I := 1to 4 do
begin
gotoxy (18,11 + I);
writeln(ALUNO.NOTAS[I]:8:2);
end;
gotoxy(1,17); write('Remover este registro? [S/N): ');
read (RESP);
gotoxy( 1,17); clreol;
if (RESP = 'S') or (RESP = 's') then
begin
ALUNO.FLAG := '*';
write(ARQALU, ALUNO);
Writexy(1,23,'Registro removido do arquivo');
gotoxy( 1,24);
Write('Pressione algo para continuar...');
TECLA := Readkey;
end;
gotoxy(1,15);clreol;
gotoxy(1,23);clreol;
end
else
begin
Writexy(1,23,'Este registro NAO esta cadastrado');
gotoxy(1,24);
writeln('Pressione algo para continuar...');
TECLA := readkey;
gotoxy(1,23);clreol;
end;
end;
until (NR_MATRIC = 0);
end;

{Rotina que altera um registro do arquivo }
procedure ROT_ALTERAR;
var
NOVO_NOME : string[30];
NOVA_NOTAS : bimestre;
begin
clrscr;
Line;
Center(SISTEMA);
Center('MODULO DE ALTERACAO');
Line;
WriteXy(1, 6,'Digite o numero de matricula:');
repeat
WriteXY(1,24,'Digite [0] Para encerrar o modulo alteracao');
Tela;
gotoxy (18,10); readln(NR_MATRIC);
gotoxy(1,24);clreol;
if (NR_MATRIC <> 0) then
begin
if (pesquisa(NR_MATRIC) = true)then
begin
gotoxy(18,10);writeln(NR_MATRIC);
gotoxy(18,11);writeln(ALUNO.NOME);
for I := i to 4 do
begin
gotoxy(18,11 + I);
writeln(ALUNO.NOTAS[I]:8:2);
end;
WriteXy (1,23,'Deseja efetuar alteracao? [S/N]: ');
readln (RESP);
gotoxy(1,23);clreol;
if (RESP = 's') or (RESP = 's') then
begin
WriteXy (1,23,'Digite as novas informacoes');
WriteXy (1,17,'Novo Nome ...: ');
WriteXy (1,18,'1a. Nota ....: ');
WriteXy (1,19,'2a. Nota ....: ');
WriteXy (1,20,'3a. Nota ....: ');
WriteXy (1,21,'4a. Nota ,.,.: ');
gotoxy (18,17); readln (Novo_NOME);
for I := 1 to 4 do
begin
gotoxy (18,17 + I);
readln (NOVA_NOTAS[I]);
end;
gotoxy( 1,23); clreol;
WriteXy( 1,23,'Altera? [S/N]: '); readln(RESP);
if (RESP = 'S') or (RESP = 's') then
begin
ALUNO.NOME := NOVO_NOME;
for I := 1 to 4 do
ALUNO.NOTAS[I] := NOVA_NOTAS[I];
write (ARQALU, ALUNO);
writeXy ( 1,23,'Alteracoes executadas com sucesso');

end;
gotoxy(1,24);
write('Pressione algo para continuar...');
TECLA :=readkey;
gotoxy(1,17);clreol;
gotoxy(1,18);clreol;
gotoxy(1,19);clreol;
gotoxy(1,20);clreol;
gotoxy(1,21);clreol;
gotoxy(1,23);clreol;
end;
end
else
begin
WriteXy( 1,23,'Este registro nao esta cadastrado');
gotoxy(1,24);
write('Pressione algo para continuar...');
TECLA := readkey;
gotoxy( 1,23); clreol;
end;
end;
until (NR_MATRIC = 0);
End;
procedure ROT_PESQUISAR;
begin
clrscr;
Line;
center(SISTEMA);
center('MODULO DE PESQUISA');
Line;
WriteXy(1, 6,'Digite o numero de matricula:');
repeat
WriteXy(1,24,'Digite [0] Para encerrar o modulo Pesquisa');
Tela;
gotoxy(18,10); readln(NR_MATRIC);
gotoxy(1,24);clreol;
if (NR_MATRIC <> 0) then
begin
if (Pesquisa(NR_MATRIC) = true)then
begin
gotoxy (18,10); writeln(NR_MATRIC);
gotoxy (18,11); writeln(ALUNO.NOME);
for I :=1 to 4 do
begin
gotoxy(18,11 + I);
writeln(ALUNO.NOTAS[I]:8:2);
end;
gotoxy(1,24); write('Pressione algo Para continuar...');
TECLA := Readkey ;
end
else
begin
WriteXy ( 1,23,'Este registro nao esta cadastrado');

gotoxy( 1,24); write('Pressione algo Para continuar...');
TECLA := readkey;
gotoxy(1,23); clreol;
end;
end;
until (NR_MATRIC = 0);
end;
procedure ROT_ENCERRAR;
begin
clrscr;
close(ARQALU);
writeln ('Fim de execucao do Cadastro de Alunos');
writeln;
exit;
end;
{ **** Programa Principal ***** }
begin
SISTEMA := 'SISTEMA DE CONTROLE ACADEMICO-ICEC';
Acessa_Arquivo;
repeat
clrscr;
line;
center(SISTEMA);
center('MENU PRINCIPAL');
line;
writeXy(26, 9,'[I] .........: Incluir Alunos ');
writeXy(26,10,'[R] .........: Remover ');
writeXy(26,11,'[A] .........: Alterar ');
writeXY(26,12,'[C] .........: Consultar ');
writexy(26,13,'[S] .........: Sair do Sistema');
writexy(26,17,'Entre com a opcao: --> ');
readln(OPCAO);
writeln;
OPCAO := upcase(OPCAO);
if (OPCAO in ['I','R','A','C','S']) then
begin
case OPCAO of
'I' : Rot_Cadastrar;
'R' : Rot_Remover;
'A' : Rot_Alterar;
'C' : Rot_Pesquisar;
'S' : ROT_Encerrar;
end;
end
else
begin
writeXy( 1,23,'Erro - Opcao invalida');
gotoxy( 1,24);
write('Pressione algo para continuar...');
TECLA := readkey;
end;
until (OPCAO = 'F');
end.



  






Patrocínio

Site hospedado pelo provedor RedeHost.
Linux banner

Destaques

Artigos

Dicas

Tópicos

Top 10 do mês

Scripts