Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

ader

[Resolvido] Agenda Pascal

Recommended Posts

Estruturei o seguinte algoritimo em Pascal, que funciona como uma Agenda, o algoritimo ta funcionando Beleza.

So que ele tem 2 Menus o MENU PRINCILA e outro MENU so para CONSULTAS(quando estou no menu consultas e digito o codigo errado o programa vai exibir a seguinte mensagem 'Codigo [Numero do Codigo Digitado] Invalido.',ele deveria continuar no menu CONSULTA, mais ele volta Para o MENU PRINCIPAL, e tambem ele tem uma OPÇÃO que serviria para voltar para o MENU principal so que ao invez dele volta pro meu principal ele Fexa o Programa.

 

Obs.: write('Peguem o Algoritimo e Testem e você's entenderão o que eu Digo');

 

Por Favor, AJUDA :D

 

 

 

program AGENDA;

uses
   Crt;

const
   CCorAzul     = 1;
   CCorVerde    = 2;
   CCorCiano    = 3;
   CCorVermelho = 4;
   CCorMagenta  = 5;
   CCorAmarelo  = 6;
   CCorBranco   = 7;
   CCorCinza    = 8;
   CCorAzulClaro     = 9;
   CCorVerdeClaro    = 10;
   CCorCianoClaro    = 11;
   CCorVermelhoClaro = 12;
   CCorMagentaClaro  = 13;
   CCorAmareloClaro  = 14;
   CCorBrancoClaro   = 15;
   CCorCinzaClaro    = 16;

   CVersao = 'v 1.0';
   CSim    = 'S';
   CNao    = 'N';

   CAquivoDoBancoDeDados = 'C:\PROJETOS\PASCAL7\AGENDA\AGENDA.DAT';

type
   TAgendaRegistro = record { tipo de registro Produto        }
      COD : Integer;      { CODIGO                              }
      NOM : String[48];   { NOME                                }
      FONE : String[16];  { TELEFONE                             }
      EMAIL : String[48]; { EMAIL                      }
      EXC : Char;        { (S/N) EXCLUIDO                      }
   end;
   TAgendaArquivo = file of TAgendaRegistro;

var
   VProdArq : TAgendaArquivo;  { Vinculo com o arquivo físico   }
   VProdReg : TAgendaRegistro; { Registro do arquivo            }
   VRegPosi : Integer;          { posicao do registro            }
   VRegCont : Integer;          { contador de registros          }
   VRegCodi : Integer;          { Codigo para localizar registro }
   VMenuOpc : Integer;          { Opcao do menu                  }


procedure PAbrirArquivo; {procedure para iniciar (abrir) o arquivo}
begin
   {vincular a variavel ao arquivo}
   Assign(VProdArq, CAquivoDoBancoDeDados);
   {diretiva de compilação com instruções de tratamento de erros }
   {$I-}
   {vai para posicao 0 do arquivo }
   Reset( VProdArq );
   {diretiva de compilação com instruções de tratamento de erros }
   {$I+}
   {verifica o resposta de erro   }
   if (IOResult <> 0) then rewrite( VProdArq );
end;
 


procedure PCadastrar( xTitulo : String ); { procedure para cadastrar         }
var
   vResp : Char;
begin
   {recebe a qte de registros do arquivo                 }
   VRegPosi := FileSize( VProdArq );
   {leva o ponteiro para posicao indicada pela variavel  }
   Seek( VProdArq, VRegPosi);
   {pega o valo do proximo codigo a ser gravado          }
   VRegCont := VRegPosi;
   repeat
      TextColor( CCorBrancoClaro );
      ClrScr;
      {Controla a posicao do ponteiro}
      VRegCont     := VRegCont + 1;
      VProdReg.COD := VRegCont;
      VProdReg.EXC := CNao;
      GotoXY(02, 02); write( xTitulo );
      {pega os dados digitados pelo usuario}
      GotoXY(02, 04); write('Codigo ......: ', VProdReg.COD );
      GotoXY(02, 05); write('Nome ........: ');
      GotoXY(02, 06); write('Fone .....: ');
      GotoXY(02, 07); write('Email ...: ');

      GotoXY(02, 05); write('Nome ........: '); readln( VProdReg.NOM );
      GotoXY(02, 06); write('Fone .....: '); readln( VProdReg.FONE );
      GotoXY(02, 07); write('Email ...: '); readln( VProdReg.EMAIL );

      GotoXY(02, 14); write('Salvar (S/N)?: '); readln( vResp );
      if (vResp in ['s', 'S']) then
      begin
         {grava o registro no arquivo}
         write(VProdArq, VProdReg);
         GotoXY(02, 14); write('Registro Salvo ...');
         Delay(500);
      end;
      GotoXY(02, 14); write('Cadastrar outro (S/N) ? '); readln( vResp );
   until (vResp in ['n', 'N']);
end;

procedure PPesquisarCab( xCor, xLin : Integer );
begin
   TextColor( xCor );
   GotoXY(01, xLin); write( 'Cod.' );
   GotoXY(06, xLin); write( 'Nome ' );
   GotoXY(55, xLin); write( 'Fone' );
   GotoXY(59, xLin); write( 'Email' );

end;



procedure PPesquisar; {procedure para listar os registro da agenda (Pesquisa pelo codigo) }
var
   vCodI : Integer;
   vCodF : Integer;



begin

   TextColor( CCorVerdeClaro );
   ClrScr;
   GotoXY(01, 01); write( 'Codigo inicial ..: '); readln( vCodI );
   GotoXY(01, 02); write( 'Codigo Final ....: '); readln( vCodF );

   {posiciona o ponteiro no primeiro registro}
   Seek(VProdArq, 0);

   {enquanto nao chegar no final do arquivo (ultimo registro) faca}


   while not eof( VProdArq ) do begin
      {ler o registro atual (corrente) e grava na variavel <ProdReg>}
      read(VProdArq, VProdReg);

      if (VProdReg.EXC = CNao) and (VProdReg.COD >= vCodI) 
                               and (VProdReg.COD <= vCodF) then
      begin

         {mostra os dados dos campos: COD, NOM, TEL, e SIT; na tela }
         writeln ('---------------------------------------');
          write ('Codigo ...:');writeln( VProdReg.COD );
          write ('Nome ...:');writeln( VProdReg.NOM   );
          write ('Fone ...:');writeln( VProdReg.FONE   );
          write ('Email ...:');writeln( VProdReg.EMAIL );
          writeln ('---------------------------------------');



      end;

      {se a varial linha = 25, e pq chegou no final da tela }
      {neste caso o sistema para ate q o usuario precione uma tecla }
      {depois limpa a tela e inicia a variavel linha com 1 novamente}

   end;


   ReadKey;
end;

procedure PPesquisarNOME; {procedure para listar os registro da agenda  }
var
   vNOME : string[48];




begin
   clrscr;
   TextColor( CCorVerdeClaro );

   GotoXY(01, 01); write( 'Digite Nome ..: '); readln( vNOME );

   {posiciona o ponteiro no primeiro registro}
   Seek(VProdArq, 0);

   {enquanto nao chegar no final do arquivo (ultimo registro) faca}


   while not eof( VProdArq ) do begin
      {ler o registro atual (corrente) e grava na variavel <ProdReg>}
      read(VProdArq, VProdReg);

      if (VProdReg.EXC = CNao) and (VProdReg.NOM = vNOME)
      then
      begin

         {mostra os dados dos campos: COD, NOM, TEL, e SIT; na tela }
         writeln ('---------------------------------------');
          write ('Codigo ...:');writeln( VProdReg.COD );
          write ('Nome ...:');writeln( VProdReg.NOM   );
          write ('Fone ...:');writeln( VProdReg.FONE   );
          write ('Email ...:');writeln( VProdReg.EMAIL );
          writeln ('---------------------------------------');



      end;



   end;


   ReadKey;
end;

procedure PPesquisarEMAIL; {procedure para listar os registro da agenda  }
var
   vEMAIL : string[48];




begin
   clrscr;
   TextColor( CCorVerdeClaro );

   GotoXY(01, 01); write( 'Digite Email ..: '); readln( vEMAIL );

   {posiciona o ponteiro no primeiro registro}
   Seek(VProdArq, 0);

   {enquanto nao chegar no final do arquivo (ultimo registro) faca}


   while not eof( VProdArq ) do begin
      {ler o registro atual (corrente) e grava na variavel <ProdReg>}
      read(VProdArq, VProdReg);

      if (VProdReg.EXC = CNao) and (VProdReg.EMAIL = vEMAIL)
      then
      begin

         {mostra os dados dos campos: COD, NOM, TEL, e SIT; na tela }
         writeln ('---------------------------------------');
          write ('Codigo ...:');writeln( VProdReg.COD );
          write ('Nome ...:');writeln( VProdReg.NOM   );
          write ('Fone ...:');writeln( VProdReg.FONE   );
          write ('Email ...:');writeln( VProdReg.EMAIL );
          writeln ('---------------------------------------');



      end;



   end;


   ReadKey;
end;

procedure PPesquisarFONE; {procedure para listar os registro da agenda  }
var
   vFONE : string[16];




begin
   clrscr;
   TextColor( CCorVerdeClaro );

   GotoXY(01, 01); write( 'Digite Fone ..: '); readln( vFONE );

   {posiciona o ponteiro no primeiro registro}
   Seek(VProdArq, 0);

   {enquanto nao chegar no final do arquivo (ultimo registro) faca}


   while not eof( VProdArq ) do begin
      {ler o registro atual (corrente) e grava na variavel <ProdReg>}
      read(VProdArq, VProdReg);

      if (VProdReg.EXC = CNao) and (VProdReg.FONE = vFONE)
      then
      begin

         {mostra os dados dos campos: COD, NOM, TEL, e SIT; na tela }
         writeln ('---------------------------------------');
          write ('Codigo ...:');writeln( VProdReg.COD );
          write ('Nome ...:');writeln( VProdReg.NOM   );
          write ('Fone ...:');writeln( VProdReg.FONE   );
          write ('Email ...:');writeln( VProdReg.EMAIL );
          writeln ('---------------------------------------');



      end;



   end;


   ReadKey;
end;


procedure PAlterar; {procedure para exclusao de registros }

var
   vEnc  : Boolean; {flag: se encontar TRUE senao FALSE}
   vResp : Char;

begin

   TextColor( CCorAmareloClaro );

   ClrScr;

   GotoXY(02, 02); write('TELA DA ROTINA DE AUTERACAO DE REGISTROS');
   GotoXY(02, 04); write('Codigo a ser alterado ..: '); readln( VRegCodi );

   {posiciona o ponteiro no primeiro registro}
   Seek(VProdArq, 0);
   vEnc := False;

   {enquanto nao chegar no final do arquivo (ultimo registro) faca}
   while not eof( VProdArq ) do begin

      {ler o registro atual (corrente) e grava na variavel <ProdReg>}
      read(VProdArq, VProdReg);

      {se o codigo lido for igual ao codigo digitado entao }
      if (VProdReg.COD = VRegCodi) and (VProdReg.EXC = CNao) then
      begin

         vEnc := True;

         {sair do loop wile (enquanto)}
         break;

      end;
   end;

   if (vEnc = True) then
   begin

      ClrScr;
      GotoXY(02, 02); write('DIGITE OS DADOS PARA ALTERACAO DO PRODUTO');

      {pega os dados digitados pelo usuario}
      GotoXY(02, 04); write('Codigo ......: ', VProdReg.COD);
      GotoXY(02, 05); write('Nome ........: ', VProdReg.NOM );
      GotoXY(02, 06); write('Fone .....: ', VProdReg.FONE );
      GotoXY(02, 07); write('Email ...: ', VProdReg.EMAIL);

      GotoXY(02, 05); write('Nome ........: '); readln( VProdReg.NOM );
      GotoXY(02, 06); write('Fone .....: '); readln( VProdReg.FONE );
      GotoXY(02, 07); write('Email ...: '); readln( VProdReg.EMAIL );


      gotoXY(02, 12); write('Confirmar Alterar (S/N)? '); read( vResp );

      if (vResp in ['s', 'S']) then
      begin

         {posiciona o ponteiro no registro de codigo lido=codigo digitado }
         Seek(VProdArq, VRegCodi - 1);

         {grava a alteracao do registro no arqiuivo}
         write(VProdArq, VProdReg);

         GotoXY(02, 13); write('Registro [', VRegCodi, '] alterado com sucesso.');

      end;

   end else begin

      GotoXY(02, 13); write('Registro ', VRegCodi, ' nao encontrado.');

   end;

   Delay( 2000 );

end;


procedure PExcluir; {procedure para exclusao de registros }
var
   vEnc  : Boolean; {flag: se encontar TRUE senao FALSE}
   vResp : Char;
begin

   TextColor( CCorCinza );

   ClrScr;

   GotoXY(02, 02); write('TELA DA ROTINA DE EXCLUSAO DE REGISTROS');
   GotoXY(02, 04); write('Codigo a ser excluido ..: '); readln( VRegCodi );

   {posiciona o ponteiro no primeiro registro}
   Seek(VProdArq, 0);

   vEnc := False;

   {enquanto nao chegar no final do arquivo (ultimo registro) faca}

   while not eof( VProdArq ) do
   begin

      {ler o registro atual (corrente) e grava na variavel <ProdReg>}
      read(VProdArq, VProdReg);

      {se o codigo lido for igual ao codigo digitado entao }
      if (VProdReg.COD = VRegCodi) and (VProdReg.EXC = CNao) then begin

         vEnc := True;

         {sair do loop wile (enquanto)}
         break;

      end;

   end;

   if (vEnc = True) then begin

      gotoXY(02, 06); write('Confirmar Excluir (S/N)? '); read( vResp );

      if (vResp in ['s', 'S']) then
      begin

         {posiciona o ponteiro no registro de codigo lido=codigo digitado }
         Seek(VProdArq, VRegCodi - 1);

         {marca o campo ATI como 'I' }
         VProdReg.EXC := CSim;

         {grava a alteracao do registro no arqiuivo}
         write(VProdArq, VProdReg);

         GotoXY(02, 08); write('Registro [', VRegCodi, '] excluido com sucesso.');

      end;

   end else begin

      GotoXY(02, 08); write('Registro [', VRegCodi, '] nao encontrado.');

   end;

   Delay( 2000 );

end;
procedure PMenuCosulta; {procedure para listar o MENU na tela }
begin

   TextColor( CCorAmareloClaro );

   ClrScr;

   GotoXY(15, 02); write('AGENDA - '); TextColor( CCorVerdeClaro );

   write( CVersao );

   TextColor( CCorBrancoClaro );

   GotoXY(15, 08); write('MENU DE CONSULTAS');
   GotoXY(15, 09); write('-------------------');
   GotoXY(15, 10); write('1 - Consulta Codigo');
   GotoXY(15, 11); write('2 - Consulta Nome');
   GotoXY(15, 12); write('3 - Consulta Fone');
   GotoXY(15, 13); write('4 - Consulta Email');
   GotoXY(15, 14); write('0 - Menu Principal');
   GotoXY(15, 15); write('-------------------');

   GotoXY(15, 16); write('Opcao : '); readln( VMenuOpc );

   if (VMenuOpc >= 0) and (VMenuOpc <= 5) then begin

      case  VMenuOpc  of




         1: PPesquisar;

         2: PPesquisarNOME;

         3: PPesquisarFONE;

         4: PPesquisarEMAIL;




      end;

   end else begin

      GotoXY(15, 18); write('Opcao INVALIDA ', VMenuOpc );
      Delay( 2000 );

   end;

end;


procedure PMenu; {procedure para listar o MENU na tela }
begin

   TextColor( CCorAmareloClaro );

   ClrScr;

   GotoXY(15, 02); write('AGENDA - '); TextColor( CCorVerdeClaro );

   write( CVersao );

   TextColor( CCorBrancoClaro );

   GotoXY(15, 08); write('MENU PRINCIPAL');
   GotoXY(15, 09); write('--------------');
   GotoXY(15, 10); write('1 - Cadastrar');
   GotoXY(15, 11); write('2 - Consulta');
   GotoXY(15, 12); write('3 - Alterar');
   GotoXY(15, 13); write('4 - Excluir');
   GotoXY(15, 14); write('0 - Sair');
   GotoXY(15, 15); write('--------------');

   GotoXY(15, 16); write('Opcao : '); readln( VMenuOpc );

   if (VMenuOpc >= 0) and (VMenuOpc < 5) then begin

      case  VMenuOpc of

         0: begin      {sai do programa           }
         ClrScr;
            GotoXY(26,10); write( 'AGUARDE SAINDO DO SISTEMA...' );
            Delay( 2000 ); {aguarda 2 segundos e sair}
         end;

         1: PCadastrar('CADASTRO DE PRODUTOS'); {chama a procedure CADASTR   }

         2: PMenuCosulta; {chama a procedure LISTAR    }

         3: PAlterar;   {chama a procedure LISTAR    }

         4: PExcluir;   {chama a procedure EXCLUIR   }







      end;

   end else begin

      GotoXY(15, 18); write('Opcao INVALIDA ', VMenuOpc );
      Delay( 2000 );

   end;

end;



{inicio do programa                                                          }
begin

   PAbrirArquivo;

   repeat
      PMenu;
   until (VMenuOpc = 0);

   Close( VProdArq );

end.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Mesmo Niguem tendo respodido, consegui solucionar o problema :D

Compartilhar este post


Link para o post
Compartilhar em outros sites

Solução do Problema:

 

Obs: Algumas Constantes não estão sendo usadas, mais e bom deixar elas para caso de um uso posterior.

 

 

program AGENDA;

uses
    crt;

const
     CCorAzul =1;
     CCorVerde =2;
     CCorCiano =3;
     CCorVermelho =4;
     CCorMagenta =5;
     CCorAmarelo =6;
     CCorBranco =7;
     CCorCinza =8;
     CCorAzulClaro =9;
     CCorVerdeClaro =10;
     CCorCianoClaro =11;
     CCorVermelhoClaro =12;
     CCorMagentaClaro =13;
     CCorAmareloClaro =14;
     CCorBrancoClaro =15;
     CCorCinzaClaro =16;

     CVersao = 'v 1.0';
     CSim = 'S';
     CNao = 'N';

     CArquivoDoBancoDeDados = 'C:\PROJETOS\PASCAL7\AGENDA\AGENDA.DAT';

type
    TProdutoRegistro = record
    COD: Integer;
    NOM: String[48];
    FON: String[16];
    MAIL: String[48];
    ENDE: String[48];
    EXC: Char;
end;
TProdutoArquivo = file of TProdutoRegistro;

var
   VProdArq: TProdutoArquivo;
   VProdReg: TProdutoRegistro;
   VRegPosi: Integer;
   VRegCont: Integer;
   VRegCodi: Integer;
   VMenuOpc: Integer;
   VAgendaOpc: Integer;

procedure PAbrirArquivo;
begin

     Assign(VProdArq, CArquivoDoBancoDeDados);
     Reset (VProdArq);
     if (IOResult <> 0) then rewrite(VProdArq);
end;

procedure PCadastrar(xTitulo: String);
var
   vResp: Char;
begin

     VRegPosi := FileSize( VProdArq);

     Seek( VProdArq, VRegPosi);

     VRegCont:= VRegPosi;
     repeat
           TextColor(CCorBrancoClaro);
           clrscr;

           VRegCont :=VRegCont +1;
           VProdReg.COD:=VRegCont;
           VProdReg.EXC:=CNao;
           gotoxy(02,02); write(xTitulo);
           gotoxy(02,04); write('Codigo......: ', VProdReg.COD);
           gotoxy(02,05); write('Nome........: ');
           gotoxy(02,06); write('Fone........: ');
           gotoxy(02,07); write('Email......: ');
           {gotoxy(02,08); write('Endereco....: ');}

           gotoxy(02,05); write('Nome........: '); readln( VProdReg.NOM);
           gotoxy(02,06); write('Fone........: '); readln( VProdReg.FON);
           gotoxy(02,07); write('Email......: '); readln( VProdReg.MAIL);
           {gotoxy(02,08); write('Endereco....: '); readln( VProdReg.ENDE);}
           gotoxy(02,14); write('Salvar (S/N)?: '); readln( vResp);
           if (vResp in ['s', 'S']) then
           begin

                write(VProdArq, VProdReg);
                gotoxy(02,14); write('Registro Salvo...');
                Delay(500);
           end;
           gotoxy(02,14); write('Cadastrar outro (S/N)?'); readln( vResp);
       until (vResp in ['n', 'N']);
end;

procedure PPesquisarCab(xCor, xLin: Integer);
begin
     TextColor(xCor);
     gotoxy(02,xLin+2);write('Cod:');
     gotoxy(02,xLin+4);write('Nome:');
     gotoxy(02,xLin+6);write('Fone:');
     gotoxy(02,xLin+8);write('Email:');
     {gotoxy(02,xLin+10);write('Endereco:');}
end;

procedure PPesquisarLin(xCor,xLin: Integer);
begin
     {TextColor(xCor);
     gotoxy(12,xLin+2); write('-----');
     gotoxy(12,xLin+4); write('-------------------------');
     gotoxy(12,xLin+6); write('-------------------------');
     gotoxy(12,xLin+8); write('-------------------------');}

end;

procedure PPesquisarC;
var
   vCodI: Integer;
   vLin: Integer;


begin

     TextColor( CCorVerdeClaro);

     clrscr;


     vLin:= 3;

     gotoxy(01,01); write( 'Codigo do Contato..:'); readln( vCodI);

     Seek(VProdArq, 0);

     PPesquisarCab( CCorAmareloClaro, vLin);
     PPesquisarLin( CCorAmareloClaro, vLin +1);

     while not eof( VProdArq ) do begin
           read(VProdArq, VProdReg);

           if (VProdReg.EXC = CNao) and (VProdReg.COD = vCodI) then
           begin

                gotoxy(12, vLin +2); write(VProdReg.COD:4);
                gotoxy(12, vLin+4); write(VProdReg.NOM);
                gotoxy(12, vLin+6); write(VProdReg.FON);
                gotoxy(12, vLin+8); write(VProdReg.MAIL);
                gotoxy(12, vLin+10); write(VProdReg.ENDE);



                vLin:= vLin+1;
           end;
           if (vLin=24) then begin
              ReadKey;
              clrscr;
              vLin:=1;
              PPesquisarCab( CCorAmareloClaro, vLin);
              PPesquisarLin( CCorAmareloClaro, vLin+1);
           end;
        end;
        readkey;
end;

procedure PPesquisarE;
var
   vCodI: String;
   vLin: Integer;


begin

     TextColor( CCorVermelhoClaro);

     clrscr;


     vLin:= 3;

     gotoxy(01,01); write( 'Email do Contato..:'); readln( vCodI);

     Seek(VProdArq, 0);

     PPesquisarCab( CCorAmareloClaro, vLin);
     PPesquisarLin( CCorAmareloClaro, vLin +1);

     while not eof( VProdArq ) do begin
           read(VProdArq, VProdReg);

           if (VProdReg.EXC = CNao) and (VProdReg.MAIL = vCodI) then
           begin

                gotoxy(12, vLin +2); write(VProdReg.COD:4);
                gotoxy(12, vLin+4); write(VProdReg.NOM);
                gotoxy(12, vLin+6); write(VProdReg.FON);
                gotoxy(12, vLin+8); write(VProdReg.MAIL);
                gotoxy(12, vLin+10); write(VProdReg.ENDE);



                vLin:= vLin +1;
           end;
           if (vLin=24) then begin
              ReadKey;
              clrscr;
              vLin:=1;
              PPesquisarCab( CCorAmareloClaro, vLin);
              PPesquisarLin( CCorAmareloClaro, vLin+1);
           end;
        end;
        readkey;
end;

procedure PPesquisarF;
var
   vCodI: String;
   vLin: Integer;


begin

     TextColor( CCorAzulClaro);

     clrscr;


     vLin:= 3;

     gotoxy(01,01); write( 'Fone do Contato..:'); readln( vCodI);

     Seek(VProdArq, 0);

     PPesquisarCab( CCorAmareloClaro, vLin);
     PPesquisarLin( CCorAmareloClaro, vLin +1);

     while not eof( VProdArq ) do begin
           read(VProdArq, VProdReg);

           if (VProdReg.EXC = CNao) and (VProdReg.FON = vCodI) then
           begin

                gotoxy(12, vLin +2); write(VProdReg.COD:4);
                gotoxy(12, vLin+4); write(VProdReg.NOM);
                gotoxy(12, vLin+6); write(VProdReg.FON);
                gotoxy(12, vLin+8); write(VProdReg.MAIL);
                gotoxy(12, vLin+10); write(VProdReg.ENDE);



                vLin:= vLin +1;
           end;
           if (vLin=24) then begin
              ReadKey;
              clrscr;
              vLin:=1;
              PPesquisarCab( CCorAmareloClaro, vLin);
              PPesquisarLin( CCorAmareloClaro, vLin+1);
           end;
        end;
        readkey;
end;

procedure PPesquisarN;
var
   vCodI: String;
   vLin: Integer;


begin

     TextColor( CCorCianoClaro);

     clrscr;


     vLin:= 3;

     gotoxy(01,01); write( 'Nome do Contato..:'); readln( vCodI);

     Seek(VProdArq, 0);

     PPesquisarCab( CCorAmareloClaro, vLin);
     PPesquisarLin( CCorAmareloClaro, vLin +1);

     while not eof( VProdArq ) do begin
           read(VProdArq, VProdReg);

           if (VProdReg.EXC = CNao) and (VProdReg.NOM = vCodI) then
           begin

                gotoxy(12, vLin +2); write(VProdReg.COD:4);
                gotoxy(12, vLin+4); write(VProdReg.NOM);
                gotoxy(12, vLin+6); write(VProdReg.FON);
                gotoxy(12, vLin+8); write(VProdReg.MAIL);
                gotoxy(12, vLin+10); write(VProdReg.ENDE);



                vLin:= vLin +1;
           end;
           if (vLin=24) then begin
              ReadKey;
              clrscr;
              vLin:=1;
              PPesquisarCab( CCorAmareloClaro, vLin);
              PPesquisarLin( CCorAmareloClaro, vLin+1);
           end;
        end;
        readkey;
end;


procedure PAlterar;
var
   vEnc: Boolean;
begin

     TextColor( CCorAmareloClaro );

     clrscr;

     gotoxy(02,02); write('ALTERACAO DE REGISTROS');
     gotoxy(02,04); write('Codigo a ser alterado..:'); readln(VRegCodi);


     Seek(VProdArq, 0);
     vEnc:=False;


     while not eof (VProdArq) do begin


           read(VProdArq, VProdReg);


           if (VProdReg.COD = VRegCodi) and (VProdReg.EXC = CNao) then
           begin
                vEnc:= True;

                break;
           end;
     end;

     if (vEnc = True) then begin

        clrscr;
        gotoxy(02,02); write('DIGITE OS DADOS PARA ALTERACAO DO CONTATO');


        gotoxy(02,04); write('Codigo......: ', VProdReg.COD);
        gotoxy(02,05); write('Nome........: ', VProdReg.NOM);
        gotoxy(02,06); write('Fone........: ', VProdReg.FON);
        gotoxy(02,07); write('Email......: ', VProdReg.MAIL);
        {gotoxy(02,08); write('Endereco....: ', VProdReg.ENDE);}
        gotoxy(02,05); write('Nome........: ');readln (VProdReg.NOM);
        gotoxy(02,06); write('Fone........: ');readln (VProdReg.FON);
        gotoxy(02,07); write('Email....: ');readln (VProdReg.MAIL);
        {gotoxy(02,08); write('Endereco....: ');readln (VProdReg.ENDE);}


        seek(VProdArq, VRegCodi - 1);

        write(VProdArq, VProdReg);
        gotoxy(02,13); write('Registro', VRegCodi  , ' alterado com sucesso. ');

    end else begin
        gotoxy(02,13); write('Registro', VRegCodi   , ' nao encontrado. ');
    end;
    delay(2000);
end;

procedure PExcluir;
var
   vEnc: Boolean;
begin
     TextColor(CCorCinza);
     Clrscr;
     GotoXY(02,02); write('tela da rotina de exclusao de registros');
     GotoXY(02,04); write('Codigo a ser excluido..:'); readln(VRegCodi);

     Seek(VProdArq, 0);
     vEnc := False;

     while not eof( VProdArq ) do begin

           read(VProdArq, VProdReg);

           if (VProdReg.COD = VRegCodi) and (VProdReg.EXC = CNao) then begin
             vEnc := TRUE;

              break;
           end;
     end;
    if (vEnc = TRUE) then
    begin

        Seek(VProdArq, VRegCodi - 1);

        VProdReg.EXC := CSim;

        write(VProdArq, VProdReg);
        GotoXY (02,08); write('Registro ', VRegCodi , ' excluido com sucesso.');
    end else begin
       GotoXY (02,08); write('Registro ', VRegCodi ,  ' nao encontrado.');
    end;
    Delay( 2000 );
end;

procedure PConsultar;
begin
     TextColor (CCorAmareloClaro);
     ClrScr;
     TextColor (CCorAmareloClaro);
     GotoXY(15, 08); Write ('CONSULTAR POR:');
     GotoXY(15, 09); Write ('-------------------');
     GotoXY(15, 10); Write ('1 - Codigo');
     GotoXY(15, 11); Write ('2 - Nome');
     GotoXY(15, 12); Write ('3 - Fone');
     GotoXY(15, 13); Write ('4 - E-mail');
     gotoxy(15, 14); write ('-------------------');
     GotoXY(15, 15); Write ('0 - Menu Principal');
     GotoXY(15, 16); Write ('-------------------');
     GotoXY(15, 17); Write ('Opcao: '); readln( VAgendaOpc );
     if (VAgendaOpc >= 0) and (VAgendaOpc < 5) then begin
        case VAgendaOpc of
             1: PPesquisarC;
             2: PPesquisarN;
             3: PPesquisarF;
             4: PPesquisarE;
        end;
     end else begin
         GotoXY (25,20); write ('Opcao ', VAgendaOpc,' Invalida !! ' );
         Delay(1000);
         GotoXY(15,17 ); Write ('Opcao: '); readln( VAgendaOpc );
         if (VAgendaOpc >= 0) and (VAgendaOpc < 5) then begin
            case VAgendaOpc of
             1: PPesquisarC;
             2: PPesquisarN;
             3: PPesquisarF;
             4: PPesquisarE;
             end;
         end;
     end;
end;

procedure PMenu;
begin
     TextColor (CCorAmareloClaro);
     ClrScr;
     GotoXY(15, 02); Write ('AGENDA - '); TextColor (CCorVerdeClaro);
     write(CVersao);
     TextColor (CCorBrancoClaro);
     GotoXY(15, 08); Write ('MENU PRINCIPAL');
     GotoXY(15, 09); Write ('--------------');
     GotoXY(15, 10); Write ('1 - Cadastrar');
     GotoXY(15, 11); Write ('2 - Consultar');
     GotoXY(15, 12); Write ('3 - Alterar');
     GotoXY(15, 13); Write ('4 - Excluir');
     GotoXY(15, 14); Write ('0 - Sair');
     GotoXY(15, 15); Write ('--------------');
     GotoXY(15, 16); Write ('Opcao: '); readln( VMenuOpc );
     if (VmenuOpc >= 0) and (VmenuOpc < 5) then begin
        case VMenuOpc of
        0:   begin
        clrscr;
               GotoXY (15,10);write (  'AGUARDE SAINDO DO SISTEMA ...') ;
                Delay ( 2000 ) ;
             end;
        1: PCadastrar ( 'CADASTRO DE CONTATOS');
        2: PConsultar;
        3: PAlterar;
        4: PExcluir;

        end;
     end else Begin
           GotoXY (15,18); write ('opcao INVALIDA ', VMenuOpc  );
           Delay ( 2000 );
     end;
end;

begin
       PAbrirArquivo;
       repeat
             PMenu;
       until (VMenuOpc  =  0);
       Close( VProdArq );


end.

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.