{--------------------------------------------------------}
{               Televox - rotinas de impressao
{--------------------------------------------------------}

unit telimpr;

interface
Uses
    DVCrt, DVWin, WinPrn,
    TelDados, TelTela, TelItem;

procedure Imprime;

implementation
var
    nomeListagem: string;
    arqListagem: text;

    tipoImpr, tipoForm: char;
    imprimeCampo: array [1..NUMCAMPOS] of boolean;

    margSup, margInf, margEsq, etiqsPorFolha: integer;
    etiqsPorPessoa, etiqPag: integer;

    posArq: integer;

    imprCanc, fazPausa: boolean;

{--------------------------------------------------------}
{             joga caracteres na impressora
{--------------------------------------------------------}

function jogaImpressora (s: string): boolean;
var
    numEnviados: word;
    c, c2: char;

label inicio;

begin
    jogaImpressora := true;

inicio:
    {$I-} write (arqListagem, s); {$i+}

    if ioresult <> 0 then
        begin
            msgBaixo ('TVERRIMP', 'Erro na Impressora, aperte uma tecla');
            sintLeTecla (c, c2);
            if c = #$1b then
                jogaImpressora := false
            else
                    goto inicio;
        end;
end;

{--------------------------------------------------------}
{               interrompe a listagem
{--------------------------------------------------------}

procedure interrompeListagem;
var c, c2: char;
    texto: string;
label reinicia;
begin
    limpaBaixo;
    msgBaixo ('TVLISINT', 'Listagem interrompida');

reinicia:

    gotoxy (1, 13);
    write ('Tecle ESC para cancelar, C para continuar ou L para localizar: ');
    sintSom ('TVESCCL');

    sintLeTecla(c, c2);
    if (c = ESC) then
        begin
            imprCanc := true;
            exit;
        end;

    c := upCase(c);
    if c = 'C' then exit;

    {--- localizacao de registros ---}

    msgBaixo ('TVSELREG', 'Selecione com PAGE UP ou PAGE DOWN, depois ENTER');

    repeat
        if (posArq > 0) and (posArq <= cadastrados) then
            begin
                texto := listaFone[posArq]^.nome^;
                gotoxy (1, 16);
                clreol;
            end
        else
            begin
                sintSom ('TVCLEK');
                texto := '';
                gotoxy (1, 16);
                write ('<Nao encontrei mais ninguem>');
            end;

        gotoxy (1, 15);
        write (texto); clreol;
        sintetiza (texto);

        sintLeTecla(c, c2);

        if (c = #$0) and (c2 = PGUP) then
            begin
                repeat
                    posArq := posArq - 1;
                until (posArq = 0) or
                      (tipoImpr = 'T') or
                      ((tipoImpr = 'S') and (
                         (listaFone [posarq]^.status and SELECIONADO) <> 0));
            end

        else

        if (c = #$0) and (c2 = PGDN) then
            begin
                repeat
                    posArq := posArq + 1;
                until (posArq > cadastrados) or
                      (tipoImpr = 'T') or
                      ((tipoImpr = 'S') and (
                         (listaFone [posarq]^.status and SELECIONADO) <> 0));
            end;

    until (c = #$1b) or (c = ENTER);

    goto reinicia;
end;

{--------------------------------------------------------}
{         transforma caracteres para a impressora
{--------------------------------------------------------}

procedure produzSaida (s: string);
var i: integer;
begin
    if s = ^L then
        begin
            if not jogaImpressora (s) then
                imprCanc := true;
        end
    else
        begin
            for i := 1 to margEsq do
                s := ' ' + s;
            s := s + #$0d + #$0a;
            if not jogaImpressora (s) then
                imprCanc := true;
        end;
end;

{--------------------------------------------------------}
{          controla o procedimento de impressao
{--------------------------------------------------------}

procedure controlaImpressao;
var i, nc: integer;
    s, nomeAmb: string;
    c, c2: char;
    netpessoa: integer;

label proxReg;

begin
    nomeAmb := sintAmbiente ('IMPRIVOX', 'AMBIMPRIVOX');
    if nomeAmb = '' then
        nomeAmb := 'c:\dosvox\printer.amb';

    limpaBaixo;
    msgBaixo ('TVINIIMP', 'Iniciando impressao');
    delay (1000);

    etiqPag := 0;
    posArq := 1;
    imprCanc := false;

    while (posArq <= cadastrados) and (not imprCanc) do
        begin
            if keypressed then
                begin
                    c := readkey;
                    if c = #$1b then
                        interrompeListagem;
                end;

            if (tipoImpr = 'T') or
               ((tipoImpr = 'S') and (
                         (listaFone [posArq]^.status and SELECIONADO) <> 0)) then
               begin
                 for netpessoa := 1 to etiqsPorPessoa do
                   begin
                       if keypressed then
                           begin
                               c := readkey;
                               if c = #$1b then
                                   begin
                                       interrompeListagem;
                                       goto proxReg;
                                   end;
                           end;

                       for i := 1 to margSup do
                           produzSaida ('');

                       for nc := 1 to NUMCAMPOS do
                           if imprimeCampo [nc] then
                                begin
                                    s := obtemItem (nc, posArq);
                                    produzSaida (s);
                                end;

                       etiqPag := etiqPag + 1;
                       if etiqPag = etiqsPorFolha then
                           begin
                             produzSaida (^L);
                             etiqPag := 0;

                             if fazPausa then
                                 begin
                                   msgBaixo ('TVMONFRM', 'Ponha novo papel e tecle ENTER');
                                   sound (2400); delay (500); nosound;
                                   sound (1200); delay (500); nosound;
                                   sound (2400); delay (500); nosound;
                                   repeat
                                       c := readkey;
                                   until not keypressed;

                                   msgBaixo ('','');
                               end;
                           end
                       else
                           for i := 1 to margInf do
                               produzSaida ('');


                   end;
               end;

            posArq := posArq + 1;
proxReg:
        end;

end;

{--------------------------------------------------------}
{         pede as caracteristicas do formulario
{--------------------------------------------------------}

procedure pedeCaracForm;
var c, c2: char;
    lvid: integer;
begin
    {--- pergunta caracteristicas do campo de impressao ---}

    limpaBaixo;
    msgBaixo ('TVCARCAM', 'Caracteristicas do formulario');

    lvid := 13;         gotoxy (1, lvid);
    write ('Margem superior (sugiro 0): ');
    sintSom ('TVMARSUP');
    margSup := 0;
    sintReadInt (margSup);

    lvid := lvid + 1;   gotoxy (1, lvid);
    write ('Margem esquerda (sugiro 3): ');
    sintSom ('TVMARESQ');
    margEsq := 0;
    sintReadInt (margEsq);

    if tipoForm <> 'M' then
        begin
            lvid := lvid + 1;    gotoxy (1, lvid);
            write ('Margem inferior (sugiro 2): ');
            sintSom ('TVMARINF');
            margInf := 0;
            sintReadInt (margInf);
        end;

    etiqsPorFolha := 1;
    etiqsPorPessoa := 1;

    if tipoForm = 'E' then
        begin
            lvid := lvid+ 1;    gotoxy (1, lvid);
            write ('Numero de etiquetas por pessoa (sugiro 1): ');
            sintSom ('TVNETPE');
            sintReadInt (etiqsPorPessoa);

            lvid := lvid+ 1;    gotoxy (1, lvid);
            write ('Numero de etiquetas por folha (9999 se formulario continuo): ');
            sintSom ('TVNETIQ');
            etiqsPorFolha := 9999;
            sintReadInt (etiqsPorFolha);
        end;

    lvid := lvid + 1;    gotoxy (1, lvid);
    write ('Faz pausa entre as paginas (s/n)? ');
    sintSom ('TVPAUSA');
   sintLeTecla(c, c2);
    fazPausa := upcase(c) = 'S';
end;

{--------------------------------------------------------}
{            imprime etiquetas ou folhas soltas
{--------------------------------------------------------}

procedure imprimeDados;
var c: char;
    qual: integer;
begin
    limpaBaixo;
    msgBaixo ('TVINFIMP', 'Marque com um x os campos a imprimir, depois ESC');

    { usa um elemento nao existente, para trabalho }

    novoRegistro (cadastrados+1);
    mostraItens (cadastrados+1);
    c := passeiaNosItens (cadastrados+1, true);

    with listaFone [cadastrados+1]^ do     { transforma em maiusculas }
        begin
            for qual := 1 to NUMCAMPOS do
                imprimeCampo [qual] := obtemItem (qual, cadastrados+1) <> '';
        end;

    removeRegistro (cadastrados+1);

    pedeCaracForm;

    controlaImpressao;
end;

{--------------------------------------------------------}
{                troca os campos da linha
{--------------------------------------------------------}

procedure trocaCamposLinha (var s: string; posArq: integer);
var i, nc: integer;
    s2: string;
begin
    for nc := 1 to NUMCAMPOS do
        begin
            i := pos (tabMalaDir [nc], s);
            if i <> 0 then
                begin
                    delete (s, i, length (tabMalaDir [nc]));
                    s2 := obtemItem (nc, posArq);
                    insert (s2, s, i);
                end;
        end;
end;

{--------------------------------------------------------}
{                      mala direta
{--------------------------------------------------------}

procedure malaDireta;
var arqModelo: text;
    nomeModelo: string;
    s, nomeAmb: string;
    c: char;
    i: integer;
begin
    writeln;
    write ('Qual o nome do arquivo da carta modelo ? ');
    sintSom ('TVNOMMOD');


    sintReadln(nomeModelo);
    assign (arqModelo, nomeModelo);
    {$I-} reset (arqModelo); {$I+}
    if ioresult <> 0 then
        begin
            msgBaixo ('TVERRMOD', 'Erro ao abrir arquivo de modelo');
            exit;
        end;

    nomeAmb := sintAmbiente ('IMPRIVOX', 'AMBIMPRIVOX');
    if nomeAmb = '' then
        nomeAmb := 'c:\dosvox\printer.amb';

    pedeCaracForm;

    limpaBaixo;
    msgBaixo ('TVINIIMP', 'Iniciando impressao');
    delay (2000);

    imprCanc := false;
    posArq := 1;
    close (arqModelo);

    while (posArq <= cadastrados) and (not imprCanc) do
        begin
            if keypressed then
                begin
                    c := readkey;
                    if c = #$1b then
                        interrompeListagem;
                end;

            if (tipoImpr = 'T') or
               ((tipoImpr = 'S') and (
                         (listaFone [posArq]^.status and SELECIONADO) <> 0)) then
               begin
                   reset (arqModelo);

                   for i := 1 to margSup do
                       produzSaida ('');

                   while not eof (arqModelo) do
                       begin
                           readln (arqModelo, s);

                           if (s = '<p>') or (s = '<p>') then
                               begin
                                   produzSaida (^L);
                                   for i := 1 to margSup do
                                       produzSaida ('');
                               end
                           else
                               begin
                                   trocaCamposLinha (s, posArq);
                                   produzSaida (s);
                               end;
                       end;

                   close (arqModelo);

                   produzSaida (^L);

                   if fazPausa then
                       begin
                           msgBaixo ('TVMONFRM', 'Ponha novo papel e tecle ENTER');
                           sound (2400); delay (500); nosound;
                           sound (1200); delay (500); nosound;
                           sound (2400); delay (500); nosound;
                           repeat
                               c := readkey;
                           until not keypressed;
                       end;

                   msgBaixo ('','');
               end;

            posArq := posArq + 1;

        end;


end;

{--------------------------------------------------------}
{                   Imprime o cadastro
{--------------------------------------------------------}

procedure Imprime;
var c, c2: char;
begin
    limpaBaixo;

    gotoxy (1, 11);
    clreol;
    textBackGround (BLUE);
    write ('IMPRESSAO:');
    textBackground (BLACK);
    sintsom ('TVIMPRIM');     {****** impressao }

    {--- pergunta se e' para todos ---}

    gotoxy (1, 13);
    write ('Tecle T para todos ou S para os selecionados: ');
    sintSom ('TVTODSEL');

    sintLeTecla(c, c2);
    c := upcase (c);
    if (c = ESC) then exit;

    if not (c in ['T','S']) then
        begin
            msgBaixo ('TVOPINV', 'Operacao invalida');
            exit;
        end;

    tipoImpr := c;

    {--- pergunta se e' envelope ou etiquetas ---}

    gotoxy (1, 14);
    write ('Tecle E para etiquetas, M para mala direta ou S para folhas soltas: ');
    sintSom ('TVETIQFO');

    sintLeTecla (c, c2);
    c := upcase (c);
    if (c = ESC) then exit;

    if not (c in ['E','M','S']) then
        begin
            msgBaixo ('TVOPINV', 'Operacao invalida');
            exit;
        end;

    tipoForm := c;

    {--- pede o nome do arquivo da impressora ---}

    gotoxy (1, 15);
    write ('Informe o nome do arquivo de impressora (sugiro PRN): ');
    sintSom ('TVNOMIMP');
    sintReadln(nomeListagem);

    if nomeListagem = '' then nomeListagem := 'PRN';
    assignDefPrn (arqListagem);
    {$I-} rewrite (arqListagem); {$I+}
    if ioresult <> 0 then
        begin
            msgBaixo ('TVERRABR', 'Erro ao abrir arquivo de impressao');
            exit;
        end;

    if tipoForm = 'M' then
        malaDireta
    else
        imprimeDados;

    {$I-} close (arqListagem);  {$I+}
    if ioresult <> 0 then;

    msgBaixo ('TVIMPFIM', 'Impressao finalizada');
end;

end.
