Manipulação de arquivos [Pascal/Kylix]

Manipulação de arquivos

Publicado por Hudson Orsine Assumpção 10/08/2006

[ Hits: 7.039 ]

Download lanchonete.pas

0 0

Denuncie Favoritos Indicar
Código-fonte de um trabalho de Estrutura de Dados II com o tema: Manipulação de Arquivos. O programa é apenas um exemplo de como se trabalha com arquivos binários.
Esconder código-fonte
{Autores: Hudson Orsine Assumpção
          Marcus Vinícius Gomes Aragão
          Luis Augusto Bernardes Tegedor
Função: Implementar as vendas de uma lanchonete armazenando os dados das vendas e apresentando-os quando pedido
Data: 12/04/2006
Linguagem: Pascal}

program LANCHONETE;
uses crt;
type
   date        = record
        DAY,                      {Registro usado para guardar a data presente no arquivo data.mhl}
        MONTH,
        YEAR:integer;
          end;
   vetor     = array[0..4] of real;
   ponteiro  = ^registro;
   registro  = record
        PROX,ANT : ponteiro;      {Registro usado para manter uma lista duplamente encadeada com os ítens da venda atual}
        CODPROD  : char;
        QUANT      : integer;
          end;      
   listaprod = ^registro2;
   registro2 = record
        ANT,PROX : pointer;       {Registro usado apenas para manter o controle da lista}
        QUANT      : integer;
          end;      
   vendedor  = record      
        NOME : string[10];        {Registro usado para armazenar o nome do atendente}
          end;    
   prod        = record      
        COD   : char;             {Registro usado para armazenar as informações de um produto}
        NOME   : string[15];
        PRECO   : real;
          end;   
   venda     = record      
        COD,                       {Registro usado para armazenar todas as informações de uma venda}
        QUANTA,
        QUANTB,
        QUANTC,
        QUANTD,
        NOMEAT,
        QUANTE: integer;
        VALOR   : real;        
          end;   
   fechadia = record
       DIA,                       {Registro usado para armazenar as informações de todas as vendas efetuadas no dia}
       MES,
       ANO,
       QUANTAA,
       QUANTBB,
       QUANTCC,
       QUANTDD,
       QUANTEE:integer;
       TOTVENDAS,       
       MEDVENDAS:real;
       TOTATEND:vetor;
         end;
var
   ATEND   : file of vendedor;
   PRODUTO : file of prod;
   LANCHE  : file of venda;
   RESUMO  : file of fechadia;
   DATA      : file of date;
procedure ABREDATA;
var                                         {Procedimento para a abertura do arquivo 'data.mhl'}
   Y : date;
begin
   assign(DATA,'data.mhl');
   {$I-}
   reset(DATA);
   {$I+}
   if ioresult<>0 then
   begin
      rewrite(DATA);
      with Y do          {Esse trecho evita um erro de leitura que aconteceria se o arquivo estivesse vazio}
      begin              {já que a primeira operação que é feita com o arquivo (após a abertura) é a leitura}
    DAY:=0;
    MONTH:=0;
    YEAR:=0;    
      end;
      write(DATA,Y);
      close(DATA);
      ABREDATA;
   end;
end; { ABREDATA }
procedure ABREATENDENTE;
begin                               {Procedimento para a abertura do arquivo 'atendente.mhl'}
   assign(ATEND,'atendente.mhl');
   {$I-}
   reset(ATEND);
   {$I+}
   if ioresult<>0 then
      rewrite(ATEND);
end; { ABREATENDENTE }
procedure ABREPRODUTO;
begin                               {Procedimento para a abertura do arquivo 'produto.mhl'}
   assign(PRODUTO,'produto.mhl'); 
   {$I-}
   reset(PRODUTO);
   {$I+}
   if ioresult<>0 then
      rewrite(PRODUTO);
end; { ABREPRODUTO }
procedure ABRELANCHE;
begin                               {Procedimento para a abertura do arquivo 'lanche.dat'}
   assign(LANCHE,'lanche.dat');
   {$I-}
   reset(LANCHE);
   {$I+}
   if ioresult<>0 then
      rewrite(LANCHE);
