{--------------------------------------------------------}
{          Telemark - procedimento de impressao
{--------------------------------------------------------}

unit tmImprim;
interface
uses dvcrt, dvwin, windos, winprn,
     tmVars, tmMsg, tmEdita, tmArquiv;

procedure imprime;

implementation

const
    tamLinha = 79;
    linhaReta =
        '+-----------------------------------------------------------------------------+';

var
    arq: text;
    imprimiuAntes: boolean;

{--------------------------------------------------------}
{                   centraliza uma cadeia
{--------------------------------------------------------}

function centra (s: string): string;
begin
    while length (s) < tamLinha-2 do
        s := ' ' + s + ' ';
    while length(s) > tamLinha-2 do
        delete (s, length (s), 1);
    centra := '|' + s + '|';
end;

{--------------------------------------------------------}
{                 calcula data e hora
{--------------------------------------------------------}

function dataHora: string;
var
    ano, mes, dia, sem: word;
    hora, min, seg, cent: word;
    s: string;
const
    tabSem: array [0..6] of string [3] =
        ('Dom', 'Seg', 'Ter', 'Qua', 'Qui', 'Sex', 'Sab');

    function strg (valor, ndig: integer): string;
    var s: string;
    begin
        str (valor, s);
        while length (s) < ndig do s := '0' + s;
        strg := s;
    end;

begin
    getDate (ano, mes, dia, sem);
    getTime (hora, min, seg, cent);
    dataHora := tabSem [sem] + ' ' +
             strg (dia, 2) + '/' + strg (mes, 2) + '/' + strg (ano, 2) + ' ' +
             strg (hora, 2) + ':' + strg (min, 2);
end;

{--------------------------------------------------------}
{                 imprime a ficha atual
{--------------------------------------------------------}

procedure imprimeFichaAtual;
var
    s: string;
    nsecao, nf, i: integer;
begin
    if imprimiuAntes then write (arq, #$0c);
    imprimiuAntes := true;

    writeln (arq, linhaReta);
    s := 'Sistema de Telemarketing - DOSVOX - v 1.0 ' + datahora;
    writeln (arq, centra (s));
    s := empresa;
    writeln (arq, centra (s));
    s := 'Responsável pela operação: ' + operador;
    writeln (arq, centra (s));
    s := 'F I C H A    D O    C L I E N T E';
    writeln (arq, centra (s));
    writeln (arq, linhaReta);
    writeln (arq);

    for nsecao := 1 to nPartesModelo do
      if fichaAtual.secao[nsecao]^.nfolhas <> 0 then
        begin
            writeln (arq, linhaReta);
            s := fichaModelo[nsecao]^.nomeParteFicha;
            writeln (arq, centra (s));
            writeln (arq, linhaReta);

            with fichaAtual.secao[nsecao]^ do
              for nf := 1 to nFolhas do
                if not folhaEstaVazia (fichaAtual, nsecao, nf) then
                  with folha[nf]^, pInfoSecao^ do
                    begin
                        for i := 1 to ndadosParteFicha do
                            begin
                                s := dadosParteFicha[i].nomeCampo;
                                while length (s) < 20 do
                                    s := s + ' ';
                                writeln (arq, s + ' ' + dado [i]);
                            end;
                    end;
            writeln (arq);
        end;
end;

{--------------------------------------------------------}
{                   imprime uma pessoa
{--------------------------------------------------------}

procedure imprimePessoa (qual: integer);
var salva: integer;
begin
    salva := posAtual;
    posAtual := qual;

    destroiFicha (fichaAtual);
    posAtual := qual;
    criaFicha (fichaAtual);

    if leFicha (fichaAtual, pessoas^[qual]^.nomeArq) then
        imprimeFichaAtual
    else
        begin
            msgBaixo ('TMFICSUM');   {'Ficha sumiu'}
            delay (500);
        end;

    posAtual := salva;
end;

{--------------------------------------------------------}
{                   imprime registros
{--------------------------------------------------------}

procedure imprime;
var tipo, c, c2: char;
    i: integer;
    nomeList: string;
begin
    if cadastrados = 0 then
        begin
            mensagem ('TMCADVAZ', 1);    {'Cadastro vazio'}
            exit;
        end;

    destroiFicha (fichaAtual);
    criaFicha (fichaAtual);

    mensagem ('TMQUAIS', 0);    {'Todos registros, só selecionados ou último editado ? '}
    sintLeTecla (c, c2);
    writeln;
    tipo := upcase (c);

    if not (tipo in ['T', 'S', 'U']) then
        begin
            mensagem ('TMDESIST', 1);   {'desistiu'}
            exit;
        end;

    mensagem ('TMOPERAD', 1);   {'Informe o nome do responsável'}
    sintReadln (operador);
    mensagem ('TMEMPRES', 1);   {'Informe o nome da empresa'}
    sintReadln (empresa);
    mensagem ('TMNOMLST', 1);   {'Informe o arquivo de listagem, tecle ENTER se impressão direta}
    sintReadln (nomeList);

    mensagem ('TMENTCNF', 1);   {'Aperte Enter para confirmar, ESC para cancelar'}
    sintLeTecla (c, c2);
    if c = ESC then
        begin
            mensagem ('TMDESIST', 1);   {'desistiu'}
            exit;
        end;

    if nomeList = '' then
        begin
            assignDefPrn (arq);
            titlePrn (arq, 'Listagem do Telemarketing');
        end
    else
        assign (arq, nomeList);

    {$I-} rewrite (arq);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('TMERRLST', 1);   {'Erro ao criar a listagem'}
            exit;
        end;

    imprimiuAntes := false;
    case tipo of
        'T':  for i := 1 to cadastrados do
                   imprimePessoa (i);
        'S':    for i := 1 to cadastrados do
                   if pessoas^[i]^.selecionado then
                       begin
                           imprimePessoa (i);
                           if keypressed and (readkey = ESC) then
                               exit;
                       end;
        'U':  imprimeFichaAtual;
    end;

    close (arq);

    destroiFicha (fichaAtual);
    criaFicha (fichaAtual);
end;

end.