(* Desenvolvido por : Pedro Gabriel Lancelloti Pinto em 04/12/2011, feito para ajudar a o pessoal da eletrônica na prova de programacao.
Creditos especiais para Alan Carpilovsky que me enviou seu programa de agenda guiada por ponteiros e persistencia, muito obrigado.
Esse programa e baseado na prova P3 do professor Antonio Claudio (AC) de 2009/1 *)

Program estoquecontrole;

uses usual,crt,sysutils,dos;

//tipos usados

Type
        ptrproduto:^produto;

        produto = record;
            nome:string;
            codigo:integer;
            preco:real;
            qnt:integer;
            proximo:ptrproduto;
            anterior:ptrproduto;
        end;
        // Esse tipo e o que sera salvo no arquivo binario, portanto nao possui pointer ja que esses sao apenas enderecos na memoria
        rproduto = record;
            nome:string;
            codigo:integer;
            preco:real;
            qnt:integer;
            ativo:boolean;
        end;

        (* rvendidos = record;
                nome:string;
                codigo:integer;
                preco:real;
                qnt:integer // vendida
                ativo:boolean;
        end; *)

//////Fim dos tipos

// variaveis globais

var
    arqproduto: File of regproduto;
    arqvendido:File of regproduto (*ou rvendidos*)
    regproduto: rproduto;
    novo, primeiro, ultimo, atual, anterior, auxiliar : ^prtproduto;
    nomearq,data:string;
    op:integer;

// Começo dos procedimentos

// OBS : Durante a programacao, primeiro foi pensado no IncluirPonteiro e suas restricoes, para cada uma delas foi criada um procedure
//esses procedures devem estar antes do IncluirPonteiro para que possam ser utilizados por ele.

Procedure IncluirPrimeiro;
begin
    primeiro^.anterior := nil;
    primeiro^.proximo := nil;
    primeiro := novo;
    ultimo := novo;
    atual := novo;
end;

Procedure IncluirTopo;
begin
    novo^.proximo := anterior;
    novo^.anterior := ultimo;
    ultimo^.proximo := novo;
    primeiro^.anterior := novo;
    primeiro := novo;
end;

Procedure IncluirFim;
begin
    novo^.proximo := primeiro;
    novo^.anterior := ultimo;
    primeiro^.anterior := novo;
    ultimo^.proximo := novo;
    ultimo := novo;
end;

Procedure IncluirGeral;
begin
    auxiliar := primeiro; // Preparando para fazer uma varredura nos produtos, começando do primeiro.
    // Aqui começa a busca e comparação entre o buscado e os produtos existente. Ele ira parar assim que achar um produto menor que o auxiliar
    While upcase (novo^.nome) > upCase (auxiliar.nome) do
    begin
        anterior := auxiliar;
        auxiliar := auxiliar^.proximo;
    end;
    // Aqui começa a "troca" dos pointers.
    novo^.proximo := auxiliar ;
    novo^.anterior := anterior ;
    auxiliar^.anterior := novo;
    anterior^.proximo := novo;
end;

procedure IncluirPonteiro;

var
    sn:char;

begin
    Repeat
        new(novo);
        VerifString('Digite o Nome do Produto que deseja adicionar'40,3,novo^.nome);
        VerifInt('Digite o codigo do produto que deseja adicionar'1000,1,novo^.codigo);
        VerifReal('Digite o preco do produto que deseja adicionar'50000,1,novo^.preco);
        If primeiro = nil then
        begin
            IncluirPrimeiro
        else
        If Upcase (novo^.nome) <= UpCase (primeiro^.nome) then
            IncluirTopo
        else
        If Upcase (novo.^nome) >= UpCase (ultimo^.nome) then
            IncluirFim
        else
        IncluirGeral;
        writeln;
        writeln (' Produto Incluido, deseja incluir outro ? S/N' )
        readln(sn);
        sn := Upcase (sn);
    until sn = 'N';
end;