end; { ABRELANCHE }
procedure ABRERESUMO;
begin                               {Procedimento para a abertura do arquivo 'resumo.dat'}
   assign(RESUMO,'resumo.dat');
   {$I-}
   reset(RESUMO);
   {$I+}
   if ioresult<>0 then
      rewrite(RESUMO);
end; { ABRERESUMO }
procedure PINTAFUNDO (bkcolor :integer) ;
var
   LINHA,                             {Procedimento usado para 'pintar' o fundo da tela com uma cor passada por parâmetro}
   COL:integer;   
begin
   textbackground(bkcolor);
   for LINHA:=1 to 25 do
      for COL:=1 to 80 do
      begin
    gotoxy(COL,LINHA);
    write(' ');
      end;
end; { PINTAFUNDO }
procedure MENSERRO;
var
   LINE,
   COLUN:integer;
begin
   window(26,12,56,18);                
   PINTAFUNDO(0);
   window(25,11,55,17);                {Exibe uma mensagem de erro}
   textbackground(4);
   for LINE:=11 to 17 do
      for COLUN:=25 to 55 do
      begin
    gotoxy(COLUN,LINE);    
    if ((LINE=11) or (LINE=17)) or ((COLUN=25) or (COLUN=55)) then
       write('#')
    else
       write(' ');
      end;   
   textcolor(14);
   gotoxy(13,4);
   write('ERRO');
   readln;
end; { MENSERRO }
procedure CADATEND;
var                                    {Efetua o cadastro de um novo atendente}
   CAD : vendedor;
begin
   ABREATENDENTE;
   PINTAFUNDO(1);
   if filesize(ATEND)=5 then            {Essa linha limita a quantidade de atendentes que podem ser cadastrados}
      MENSERRO                          {pois o arquivo resumo.dat exige as informações de venda de cada vendedor} 
   else                                 {portanto se não se o limite não fosse colocado, não saberíamos quantos atendentes}
   begin                                {estariam cadastrados, o que impossibilitaria a manipulação correta do registro usado no arquivo}
      textcolor(10);
      gotoxy(25,4);
      writeln('CADASTRO DE ATENDENTES');
      gotoxy(1,7);
      write('Nome: ');
      readln(CAD.NOME);
      seek(ATEND,filesize(ATEND));
      write(ATEND,CAD);
      gotoxy(1,22);
      writeln('CADASTRO EFETUADO COM SUCESSO!');
      writeln('Pressione uma tecla para continuar...');
      readln;
   end;
   close(ATEND);
end; { CADATEND }
procedure CADPROD;
var                                           {Procedimento que efetua o cadastro de um produto}
   CAD : prod;
begin
   PINTAFUNDO(1);                             {Como foi dito anteriormente o arquivo resumo.dat pede as informações de venda de}
   ABREPRODUTO;                               {cada atendente, esse arquivo também pede a quantidade vendida de cada produto}
   if filesize(PRODUTO)=5 then                {portanto o limite da quantidade de produtos também foi necessária}
      MENSERRO
   else
   begin
      textcolor(10);
      seek(PRODUTO,filesize(PRODUTO));
      gotoxy(25,4);
      writeln('CADASTRO DE PRODUTOS');
      gotoxy(1,8);
      writeln('Codigo:');
      writeln('Nome:');
      gotoxy(30,9);
      write('Preco:');
      gotoxy(9,8);      
      readln(CAD.COD);
      gotoxy(7,9);
      readln(CAD.NOME);
      gotoxy(37,9);
      readln(CAD.PRECO);
      write(PRODUTO,CAD);
      gotoxy(1,22);
      writeln('CADASTRO EFETUADO COM SUCESSO!');
      writeln('Pressione uma tecla para continuar...');
      readln;
   end;
   close(PRODUTO);
end; { CADPROD }
procedure VENDAITEM (var L : listaprod;var ACHOU:boolean;var LOCAL:integer;var ITEM:ponteiro;var TEMP2:integer);
var
   LINHA1 : integer;                               {Efetua a venda de um ítem, colocando ele no início da fila caso não haja nenhum}
   AUX4     : prod;                                  {produto. Caso a lista ja tenha sido inicializada, uma busca é feita para se saber}
   TEMP     : char;                                  {se o mesmo produto já estava na lista; evitando assim que uma alocação desnecessária}
