{--------------------------------------------------------}
{
{    Monitor de Janelas, teclado e menus
{
{    Por José Antonio Borges
{
{    Em 29/05/98
{
{--------------------------------------------------------}

program monitVox;
{$M 32000, 8192}

uses winprocs, wintypes, dvcrt, dvwin, strings, mmsystem;

function StartRecording: boolean;    far;   external 'DVKBLIB' index 2;
function StopRecording: boolean;     far;   external 'DVKBLIB' index 3;
function getRecordedChar: word;      far;   external 'DVKBLIB' index 4;

const debug = false;

var
    janAtiva, janFoco, janInibida: hWnd;
    classeJ: array [0..144] of char;
    terminou: boolean;
    saidaMenu, saidaAntMenu: string;
    vez: integer;

procedure mostraJanela (j, nivel: integer); forward;

{--------------------------------------------------------}
{                      inicializacao
{--------------------------------------------------------}

procedure inicializa;
var arq: file;
begin
    assign (arq, 'c:\calaboca.$$$');
    {$I-} erase (arq);  {$I+}
    if ioresult <> 0 then;

    if findWindow (NIL, 'MONITVOX') <> 0 then
        halt;                { evita dois monitvox }

    clrscr;
    setWindowText (crtWindow, 'MONITVOX');
    textBackground (BLUE);
    writeln ('Projeto DOSVOX - Monitor de janelas');
    textBackground (BLACK);
    showWindow (crtWindow, sw_minimize);

    sintInic (0, '');
    checkFocus := true;
    saidaAntMenu := '';
    janInibida := $ffff;
end;

{--------------------------------------------------------}
{           converte nomes para fala mais rapida
{--------------------------------------------------------}

function simplifica (s: string): string;
var final, palavra: string;
    p: integer;
    c: char;
begin
    final := '';
    while s <> '' do
        begin
             while (s <> '') and (s[1] = ' ') do
                 delete (s, 1, 1);

             if s <> '' then
                 begin
                     palavra := '';
                     while (s <> '') and (s[1] <> ' ') do
                         begin
                             palavra := palavra + copy (s, 1, 1);
                             delete (s, 1, 1);
                        end;

                    repeat
                        p := pos ('\', palavra);
                        if (p <> 0) and (p <> length (palavra)) then
                            delete (palavra, 1, p);
                    until (p = 0) or (p = length (palavra));

                    final := final + palavra + ' ';
                 end;

        end;

    while (length (final) > 0) and (final [length (final)] = ' ') do
        delete (final, length(final), 1);

    p := pos ('&', final);
    if p > 0 then
        begin
            c := final[p+1];
            delete (final, p, 1);
            saidaMenu := c + ^a + final;
        end;

    simplifica := final;
end;

{--------------------------------------------------------}
{              verifica se pode falar
{--------------------------------------------------------}

function acessoLivre: boolean;
var arq: file;
begin
    if getActiveWindow <> janInibida then
        janInibida := $ffff;

    acessoLivre := true;
    assign (arq, 'c:\calaboca.$$$');
    {$I-} reset (arq);  {$I+}
    if ioresult = 0 then
        begin
            acessoLivre := false;
            {$I-}  close (arq);  {$I+}
            if ioresult <> 0 then;
            {$I-} erase (arq); {$I+}
            if ioresult <> 0 then;

            getClassName (getActiveWindow, classeJ, 144);
            if strLiComp (classeJ, 'dvWinCrt', 8) = 0 then
                begin
                    delay (500);
                    getClassName (getActiveWindow, classeJ, 144);
                end;
            if strLiComp (classeJ, 'dvWinCrt', 8) <> 0 then
                janInibida := getActiveWindow;
        end;
end;

{--------------------------------------------------------}
{              mostra o titulo de uma janela
{--------------------------------------------------------}

procedure mostraTituloJan (j: hWnd);
var
    tituloAtual: array [0..144] of char;
    titulo: string;
begin
    getWindowText (j, tituloAtual, 144);
    titulo := strPas (tituloAtual);
    if debug then
        writeln (titulo);
    titulo := simplifica (titulo);

    if (titulo <> 'DOSVOX') and (titulo <> 'CLOCKVOX') and acessoLivre then
        begin
            while sintFalando do;
            sintetiza (titulo);
        end;
end;

{--------------------------------------------------------}
{           monitora janela ativa e do foco
{--------------------------------------------------------}

procedure monitoraJanAtiva;
var j, f: hWnd;
    classe: array [0..144] of char;
begin
     getClassName (getFocus, classe, 144);

     j := getActiveWindow;
     f := getFocus;
     if (janAtiva <> j) then
     begin
         janAtiva := j;
         mostraTituloJan (janAtiva);
     end;

     if (f <> janFoco) and (f <> j) then
         begin
             janFoco := f;
             sintBip;
             mostraJanela (f, -1);
         end;
end;

{--------------------------------------------------------}
{                monitora menu (recursiva)
{--------------------------------------------------------}

var
    textoMenu: array [0..144] of char;

procedure capturaMenu (m: hMenu; nivel: integer);
var
    i, p, nc, nelem: integer;
    status: word;
    sm: hMenu;
    c: char;
begin
    nelem := getMenuItemCount (m);
    for i := 0 to nelem-1 do
        begin
           status := getMenuState (m, i, MF_BYPOSITION);
           nc := GetMenuString(m, i, textoMenu, 144, MF_BYPOSITION);

           if ((status and MF_HILITE) <> 0) then
               begin
                   saidaMenu := strPas (textoMenu);
                   p := pos ('&', saidaMenu);
                   if p > 0 then
                       begin
                           c := saidaMenu[p+1];
                           delete (saidaMenu, p, 1);
{                           saidaMenu := c + ^a + saidaMenu;}
                       end;
                   p := pos ('...', saidaMenu);
                   if p > 0 then
                       begin
                           delete (saidaMenu, p, length (saidaMenu)-p+1);
                           saidaMenu := saidaMenu + '+';
                       end;
                   p := pos ('Alt+', saidaMenu);
                   if p > 0 then delete (saidaMenu, p, length (saidaMenu)-p+1);
                   p := pos ('Ctrl+', saidaMenu);
                   if p > 0 then delete (saidaMenu, p, length (saidaMenu)-p+1);

                   if ((status and MF_DISABLED) <> 0) or
                      ((status and MF_GRAYED) <> 0) then
                           saidaMenu := 'inibido ' + saidaMenu;

                   sm := getSubmenu (m, i);
                   if (sm <> 0) and ((status and MF_POPUP) <> 0) then
                        capturaMenu (sm, nivel+1);
               end;
        end;

    if debug then
        writeln ('Menu: ', saidaMenu);
end;

{--------------------------------------------------------}
{                    monitora menu
{--------------------------------------------------------}

procedure monitoraMenu;
var m: hMenu;
begin
    m := getMenu (janAtiva);
    if m <> 0 then
        begin
            saidaMenu := '';
            CapturaMenu (m, 1);
        end;
    if saidaMenu <> saidaAntMenu then
        begin
            saidaAntMenu := saidaMenu;
            if saidaMenu <> '' then
                sintetiza (saidaMenu);
            repeat until getRecordedChar = 0;
        end;
end;

{--------------------------------------------------------}
{             mostra a hierarquia de uma janela
{--------------------------------------------------------}

var
    nome, classe: array [0..255] of char;
    saida: string;
    tam, posic: integer;
    j: hWnd;

procedure mostraJanela (j, nivel: integer);
var i: hWnd;
    c: char;
    p: integer;
begin
    if j = 0 then exit;
    if nivel > 5 then exit;

    getClassName (j, classe, 255);
    getWindowText (j, nome, 255);
    if strlen (nome) <> 0 then
        begin
            if strComp (classe, 'Button') = 0 then
                sintetiza ('Botão');

            saida := strPas (nome);
            p := pos ('&', saida);
            if p > 0 then
                begin
                    c := saida[p+1];
                    delete (saida, p, 1);
                    saida := c + ^a + saida;
                end;
            sintetiza (saida);
        end;

    if strComp (classe, 'BorBtn') = 0 then
        begin
            case getDlgCtrlId (j) of
               1: sintetiza ('Botão OK');
               2: sintetiza ('Botão Cancel');
             998: sintetiza ('Botão Help');
            end;
        end;

    if strComp (classe, 'BorCheck') = 0 then
        begin
            case isDlgButtonChecked (getParent(j), getDlgCtrlId (j)) of
               0: sintetiza ('botão desligado');
               1: sintetiza ('botão ligado');
               2: sintetiza ('botão inibido');
            end;
        end;

    if strComp (classe, 'Edit') = 0 then
        begin
            if nivel = -1 then
                 sintetiza ('Campo')
            else
                 begin
                    tam := sendMessage (j, EM_LINELENGTH, 0, 0);
                    sendMessage (j, EM_GETLINE, 0, longint(@nome));
                    nome[tam] := #$0;
                    sintetiza ('Campo ' + strPas (nome));
                 end;
        end;

    if (strComp (classe, 'ComboBox') = 0) and
                ((nivel = 0) or (nivel = 5)) then
        begin
            if nivel = -1 then
                sintetiza ('Campo Composto')
            else
                begin
                    posic := sendMessage (j, CB_GETCURSEL, 0, 0);
                    if posic <> LB_ERR then
                        begin
                            tam := sendMessage (j, CB_GETLBTEXTLEN, posic, 0);
                            sendMessage (j, CB_GETLBTEXT, posic, longint(@nome));
                            nome[tam] := #$0;
                            sintetiza ('Campo Composto ' + strPas (nome));
                        end;
                end;
        end;

    if strComp (classe, 'ListBox') = 0 then
        begin
            posic := sendMessage (j, LB_GETCURSEL, 0, 0);
            if posic <> LB_ERR then
            begin
                tam := sendMessage (j, LB_GETTEXTLEN, posic, 0);
                sendMessage (j, LB_GETTEXT, posic, longint(@nome));
                nome[tam] := #$0;
                sintetiza ('Item de lista ' + strPas (nome));
            end;
        end;

    if nivel <= 0 then exit;

    j := getWindow (j, GW_CHILD);
    if j = 0 then exit;
    mostraJanela (j, nivel+1);
    for i := 1 to 15 do
        begin
            j := getWindow (j, GW_HWNDNEXT);
            if j = 0 then exit;
            mostraJanela (j, nivel+1);
        end;
end;

{--------------------------------------------------------}
{                mostra toda a janela de foco
{--------------------------------------------------------}

procedure mostraTodaJanela;
begin
    sintbip;
    sintetiza ('Foco');
    delay (500);
    j := getFocus;
    mostraJanela (j, 0);
    delay (500);

    sintbip;
    sintetiza ('Detalhes');
    delay (500);
    j := getActiveWindow;
    mostraJanela (j, 1);
end;

{--------------------------------------------------------}
{            mostra o que esta sendo teclado
{--------------------------------------------------------}

procedure mostraTeclagem;
var
    clido: word;
    c: char;
label inicio;
begin
    repeat
inicio:
        clido := getRecordedChar;
        if clido = 0 then exit;
        c := chr (clido and $ff);

        if c = #145 then
            begin
                mostraTodaJanela;
                repeat until getRecordedChar = 0;
                exit;
            end;

        if c in ['A'..'Z'] then
            begin
                if (GetKeyState(vk_Shift) >= 0) then
                    c := chr (clido + 32);
                if (GetKeyState(vk_Menu) >= 0) then
                    sintCarac (c);
                goto inicio;
            end;

        if c in ['0'..'9'] then
            begin
                if (GetKeyState(vk_Shift) >= 0) then
                    sintCarac (c)
                else
                    sintClek;
                goto inicio;
            end;

        case ord(c) of
            188:  if (GetAsyncKeyState(vk_Shift) >= 0) then
                        sintCarac (',')
                  else
                        sintCarac ('<');
            190:  if (GetAsyncKeyState(vk_Shift) >= 0) then
                        sintCarac ('.')
                  else
                        sintCarac ('>');
            186:  if (GetAsyncKeyState(vk_Shift) >= 0) then
                        sintCarac (';')
                  else
                        sintCarac (':');
            191:  if (GetAsyncKeyState(vk_Shift) >= 0) then
                        sintCarac ('/')
                  else
                        sintCarac ('?');
            220:  if (GetAsyncKeyState(vk_Shift) >= 0) then
                        sintCarac ('\')
                  else
                        sintCarac ('|');
            198:  if (GetAsyncKeyState(vk_Shift) >= 0) then
                        sintCarac ('-')
                  else
                        sintCarac ('_');
            8:    sintSom   ('_DEL');
{
        else
            if (GetKeyState(vk_Menu) >= 0) and
               (GetKeyState(vk_Control) >= 0) then
                sintClek;
}
        end;
    until false;
end;

{--------------------------------------------------------}
{                   programa principal
{--------------------------------------------------------}

var i: integer;

begin
    inicializa;
    if not startRecording then
        begin
            sintWriteln ('Erro na DLL de teclado');
            sintFim;
            halt;
        end;

    janAtiva := 0;
    janFoco := 0;

    terminou := false;
    vez := 0;
    repeat
         while sintFalando do;
         delay (200);

         if keypressed then
             if readkey = NOFOCUS then
                 showWindow (crtWindow, sw_minimize);

         getClassName (getFocus, classeJ, 144);

         if strLiComp (classeJ, 'dvWinCrt', 8) = 0 then
             begin
                 while getRecordedChar <> 0 do;
             end
         else
             mostraTeclagem;

         vez := (vez + 1) mod 3;
         if vez = 0 then
             begin
                 monitoraJanAtiva;
                 monitoraMenu;
             end;

         if keypressed then
              if readkey = #$1b then
                   begin
                       terminou := true;
                       sintWriteln ('MonitVox desativado');
                       delay (1000);
                   end;
    until terminou;

    if not stopRecording then
        sintWriteln ('Erro na DLL de teclado');
    sintFim;
    doneWinCrt;
end.
