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

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

procedure exporta;
procedure importa;

implementation

var
    arq: text;
    arqVeioDoTelemark: boolean;

{--------------------------------------------------------}
{   exporta os dados principais da ficha atual em txt
{--------------------------------------------------------}

procedure exportaFichaAtual;
var
    s: string;
    nsecao, nf, i: integer;
begin
    nsecao := 1;
    with fichaAtual do
        write (arq, nomeArqFicha, ^i);

    with fichaAtual.secao[nsecao]^ do
      begin
         nf := 1;
         if not folhaEstaVazia (fichaAtual, nsecao, nf) then
             with folha[nf]^, pInfoSecao^ do
                  begin
                      for i := 1 to ndadosParteFicha do
                          begin
                              write (arq, dado [i]);
                              if i <> ndadosParteFicha then
                                  write (arq, ^i);
                          end;
                      writeln (arq);
                  end;
        end;
end;

{--------------------------------------------------------}
{                   exporta uma pessoa
{--------------------------------------------------------}

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

    destroiFicha (fichaAtual);
    posAtual := qual;
    criaFicha (fichaAtual);
    if leFicha (fichaAtual, pessoas^[qual]^.nomeArq) then
        exportaFichaAtual
    else
        begin
            msgBaixo ('TMFICSUM');   {'Ficha sumiu'}
            delay (500);
        end;

    posAtual := salva;
end;

{--------------------------------------------------------}
{                   exporta registros
{--------------------------------------------------------}

procedure exporta;
var tipo, c, c2: char;
    i: integer;
    nomeList: string;
    dir: 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 ('TMNOMDST', 1);   {'Informe o arquivo de destino'}
    sintReadln (nomeList);
    if nomeList = '' then
        begin
            mensagem ('TMDESIST', 1);   {'desistiu'}
            exit;
        end;

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

    assign (arq, nomeList);
    {$I-} reset (arq);  {$I+}
    if ioresult = 0 then
        begin
            close (arq);
            mensagem ('TMARQEXI', 1);    {'Arquivo ja existe, adiciona, remove ou desiste ? '}
            sintLeTecla (c, c2);
            writeln;

            case upcase(c) of
                 'A':  {$I-}  append (arq);    {$I+}
                 'R':  {$I-}  rewrite (arq);   {$I+}
            else
                mensagem ('TMDESIST', 1);   {'desistiu'}
                exit;
            end;
        end
    else
        {$I-} rewrite (arq);  {$I+}

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

    getDir (0, dir);
    writeln (arq, dir);

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

    close (arq);

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

{--------------------------------------------------------}
{                  importa um registro
{--------------------------------------------------------}

procedure importaReg (s: string);

    procedure trim (var s: string);
    begin
        while (s <> '') and (s[length(s)] = ' ') do
            delete (s, length (s), 1);
    end;

var valorCampo: string;
    nc, p, i: integer;
begin
    with fichaAtual do
        begin
            if arqVeioDoTelemark then
                begin
                    p := pos (^i, s);
                    if p = 0 then p := length (s)+1;
                    nomeArqFicha := copy (s, 1, p-1);
                    delete (s, 1, p);
                    trim (nomeArqFicha);
                end
            else
                nomeArqFicha := '';
        end;

    with fichaAtual.secao[1]^ do
        begin
            criaFolha (fichaAtual, 1);
            new (folha[1]);

            for i := 1 to MAXDADOSPARTEFICHA do
                folha [1]^.dado [i] := '';

            nc := 0;
            while s <> '' do
                begin
                    p := pos (^i, s);
                    if p = 0 then p := length (s)+1;
                    valorCampo := copy (s, 1, p-1);
                    delete (s, 1, p);
                    trim (valorCampo);
                    nc := nc + 1;
                    folha [1]^.dado [nc] := valorCampo;
                end;

        end;
end;

{--------------------------------------------------------}
{                   exporta registros
{--------------------------------------------------------}

procedure importa;
var tipo, c, c2: char;
    i: integer;
    arqOrig, nomeOrig, s: string;
    lidos: integer;
begin
    mensagem ('TMNOMORG', 1);   {'Informe o arquivo txt original'}
    sintReadln (nomeOrig);

    if nomeOrig = '' then
        begin
            mensagem ('TMDESIST', 1);   {'desistiu'}
            exit;
        end;

    assign (arq, nomeOrig);
    {$I-} reset (arq);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('TMNAOEXS', 1);   {'Arquivo não existe'}
            exit;
        end;

    mensagem ('TMVEIOTM', 0);           {'Arquivo foi gerado no programa Telemark ? '}
    c := sintReadkey;
    writeln (c);
    arqVeioDoTelemark := upcase(c) = 'S';

    lidos := 0;
    while not eof (arq) do
        begin
            readln (arq, s);
            if (s <> '') and (copy (s, 2, 2) <> ':\') then
                begin
                    lidos := lidos + 1;
                    destroiFicha (fichaAtual);
                    criaFicha (fichaAtual);

                    importaReg (s);
                    gravaFicha (fichaAtual);
                end;
        end;
    close (arq);

    leCadastro;
    sintWriteln ('ok');

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

end.