begin                                              {seja efetuada, caso o produto não esteja na lista, uma nova alocação é feita}
   window(1,20,80,25);
   PINTAFUNDO(2);
   ACHOU:=false;
   textcolor(0);
   seek(PRODUTO,0);
   read(PRODUTO,AUX4);
   LINHA1:=1;
   while not eof(PRODUTO) do
   begin
      gotoxy(45,LINHA1);
      write(AUX4.COD,' -> ',AUX4.NOME);
      gotoxy(70,LINHA1);
      write(' = ',AUX4.PRECO:6:2);
      LINHA1:=LINHA1+1;
      read(PRODUTO,AUX4);
   end;
   gotoxy(45,LINHA1);
   write(AUX4.COD,' -> ',AUX4.NOME);
   gotoxy(70,LINHA1);
   write(' = ',AUX4.PRECO:6:2);
   gotoxy(1,1);
   writeln('Codigo do produto: ');
   writeln('Quantidade:');
   if (L^.ANT=nil) and (L^.PROX=nil) then
   begin
      gotoxy(21,1);
      readln(TEMP);
   end   
   else
   begin
      gotoxy(21,1);
      readln;
      readln(TEMP);
   end;      
   while ((TEMP<>'A') and (TEMP<>'B')) and (((TEMP<>'C') and (TEMP<>'D')) and (TEMP>'E')) do
   begin
      gotoxy(1,4);
      writeln('ERRO! Entre com um código válido!');
      gotoxy(21,1);
      readln(TEMP);
   end;
   gotoxy(14,2);
   readln(TEMP2);
   if (L^.ANT=nil) and (L^.PROX=nil) then
   begin
      new(ITEM);
      ITEM^.ANT:=nil;
      L^.ANT:=ITEM;
      ITEM^.PROX:=nil;
      L^.PROX:=ITEM;
      L^.QUANT:=L^.QUANT+1;
      ITEM^.CODPROD:=TEMP;
      ITEM^.QUANT:=TEMP2;
   end
   else
   begin
      ITEM:=L^.ANT;
      while (ITEM^.PROX<>nil) and (ITEM^.CODPROD<>TEMP) do
      begin
    LOCAL:=LOCAL+1;
    write(ITEM^.CODPROD,'<>',TEMP);
    ITEM:=ITEM^.PROX;
      end;
      if ITEM^.CODPROD=TEMP then
       ACHOU:=true;
      if ACHOU then
    ITEM^.QUANT:=ITEM^.QUANT+TEMP2
      else
      begin
    new(ITEM);
    ITEM^.ANT:=L^.PROX;
    ITEM^.ANT^.PROX:=ITEM;
    ITEM^.PROX:=nil;
    L^.PROX:=ITEM;
    L^.QUANT:=L^.QUANT+1;
    LOCAL:=LOCAL+1;
    ITEM^.CODPROD:=TEMP;
    ITEM^.QUANT:=TEMP2;
      end;
   end;
end; { VENDAITEM }
procedure CONTAQUANT (var AUX22   : venda;L:listaprod);
var
   Q : ponteiro;
begin
   with AUX22 do                                {Este procedimento conta a quantidade vendida de cada produto}
   begin                                        {e desaloca todos os nós da lista, liberando-a para uma nova venda}
      QUANTA:=0;
      QUANTB:=0;
      QUANTC:=0;
      QUANTD:=0;
      QUANTE:=0;
   end;
   repeat
      Q:=L^.ANT;
      if Q^.PROX<>nil then
    Q^.PROX^.ANT:=nil;
      L^.QUANT:=L^.QUANT-1;
      L^.ANT:=Q^.PROX;
      if L^.ANT=nil then
    L^.PROX:=nil;
      if Q^.CODPROD='A' then
    AUX22.QUANTA:=AUX22.QUANTA+Q^.QUANT;
      if Q^.CODPROD='B' then
    AUX22.QUANTB:=AUX22.QUANTB+Q^.QUANT;
      if Q^.CODPROD='C' then
    AUX22.QUANTC:=AUX22.QUANTC+Q^.QUANT;
      if Q^.CODPROD='D' then
    AUX22.QUANTD:=AUX22.QUANTD+Q^.QUANT;
      if Q^.CODPROD='E' then
    AUX22.QUANTE:=AUX22.QUANTE+Q^.QUANT;
      dispose(Q);
   until L^.ANT=nil;
