Desafio Leilão em Pascal.

[Junior Mayer]

Menor lance único é um sistema de leilão, no qual o apostador informa um valor que ele acredita será o menor e único, ou seja, não possui repetição. O ganhador leva o produto leiloado pelo valor

que foi apostado.

Escreva um sistema para cadastrar os lances dos apostadores (um apostador pode apostar vários lances), cada aposta deverá conter: data da aposta (obter do sistema), nome do apostador, telefone para contato e o valor apostado.

Ao final o sistema deverá fazer a verificação das apostas e identificar o menor valor apostado e único. Caso haja, o sistema exibirá o nome do apostador, telefone para contato e o valor apostado.

No caso de não haver ganhador, o sistema deverá exibir uma mensagem indicando o prêmio está acumulado.

O prêmio equivale a 60% (sessenta) do montante arrecadado com os lances.

Logo abaixo esta o meu código. Não conseguir. Quem quiser aproveita, corrigir os bugs e concluir agradeço.

program lance_unico;

uses crt,dos;

type Tdata = record
     dia,mes,ano: integer;
end;

type
     TApostador = record
     nome : string[20];
     lance: real;
     fone : string[10];
     data:Tdata;
end;

var
    arquivo: file of TApostador;
    reg:TApostador;
    opcao:char;
    qtde_depois, qtde_antes: integer;
    dia,mes,ano,dia_semana:word;


