{--------------------------------------------------------}
{    Programa WordUtil
{    Interface com o Word
{    Biblioteca de opcoes do menu Arquivo
{--------------------------------------------------------}

unit WuMeArq;

interface

uses dvcrt,winprocs,strings,WuUtil,wintypes,dvwin,
     dvmacro, WuVars, WuArquiv, WuMensa;

procedure menuArquivar;
procedure importar (param:boolean);

implementation

{---------------------------}
function novoArquivo:boolean;
{---------------------------}
var
   Conseguiu_Criar:boolean;
   p:integer;
   path :string;
begin
   textcolor (WHITE); textbackground (RED);
   mensagem ('wunonoar',0); {Qual o nome do novo arquivo }
   textcolor (7); textbackground (BLACK);
   SintReadln (Nome_Arq);

   (* usa o diretorio de trabalho *)
   if pos ('\',Nome_Arq) = 0 then
      begin
         GetDir (0,path);
         Nome_Arq := path + '\' + Nome_Arq;
      end;

   tipo_Arq := 'doc';
   p := pos ('.', Nome_Arq);

   if p <> 0 then
       tipo_Arq := copy (Nome_Arq, p + 1, 999);

   Conseguiu_Criar := CriaNovo (Nome_Arq,Tipo_Arq);

   if not Conseguiu_Criar then
      begin
         mensagem ('wunacrar',1);  {Não foi possivel criar esse arquivo.}
         novoArquivo := false;
      end
   else
      begin
         Novo_Modulo := 'edicao';
         mensagem ('wuarno',1);   {Arquivo novo}
         novoArquivo := true;
      end;
end;

{---------------------------------------------------------}
procedure importar (param:boolean);   { importa texto txt }
{---------------------------------------------------------}
var c, c2: char;
    arqEnvia: text;
    s1,s: string;
    nomeArq: string;
    primeira, abriu, comEnter: boolean;
    arq:text;
    new_jan:hwnd;
    cont,i:integer;
    marcado:boolean;
    tecleiEnter:boolean;

begin
    if param then
       begin
          mensagem ('wuquteen',0); {Qual o arquivo de texto a enviar ? }
          sintReadln (nomeArq);
          if nomeArq = '' then
             begin
                mensagem ('wudesi',1);  {Desistiu}
                exit;
             end;
       end
    else
       nomeArq := '\dosvox\~temp._t_';

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

    if param then
       begin
          mensagem ('wuteenli',0);  {Teclo ENTER ao fim de todas das linhas ?}
          c := sintReadKey;
          writeln (c);
          comEnter := upcase(c) = 'S';
       end
    else
       begin
          comEnter := false;
          c2 := 'n';
       end;

    if (novo_Modulo = 'leitura') then
       mensagem ('wumolemu',1); {voce esta em modulo de leitura }
                                { Esta operacao nao pode ser feita.}
                                { Mude para o modulo de edicao ou importe para um novo arquivo.}


    if (novo_modulo <> 'edicao') or not abriu then
       exit;

    if param then
       mensagem ('wuagua',1);  {Aguarde um momento}

    trocaJanela (jan_Prog);

    if param then
       begin
          playInit (300);
          {desmarca bloco}
          playVirtKey (VK_HOME, false, false, false, 1);
          playStart;
          while  playIsActive do;
       end;

    s1 := '';
    tecleiEnter := false;

    while not eof (arq) do
       begin
          (* utiliza o clack na abertura *)
          cont := cont + 1;
          if cont = 2 then
             begin
                cont := 0;
                sintClek;
             end;

          readln (arq, s);

          tecleiEnter := false;

          cont := 1;

          if (s = '') or (s[1] = ' ') or (s[1] = TAB) then
             begin

                (* retira o espaco no inicio da linha se houver apenas um *)
                if (s [1] = ' ') and (s [2] <> ' ') and (s [0] <> #0) then
                   delete (s,1,1);

                (* conta a quantidade de espacos em branco no inicio *)
                if (s [1] = ' ') and (s [2] = ' ') and (s [0] <> #0) then
                   while (s [cont] = ' ') do cont := cont + 1;

                (* retira o excesso de espacos em branco *)
                while pos ('  ',s) > 0 do
                   delete (s,pos ('  ',s),1);


                (* cria um novo paragrafo *)
                playInit (300);
                playVirtKey (VK_RETURN, false, false, false, 1);

                (* se houver uma linha em branco *)
                if (s = '') then
                   playVirtKey (VK_RETURN, false, false, false, 1);

                playStart;
                while playIsActive do;

                tecleiEnter := true;

             end
          else  (* se nao for para criar outro paragrafo *)
             begin

                (* retira o excesso de espacos em branco *)
                while pos ('  ',s) > 0 do
                   delete (s,pos ('  ',s),1);

                if comEnter then
                   begin
                      playInit (300);
                      playVirtKey (VK_RETURN, false, false, false, 1);
                      playStart;
                      while playIsActive do;
                   end
                else
                   s := ' ' + s;
             end;

          primeira := false;

          if eof (arq) and (param) then s := s + #$0d;
             s := s + #$0;

          putClipBoard (@s[1]);

          if cont > 1 then
             for i := 1 to cont do
                enviaCarac (VK_SPACE);

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

       end;

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

    trocaJanela (Minha_Jan);;
    if param then
       mensagem ('wuimp',1) { importei }

    else
       begin
          erase (arq);
          mensagem ('wuedit',1); { editado }
       end;

end;

{--------------------------------------------------------}
procedure FecharArquivo2;   { fecha o arquivo sem salvar }
{--------------------------------------------------------}

var
   opc:char;
begin
   trocaJanela (Jan_Prog);

   playInit (300);
   playVirtKey (VK_F4, true, false, false, 1);
   playStart;
   while  playIsActive do;
   delay (50);

   (* se apareceu alguma mensagem *)

   trocaJanela (Minha_Jan);
end;

{--------------------------------------------------------------------}
function salvarComo:boolean;   { salva um arquivo com os novos dados }
{--------------------------------------------------------------------}
var
   path :string;
   p:integer;
   New_Jan:hwnd;
   nomeJan,nome :array [0..256] of char;
   tipo :array [0..3]   of char;

label cancel;
begin
   textcolor (WHITE); textbackground (RED);
   mensagem ('wuqunome',0); { Qual o nome do arquivo :}
   textcolor (7); textbackground (BLACK);
   SintReadln (Nome_Arq);

   if Nome_Arq = '' then
      begin
         mensagem ('wucancel',1);
         goto cancel;
      end;

   (* usa o diretorio de trabalho *)
   if pos ('\',Nome_Arq) = 0 then
      begin
         GetDir (0,path);
         Nome_Arq := path + '\' + Nome_Arq;
      end;

   tipo_Arq := 'DOC';
   p := pos ('.', Nome_Arq);

   if p <> 0 then
       tipo_Arq := copy (Nome_Arq, p + 1, 999);

   p := pos ('.', Nome_Arq);
   if p = 0 then
      Nome_Arq := Nome_Arq + '.' + tipo_Arq;

   strpcopy (nome,Nome_Arq);
   putClipBoard (nome);

   mensagem ('wuagua',1); { Aguarde um momento. }

   setActiveWindow (Jan_Prog);
   repeat keypressed until getActiveWindow = Jan_Prog;

   (* Regrava com outro nome *)
   playInit (300);
   playVirtKey (ord ('A'), false, false, true, 1);
   playStart;
   while  playIsActive do;
   delay (100);

   enviaCarac (ord ('C'));

   (* colando o nome do arquivo *)
   playInit (300);
   playVirtKey (VK_INSERT, false, true, false, 1);
   playStart;
   while  playIsActive do;
   delay (100);

   New_Jan := getActiveWindow;

   (* muda para o tipo do arquivo *)
   enviaCarac (VK_TAB);

   enviaCarac (ord ('C'));
   enviaCarac (VK_HOME);

   strPcopy (tipo,Tipo_Arq);

   ansiUpper (tipo);
   (* seleciona o tipo de arquivo *)
   if strComp (tipo, 'DOC') = 0 then
      enviaCarac (ord ('D'))
   else
      begin
         delay (500);
         enviaCarac (ord ('S'));
         delay (500);
         enviaCarac (ord ('S'));
         delay (100);
      end;


   (* comeca a abertura *)
   enviaCarac (VK_RETURN);

   playInit (300);
   playVirtKey (ord ('S'), false, false, true, 1);
   playStart;
   while  playIsActive do;
   delay (100);

   (* espera tentar abrir *)
   delay (500);

    getwindowtext (getActiveWindow,nomeJan,80);
    if pos ('Micro',strpas (nomeJan)) <> 0 then
      enviaCarac (ord ('S'));

    if pos ('Propriedades',strpas (nomeJan)) <> 0 then
      keyBoardClick (ENTER);

   (* se conseguiu criar *)
   if not getActiveWindow = Jan_Prog then
      begin

         getwindowtext (getActiveWindow,nomeJan,80);

         if pos ('Propriedades',strpas (nomeJan)) <> 0 then
            enviaCarac (VK_RETURN)

         else
            begin

            enviaCarac (ord ('S'));


               delay (100);
                  if ( not getActiveWindow = Jan_Prog ) and (not getActiveWindow = New_Jan) then
                     begin
                        enviaCarac (VK_ESCAPE);
                        delay (100);
                     end;
            end;

         if getActiveWindow = New_Jan then
            begin
               mensagem ('wuarnasa',1);
               goto cancel;
            end;

         setActiveWindow (Minha_Jan);
         repeat keypressed until getActiveWindow = Minha_Jan;

         salvarComo := false;

         mensagem ('wuarnasa',1);  { O arquivo nao foi salvo. }

      end
   else
      begin
         setActiveWindow (Minha_Jan);
         repeat keypressed until getActiveWindow = Minha_Jan;

         salvarComo := true;

         mensagem ('wuarsa',1);   { Arquivo salvo. }
      end;
cancel:
end;

{--------------------------------------------------------}
procedure exportar;  { exporta um texto do word para txt }
{--------------------------------------------------------}
var
   continua  :char;
   conseguiu :boolean;
   arqs      :string;
   arqc      :array [0..256] of char;
begin
   textcolor (WHITE); textbackground (BLUE);
   mensagem ('wuesfear',0);   { Este comando fechara automaticamente o seu arquivo.}
   textcolor (7); textbackground (BLACK);
   writeln;
   textcolor (WHITE); textbackground (BLUE);
   mensagem ('wudeco',0);  { Deseja cantinuar? }
   textcolor (7); textbackground (BLACK);
   continua := upcase (sintReadKey);
   writeln (continua);

   (* se vai continuar a operacao *)
   if continua = 'S' then
      begin
         (* salva o arquivo como txt *)
         conseguiu := salvarComo;

         (* se conseguiu salvar como txt *)
         if conseguiu then
            begin
               (* fecha o arquivo *)
               trocaJanela (Jan_Prog);

               playInit (300);
               playVirtKey (VK_F4, true, false, false, 1);
               playStart;
               while  playIsActive do;
               delay (50);
               enviaCarac (ord ('S'));
               enviaCarac (ord ('S'));

               trocaJanela (Minha_Jan);
               mensagem ('wuextx',1);   { Exportado para txt. }
            end;
      end
   else
      mensagem ('wudesi',1)  { Desistiu. }
end;


{---------------------------------------}
procedure abrir;    { abre um arquivo   }
{---------------------------------------}
var
   conseguiu:boolean;
   path:string;
   p:integer;

label cancelado;

begin

   (*  nome do arquivo *)
   textcolor (WHITE); textbackground (BLUE);
   mensagem ('wuqunome',0);   { Qual o nome do arquivo : }
   textcolor (7); textbackground (BLACK);
   SintReadln (Nome_Arq);

    (* cancelou a abertura *)
    if Nome_Arq = '' then
       begin
          conseguiu := false;
          mensagem ('wuabca',1);   { Abertura  cancelada }
          goto cancelado;
       end;

   (* usa o diretorio de trabalho *)
   if pos ('\',Nome_Arq) = 0 then
      begin
         GetDir (0,path);
         Nome_Arq := path + '\' + Nome_Arq;
      end;

   tipo_Arq := 'doc';
   p := pos ('.', Nome_Arq);

   if p <> 0 then
       tipo_Arq := copy (Nome_Arq, p + 1, 999);

   conseguiu := AbrirArquivo (Nome_Arq,Tipo_Arq);
   if conseguiu then
      mensagem ('wuarab',1)     { Arquivo aberto }
   else
      mensagem ('wunaabar',1);   { Nao foi possivel abrir o arquivo }
cancelado:
end;

{-----------------------}
procedure arquivarAjuda;
{-----------------------}
begin
   mensagem ('wumearn',1);   { N - arquivo novo }
   mensagem ('wumeara',1);   { A - abrir }
   mensagem ('wumearf',1);   { F - fechar arquivo }
   mensagem ('wumears',1);   { S - salvar }
   mensagem ('wumearc',1);   { C - salvar como }
   mensagem ('wumeare',1);   { E - exportar para formato txt }
   mensagem ('wumeari',1);   { I - importar para formato txt }
   while sintFalando do;
end;

{-----------------------------------------------------}
procedure menuArquivar;   { funcoes do menu arquivar  }
{-----------------------------------------------------}
var
   op:char;

label retorno;
begin

retorno:

   textcolor (WHITE); textbackground (RED);
   mensagem ('wumearop',0);    { Menu Arquivar, qual sua opcao? }
   textcolor (7); textbackground (BLACK);

   op := sintReadKey;
   writeln (op);
   if op = #$0 then
      op := ReadKey;

   if op = F9 then while keypressed do;

   case upcase (op) of
      (* so permite a substituicao se estiver no modulo de edicao *)
      'E': exportar; (* exportar para txt *)
      'I': importar (true); (* importar para txt *)
      'N': novoArquivo;
      'S': salva;
      'C': salvarComo;
      'F': FecharArquivo;
      'A': abrir;
      ESC: mensagem ('wucoca',1);   { Comando cancelado. }
      F1 : begin
              arquivarAjuda;
              goto retorno;
           end;
      else
         mensagem ('wuopin',1);    { Opcao invalida. }
   end;
end;
end.