end; { CONTAQUANT }
procedure VENDACOMPLETA;
var
   ACAO   : char;               {Este procedimento chama dois outros procedimentos: VENDAITEM e CONTAQUANT}
   P   : ponteiro;           {após isso grava os dados necessários em 'lanche.dat'}
   AUX   : prod;
   AUX2   : venda;
   AUX3   : vendedor;
   LINHA,
   CODFUNC,
   QUANTFORA : integer;
   PRECOITEM:real;
   LISTA   : listaprod;
   LOCALIZADO:boolean;
begin   
   new(LISTA);
   LISTA^.ANT:=nil;
   LISTA^.PROX:=nil;
   LISTA^.QUANT:=0;
   PINTAFUNDO(1);
   textcolor(10);
   AUX2.VALOR:=0;
   ACAO:='S';
   ABREPRODUTO;
   ABREATENDENTE;
   gotoxy(25,3);
   write('VENDA');
   gotoxy(1,6);
   write('Informe o codigo do atendente:');
   window(61,7,79,13);
   PINTAFUNDO(0);
   window(60,6,78,12);
   PINTAFUNDO(5);
   read(ATEND,AUX3);
   while not eof(ATEND) do
   begin
      writeln(' ',filepos(ATEND)-1,' -> ',AUX3.NOME);
      read(ATEND,AUX3);
   end;
   writeln(' ',filepos(ATEND)-1,' -> ',AUX3.NOME);
   window(1,1,80,25);
   textbackground(1);
   textcolor(2);
   gotoxy(32,6);
   readln(CODFUNC);
   while (CODFUNC>4) or (CODFUNC<0) do
   begin
      gotoxy(1,10);
      writeln('ERRO! Entre com um valor valido!');
      gotoxy(32,6);
      readln(CODFUNC);
   end;
   window(1,1,80,19);
   PINTAFUNDO(1);
   gotoxy(25,3);
   write('    Lanchonete ESTRUTURA DO SABOR');
   gotoxy(25,4);
   write('Saboreie nossas delicias passo a passo!');
   gotoxy(35,6);
   write('VENDA');
   gotoxy(1,7);
   seek(ATEND,CODFUNC);
   read(ATEND,AUX3);
   writeln('Atendente: ',AUX3.NOME);
   gotoxy(7,9);
   writeln('Quant');
   gotoxy(15,9);
   writeln('Descricao');
   gotoxy(27,9);
   writeln('Valor');
   while (ACAO='S') or (ACAO='s') do
   begin
      LINHA:=11;
      VENDAITEM(LISTA,LOCALIZADO,LINHA,P,QUANTFORA);
      window(1,1,80,19);
      seek(PRODUTO,0);
      read(PRODUTO,AUX);
      while (not eof(PRODUTO)) and (P^.CODPROD<>AUX.COD) do
    read(PRODUTO,AUX);
      gotoxy(10,LINHA);
      write(P^.QUANT);
      gotoxy(13,LINHA);
      write(AUX.NOME);
      gotoxy(25,LINHA);
      PRECOITEM:=P^.QUANT*AUX.PRECO;
      write(PRECOITEM:6:2);
      gotoxy(65,18);
      if not LOCALIZADO then
    AUX2.VALOR:=AUX2.VALOR+PRECOITEM
      else
      begin
    QUANTFORA:=P^.QUANT-QUANTFORA;
    PRECOITEM:=QUANTFORA*AUX.PRECO;
    PRECOITEM:=P^.QUANT*AUX.PRECO-PRECOITEM;
    AUX2.VALOR:=AUX2.VALOR+PRECOITEM;
      end;
      write(AUX2.VALOR:6:2);
      gotoxy(1,18);      
      write('Deseja inserir outro produto? ');
      gotoxy(30,18);
      read(ACAO);      
   end;   
   ABRELANCHE;
   CONTAQUANT(AUX2,LISTA);
   dispose(LISTA);
   AUX2.NOMEAT:=CODFUNC;
   AUX2.COD:=filesize(LANCHE);
   seek(LANCHE,filesize(LANCHE));
   write(LANCHE,AUX2);
   close(PRODUTO);
   close(ATEND);
   close(LANCHE);
   readln;