procedure menu_principal;
var i:integer;
begin
clrscr;

   //tabela com menu principal
  for i := 30 to 60 do
      begin
         textbackground(7);
         textcolor(7);
         gotoxy(i,8);   write(#196);
         textbackground(1);
         textcolor(1);
         gotoxy(i,9);   write(#196);
         textbackground(7);
         textcolor(7);
         gotoxy(i,10);   write(#196);
         textbackground(1);
         textcolor(1);
         gotoxy(i,11);   write(#196);
         textbackground(7);
         textcolor(7);
         gotoxy(i,12);   writeln(#196);

      end;
   textbackground(7);
   textcolor(0);
   gotoxy(36,8);   writeLN('  MENU PRINCIPAL ');
   textbackground(1);
   textcolor(14);
   gotoxy(34,9);   writeLN(' 1 - CADASTRAR APOSTAS  ');
   textbackground(7);
   textcolor(0);
   gotoxy(34,10);   writeLN(' 2 - LISTAR APOSTAS   ');
   textbackground(1);
   textcolor(14);
   gotoxy(34,11);   writeLN(' 3 - EXIBIR GANHADOR  ');
   textbackground(7);
   textcolor(0);
   gotoxy(34,12);   writeLN(' 4 - SAIR DO JOGO ');

end;

procedure cadastrar_apostadores;
begin
   //nomear o arquivo
   assign(arquivo,'c:\Users\JUNIOR\Downloads\Unititled1.pas');

   //tentar abrir o arquivo binario

   {$I-}
   reset(arquivo);
   {$I+}

   // verificar se arquivo foi aberto, ou seja, não houve erro
   if (IOResult <> 0) then

   // houve erro, arquivo foi criado
   rewrite(arquivo);

   write ('Informe Seu Nome:');
   readln (reg.nome);

   write ('Informe o valor do lance:(De 0.01 a 100.00 R$): ');
   readln (reg.lance);
   while(reg.lance <=0 ) or (reg.lance >100) do
   begin
      writeln('lance invalido!');
      write('digite o valor correto: ');
      readln (reg.lance);
   end;

   write('Informe Fone:');
   readln (reg.fone);

   getdate(ano, mes, dia, dia_semana);
   reg.data.ano:=ano;
   reg.data.mes:=mes;
   reg.data.dia:=dia;

   // obter a quantidade de registros, antes de gravar
   qtde_antes := filesize(arquivo);

   // deslocar para o final do arquivo
   seek(arquivo, filesize(arquivo));

   //persistir no arquivo
   write(arquivo,reg);

   // obter a quantidade de registros, depois de gravar
   qtde_depois := filesize(arquivo);

   if (qtde_depois > qtde_antes) then
   writeln('Registro gravado com sucesso!')
   else
   writeln('Erro: Registro nao gravado com sucesso!');

   close(arquivo);
end;

procedure listar_apostas;
var i:integer;

begin
    //tentar abrir o arquivo binario

    {$I-}
    reset(arquivo);
    {$I+}

    // verificar se arquivo foi aberto, ou seja, não houve erro
    if (IOResult <> 0) then
    // houve erro
    write(' nao existe apostas feitas') else
    begin

       // deslocar para o início do arquivo
       seek(arquivo, 0);
       for i := 1 to filesize(arquivo) do
       begin
          // ler do arquivo
          read(arquivo, reg);

          // exibir a informação que foi lida
          writeln('REG',i - 1,':NOME : ', reg.nome,'       LANCE: ', reg.lance:2:2);
          writeln('     TELEFONE: ', reg.fone,'     DATA: ', reg.data.dia,'/',reg.data.mes,'/',reg.data.ano);
          writeln('========================================');
          writeln;
       end;
    end;
    close(arquivo);
end;

procedure verificar_ganhador;

var i,j,posicao,qtd:integer;
    menor_lance:real;

begin
    //tentar abrir o arquivo binario
    {$I-}
    reset(arquivo);
    {$I+}
    // verificar se arquivo foi aberto, ou seja, nao houve erro
    if (IOResult <> 0) then
    // houve erro
    write('nao existe aposta') else
    begin
       menor_lance:=100;
       qtd:=0;

       //deslocar para o início do arquivo
       seek(arquivo, 0);

       for i := 1 to filesize(arquivo) do
       begin

          // ler do arquivo
          read(arquivo, reg);

          if(reg.lance < menor_lance) then
          begin
             qtd:= qtd +1;
             menor_lance:= reg.lance;
             posicao:= i-1;
          end;
       end;
     end;
    //deslocar para posicao do ganhador no arquivo
    seek(arquivo,posicao);

    //ler o registro ganhador
    read(arquivo,reg);
    writeln('ganhador: ', reg.nome);
    writeln('menor_lance:',menor_lance:2:2);
    close(arquivo);
end;

begin
clrscr;
repeat
    clrscr;
    menu_principal;
    writeln;
    gotoxy(34,14);  write('digite sua opcao: ');
    opcao:=readkey;
    writeln(opcao);
    textbackground(0);
    case (opcao) of

    '1': begin
            textcolor(12);
            writeln;
            writeln('CADASTRAR APOSTAS');
            writeln;
            textcolor(9);
            cadastrar_apostadores;
         end;
    '2': begin
            textcolor(12);
            writeln;
            writeln(' APOSTAS CADASTRADAS ');
            textcolor(9);
            listar_apostas;
         end;
    '3': begin
            textcolor(12);
            writeln;
            writeln(' GANHADOR ');
            textcolor(9);
            verificar_ganhador;
         end;
    '4': begin
            textcolor(12);
            writeln;
            write(' volte sempre');
         end;
     end;//fim do case

readkey;
until(opcao='4');
end.

[thoga31]

Logo abaixo esta o meu código. Não conseguir. Quem quiser aproveita, corrigir os bugs e concluir agradeço.

Não estás a conseguir... o quê, exactamente?

Agradeces porque assim te faziam a paparoca toda - detectar os erros, corriji-los e colocar aqui o código novo.

Por isso, o que é que não está a funcionar e em que parte do código é que não está a funcionar correctamente? Desbobina isso.

[Junior Mayer]

Não estou conseguindo validar os dados. Por exemplo: Na parte nome só aceitar letras e na parte valor só aceitar números, se digitar algo diferente voltar e pedir denovo. No final pegar o menor lance e único e colocar com vencedor, o Nuno aqui do forum me deu uma dica bacana mas não conseguir fazer. Já lendo aqui um livro achei interessante pegar os menores e repetidos lances e separar, dai sobrariam os lances que não se repetem, neles percorria para ver qual o menor, então seria o campeão. E fazer a soma das apostas e colocar 60% para o ganhador.

Se alguém puder usar meu código e conseguir agradeço.

[nunopicado]

Como eu disse, para o primeiro problema tens de usar o val para impedir letras ao ler o valor.

Para o segundo, fazer uma pesquisa completa para verificar potenciais duplicatas.

1º problema

Em primeiro lugar, livra-te do While neste caso. Sempre que tens de fazer algo pelo menos uma vez (no caso, ler o input do utilizador), deves usar o Repeat (salvo alguma situação especial).

   .
   .
var
   s:String;
   ErrCode:integer;
   Invalido:Boolean;
   .
   .
   .
   write ('Informe Seu Nome:');
   readln (reg.nome);

   repeat
      write ('Informe o valor do lance:(De 0.01 a 100.00 R$): ');
      readln (s);   // Le o input do utilizador para uma string
      Val(s,reg.Lance,ErrCode);  // Converte a string para um valor real em reg.Lance: Se correr bem, ErrCode será 0
      Invalido:=(ErrCode>0) or (reg.Lance<0.01) or (reg.Lance>100);  // Verifica se o valor inserido é valido
      if Invalido then writeln('lance invalido!');  // Se não for, avisa o utilizador
   until not Invalido;  // Repete até encontrar um valor válido.

   write('Informe Fone:');
   readln (reg.fone);
   .
   .
   .

Para o segundo problema, sugiro ordenar os registos todos por valor do lance, do menor para o maior.

Depois, é só encontrar o primeiro que seja diferente do anterior e do seguinte.

[Junior Mayer]

Valeu Nuno!!!  🙂

Deu certo em lance, como faço para colocar em reg.nome não aceitar números só letras, de preferencia mais de três. E em reg.fone tb, cria o repeat para cada um?

E sobre comparação no final não estou conseguindo, esta é a verdade. O raciocínio eu entendi. Mas colocar no Pascal é que não consigo.

Obrigado Nuno.

[thoga31]

Verifica se só tem letras e tem o número mínimo de caracteres

function OnlyLetters_And_HigherThanLimit(Line : String; Limit : word) : Boolean;
var i : integer;
begin
     if (Length(Line) >= Limit) then begin  // está acima do limite mínimo?
        OnlyLetters := true;
        for i:=1 to Length(Line) do begin
            if (Line[i] in ['0'..'9']) then  // tem algarismos?
               OnlyLetters := false;
        end;
     end else OnlyLetters := false;
end;

[nunopicado]

- Dos testes se é só letras é como disse o Thoga.

- Sim, tens de fazer um repeat para cada um.

- Criar um array para guardar os dados:

Exemplo:

var
   ListaOrdenada:array[1..100] of TApostador;

Uma vez todos os registos no array, corre um algoritmo de ordenação (Bubblesort por exemplo) no array

(se não souberes nenhum, fica atento ao forum, vou ver se faço um e crio um tópico à parte para ele)

Depois com um ciclo começas a pesquisar o array. Dentro do ciclo, testas o lance da posição actual com o anterior e o proximo. Se algum deles for igual, passa ao proximo. Se ambos forem diferentes, é esse que precisas.

Por fim, mostras o valor.

[Junior Mayer]

Nuno, tenha calma comigo, como explicado minha situação é complicada.

Olha o que vc me mandou, coloquei e ficou perfeito.

write ('Informe Seu Nome:');
   readln (reg.nome);

   repeat
     write ('Informe o valor do lance:(De 0.01 a 100.00 R$): ');
     readln (s);   // Le o input do utilizador para uma string
     Val(s,reg.Lance,ErrCode);  // Converte a string para um valor real em reg.Lance: Se correr bem, ErrCode será 0
     Invalido:=(ErrCode>0) or (reg.Lance<0.01) or (reg.Lance>100);  // Verifica se o valor inserido é valido
     if Invalido then writeln('lance invalido!');  // Se não for, avisa o utilizador
   until not Invalido;  // Repete até encontrar um valor válido.

   write('Informe Fone:');
   readln (reg.fone);

Sobre o que thoga31 colocou não conseguir acrescentar aqui. Teria como fazer usando este meu código como o Nuno fez?

E só ficaria faltando a ultima parte com o lance menor e único. Aqui no meu só mostra o menor.

procedure verificar_ganhador;

var i,j,posicao,qtd:integer;
    menor_lance:real;

begin
    //tentar abrir o arquivo binario
    {$I-}
    reset(arquivo);
    {$I+}
    // verificar se arquivo foi aberto, ou seja, nao houve erro
    if (IOResult <> 0) then
    // houve erro
    write('nao existe aposta') else
    begin
       menor_lance:=100;
       qtd:=0;

       //deslocar para o início do arquivo
       seek(arquivo, 0);

       for i := 1 to filesize(arquivo) do
       begin

          // ler do arquivo
          read(arquivo, reg);

          if(reg.lance < menor_lance) then
          begin
             qtd:= qtd +1;
             menor_lance:= reg.lance;
             posicao:= i-1;
          end;
       end;
     end;

Obs.: O que significa

Agradeces porque assim te faziam a paparoca toda

e

Desbobina isso.

[nunopicado]

Nuno, tenha calma comigo, como explicado minha situação é complicada.

Tudo calmo... 🙂 Mas como não sabemos o teu nivel de conhecimento de pascal, por vezes podemos dizer algo que esteja acima.

Olha o que vc me mandou, coloquei e ficou perfeito.

Ainda bem. Para os restantes é inserires aquela função do Thoga no programa, e depois testar:

   repeat   
      write ('Informe Seu Nome:');
      readln (reg.nome);
      if not OnlyLetters_And_HigherThanLimit(reg.Nome,3) then writeln('Nome inválido...');   
   until OnlyLetters_And_HigherThanLimit(reg.Nome,3);  // = True se a string só tiver letras e for maior que 3


   repeat
     write ('Informe o valor do lance:(De 0.01 a 100.00 R$): ');
     readln (s);   // Le o input do utilizador para uma string
     Val(s,reg.Lance,ErrCode);  // Converte a string para um valor real em reg.Lance: Se correr bem, ErrCode será 0
     Invalido:=(ErrCode>0) or (reg.Lance<0.01) or (reg.Lance>100);  // Verifica se o valor inserido é valido
     if Invalido then writeln('lance invalido!');  // Se não for, avisa o utilizador
   until not Invalido;  // Repete até encontrar um valor válido.

   write('Informe Fone:');
   readln (reg.fone);

E só ficaria faltando a ultima parte com o lance menor e único. Aqui no meu só mostra o menor.

Divide o problema em vários. Por exemplo, este método é talvez o mais simples:

1ª questão: Recolhes numa matriz todos os valores únicos e a sua posição no ficheiro

- Sabes trabalhar com arrays e matrizes? Se sim, é só usares um ciclo FOR para ler todos os dados do ficheiro, e de cada vez que lês um registo, percorres a matriz (com outro ciclo FOR por exemplo). Se encontrar na matriz o valor lido, apaga-o de lá. Se não o encontrar, insere-o lá.

2ª questão: Procuras na matriz qual o menor valor.

3ª Questão: mostras o valor

Dos 3 problemas, qual é que tens duvidas?

PS:

paparoca significa papa ou comida. Ter a paparoca feita é uma expressão que significa não ter trabalho a fazer algo.

Desbobina é uma palavra usada para indicar a alguém para se explicar melhor, para falar mais.

[Junior Mayer]

o teu nivel de conhecimento de pascal

Fiz o projeto ate aqui com livro aqui do meu lado, estou vendo tudo agora. Como dizemos por aqui:

" A NECESSIDADE FAZ O SAPO PULAR."

Coloquei no meu projeto:

repeat   
      write ('Informe Seu Nome:');
      readln (reg.nome);
      if not OnlyLetters_And_HigherThanLimit(reg.Nome,3) then writeln('Nome inválido...');   
   until OnlyLetters_And_HigherThanLimit(reg.Nome,3);  // = True se a string só tiver letras e for maior que 3

Onde coloco este aqui:

function OnlyLetters_And_HigherThanLimit(Line : String; Limit : word) : Boolean;
var i : integer;

Não estou sabendo onde colocar no meu projeto. Por isso esta dando erro.

Se puderes fazer como acima agradeço.

E sobre:

- Sabes trabalhar com arrays e matrizes?

Estou lendo aqui agora, fiz uns exemplos e estou meio sem entender.

Sempre que me ajudar com alguma dica, coloca no projeto como exemplo.

E sobre as palavras foi bom, vai enriquecer meu vocabulário agora.

Mais uma vez obrigado pela atenção!  🙂

[nunopicado]

O que o Thoga te deu foi uma função prontinha.

Terás de a colocar antes dos procedimentos todos:

.
.
.
var
    arquivo: file of TApostador;
    reg:TApostador;
    opcao:char;
    qtde_depois, qtde_antes: integer;
    dia,mes,ano,dia_semana:word;

<---   É aqui que inseres o código do Thoga

procedure menu_principal;
var i:integer;
begin
.
.
.

Do outro problema: Dizes que estás meio sem entender. Qual parte (das 3 que te mostrei)?

Sugiro-te que leias o tutorial de pascal cá do forum, de autoria do Thoga, que explica muito bem as bases do Pascal. Depois de o estudares, terás a tarefa muito facilitada.

[Junior Mayer]

Nuno, estou fazendo errado com certeza, olha como fiz:

var
    s:String;
    ErrCode:integer;
    Invalido:Boolean;
    arquivo: file of TApostador;
    reg:TApostador;
    opcao:char;
    qtde_depois, qtde_antes: integer;
    dia,mes,ano,dia_semana:word;

function OnlyLetters_And_HigherThanLimit(Line : String; Limit : word) : Boolean;
var i : integer;

procedure menu_principal;
var i:integer;
begin

e a outra parte:

// houve erro, arquivo foi criado
   rewrite(arquivo);

   repeat   
      write ('Informe Seu Nome:');
      readln (reg.nome);
      if not OnlyLetters_And_HigherThanLimit(reg.Nome,3) then writeln('Nome inválido...');
   until OnlyLetters_And_HigherThanLimit(reg.Nome,3);  // = True se a string só tiver letras e for maior que 3

   repeat
     write ('Informe o valor do lance:(De 0.01 a 100.00 R$): ');
     readln (s);   // Le o input do utilizador para uma string
     Val(s,reg.Lance,ErrCode);  // Converte a string para um valor real em reg.Lance: Se correr bem, ErrCode será 0
     Invalido:=(ErrCode>0) or (reg.Lance<0.01) or (reg.Lance>100);  // Verifica se o valor inserido é valido
     if Invalido then writeln('lance invalido!');  // Se não for, avisa o utilizador
   until not Invalido;  // Repete até encontrar um valor válido.

Fica mostrando erro.

Entendi os FOR, só não sei como fazer.

[nunopicado]

Está a dar erro porque não inseriste a função completa.

Tens a certeza que fizeste o resto do programa?  🙂 ?

Como fizeste os vários procedimentos, terás de inserir a função:

var
    s:String;
    ErrCode:integer;
    Invalido:Boolean;
    arquivo: file of TApostador;
    reg:TApostador;
    opcao:char;
    qtde_depois, qtde_antes: integer;
    dia,mes,ano,dia_semana:word;

function OnlyLetters_And_HigherThanLimit(Line : String; Limit : word) : Boolean;
var i : integer;
begin
     if (Length(Line) >= Limit) then begin  // está acima do limite mínimo?
        OnlyLetters := true;
        for i:=1 to Length(Line) do begin
            if (Line[i] in ['0'..'9']) then  // tem algarismos?
               OnlyLetters := false;
        end;
     end else OnlyLetters := false;
end;

procedure menu_principal;
var i:integer;
begin
.
.
.

 

O outro problema (e mesmo a função que o Thoga fez) é mais complexo, é certo, mas é mesmo por isso que precisas de o perceber bem, caso contrário quando chegares à aula, o professor vai ver aquilo e se desconfiar que não foste tu, vai-te perguntar sobre como fizeste, e aí sim, estás tramado ( = ferrado 😄 ).

Eu, e os outros do forum, podemos ajudar-te, mas se fizermos simplesmente o procedimento todo, não estarás a aprender nada, e estarás a colocar em risco toda a avaliação dessa aula.

Vamos por partes. Daqueles três pontos que falei para resolveres o problema, vamos começar por resolver o primeiro:

Citação

1ª questão: Recolhes numa matriz todos os valores únicos e a sua posição no ficheiro

- Sabes trabalhar com arrays e matrizes? Se sim, é só usares um ciclo FOR para ler todos os dados do ficheiro, e de cada vez que lês um registo, percorres a matriz (com outro ciclo FOR por exemplo). Se encontrar na matriz o valor lido, apaga-o de lá. Se não o encontrar, insere-o lá.

Já sabes declarar a matriz?

[thoga31]

Aproveito para informar que, na minha função, OnlyLetters deve ser substituído pelo nome da função, OnlyLetters_And_HigherThanLimit. Isto porque o nome original era OnlyLetters e só depois reparei que era necessário limite mínimo de caracteres. 🙂

[nunopicado]

Aproveito para informar que, na minha função, OnlyLetters deve ser substituído pelo nome da função, OnlyLetters_And_HigherThanLimit. Isto porque o nome original era OnlyLetters e só depois reparei que era necessário limite mínimo de caracteres. 🙂

LOL, nem reparei.

De qualquer maneira, convém o Junior usar a tua função para análise, e depois criar uma dele, caso contrário poderá ter problemas!

[Junior Mayer]

Aqui troquei o nome da função e fiz alguns ajustes e funcionou. Se digitar numero não funciona e se digitar duas letras tb não funciona.  🙂

Vamos agora para o menor e único, aqui esta quase saindo.

Um abraço.

[nunopicado]

Vamos agora para o menor e único, aqui esta quase saindo.

Isso é que eu gosto de ouvir... 🙂

[nunopicado]

Já agora Junior, uma dica:

Se tentares listar os apostadores antes de os cadastrares (por exemplo, se saiste do programa e voltaste a entrar), dá erro.

A mesma coisa se tentares ver o vencedor.

Isto acontece porque estás a fazer o Assign ao ficheiro no procedimento de cadastrar, o que está mal.

O Assign deverá ser feito logo no programa principal, antes de qualquer outra coisa.

É aí que testas se o ficheiro existe, e crias um novo se não existir, e por fim fechas o ficheiro.

Assim, ele estará pronto para fazer o reset em qualquer dos procedimentos que chames.

[Junior Mayer]

Valeu Nuno!  🙂

Está corrigido.

[Junior Mayer]

Fiz o seguinte:

Criei outro arquivo binário auxiliar para guardar os mesmos valores dos lances do arquivo principal;

Depois fiz um for i e dentro dele um for j comparado os valores do arquivo principal com o arquivo auxiliar.

Bugs:

1 - Quando clico em lista ele não lista.

2 - Quando clico em Ganhador ele não mostra.

3 - Não sei se o FOR esta do jeito que vc me pediu.

program lance_unico;

uses crt,dos;

type Tdata = record
     dia,mes,ano: integer;
end;

//ARQUIVO AUXILIAR
type TLance = record
      nome2 : string[20];
      lance_unico:real;
      fone2 : string[10];
      data2:Tdata;

end;
type
     TApostador = record
     nome : string[20];
     lance: real;
     fone : string[10];
     data:Tdata;
end;

var
    s:String;
    ErrCode:integer;
    Invalido:Boolean;
    arquivo: file of TApostador;
    reg:TApostador;
    arq_auxiliar: file of TLance;
    reg2:TLance;
    opcao:char;
    qtde_depois, qtde_antes: integer;
    dia,mes,ano,dia_semana:word;

function letras(Line : String; Limit : word) : Boolean;
var i : integer;
begin
     if (Length(Line) >= Limit) then begin  // está acima do limite mínimo?
        letras := true;
        for i:=1 to Length(Line) do begin
            if (Line[i] in ['0'..'9']) then  // tem algarismos?
               letras := false;
        end;
     end else letras := false;
end;

procedure menu_principal;
var i:integer;
begin
clrscr;

//nomear o arquivo
   assign(arquivo,'c:\teste.pas');

    //nomear o arquivo auxiliar
   assign(arq_auxiliar,'c:\auxiliar.binario');

   //tentar abrir o arquivo binario

   {$I-}
   reset(arquivo);
   {$I+}

   // verificar se arquivo foi aberto, ou seja, não houve erro
   if (IOResult <> 0) then

   // houve erro, arquivo foi criado
   rewrite(arquivo);

   //tentar abrir o arquivo auxiliar

   {$I-}
   reset(arq_auxiliar);
   {$I+}

   // verificar se arquivo auxiliar foi aberto
   if (IOResult <> 0) then

   // houve erro, arquivo foi criado
   rewrite(arq_auxiliar);


   //tabela com menu principal
  for i := 30 to 60 do
      begin
         textbackground(7);
         textcolor(7);
         gotoxy(i,8);   write(#196);
         textbackground(1);
         textcolor(1);
         gotoxy(i,9);   write(#196);
         textbackground(7);
         textcolor(7);
         gotoxy(i,10);   write(#196);
         textbackground(1);
         textcolor(1);
         gotoxy(i,11);   write(#196);
         textbackground(7);
         textcolor(7);
         gotoxy(i,12);   writeln(#196);

      end;
   textbackground(7);
   textcolor(0);
   gotoxy(36,8);   writeLN('  MENU PRINCIPAL ');
   textbackground(1);
   textcolor(14);
   gotoxy(34,9);   writeLN(' 1 - CADASTRAR APOSTAS  ');
   textbackground(7);
   textcolor(0);
   gotoxy(34,10);   writeLN(' 2 - LISTAR APOSTAS   ');
   textbackground(1);
   textcolor(14);
   gotoxy(34,11);   writeLN(' 3 - EXIBIR GANHADOR  ');
   textbackground(7);
   textcolor(0);
   gotoxy(34,12);   writeLN(' 4 - SAIR DO JOGO ');

end;

procedure cadastrar_apostadores;
begin

  repeat
   write ('Informe Seu Nome:');
   readln (reg.nome);
   reg2.nome2:=reg.nome;
   if not letras(reg.Nome,3) then writeln('Nome invalido...');
  until letras(reg.Nome,3);  // = True se a string só tiver letras e for maior que 3

  repeat
   write ('Informe o valor do lance: ');
   readln (s);
   reg2.lance_unico:= reg.lance;
   Val(s,reg.lance,ErrCode);  // Converte a string para um valor real em reg.Lance: Se correr bem, ErrCode será 0
     Invalido:=(ErrCode>0) or (reg.Lance<0.01) or (reg.Lance>100);  // Verifica se o valor inserido é valido
     if Invalido then writeln('lance invalido!');  // Se não for, avisa o utilizador
  until not Invalido;  // Repete até encontrar um valor válido.

   write('Informe Fone:');
   readln (reg.fone);
   reg2.fone2:=reg.fone;

   getdate(ano, mes, dia, dia_semana);
   reg.data.ano:=ano;
   reg.data.mes:=mes;
   reg.data.dia:=dia;
   reg2.data2.ano:=ano;
   reg2.data2.mes:=mes;
   reg2.data2.dia:=dia;

   // obter a quantidade de registros, antes de gravar
   qtde_antes := filesize(arquivo);

   // deslocar para o final do arquivo
   seek(arquivo, filesize(arquivo));
   seek(arq_auxiliar, filesize(arq_auxiliar));
   //persistir no arquivo
   write(arquivo,reg);
   write(arq_auxiliar,reg2);

   // obter a quantidade de registros, depois de gravar
   qtde_depois := filesize(arquivo);

   if (qtde_depois > qtde_antes) then
   writeln('Registro gravado com sucesso!')
   else
   writeln('Erro: Registro nao gravado com sucesso!');

   close(arquivo);
   close(arq_auxiliar);
end;

procedure listar_apostas;
var i,j:integer;

begin
    //tentar abrir o arquivo binario

    {$I-}
    reset(arquivo);
    {$I+}

    // verificar se arquivo foi aberto, ou seja, não houve erro
    if (IOResult <> 0) then
    // houve erro
    write(' nao existe apostas feitas') else
    begin

       // deslocar para o início do arquivo
       seek(arquivo, 0);
       for i := 1 to filesize(arquivo) do
       begin
          // ler do arquivo
          read(arquivo, reg);

          // exibir a informação que foi lida
          writeln('REG',i - 1,':NOME : ', reg.nome,'       LANCE: ', reg.lance:2:2);
          writeln('     TELEFONE: ', reg.fone,'     DATA: ', reg.data.dia,'/',reg.data.mes,'/',reg.data.ano);
          writeln('========================================');
          writeln;
       end;
    end;


   // ABRIR O ARQUIVO AUXILIAR /SO TESTANDO SE ELE GRAVOU NO SEGUNDO ARQUIVO
    writeln;  writeln;
   {$I-}
    reset(arq_auxiliar);
    {$I+}

    // verificar se arquivo foi aberto, ou seja, não houve erro
    if (IOResult <> 0) then
    // houve erro
    write(' nao existe apostas feitas') else
    begin
       writeln (' REGISTRO 2');
       writeln;

       // deslocar para o início do arquivo
       seek(arq_auxiliar, 0);
       for j := 1 to filesize(arq_auxiliar) do
       begin
          // ler do arquivo
          read(arq_auxiliar, reg2);

          writeln('REG',i - 1,':NOME : ', reg2.nome2,'       LANCE: ', reg2.lance_unico:2:2);
          writeln('     TELEFONE: ', reg2.fone2,'     DATA: ', reg2.data2.dia,'/',reg2.data2.mes,'/',reg2.data2.ano);
          writeln('========================================');
          writeln;
       end;
    end;
     close(arquivo);
    close(arq_auxiliar);

end;

procedure verificar_ganhador;

var i,j,posicao,qtd_igual:integer;
              menor:real;

begin
clrscr;
menor:=100;// maior valor possivel,qualquer lance sera menor ou igual

    //tentar abrir o arquivo binario
    {$I-}
    reset(arquivo);
    {$I+}

    // verificar se arquivo foi aberto, ou seja, nao houve erro
    if (IOResult <> 0) then

    // houve erro
    write('nao existe aposta');

     //tentar abrir o arq auxiliar
    {$I-}
    reset(arq_auxiliar);
    {$I+}

    // verificar se arquivo foi aberto, ou seja, nao houve erro
    if (IOResult <> 0) then

    // houve erro
    write('nao existe aposta');

    //deslocar para o inicio dos arquivos
    seek(arquivo, 0);
    seek(arq_auxiliar, 0);

       for i := 1 to filesize(arquivo) do
       begin
       qtd_igual:= 0;

          for j:= 1 to filesize(arq_auxiliar) do
          begin
              read(arquivo, reg); // ler do arquivo,essa parte que t  dando problema,
              read(arq_auxiliar, reg2); // se tirar, o programa executa a opcao 3,porem executa errado

              if (reg.lance = reg2.lance_unico) then
               qtd_igual:= qtd_igual + 1; //para um lance ser diferente dos outros a qtd
                                         // que ser igual a 1,que e o proprio numero no outro arquivo
          end;//fim do j

          if(qtd_igual = 1) then //so existe um numero igual,que e ele mesmo no outro arquivo
          if( reg.lance < menor)then

          begin
              menor:= reg.lance;
              posicao:= i; //posicao do menor no arquivo
          end;

          end;//fim do for i

          writeln('a quantidade de lances iguais e;', qtd_igual);

          if(menor=100) then //nao tem lance unico
          write('nao houve menor lance unico')

          else
          writeln('menor valor e unico: ',menor:2:2);

    //deslocar para posicao do ganhador no arquivo
    seek(arquivo,posicao);

    //ler o registro ganhador

    read(arquivo,reg);
    writeln('ganhador: ', reg.nome);
    writeln('menor_lance:',menor:2:2);

    close(arquivo);
    close(arq_auxiliar);

end;

begin
clrscr;
repeat
    clrscr;
    menu_principal;
    writeln;
    gotoxy(34,14);  write('digite sua opcao: ');
    opcao:=readkey;
    writeln(opcao);
    textbackground(0);
    case (opcao) of

    '1': begin
            textcolor(12);
            writeln;
            writeln('CADASTRAR APOSTAS');
            writeln;
            textcolor(9);
            cadastrar_apostadores;
         end;
    '2': begin
            textcolor(12);
            writeln;
            writeln(' APOSTAS CADASTRADAS ');
            textcolor(9);
            listar_apostas;
         end;
    '3': begin
            textcolor(12);
            writeln;
            writeln(' GANHADOR ');
            textcolor(9);
            verificar_ganhador;
         end;
    '4': begin
            textcolor(12);
            writeln;
            write(' volte sempre');
         end;
     end;//fim do case

readkey;
until(opcao='4');
end.