{--------------------------------------------------------}
{    Programa de captura de leitura
{    Autor: José Antonio Borges
{    Em 30/9/99
{--------------------------------------------------------}

{$M 16536,8192}
{$R captxt.res}
program captxt;

uses dvcrt, dvwin, dvmacro, dvexec,
     winprocs, wintypes, strings, win31;

var minhaJan, janProg: hwnd;
    monitorAtivo: boolean;
    capturando: boolean;
    arq: text;

{---------------------------------------------------------------------}

procedure trocaJan (j: hWnd);
var vezes: integer;
begin
    if not isWindow (j) then exit;

    setActiveWindow (j);
    vezes := 1;
    while (vezes < 20) and (getActiveWindow <> j) and (isWindow (j)) do
        begin
            delay (100);
            vezes := vezes + 1;
        end;
end;

{---------------------------------------------------------------------}

procedure cancelaMonitor;
var janMonitor, janAtual: hWnd;
begin
    janMonitor := findWindow (NIL, 'MONITVOX');
    monitorAtivo := janMonitor <> 0;
    janAtual := getActiveWindow;
    if monitorAtivo then
        begin
            showWindow (janMonitor, sw_maximize);
            playInit (300);
            playVirtKey (VK_F4, false, false, true, 1);
            playStart;
            while  playIsActive do;
        end;
    setActiveWindow (janAtual);
end;

{--------------------------------------------------------}

procedure recuperaMonitor;
var i: integer;
begin
    if monitorAtivo then
        begin
            executaProg (sintAmbiente ('DOSVOX', 'MONITOR'), '', '');
            setActiveWindow (minhaJan);   { para evitar problemas }

            for i := 1 to 20 do
                begin
                   keypressed;
                   setActiveWindow (janProg);
                   keypressed;
                   if getActiveWindow = janProg then
                       exit;
                   delay (100);
                end;
        end;
end;

{--------------------------------------------------------}

function pegaLinha: string;
var linha: array [0..255] of char;
begin
    trocaJan (janProg);

    putClipBoard ('');
    playInit (300);
    playVirtKey (VK_HOME, false, false, false, 1);
    playVirtKey (VK_END, false, true, false, 1);
    playVirtKey (VK_INSERT, true, false, false, 1);
    playStart;
    while  playIsActive do;

    delay (200);
    getClipBoard (linha, 254);
    pegaLinha := strPas(linha);

    trocaJan (minhaJan);
end;

{---------------------------------------------------------------------}

procedure enviaCarac (carac: word);
begin
    trocaJan (janProg);

    playInit (300);
    playVirtKey (carac, false, false, false, 1);
    playStart;
    while  playIsActive do;

    trocaJan (minhaJan);
end;

{---------------------------------------------------------------------}

procedure reenviaLinha (s: string; perguntando: boolean);
var resp: char;
begin
    if perguntando then
        begin
            textBackground (RED);
            sintWrite ('Linha alterada, envia ? ');
            resp := upcase(sintReadkey);
            textBackground (BLACK);
            writeln (resp);
            if resp <> 'S' then exit;
        end;

    trocaJan (janProg);

    s := s + #$0;
    putClipBoard (@s[1]);

    playInit (300);
    playVirtKey (VK_HOME, false, false, false, 1);
    playVirtKey (VK_END, false, true, false, 1);
    playKey (' ', 1);
    playVirtKey (VK_BACK, false, false, false, 1);
    playVirtKey (VK_INSERT, false, true, false, 1);
    playStart;
    while  playIsActive do;

    trocaJan (minhaJan);
end;

{--------------------------------------------------------}

const
    INSEREDEPOIS   = 0;
    INSEREANTES    = 1;

procedure insereLinha (opcao: integer);
var resp: char;
begin
    sintClek;

    trocaJan (janProg);

    playInit (300);
    if opcao = INSEREANTES then
        begin
            textBackground (RED);
            sintWrite ('Linha inserida antes dessa');
            textBackGround (BLACK);
            writeln;

            playVirtKey (VK_END, false, false, false, 1);    { para desmarcar bloco }
            playVirtKey (VK_HOME, false, false, false, 1);
            playVirtKey (VK_RETURN, false, false, false, 1);
            playVirtKey (VK_UP, false, false, false, 1);
        end
    else
    if opcao = INSEREDEPOIS then
        begin
            textBackground (RED);
            sintWrite ('Nova linha');
            textBackGround (BLACK);
            writeln;

            playVirtKey (VK_END, false, false, false, 1);
            playVirtKey (VK_RETURN, false, false, false, 1);
        end;

    playStart;
    while  playIsActive do;

    trocaJan (minhaJan);
end;

{--------------------------------------------------------}

procedure removeLinha;
var resp: char;
begin
    textBackground (RED);
    sintWrite ('Confirma remoção de linha ? ');
    resp := upcase (sintReadkey);
    textBackground (BLACK);
    writeln (resp);

    if resp <> 'S' then exit;

    trocaJan (janProg);

    playInit (600);
    playVirtKey (VK_HOME, false, false, false, 1);
    playVirtKey (VK_END, false, true, false, 1);
    playKey (' ', 1);
    playVirtKey (VK_BACK, false, false, false, 1);
    playVirtKey (VK_DELETE, false, false, false, 1);
    playStart;
    while  playIsActive do;

    trocaJan (minhaJan);
end;

{--------------------------------------------------------}

procedure controlaCaptura;
var nomeArqCap: string;
begin
    capturando := not capturando;

    if capturando then
        begin
            textBackground (RED);
            sintWrite ('Nome do arquivo de captura');
            textBackground (BLACK);
            writeln;
            sintReadln (nomeArqCap);
            if nomeArqCap = '' then exit;

            assign (arq, nomeArqCap);
            {$I-}  reset (arq);  {$I+}
            if ioresult = 0 then
                begin
                    close (arq);
                    append (arq);
                end
            else
                begin
                    {$I-}  rewrite (arq);  {$I+}
                    if ioresult = 0 then
                         begin
                             sintWriteln ('Erro no arquivo de captura');
                             capturando := false;
                         end;
                end;
        end
    else
        begin
            close (arq);
            textBackground (RED);
            sintWrite ('Fim da captura');
            textBackground (BLACK);
            writeln;
        end;
end;

{---------------------------------------------------------------------}

procedure enviaTexto;
var c, c2: char;
    arqEnvia: text;
    s: string;
    nomeArq: string;
    primeira, comEnter: boolean;
begin
    sintWriteln ('Qual o arquivo de texto a enviar ? ');
    sintReadln (nomeArq);
    if nomeArq = '' then
        begin
            sintWriteln ('Desistiu');
            exit;
        end;

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

    sintWriteln ('Teclo ENTER ao fim de todas as linhas ? ');
    sintLetecla (c, c2);
    writeln;
    comEnter := upcase(c) = 'S';

    trocaJan (janProg);

    playInit (300);
    playVirtKey (VK_END, false, false, false, 1);   {desmarca bloco}
    playVirtKey (VK_HOME, false, false, false, 1);
    playStart;
    while  playIsActive do;

    primeira := true;
    while not eof (arq) do
        begin
            readln (arq, s);
            if not primeira then
                if (s = '') or (s[1] = ' ') or (s[1] = TAB) then
                    begin
                        playInit (300);
                        playVirtKey (VK_RETURN, false, false, false, 1);
                        if comEnter and (s = '') then
                            playVirtKey (VK_RETURN, false, false, false, 1);
                        playStart;
                        while playIsActive do;
                    end
                else
                    begin
                        if comEnter then
                            playVirtKey (VK_RETURN, false, false, false, 1)
                        else
                            s := ' ' + s;
                    end;

            primeira := false;

            if eof (arq) then s := s + #$0d;
            s := s + #$0;
            putClipBoard (@s[1]);

            playInit (300);
            playVirtKey (VK_INSERT, false, true, false, 1);
            playStart;
            while  playIsActive do;
        end;

    trocaJan (minhaJan);;
end;

{---------------------------------------------------------------------}

var s, salva: string;
    resp, c: char;
label fim;
begin
    janProg := getActiveWindow;

    screenSize.y := 3;
    textBackGround (BLUE);
    writeln ('Capturador de linhas para o DOSVOX - ESC termina');
    textBackGround (BLACK);
    checkBreak := false;

    sintInic (0, '');
    sintBip;
    capturando := false;

    minhaJan := getActiveWindow;
    cancelaMonitor;

    repeat
        salva := pegaLinha;
        while (salva <> '') and (salva [length (salva)] = ' ') do
            delete (salva, length (salva), 1);
        s := salva;

        if s = '' then sintclek;

        write (copy (s, 1, 79));
        sintetiza (s);

        if not isWindow (janProg) then goto fim;
        c := sintEditaCampo (s, 1, wherey, 200, 80, true);
        writeln;

        if not isWindow (janProg) then goto fim;
        if (c <> ESC) and (s <> salva) then
             if (c = ENTER) or (salva = '') then
                 reenviaLinha (s, false)
             else
                 reenviaLinha (s, true);

        if capturando then
             writeln (arq, s);

        case c of
              F2: enviaTexto;
              F3: controlaCaptura;

           ENTER: ;

              F6: insereLinha (INSEREDEPOIS);
           CTLF6: insereLinha (INSEREANTES);

              F7: removeLinha;

            BAIX: enviaCarac (VK_DOWN);
            CIMA: enviaCarac (VK_UP);
            PGDN: enviaCarac (VK_NEXT);
            PGUP: enviaCarac (VK_PRIOR);
        end;
    until c = ESC;

fim:
    sintBip;  sintBip;
    sintFim;

    recuperaMonitor;
    doneWinCrt;
end.