end; { VENDACOMPLETA }
procedure RELATORIO;
var
   RESUMODIA : fechadia;          {Este procedimento coleta todos os dados referentes ao dia e os grava no arquivo 'resumo.dat'}
   VENDADIA  : venda;             {Além disso apresenta na tela os valores contidos em 'resumo.dat'} 
   LINHA,
   T        : integer;
   AUX7836   : vendedor;
   DATATO    : date;
   ACHOU:boolean;
begin
   ACHOU:=FALSE;
   window(1,1,80,25);
   PINTAFUNDO(1);
   ABREDATA;
   read(DATA,DATATO);
   ABRERESUMO;
   if filesize(RESUMO)>0 then
   begin
      repeat
    read(RESUMO,RESUMODIA);
    if (RESUMODIA.DIA=DATATO.DAY) and ((RESUMODIA.MES=DATATO.MONTH) and (RESUMODIA.ANO=DATATO.YEAR)) then
       ACHOU:=TRUE;
      until (eof(RESUMO)) or (ACHOU);
      if not ACHOU then
      begin
    seek(RESUMO,filesize(RESUMO));
    RESUMODIA.DIA:=DATATO.DAY;
    RESUMODIA.MES:=DATATO.MONTH;
    RESUMODIA.ANO:=DATATO.YEAR;
    RESUMODIA.QUANTAA:=0;
    RESUMODIA.QUANTBB:=0;
    RESUMODIA.QUANTCC:=0;
    RESUMODIA.QUANTDD:=0;
    RESUMODIA.QUANTEE:=0;
    RESUMODIA.TOTVENDAS:=0;
    RESUMODIA.MEDVENDAS:=0;
    RESUMODIA.TOTATEND[0]:=0;
    RESUMODIA.TOTATEND[1]:=0;
    RESUMODIA.TOTATEND[2]:=0;
    RESUMODIA.TOTATEND[3]:=0;
    RESUMODIA.TOTATEND[4]:=0;
      end
      else
      begin
    ABRELANCHE;
    if filesize(LANCHE)>0 then
    begin
       RESUMODIA.QUANTAA:=0;
       RESUMODIA.QUANTBB:=0;
       RESUMODIA.QUANTCC:=0;
       RESUMODIA.QUANTDD:=0;
       RESUMODIA.QUANTEE:=0;
       RESUMODIA.TOTVENDAS:=0;
       RESUMODIA.MEDVENDAS:=0;
       RESUMODIA.TOTATEND[0]:=0;
       RESUMODIA.TOTATEND[1]:=0;
       RESUMODIA.TOTATEND[2]:=0;
       RESUMODIA.TOTATEND[3]:=0;
       RESUMODIA.TOTATEND[4]:=0;
    end;
    close(LANCHE);
      end;
   end
   else
   begin
      RESUMODIA.DIA:=DATATO.DAY;
      RESUMODIA.MES:=DATATO.MONTH;
      RESUMODIA.ANO:=DATATO.YEAR;
      RESUMODIA.QUANTAA:=0;
      RESUMODIA.QUANTBB:=0;
      RESUMODIA.QUANTCC:=0;
      RESUMODIA.QUANTDD:=0;
      RESUMODIA.QUANTEE:=0;
      RESUMODIA.TOTVENDAS:=0;
      RESUMODIA.MEDVENDAS:=0;
      RESUMODIA.TOTATEND[0]:=0;
      RESUMODIA.TOTATEND[1]:=0;
      RESUMODIA.TOTATEND[2]:=0;
      RESUMODIA.TOTATEND[3]:=0;
      RESUMODIA.TOTATEND[4]:=0;
   end;      
   ABRELANCHE;
   repeat
      read(LANCHE,VENDADIA);
      RESUMODIA.QUANTAA:=RESUMODIA.QUANTAA+VENDADIA.QUANTA;
      RESUMODIA.QUANTBB:=RESUMODIA.QUANTBB+VENDADIA.QUANTB;
      RESUMODIA.QUANTCC:=RESUMODIA.QUANTCC+VENDADIA.QUANTC;
      RESUMODIA.QUANTDD:=RESUMODIA.QUANTDD+VENDADIA.QUANTD;
      RESUMODIA.QUANTEE:=RESUMODIA.QUANTEE+VENDADIA.QUANTE;
      RESUMODIA.TOTVENDAS:=RESUMODIA.TOTVENDAS+VENDADIA.VALOR;
      RESUMODIA.MEDVENDAS:=RESUMODIA.TOTVENDAS/filesize(LANCHE);
      case VENDADIA.NOMEAT of
        0 : RESUMODIA.TOTATEND[0]:=RESUMODIA.TOTATEND[0]+VENDADIA.VALOR;
        1 : RESUMODIA.TOTATEND[1]:=RESUMODIA.TOTATEND[1]+VENDADIA.VALOR;
        2 : RESUMODIA.TOTATEND[2]:=RESUMODIA.TOTATEND[2]+VENDADIA.VALOR;
        3 : RESUMODIA.TOTATEND[3]:=RESUMODIA.TOTATEND[3]+VENDADIA.VALOR;
        4 : RESUMODIA.TOTATEND[4]:=RESUMODIA.TOTATEND[4]+VENDADIA.VALOR;
      end; { case }
   until eof(LANCHE);
   write(RESUMO,RESUMODIA);
   close(LANCHE);
   window(1,1,80,25);
   PINTAFUNDO(1);
   gotoxy(30,3);
   writeln('RESUMO DO DIA');
   gotoxy(1,5);
   write(RESUMODIA.DIA,'/',RESUMODIA.MES,'/',RESUMODIA.ANO);
   gotoxy(3,7);
   writeln('Produto A: ',RESUMODIA.QUANTAA);
   gotoxy(3,8);
   writeln('Produto B: ',RESUMODIA.QUANTBB);
   gotoxy(3,9);
   writeln('Produto C: ',RESUMODIA.QUANTCC);
   gotoxy(3,10);
   writeln('Produto D: ',RESUMODIA.QUANTDD);
   gotoxy(3,11);
   writeln('Produto E: ',RESUMODIA.QUANTEE);
   gotoxy(40,7);
   write('Total arrecadado......: ',RESUMODIA.TOTVENDAS:6:2);
   gotoxy(40,8);
   write('Valor medio por pedido: ',RESUMODIA.MEDVENDAS:6:2);
   ABREATENDENTE;
   gotoxy(3,14);
   write('Vendedor');
   gotoxy(30,14);
   write('Total vendido');
   LINHA:=16;
   T:=0;
   read(ATEND,AUX7836);
   while not eof(ATEND) do
   begin
      gotoxy(3,LINHA);
      write(AUX7836.NOME);
      gotoxy(30,LINHA);
      write(RESUMODIA.TOTATEND[T]:6:2);
      T:=T+1;
      read(ATEND,AUX7836);
      LINHA:=LINHA+1;
   end;
   gotoxy(3,LINHA);
   write(AUX7836.NOME);
   gotoxy(30,LINHA);
   write(RESUMODIA.TOTATEND[T]:6:2);
   gotoxy(1,25);
   textcolor(142);
   writeln('Pressione uma tecla para continuar...');
   readln;
   close(ATEND);
   close(RESUMO);