// Procedimento Menu
Procedure Menu(Op1,Op2,Op3,Op4:string; var escolha:integer);
begin
        Writeln('--------Menu--------');
        writeln(Op1);
        writeln(Op2);
        writeln(Op3);
        writeln(Op4);
        writeln('---------------------');
        writeln('Digite a opcao desejada');
        readln(escolha);
end;

Procedure Buscar;
var
        buscado:string;
        encontrado:boolean;

begin
    If primeiro = nil then // Caso do estoque nao ter produtos
    begin
        writeln (' Nao ha produtos no catalogo ');
    end
    else
        VerifString('Digite o nome do produto que deseja Buscar: ',30,3,buscado);
        auxiliar := primeiro // e usado o auxiliar para que nao altere a lista encadeada.
        encontrado := false; // para realizar a checagem.
        Repeat
                If upcase((auxiliar^.nome) = Upcase (buscado)) and (auxiliar^.ativo = true) then
                (*Explicando: O auxiliar recebe o primeiro para comecar do inicio da lista, se for igual e ativo ele lista. Em seguida o auxiliar recebe o proximo
                registro. O ativo e uma booleana verdadeira em true, falsa em false , ela sera falsa quando quantidade dos produtos for igual a false ou quando o usuario decidir
                excluir o produto*)
                begin
                    encontrado := true;
                    writeln('-------------------------------------------Informacoes:--------------------------------------------------------');
                    writeln(' Codigo : ');
                    write(auxiliar.codigo);
                    writeln(' Nome : ');
                    write(auxiliar.nome);
                    writeln(' Quantidade em estoque : ');
                    write(auxiliar.qnt);
                    writeln('----------------------------------------------------------------------------------------------------------------');
                end;
        auxiliar := auxiliar^.proximo;
        until auxiliar.nome = primeiro.nome; //Isso marca o fim de uma volta na lista
        If encontrado = false then
        writeln('PRODUTO NAO ENCONTRADO VERIFIQUE NO REGISTRO DE VENDIDOS SE TODAS SUAS UNIDADES FORAM VENDIDAS !!!');
    end;
end;

Procedure Excluir;

var
        buscado:string;
        sn:char;

begin
        If primeiro = nil then
        writeln (' Nao ha produtos adicionados ao estoque ');
        else
            VerifString('Digite o nome do produto que deseja Buscar: ',30,3,buscado);
            auxiliar := primeiro // e usado o auxiliar para que nao altere a lista encadeada.
            Repeat
                If upcase((auxiliar^.nome) = Upcase (buscado)) and (auxiliar^.ativo = true) then // procedure similar ao buscar
                begin
                        writeln('Deseja Excluir : ',auxiliar^.nome,' ? ') // validacao da escolha do usuario
                        readln(sn);
                        sn:= Upcase(sn);
                        If Upcase(sn) = 's' then // validacao da resposta
                        auxiliar^.ativo := false; // exclusao logica, todos com false nao serao passados para o registro
                end;
            auxiliar := auxiliar^.proximo;
            until auxiliar.nome = primeiro.nome; // marcando 1 volta no registro.
        end;
end;

Procedure Vender;

buscado:string;
nvendido:integer;

begin
    If primeiro = nil then
    writeln (' Nao ha produtos adicionados ao estoque ');
    else
        VerifString('Digite o nome do produto que deseja Buscar: ',30,3,buscado);
        auxiliar := primeiro // e usado o auxiliar para que nao altere a lista encadeada.
        Repeat
            If upcase((auxiliar^.nome) = Upcase (buscado)) and (auxiliar^.ativo = true) then // procedure similar ao buscar
            begin
                writeln('Deseja Vender : ',auxiliar^.nome,' ? ') // validacao da escolha do usuario
                readln(sn);
                sn:= Upcase(sn);
                If Upcase(sn) = 's' then // validacao da resposta
                begin
                    writeln(' Digite a quantidade a ser vendida ');
                    readln(nvendido);
                    If auxiliar^.qnt < nvendido then // Validando se a quantidade requisitada e disponivel
                    writeln ('Operacao invalida, numero de produtos disponiveis menor que a quantidade requisitada');
                    else
                    If auxiliar^.qnt < nvendido then
                    begin
                        auxiliar^.qnt := auxiliar^.qnt - (nvendido); // exclusao logica, todos com false nao serao passados para o registro
                        If auxiliar^.qnt := 0 then
                        auxiliar^.ativo := false; // Todas unidades vendidas, logo produto sai do catalogo.
                    end;
                end;
            end;
        auxiliar := auxiliar^.proximo;
        until auxiliar.nome = primeiro.nome; // marcando 1 volta no registro.
    end;
