{--------------------------------------------------------}
{    Programa WordWtil
{    Interface com o Word
{    Biblioteca de opcoes de fonte
{--------------------------------------------------------}

unit WuMeFo;

interface

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

Procedure menuFontes;
procedure modificaBloco (c:char);

implementation


{------------------------------------------------------------------------}
function alteraFonte:boolean;   { autera a fonte de um determinado bloco }
{------------------------------------------------------------------------}
var
   opcao:char;
   fontec:array [0..30] of char;
   New_Jan:hwnd;

label cancelou;

begin
   trocaJanela (Jan_Prog);

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

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

   New_Jan := getActiveWindow;

   repeat

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

      getClipBoard (fonteC, 254);

      trocaJanela (Minha_Jan);
      mensagem ('wufo',0); { Fonte: } sintWriteln (strPas (fontec));

      opcao := ReadKey;
      if opcao = #$0 then
         opcao := ReadKey;

      opcao := upcase (opcao);

      trocaJanela (New_Jan);

      if opcao = CIMA then
         enviaCarac (VK_UP)
      else if opcao = BAIX then
         enviaCarac (VK_DOWN)
      else if opcao = ESC then
         begin
            alteraFonte := false;
            enviaCarac (VK_ESCAPE);
            goto cancelou;
         end;

   until (opcao = ENTER) or (opcao = ESC);

   keyBoardClick (ENTER);
   alteraFonte := true;

   trocaJanela (Minha_Jan);

cancelou:
end;

{--------------------------------------------------------}
procedure alteraTamanhoFonte;   { altera tamanho a fonte }
{--------------------------------------------------------}
var
   erro,cont,tamanho_Int:integer;
   tamanho_Char: array [0..3] of char;
   tamanho_String:string;
   tecla :char;
   New_Jan:hwnd;
label cancel;
begin
   cont := 0;
   tamanho_Char [0] := #$0;

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


   New_Jan := getActiveWindow;

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

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

   (* pega o tamanho atual *)
   getClipBoard (tamanho_Char,4);

   (* transforma o tamanho atual em inteiro *);
   val (strPas (tamanho_Char),tamanho_Int,erro);

   (* almenta de duas unidades o tamanho atual *);

   trocaJanela (Minha_Jan);

   mensagem ('wutaan',0); { Tamanho antigo } sintWriteln (strPas (tamanho_Char));
   mensagem ('wutano',0);  { Novo tamanho }

   repeat
      tecla := ReadKey;
      if tecla = #$0 then
         tecla := readkey;

      tecla := upcase (tecla);

      if tecla = CIMA then
         begin
            tamanho_Int := tamanho_Int + 1;
            str (tamanho_Int,tamanho_String);
            sintWriteln (tamanho_string);
         end
      else if tecla = BAIX then
         begin
            tamanho_Int := tamanho_Int - 1;
            str (tamanho_Int,tamanho_String);
            sintWriteln (tamanho_string);
         end
      else if tecla = 'E' then
         begin
            writeln;
            mensagem ('wutano',1);    { Novo tamanho: }
            sintReadln (tamanho_string);
            val (tamanho_String,tamanho_Int,erro);

            (* digitou um valor que nao e numerico *)
            if erro <> 0 then
               begin
                  mensagem ('wucancel',1);  { cancelado. }
                  trocaJanela (New_Jan);
                  enviaCarac (VK_ESCAPE);
                  goto cancel;
               end;

            tecla := ENTER;
         end
      else if (tecla = ESC) or (tecla = ENTER) then
         keypressed
      else
         mensagem ('wucoin',1);    { comando invalido }

   until (tecla = ENTER) or (tecla = ESC);

   if tecla = ESC then
      begin
         mensagem ('wucancel',1);  { Cancelado. }
         trocaJanela (New_Jan);
         enviaCarac (VK_ESCAPE);
         goto cancel;
      end;
   (* envia o novo tamanho para o word *);

   trocaJanela (New_Jan);

   str (tamanho_Int,tamanho_String);

   strPcopy (tamanho_Char, tamanho_string);

   putClipBoard (tamanho_Char);

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

   keyBoardClick (ENTER);

cancel:
end;

{------------------------------------------------------------}
procedure veriFonte; { verifica a fonte que esta sendo usada }
{------------------------------------------------------------}
var
   char_font     : array [0..20] of char;
   string_font   : string;
   char_tipo     : array [0..20] of char;
   string_tipo   : string;
   char_tamanho  : array [0..20] of char;
   string_tamanho: string;
   i:integer;

begin

   trocaJanela (jan_Prog);

   enviaCarac (VK_HOME);

   for i := 0 to (sintCursorX - 2) do
      enviaCarac (VK_RIGHT);


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

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

   getClipBoard (char_font,30);
   string_font := strPas (char_font);

   enviaCarac (VK_TAB);

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

   getClipBoard (char_tipo,30);
   string_tipo := strPas (char_tipo);

   enviaCarac (VK_TAB);

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

   getClipBoard (char_tamanho,30);
   string_tamanho := strPas (char_tamanho);

   enviaCarac (VK_ESCAPE);

   trocaJanela (minha_Jan);

   mensagem ('wufont',0);  { Fonte } sintWriteln (string_font);
   mensagem ('wutipo',0);  { Tipo  } sintWriteln (string_tipo);

   mensagem ('wutama',0);  { Tamanho } sintWriteln (string_tamanho);

end;

{-------------------------------------------------------------------}
procedure fonteNova;     { altera a fonte de uma determinada regiao }
{-------------------------------------------------------------------}
var
   opc :char;
   isolou:boolean;

label fim;
begin
   repeat
      textcolor (WHITE); textbackground (BLUE);
      mensagem ('wualtoq',0);     { O que deseja alterar ? }
      textcolor (7); textbackground (BLACK);

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


      opc := upcase (opc);

      if opc = F1 then
         blocoAjuda;

   until (opc = 'T') or (opc = ESC) or (opc = 'L') or (opc = 'P');

   trocaJanela (Jan_Prog);

   if opc = ESC then
      goto fim
   else if opc = 'T' then
      marcaTudo
   else if opc = 'L' then
      marcaLinha
    else if opc = 'P' then
      begin
         isolou := isolaPalavra;
         trocaJanela (Jan_Prog);
         (* se foi cancelado o isolamento *)
         if not isolou then
            begin
               opc := ESC;
               goto fim;
            end;
         marcaLinha;
      end;

   (* altera a fonte do bloco marcado *)
   isolou := alteraFonte;

   if not isolou then
      opc := ESC;

   (* desmarcando *)
   enviaCarac (VK_LEFT);

   if opc = 'P' then
      juntaAsLinhas;

fim:

   trocaJanela (Minha_Jan);

   if opc = ESC then
      mensagem ('wucoca',1)    { Comando cancelado }
   else
      mensagem ('wufoalt',1);    { Fonte auterada. }
end;

{------------------------------------------------------------------------}
procedure modificaBloco (c:char); { modifica a fonte de um bloco marcado }
{------------------------------------------------------------------------}
begin
   (* menu formatar *)
   playInit (300);
   playVirtKey (ord ('D'), true, false, false, 1);
   playStart;
   while  playIsActive do;
   delay (50);

   (* opcao de estio do fonte *)
   playInit (300);
   playVirtKey (ord ('A'), false, false, true, 1);
   playStart;
   while  playIsActive do;
   delay (50);

   if c = 'N' then
      putClipBoard ('Negrito')
   else if c = 'T' then
      putClipBoard ('Negrito Itálico')
   else if c = 'I' then
      putClipBoard ('Itálico')
   else if c = 'C' then
      putClipBoard ('Normal');

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

   if c = 'C' then
      begin
         playInit (300);
         playVirtKey (ord ('U'), false, false, true, 1);
         playStart;
         while  playIsActive do;
         delay (50);

         enviaCarac (VK_HOME);

         enviaCarac (VK_RETURN);
      end;

   keyBoardClick (ENTER);

end;


{--------------------------------------------------------}
procedure negritar;     { negrita uma determinada regiao }
{--------------------------------------------------------}
var
   opc :char;
   isolou:boolean;

label fim;
begin
   repeat
      textcolor (WHITE); textbackground (BLUE);
      mensagem ('wuneoq',0);   { O que deseja negritar ? }
      textcolor (7); textbackground (BLACK);

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


      opc := upcase (opc);

      if opc = F1 then
         blocoAjuda;

   until (opc = 'T') or (opc = ESC) or (opc = 'L') or (opc = 'P');

   trocaJanela (Jan_Prog);

   if opc = ESC then
      goto fim
   else if opc = 'T' then
      marcaTudo
   else if opc = 'L' then
      marcaLinha
   else if opc = 'P' then
      begin
         isolou := isolaPalavra;
         trocaJanela (Jan_Prog);
         (* se foi cancelado o isolamento *)
         if not isolou then
            begin
               opc := ESC;
               goto fim;
            end;
         marcaLinha;
      end;

    (* negrita o bloco marcado *)
    modificaBloco ('N');

   (* desmarcando *)
   enviaCarac (VK_LEFT);

   if opc = 'P' then
      juntaAsLinhas;

fim:
   trocaJanela (Minha_Jan);

   if opc = ESC then
      mensagem ('wucoca',1)      { Comando cancelado }
   else
      mensagem ('wunegri',1);   { Negritei }
end;


{-------------------------------------------------------------------------}
procedure alterar;     { altera o tamanho da fonte uma determinada regiao }
{-------------------------------------------------------------------------}
var
   opc :char;
   isolou:boolean;

label fim;
begin
   repeat
      textcolor (WHITE); textbackground (BLUE);
      mensagem ('wualtade',0);   { Do que deseja alterar o tamanho? }
      textcolor (7); textbackground (BLACK);

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

      opc := upcase (opc);

      if opc = F1 then
         blocoAjuda;

   until (opc = 'T') or (opc = ESC) or (opc = 'L') or (opc = 'P');

   trocaJanela (Jan_Prog);

   if opc = ESC then
      goto fim
   else if opc = 'T' then
      marcaTudo
   else if opc = 'L' then
      marcaLinha
   else if opc = 'P' then
      begin
         isolou := isolaPalavra;
         trocaJanela (Jan_Prog);
         (* se foi cancelado o isolamento *)
         if not isolou then
            begin
               opc := ESC;
               goto fim;
            end;
         marcaLinha;
      end;

    (* negrita o bloco marcado *)
    alteraTamanhoFonte;

   (* desmarcando *)
   enviaCarac (VK_LEFT);

   if opc = 'P' then
      juntaAsLinhas;

fim:
   trocaJanela (Minha_Jan);

   if opc = ESC then
      mensagem ('wucoca',1)    { Comando cancelado. }
   else
      mensagem ('wualta',1);   { Alterei o tamanho }
end;

{----------------------------------------------------------}
procedure sublinhar;     { sublinha uma determinada regiao }
{----------------------------------------------------------}
var
   opc :char;
   isolou:boolean;

label fim;
begin
   repeat
      textcolor (WHITE); textbackground (BLUE);
      mensagem ('wusuoq',0);   { O que deseja sublinhar ? }
      textcolor (7); textbackground (BLACK);

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

      opc := upcase (opc);

      if opc = F1 then
         blocoAjuda;

   until (opc = 'T') or (opc = ESC) or (opc = 'L') or (opc = 'P');

   trocaJanela (Jan_Prog);

   if opc = ESC then
      goto fim
   else if opc = 'T' then
      marcaTudo
   else if opc = 'L' then
      marcaLinha
   else if opc = 'P' then
      begin
         isolou := isolaPalavra;
         trocaJanela (Jan_Prog);
         (* se foi cancelado o isolamento *)
         if not isolou then
            begin
               opc := ESC;
               goto fim;
            end;
         marcaLinha;
      end;

   (* sublinha o bloco marcado *)
   (* menu formatar *)
   playInit (300);
   playVirtKey (ord ('D'), true, false, false, 1);
   playStart;
   while  playIsActive do;
   delay (50);

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

   enviaCarac (ord ('S'));

   enviaCarac (VK_RETURN);

   keyBoardClick (ENTER);

   (* desmarcando *)
   enviaCarac (VK_LEFT);

   if opc = 'P' then
      juntaAsLinhas;

fim:

   trocaJanela (Minha_Jan);
   if opc = ESC then
      mensagem ('wucoca',1)   { Comando cancelado. }
   else
      mensagem ('wusu',1);    { Sublinhei }
end;

{------------------------------------------------------------}
procedure italinizar;     { italiniza uma determinada regiao }
{------------------------------------------------------------}
var
   opc :char;
   isolou:boolean;

label fim;
begin
   repeat
      textcolor (WHITE); textbackground (BLUE);
      mensagem ('wuitoq',0);  { O que deseja italinizar ? }
      textcolor (7); textbackground (BLACK);

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

      opc := upcase (opc);

      if opc = F1 then
         blocoAjuda;

   until (opc = 'T') or (opc = ESC) or (opc = 'L') or (opc = 'P');

   trocaJanela (Jan_Prog);

   if opc = ESC then
      goto fim
   else if opc = 'T' then
      marcaTudo
   else if opc = 'L' then
      marcaLinha
    else if opc = 'P' then
      begin
         isolou := isolaPalavra;
         trocaJanela (Jan_Prog);
         (* se foi cancelado o isolamento *)
         if not isolou then
            begin
               opc := ESC;
               goto fim;
            end;
         marcaLinha;
      end;

   (* italiniza o bloco marcado *)
   modificaBloco ('I');

   (* desmarcando *)
   enviaCarac (VK_LEFT);

   if opc = 'P' then
      juntaAsLinhas;

fim:

   trocaJanela (Minha_Jan);

   if opc = ESC then
      mensagem ('wucoca',1)   { Comando cancelado. }
   else
      mensagem ('wuit', 1);   { Italinizei }
end;


{------------------------------------------------------------}
procedure comum;     { letra comum de uma determinada regiao }
{------------------------------------------------------------}
var
   opc :char;
   isolou:boolean;

label fim;
begin
   repeat
      textcolor (WHITE); textbackground (BLUE);
      mensagem ('wutocooq',0);  { O que deseja tornar comum ? }
      textcolor (7); textbackground (BLACK);

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

      opc := upcase (opc);

      if opc = F1 then
         blocoAjuda;

   until (opc = 'T') or (opc = ESC) or (opc = 'L') or (opc = 'P');

   trocaJanela (Jan_Prog);

   if opc = ESC then
      goto fim
   else if opc = 'T' then
      marcaTudo
   else if opc = 'L' then
      marcaLinha

   else if opc = 'P' then
      begin
         isolou := isolaPalavra;
         trocaJanela (Jan_Prog);
         (* se foi cancelado o isolamento *)
         if not isolou then
            begin
               opc := ESC;
               goto fim;
            end;
         marcaLinha;
      end;

   (* torna comum o bloco marcado *)
   modificaBloco ('C');

   (* desmarcando *)
   enviaCarac (VK_LEFT);

   if opc = 'P' then
      juntaAsLinhas;

fim:

   trocaJanela (Minha_Jan);

   if opc = ESC then
      mensagem ('wucoca',1)   { Comando cancelado. }
   else
      mensagem ('wuleco',1);   { Letra comum }
end;


{---------------------------------------------------------------------------}
procedure negritoItalico;     { italiniza e negrita  uma determinada regiao }
{---------------------------------------------------------------------------}
var
   opc :char;
   isolou:boolean;

label fim;
begin
   repeat
      textcolor (WHITE); textbackground (BLUE);
      mensagem ('wuneitoq',0);  { O que deseja negritar e italicizar ? }
      textcolor (7); textbackground (BLACK);

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

      opc := upcase (opc);

      if opc = F1 then
         blocoAjuda;

   until (opc = 'T') or (opc = ESC) or (opc = 'L') or (opc = 'P');

   trocaJanela (Jan_Prog);

   if opc = ESC then
      goto fim
   else if opc = 'T' then
      marcaTudo
   else if opc = 'L' then
      marcaLinha

   else if opc = 'P' then
      begin
         isolou := isolaPalavra;
         trocaJanela (Jan_Prog);
         (* se foi cancelado o isolamento *)
         if not isolou then
            begin
               opc := ESC;
               goto fim;
            end;
         marcaLinha;
      end;

   (* italiniza o bloco marcado *)
   modificaBloco ('T');

   (* desmarcando *)
   enviaCarac (VK_LEFT);

   if opc = 'P' then
      juntaAsLinhas;

fim:

   trocaJanela (Minha_Jan);

   if opc = ESC then
      mensagem ('wucoca',1)   { Comando cancelado. }
   else
      mensagem ('wuneit',1);  { Negritei e Italicizei }
end;


{------------------------------------------}
procedure fontesAjuda;  { ajuda do sistema }
{------------------------------------------}
begin
    mensagem ('wumefov',1);   { V - verificar fonte atual. }
    mensagem ('wumefof',1);   { F - alterar fonte. }
    mensagem ('wumefoa',1);   { A - alterar tamanho da fonte. }
    mensagem ('wumefon',1);   { N - negritar. }
    mensagem ('wumefos',1);   { S - sublinhar. }
    mensagem ('wumefoi',1);   { I - italicizar. }
    mensagem ('wumefot',1);   { T - negrito italico. }
    mensagem ('wumefoc',1);   { C - letra comum. }
    while sintFalando do;

end;

{-----------------------------------------------------}
procedure menuFontes;   { comandos de pagina }
{-----------------------------------------------------}
var
   op:char;

label retorno;
begin

retorno:

   textcolor (WHITE); textbackground (RED);
   mensagem ('wumefo',0);  { menu fontes - 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
      'V': veriFonte;(* verificar fonte atual *)
      'F': begin
              if modulo = 'edicao' then fonteNova (* alterar fonte *)
              else mensagem ('wuesexed', 1); { Esse comando so pode ser executado em modulo de edicao }
           end;
      'A': begin
              if modulo = 'edicao' then alterar (* aumentar fonte *)
              else mensagem ('wuesexed', 1); { Esse comando so pode ser executado em modulo de edicao }
           end;
      'N': begin
              if modulo = 'edicao' then negritar  (* negritar *)
              else mensagem ('wuesexed', 1); { Esse comando so pode ser executado em modulo de edicao }
           end;
      'S': begin
              if modulo = 'edicao' then sublinhar (* sublinhar *)
              else mensagem ('wuesexed', 1); { Esse comando so pode ser executado em modulo de edicao }
           end;
      'I': begin
              if modulo = 'edicao' then italinizar (* italinizar *)
              else mensagem ('wuesexed', 1); { Esse comando so pode ser executado em modulo de edicao }
           end;
      'T': begin
              if modulo = 'edicao' then negritoitalico (* negrita e italiniza *)
              else mensagem ('wuesexed', 1); { Esse comando so pode ser executado em modulo de edicao }
           end;
      'C': begin
              if modulo = 'edicao' then comum  (* letra comun *)
              else mensagem ('wuesexed', 1); { Esse comando so pode ser executado em modulo de edicao }
           end;
      ESC: mensagem ('wucoca',1);  { Comando cancelado. }
      F1 : begin    (* ajuda do sistema *)
              fontesAjuda;
              goto retorno;
           end;
      else
         mensagem ('wuopin',1);   { Opcao invalida. }
   end;
end;

end.