end; { RELATORIO }
procedure MOSTRAEQUIPE;                                  {Procedimento que apresenta a tela inicial contendo os integrantes da equipe}
begin
   window(1,1,80,25);
   PINTAFUNDO(2);
   textcolor(1);
   gotoxy(15,2);
   writeln('UNIMONTES - UNIVERSIDADE ESTADUAL DE MONTES CLAROS');
   gotoxy(15,3);
   writeln('  CCET - CENTRO DE CIENCIAS EXATAS E TECNOLOGICAS');
   gotoxy(15,4);
   writeln('   DCC - DEPARTAMENTO DE CIENCIAS DA COMPUTACAO');
   writeln('________________________________________________________________________________');
   gotoxy(25,7);
   write('LANCHONETE ESTRUTURA DO SABOR');
   gotoxy(20,8);
   write('Saboreie nossas delicias passo a passo!');
   gotoxy(1,15);
   writeln('EQUIPE 3 - MVGA & BREVLEQ ASSOCIATIONS');
   writeln;
   writeln('Integrantes: Hudson Orsine Assumpcao (brevleq)');
   writeln('             Marcus Vinicius Gomes Aragao (MVGA)');
   writeln('             Luis Augusto Bernardes Tegedor (Pai)');
   gotoxy(1,24);
   textcolor(128);
   write('Pressione uma tecla para continuar...');
   readln;