end;

 Procedure Entrada;

 var

 sn:char;
 adicionado:integer;

 begin
    If primeiro = nil then // Caso do estoque nao ter produtos
    begin
        writeln (' Nao ha produtos no catalogo ');
    end
    else
        VerifString('Digite o nome do produto que deseja Buscar: ',30,3,buscado);
        auxiliar := primeiro // e usado o auxiliar para que nao altere a lista encadeada.
        Repeat
            If upcase((auxiliar^.nome) = Upcase (buscado)) and (auxiliar^.ativo = true) then // procedure similar ao buscar
            begin
                writeln('Deseja adicionar mais produto de  : ',auxiliar^.nome,' ? ') // validacao da escolha do usuario
                readln(sn);
                sn:= Upcase(sn);
                If Upcase(sn) = 's' then // validacao da resposta
                begin
                    writeln(' Digite a quantidade a ser adicionada: ');
                    readln(adicionado);
                    If auxiliar^.qnt = 0 then // Validando se o item esta fora de estoque
                    begin
                        auxiliar^.qnt := adicionado;
                        auxiliar^.ativado := true;
                    end
                    else
                    auxiliar^.qnt := auxiliar^.qnt + (adicionado); // adicionando.
                end;
            end;
            auxiliar := auxiliar^.proximo;
        until auxiliar.nome = primeiro.nome; // marcando 1 volta no registro.
    end;
 end;

Procedure SalvarInfo;
var
begin
        auxiliar := primeiro
    reset(regproduto)
        Repeat
                rproduto.nome := auxiliar^.nome;
                rproduto.codigo := auxiliar^.codigo;
                rpdrouto.preco := auxiliar^.preco;
                rproduto.qnt := auxiliar^.qnt;
                rproduto.ativo := auxiliar^.ativo;
                If rprotudo.ativo = true then (*escreve no registro de ativos*)
                begin
                    assign(regproduto,estoque.bin);
                    write(rproduto,regproduto);
                end
                else
                If rproduto.ativo = false then (*escreve no registro de vendidos do dia*)
                begin
                    data:= date;
                    nomearq:= 'vendidos' + (data) + '.bin';
                    assign(regproduto,nomearq);
                    write(rproduto,regproduto);
                end;
                auxiliar := auxiliar^.proximo;
        until auxiliar.nome = primeiro.nome; //Isso marca o fim de uma volta na lista
end;

Function Fechar():char; // Fechar tem que ser uma function para retornar ao "loop" do menu seu valor, caso ela retorne com S, o programa fecha e sai do loop do menu.

var

sn:char;

begin
        writeln('Deseja Realmente fechar o programa ? s/n' );
        readln(sn);
        sn:=Upcase(sn);
        If sn = 'S' then
        begin
                SalvarInfo;
        end;
        Fechar := sn;
end;


// Corpo principal do programa.

Begin
    Repeat
        Menu('1- Incluir novo Produto','2- Buscar Produto','3- Entrada de Produto','4- Venda de Produto','5- Excluir Produto',op);
        Case (op) of
        1 :
        begin
            IncluirPonteiro;
            SalvarInfo;
        end;
        2 :
        begin
            Buscar;
            SalvarInfo;
        end;
        3 :
        begin
            Entrada;
            SalvarInfo;
        end;
        4 :
        begin
            Vender;
            SalvarInfo;
        end;
        5 :
        begin
            Excluir;
            SalvarInfo;
        end;
        6:
        begin
            Fechar;
        end;
    until Fechar = 'S';
End.