{--------------------------------------------------------}
{
{   Caderno de Telefones - Vox
{
{   Autor:  Jose' Antonio Borges
{
{   Baseado num programa de
{       Marcelo Pimentel e David Cipriano
{
{   Em Junho de 1994
{
{   Versao 1.4 em Abril de 1996
{
{--------------------------------------------------------}

{$M 16536,8192}
Program TeleVox ;

Uses
    DVCRT, TelTela, TelDados, TelItem, TelImpr,
    DVLeNum, DVWin;

{--------------------------------------------------------}
{                    ajuda principal
{--------------------------------------------------------}

Procedure ajuda;
Var i: byte;
const
    TAMMENU1 = 8;
    menutela1 : Array [1..TAMMENU1] Of String [25] = (
        'N - Novo registro',
        'P - Procurar',
        'S - Selecionar',
        'F - Folhear',
        'R - Remover',
        'O - Ordenar',
        'I - Imprimir',
        'A - Arquivo externo'
    );

    TAMMENU2 = 7;
    menutela2 : Array [1..TAMMENU2] Of String [35] = (
        'F2  - grava cadastro',
        'F3  - troca de arquivo',
        'F5  - procura',
        'F7  - informa numero de registros',
        'F9  - marca ultimo lido',
        'F10 - desmarca ultimo',
        'ESC - termina'
    );

begin
    limpaTela;
    gotoxy (25, 13);
    write ('As op‡”es do Televox s„o:');

    For i := 1 to TAMMENU1 do
       begin
           gotoxy (10, 14+i);
           write ( menutela1 [i]);
       end;

    For i := 1 to TAMMENU2 do
       begin
           gotoxy (45, 14+i);
           write ( menutela2 [i]);
       end;

    sintSom ('TVAJUDA'); { As principais opcoes do Televox sao... }
    for i := 1 to TAMMENU1 do
       if not keypressed then
           sintSom ('TVAJ0' + chr (i + ord ('0')));

    if not keypressed then
        sintSom ('TVAJUD2'); { Existem ainda outros controles... }
    for i := 1 to TAMMENU2 do
       if not keypressed then
           sintSom ('TVAJ1' + chr (i + ord ('0')));
end;

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

Procedure Inicializa;
var c: char;
Begin
    SintInic (0, sintAmbiente('TELEVOX', 'DIRTELEVOX'));

    limpaTela;
    sintSom ('TVINIC'); { Televox, Caderno de telefones }

    fim := False;
    cadastrados := 0;
    inserindo := true;
    posatual := 0;
end;

{--------------------------------------------------------}
{              informa numero de registros
{--------------------------------------------------------}

procedure falaNumRegs;
var s: string;
begin
    str (cadastrados, s);
    msgBaixo ('TVLIDOS', 'Registros lidos: ' + s);
    falaNumeroConv (numeroParaString (cadastrados), MASCULINO);
end;

{--------------------------------------------------------}
{               Desmarca todos os registros
{--------------------------------------------------------}

procedure desmarcaTodos;
var i: integer;
begin
    for i := 1 to cadastrados do
        listaFone[i]^.status := 0;
end;

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

procedure marcaUltimoLido;
begin
    if posAtual <= 0 then exit;
    listaFone[posAtual]^.status := listaFone[posAtual]^.status or SELECIONADO;
end;

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

procedure desmarcaUltimoLido;
begin
    if posAtual > 0 then
        listaFone[posAtual]^.status := 0;
end;

{--------------------------------------------------------}
{                  le arquivo do disco
{--------------------------------------------------------}

Procedure leCadastro (novo, trataParam: boolean);
var
    c: char;
    s: string;
    qual: integer;
    temDados: boolean;
    lidos: integer;

label abre, proximo, inicio, erro, fimDoArquivo;

Begin
    if trataParam and (paramcount <> 0) then
        begin
            nomeCadastro := paramStr(1);
            goto abre;
        end;

inicio:
    gotoxy (1, 12);
    write ('Qual o nome do arquivo ? ');
    clreol;
    sintSom ('TVNOMARQ');
    sintReadln (nomeCadastro);

    if nomeCadastro = '' then
        if not novo then
            begin
                msgBaixo ('TVDESIS', 'Desistiu...');
                exit;
            end
        else
            begin
erro:
                limpaBaixo;
                gotoxy (1, 14);
                writeln ('Programa cancelado');  clreol;
                sintSom ('TVPROCAN');
                sintFim;
                doneWinCRT;
            end;

abre:
    lidos := 0;

    assign (arqfone, nomeCadastro);
    {$I-}  reset (arqfone); {$I+}
    If Ioresult = 0  Then
        begin
            msgBaixo ('TVCARGA', 'Carregando arquivo');

            while not eof (arqfone) do
                Begin
                    gotoxy (70, 11);
                    write (lidos+1);

                    if maxAvail < NUMCAMPOS * sizeof (string) then
                        begin
                            limpaBaixo;
                            msgBaixo ('TVFALMEM',
                               'Memoria insuficiente para incluir novos registros');
                            delay (1000);

                            gotoxy (1, 14);
                            writeln ('Aperte ENTER para ignorar, ESC para cancelar o programa');
                            sintSom ('TVAPENT');
                            repeat
                                c := readkey;
                                if c = ESC then goto erro;
                            until c = ENTER;
                            goto fimDoArquivo;
                        end;

                    inc (cadastrados);
                    inc (lidos);
                    novoRegistro (cadastrados);

                    with listaFone [cadastrados]^ do
                        begin
                            status := 0;
                            temDados := false;

                            for qual := 1 to 100 do
                                begin
                                    if eof(arqfone) then goto proximo;
                                    {$I-} readln (arqfone, s); {$I+}
                                    if ioresult <> 0 then
                                        begin
                                            msgBaixo ('TVERRLEI', 'Erro no arquivo, Enter ignora, ESC termina leitura');
                                            c := readkey;
                                            if c = #$1b then goto
                                                fimDoArquivo;
                                            s := 'Erro no disco';
                                        end;

                                    if (s <> '') and (s <> '@') then
                                        temDados := true;

                                    if (s <> '') and (s[1] = '@') then
                                        goto proximo;

                                    atualizaItem (qual, cadastrados, s);
                            end;
           proximo:
                            if not temDados then
                                removeRegistro (cadastrados);
                        end;
                end;

fimDoArquivo:

            close (arqfone);

            gotoxy (1, 14);
            write ('     ');
            str (cadastrados, s);
            msgBaixo ('TVLIDOS', 'Registros lidos: ' + s);
            falaNumeroConv (numeroParaString (cadastrados), MASCULINO);
        end
    else
        begin
            assign (arqfone, nomeCadastro);
            {$I-}  rewrite (arqfone);  {$I+}
            if ioresult = 0 then
                begin
                    msgBaixo ('TVNOVO', 'Foi criado um caderno novo');
                    close (arqfone);
                end
            else
                begin
                    msgBaixo ('TVNOMINV', 'Nome de arquivo novo nao foi aceito');
                    limpaBaixo;
                    goto Inicio;
                end;
        end;

    limpaBaixo;
    posAtual := 0;
    achados := 0;
end;

{--------------------------------------------------------}
{                  gravacao do arquivo
{--------------------------------------------------------}

function gravaCadastro: boolean;
var
    nome: string;
    i, n, nc, result: integer;
    campo: string;
    c: char;

label
    achou, errodisco;

begin
    gravaCadastro := true;

    repeat
         msgBaixo ('TVSALVSN', 'Aperte S para salvar o que voce fez, N para nao gravar');
         c := upcase(readkey);
         if c = 'N' then exit;
         if c = #$1b then
             begin
                 msgBaixo ('TVDESIS', 'Desistiu...');
                 gravaCadastro := false;
                 exit;
             end;
    until c = 'S';

    repeat
        {$I-} rewrite (arqfone); {$I+}
        result := ioresult;
        if result <> 0 then
            begin
erroDisco:
                {$I-} close (arqfone);  {$I+}
                result := ioresult;  { limpa eventual erro }

                limpaBaixo;
                msgBaixo ('TVNGRAV', 'Deu problema na gravacao');

                writeln ('Qual o nome do arquivo ? ');
                sintSom ('TVNOMARQ');

                repeat
                    nome := '';
                    sintReadln(nome);
                until nome <> '';
                assign (arqfone, nome);
            end;

    until result = 0;

    for i := 1 to cadastrados do
        begin
             for nc := NUMCAMPOS downto 2 do
                  if obtemItem (nc, i) <> '' then
                      goto achou;
             nc := 1;
achou:
             for n := 1 to nc do
                 begin
                     campo := obtemItem (n, i);
                     writeln (arqFone, campo);
                     if ioresult <> 0 then goto erroDisco;
                 end;

             {$I-} writeln (arqFone, '@'); {$I+}
             if ioresult <> 0 then goto erroDisco;
        end;

    {$i-} close (arqfone); {$I+}
    if ioresult <> 0 then goto erroDisco;
    msgBaixo ('TVSALVA', 'Arquivo gravado');
end;

{--------------------------------------------------------}
{                 troca de arquivo
{--------------------------------------------------------}

procedure trocaArquivo;
begin
    if gravaCadastro then
        begin
            msgBaixo ('TVTROCAR', 'Trocando de arquivo');
            limpaLista;
            leCadastro (true, false);
        end;
end;

{--------------------------------------------------------}
{                  inclusao de um nome
{--------------------------------------------------------}

Procedure inclui;
var
    c, c2: char;
    qual: integer;
    preenchido: boolean;

Begin
    gotoxy (1, 11);
    clreol;
    textBackGround (BLUE);
    write ('NOVO REGISTRO:');
    textBackground (BLACK);
    sintsom ('TVINCLUI'); { Inclusao }

    If cadastrados > MAXCADASTRO then
        begin
            msgBaixo ('TVCHEIO',
            'Caderno de telefones cheio, nao posso mais incluir');
            delay (1000);
            exit;
        end;

    if maxAvail < NUMCAMPOS * sizeof (string) then
        begin
            msgBaixo ('TVFALMEM',
                 'Memoria insuficiente para incluir novos registros');
            delay (1000);
            exit;
        end;

    cadastrados := cadastrados + 1;
    novoRegistro (cadastrados);
    mostraItens (cadastrados);
    c := passeiaNosItens (cadastrados, true);

    preenchido := false;
    for qual := 1 to NUMCAMPOS do
        if obtemItem (qual, cadastrados) <> '' then preenchido := true;

    if not preenchido then
        begin
            cadastrados := cadastrados - 1;
            msgBaixo ('TVIGNORA', 'Entrada foi ignorada');
            exit;
        end;

    msgBaixo ('TVCNFINC', 'Confirma inclusao (s/n) ?');
    sintLeTecla (c, c2);
    if (c = ESC) or (upcase (c) = 'N') then
        begin
            cadastrados := cadastrados - 1;
            msgBaixo ('TVIGNORA', 'Entrada foi ignorada');
            exit;
        end;

    msgBaixo ('TVREGINC', 'Registro foi incluido');
    posatual := cadastrados;
end;

{--------------------------------------------------------}
{     transforma cadeia em maiusculos nao acentuados
{--------------------------------------------------------}

function semAcentos (s: string): string;
const
    tabMaiuscPC: array [#$80..#$ff] of char = (

    'C','U','E','A','A','A','A','C','E','E','E','I','I','I','A','A',
    'E','þ','þ','O','O','O','U','U','Y','O','U','þ','þ','þ','þ','þ',
    'A','I','O','U','N','N','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ',
    'þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ',
    'A','A','A','A','A','A','‘','C','E','E','E','E','I','I','I','I',
    'þ','N','O','O','O','O','O','X','þ','U','U','U','U','Y','þ','þ',
    'A','A','A','A','A','A','‘','C','E','E','E','E','I','I','I','I',
    'þ','N','O','O','O','O','O','X','þ','U','U','U','U','Y','þ','þ');

var
    s2: string;
    i: integer;

begin
    move (s, s2, length(s)+1);
    for i := 1 to length (s2) do
        if s2[i] in ['a'..'z'] then
            s2[i] := upcase (s2[i])
        else
        if s2[i] >= #$80 then
            s2[i] := tabMaiuscPC [s2[i]];

    semAcentos := s2;
end;

{--------------------------------------------------------}
{                seleciona registros
{--------------------------------------------------------}

procedure folheia (masc: byte);
var
    nomeLista, s: string;
    c, c2, cod: char;
    postab: integer;

label canc, achei;

begin
    if masc = TODOS then
        achados := cadastrados
    else
        begin
            achados := 0;
            for postab := 1 to cadastrados do
                if (listaFone[postab]^.status and masc) <> 0 then
                     achados := achados + 1;
        end;

    str (achados, s);
    msgBaixo ('TVACHAD', 'Registros achados: ' + s);
    falaNumeroConv (numeroParaString (achados), MASCULINO);

    if achados = 0 then goto canc;
    sintSom ('TVPODLER');  { pode ler...}

    postab := 0;
    c := PGDN;
    repeat
        if c = CTLPGUP then
            begin
                postab := 0;
                c := PGDN;
            end
        else
        if c = CTLPGDN then
            begin
                postab := cadastrados+1;
                c := PGUP;
            end;

        if c = PGDN then
            begin
                for postab := postab+1 to cadastrados do
                    begin
                        if masc = TODOS then goto achei;
                        if (listaFone [postab]^.status and masc) <> 0 then
                            goto achei;
                    end;
                postab := cadastrados + 1;
            end
        else
            begin
                for postab := postab-1 downto 1 do
                    begin
                        if masc = TODOS then goto achei;
                        if (listaFone [postab]^.status and masc) <> 0 then
                            goto achei;
                    end;
                postab := 0;
            end;
achei:
        if (postab > cadastrados) or (postab <= 0) then
            begin
                msgBaixo ('TVCLEK', 'Ultimo registro');
                c := readkey;
                if c = #0 then c := readkey;
            end
        else
            begin
                limpaBaixo;
                mostraItens (postab);
                c := passeiaNosItens (postab, true);
            end;
    until c = #$1b;

canc:
    msgBaixo ('TVTERM', 'Operacao terminada');
    posAtual := postab;
end;

{--------------------------------------------------------}
{                       procura um nome
{--------------------------------------------------------}

procedure procura;
var
    texto, nomeLista, s: string;
    cod: char;
    postab: integer;

label buscaCadeia, canc;

begin
    gotoxy (1, 11);
    clreol;
    textBackGround (BLUE);
    write ('PROCURA:');
    textBackground (BLACK);
    sintsom ('TVPROCUR');     { procurar }

    limpaBaixo;
    gotoxy (1, 13);
    write ('Nome a procurar: ');
    sintSom ('TVNOMPRO');

    texto := '';
    cod := sintEdita (texto, 1, 14, 80, true);
    if (cod = ESC) or (texto = '') then
        goto canc;
    texto := maiuscAnsi (semAcentos(texto));

buscaCadeia:
    for postab := 1 to cadastrados do
        with listaFone [postab]^ do
            begin
                nomeLista := maiuscAnsi (semAcentos (nome^));
                if pos (texto, nomeLista) <> 0 then
                    begin
                        status := status or ACHADO;
                        achados := achados + 1;
                    end
                else
                     status := status and not ACHADO;
            end;

     folheia (ACHADO);
canc:
end;

{--------------------------------------------------------}
{                seleciona registros
{--------------------------------------------------------}

procedure seleciona;
var
    campo, s: string;
    buscado: array [1..NUMCAMPOS] of string;
    postab, qual: integer;
    c: char;

label proximo, canc;

begin
    msgBaixo ('TVINFSEL', 'Preencha os itens que contem informacoes desejadas');

    { usa um elemento nao existente, para comparacoes }

    novoRegistro (cadastrados+1);
    mostraItens (cadastrados+1);
    c := passeiaNosItens (cadastrados+1, true);

    with listaFone [cadastrados+1]^ do     { transforma em maiusculas }
        begin
            for qual := 1 to NUMCAMPOS do
                begin
                    campo := obtemItem (qual, cadastrados+1);
                    buscado[qual] := maiuscAnsi (semAcentos (campo));
                end;
        end;

    removeRegistro (cadastrados+1);

    desmarcaTodos;
    achados := 0;

    for postab := 1 to cadastrados do
        with listaFone [postab]^ do
            begin
                for qual := 1 to NUMCAMPOS do
                    if buscado[qual] <> '' then
                        begin
                            campo := obtemItem (qual, postab);
                            campo := maiuscAnsi (semAcentos (campo));
                            if pos (buscado[qual], campo) <> 1 then
                                begin
                                    status := status and not SELECIONADO;
                                    goto proximo;
                                end;
                        end;

                achados := achados + 1;
                status := status or SELECIONADO;
proximo:
            end;


    str (achados, s);
    msgBaixo ('TVACHAD', 'Registros achados: ' + s);
    falaNumeroConv (numeroParaString (achados), MASCULINO);
end;

{--------------------------------------------------------}
{         escolhe tipo de folheameneto de registros
{--------------------------------------------------------}

procedure folheiaCadastro;
var c, c2: char;
begin
    gotoxy (1, 11);
    clreol;
    textBackGround (BLUE);
    write ('FOLHEAR:');
    textBackground (BLACK);
    sintsom ('TVFOLHEA');     { folhear }

    limpaBaixo;
    gotoxy (1, 13);
    write ('Tecle T para todos ou S para os selecionados: ');
    sintSom ('TVTODSEL');

    sintLeTecla (c, c2);
    c := upcase (c);
    if (c = ESC) then exit;

    case c of
        'T': folheia(TODOS);
        'S': folheia(SELECIONADO);
    else
        msgBaixo ('TVOPINV', 'Operacao invalida');
    end;
end;

{--------------------------------------------------------}
{                       ordena a lista
{--------------------------------------------------------}

procedure ordena;
var
    c: char;
    p: pCadastro;
    s, campo: string;
    i, j, qual: integer;
    ordenaCampo: array [1..NUMCAMPOS] of boolean;

begin
    msgBaixo ('TVORDSEL', 'Marque com um x os campos de ordenacao');

    { usa um elemento nao existente, para trabalho }

    novoRegistro (cadastrados+1);
    mostraItens (cadastrados+1);
    c := passeiaNosItens (cadastrados+1, true);

    with listaFone [cadastrados+1]^ do     { transforma em maiusculas }
        begin
            for qual := 1 to NUMCAMPOS do
                ordenaCampo [qual] := obtemItem (qual, cadastrados+1) <> '';
        end;

    removeRegistro (cadastrados+1);

    msgBaixo ('TVAGUARD', 'Aguarde, ordenando');

    for qual := 1 to NUMCAMPOS do
        if ordenaCampo [qual] then

            for i := 1 to cadastrados-1 do
                begin
                    s := maiuscAnsi (semAcentos (obtemItem (qual, i)));

                    for j := i+1 to cadastrados do
                        begin
                            campo := maiuscAnsi (semAcentos (
                                                    obtemItem (qual, j)));
                            if s >= campo then
                               begin
                                   p := listaFone [j];
                                   listaFone [j] := listaFone [i];
                                   listaFone [i] := p;
                                   s := campo;
                               end;
                        end
                end;

    msgBaixo ('TVOKORD', 'Ok, ordenado');
    posAtual := 0;
end;

{--------------------------------------------------------}
{                         remocao
{--------------------------------------------------------}

procedure remove;
var i, removidos: integer;
    s, fonemas: string;
    c, c2: char;

    procedure removeUltimo;
    begin
        if (posAtual <= 0) or (posAtual > cadastrados) then
            begin
                msgBaixo ('TVNPOS', 'Registro desconhecido: nao apagado.');
                exit;
            end;

        s := mostraItem (1, posAtual, true);
        sintetiza (s);

        msgBaixo ('TVCONFRM', 'Confirma remocao deste (S/N) ?');
        sintLeTecla (c, c2);
        if (upcase(c) <> 'S') then
            begin
                msgBaixo ('TVCANC', 'Operacao cancelada');
                exit;
            end
        else
            msgBaixo ('TVREM', 'Removido');

        removeRegistro (posAtual);
    end;

begin
    gotoxy (1, 11);
    clreol;
    textBackGround (BLUE);
    write ('REMOVE:');
    textBackground (BLACK);
    sintsom ('TVREMOV');

    limpaBaixo;
    gotoxy (1, 13);
    write ('Tecle U para remover o ultimo lido ou S para os selecionados: ');
    sintSom ('TVESCREM');

    sintLeTecla (c, c2);
    c := upcase (c);
    if (c = ESC) then exit;

    case c of
        'U': removeUltimo;

        'S': begin
                 removidos := 0;
                 i := cadastrados;
                 while i > 0 do
                     begin
                        if (listaFone [i]^.status and SELECIONADO) <> 0 then
                            begin
                                 removeRegistro (i);
                                 removidos := removidos + 1;
                            end;
                        i := i - 1;
                     end;

                 str (removidos, s);
                 msgBaixo ('TVNREMOV', 'Registros removidos: ' + s);
                 falaNumeroConv (numeroParaString (removidos), MASCULINO);
             end;
    else
        msgBaixo ('TVOPINV', 'Operacao invalida');
    end;

    posAtual := 0;
end;

{--------------------------------------------------------}
{                       exportacao
{--------------------------------------------------------}

procedure exporta;
var
    nomeExport, campo: string;
    arqExport: text;
    tipoExport, c, c2: char;
    nc, i, n: integer;

label erro, achou, deNovo;

begin
    gotoxy (1, 15);
    write ('Tecle T para todos ou S para os selecionados: ');
    sintSom ('TVTODSEL');

    sintLeTecla (c, c2);
    c := upcase (c);
    if (c = ESC) then exit;

    if not (c in['T','S']) then
        begin
            msgBaixo ('TVOPINV', 'Operacao invalida');
            exit;
        end;

    tipoExport := c;

    gotoxy (1, 17);
    write ('Qual o nome do arquivo: ');
    clreol;
    sintSom ('TVNOMARQ');
    sintReadln(nomeExport);
    if nomeExport = '' then
        begin
            msgBaixo ('TVDESIS', 'Desistiu...');
            exit;
        end;

    assign (arqExport, nomeExport);
    {$I-} reset (arqExport); {$I+}
    if ioresult <> 0 then
        begin
            {$I-}  rewrite (arqExport); {$I+}
        end
    else
        begin
deNovo:
            msgBaixo ('TVADICRI', 'Arquivo ja existia, aperte A para adicionar, ENTER para recriar');
            c := readkey;
            if c = #$1b then
                begin
                    msgBaixo ('TVDESIS', 'Desistiu...');
                    exit;
                end;

            case upcase(c) of
                #$0d:  begin
                           {$I-} rewrite (arqExport);  {$I+}
                       end;

                'A':   begin
                           {$I-} append (arqExport);  {$I+}
                       end;
            else
                goto denovo;
            end;
        end;

    If ioresult <> 0  Then
        goto erro;

    msgBaixo ('TVGRAVAN', 'Gravando');

    for i := 1 to cadastrados do
        begin
            if (tipoExport = 'T') or
               ((tipoExport = 'S') and (
                         (listaFone [i]^.status and SELECIONADO) <> 0)) then
                   begin
                       for nc := NUMCAMPOS downto 2 do
                            if obtemItem (nc, i) <> '' then
                                goto achou;
                       nc := 1;
          achou:
                       for n := 1 to nc do
                           begin
                               campo := obtemItem (n, i);
                               writeln (arqExport, campo);
                               if ioresult <> 0 then goto erro;
                           end;

                       {$I-} writeln (arqExport, '@'); {$I+}
                       if ioresult <> 0 then goto erro;
                   end;
        end;

    {$I-} close (arqExport); {$I+}
    if ioresult <> 0 then goto erro;
    exit;

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

erro:
    {$I-} close (arqExport); {$I+}
    if ioresult <> 0 then;

    limpaBaixo;
    msgBaixo ('TVNGRAV', 'Deu problema na gravacao');
end;

{--------------------------------------------------------}
{           selecao de exportacao e importacao
{--------------------------------------------------------}

procedure arquiva;
var c, c2: char;
    salva: string;
begin
    gotoxy (1, 11);
    clreol;
    textBackGround (BLUE);
    write ('ARQUIVAMENTO:');
    textBackground (BLACK);
    sintsom ('TVARQUIV');     { arquivamento }

    limpaBaixo;
    gotoxy (1, 13);
    write ('Tecle S para salvar, E para exportar ou I para importar: ');
    sintSom ('TVEXPIMP');

    sintLeTecla (c, c2);
    c := upcase (c);
    if (c = ESC) then exit;

    case c of
        'S': if gravaCadastro then;

        'I': begin
                 salva := nomeCadastro;
                 leCadastro (false, false);
                 nomeCadastro := salva;
             end;

        'E': exporta;
    else
        msgBaixo ('TVOPINV', 'Operacao invalida');
    end;
end;

{--------------------------------------------------------}
{                    finalizacao
{--------------------------------------------------------}

Procedure Finaliza;
begin
    if gravaCadastro then
        begin
            limpaTela;
            msgBaixo ('TVOBRIG', 'Obrigado, ate'' a proxima.');
            sintFim;

            fim := True;
        end;
end;

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

var c, c2: char;
    pheap: pointer;
    i: integer;
label sai;

Begin
    clrscr;
    Inicializa;
    leCadastro (true, true);

    Repeat
        while keypressed do
            c := readkey;

        gotoxy (1, 11);
        textBackground (blue);
        write ('Qual a sua opcao: ');
        textBackground (black);
        clreol;
        sintsom ('TVQUALOP');

        c := readkey;
        if c in ['A'..'Z','a'..'z'] then
            begin
                write (c);
                sintCarac (c);
            end;

        if (c = #0) then
           case readkey of
               F1: ajuda;
               F2: if gravaCadastro then;
               F3: trocaArquivo;
               F5: procura;
               F7: falaNumRegs;
               F9: marcaUltimoLido;
              F10: desmarcaUltimoLido;
           end
        else
            case upcase(c) of
                'N': inclui;
                'P': procura;
                'S': seleciona;
                'F': folheiaCadastro;
                'R': remove;
                'O': ordena;
                'I': imprime;
                'A': arquiva;

                #27: finaliza;
            else
                msgBaixo ('TVERROP', 'Opcao errada: aperte F1 para ajuda');
        end;

sai:
    Until fim ;
    gotoxy (1, 25);
  doneWinCRT;
end.