end; { MOSTRAEQUIPE }
procedure TELAPRINCIPAL;
var
   OPCAO : char;                            {Procedimento que apresenta a tela principal, onde o usuário pode trabalhar com o programa}
begin                                       {através das opções que esse procedimento é capaz de ler}
   OPCAO:='K';
   while (OPCAO<>'S') and (OPCAO<>'s') do
   begin
      window(1,1,80,25);
      PINTAFUNDO(1);
      textcolor(14);
      gotoxy(25,3);
      write('LANCHONETE ESTRUTURA DO SABOR');
      gotoxy(32,6);
      textcolor(142);
      writeln('OPCOES _');
      gotoxy(32,7);
      writeln('        |');
      gotoxy(32,8);
      writeln('        V');
      textcolor(14);
      gotoxy(30,10);
      write('          C - Cadastro de atendentes');
      gotoxy(30,11);
      write('          P - Cadastro de produtos');
      gotoxy(30,12);
      write('          V - Efetuar venda');
      gotoxy(30,13);
      write('          R - Resumo do dia');
      gotoxy(30,14);
      write('          S - Sair');
      gotoxy(1,20);
      write('Digite a acao desejada: ');
      readln(OPCAO);
      case OPCAO of
   'C','c'   : CADATEND;
   'P','p'   : CADPROD;
   'V','v'   : VENDACOMPLETA;
   'R','r'   : RELATORIO;   
   'S','s'   : write('brevleq');
      else
    MENSERRO;
      end; { case }
   end;
end; { TELAPRINCIPAL }
procedure TESTADATA;
var                            {Esse procedimento testa se a data atual é igual a da data guardada no arquivo 'data.mhl'}
   DT : date;                  {caso a data seja diferente esse procedimento limpa todos os dados contidos em 'lanche.dat'}
   DIAS,
   MESES,
   ANOS:integer;
begin
   clrscr;
   ABREDATA;
   read(DATA,DT);
   window(1,1,30,5);
   PINTAFUNDO(0);
   textcolor(15);
   gotoxy(1,1);
   writeln('Insira a data de hoje!');
   gotoxy(1,3);
   writeln('Dia:    Mes:     Ano:');
   gotoxy(5,3);
   readln(DIAS);
   gotoxy(13,3);
   readln(MESES);
   gotoxy(22,3);
   readln(ANOS);
   with DT do
   begin
      if ((DAY<>DIAS) and (MONTH<>MESES)) and (YEAR<>ANOS) then
      begin
    DAY:=DIAS;
    MONTH:=MESES;
    YEAR:=ANOS;
    rewrite(DATA);
    write(DATA,DT);
    ABRELANCHE;
    rewrite(LANCHE);
    close(LANCHE);
      end;
   end;
   close(DATA);
end; { TESTADATA }   
begin
   TESTADATA;
   MOSTRAEQUIPE;
   TELAPRINCIPAL;
end.
Scripts recomendados
Equação do segundo grau
Cadastro Empresarial
Numeros pitagoricos
Visualizador de imagens feito no Lazarus
Visualizador De Imagem feito no Lazarus (Delphi 7 para Linux)
Comentários
Nenhum comentário foi encontrado.