{--------------------------------------------------------}
{
{    Programa para emissao de cheques
{
{    Autor: Xyko Gon‡alves
{
{    Em Mar‡o/96
{
{--------------------------------------------------------}

{$M 16536,8192}
program cheqvox;
uses dvcrt, dvwin, dvlenum, windos, imprvox;

type
    regmasc = record
        nomebanco : string [25];
        moeda : string[20];
        moedas : string [20];
        centmoeda : string[20];
        centmoedas : string [20];
        valor : array [1..24] of integer;   {x, y, tamanho com 8 posicoes}
    end;

    regpessoal = record
        localidade : string [25];
        rg : string [12];
        expedidor : string [3];
        cpf : string [18];
        tel : string [15];
        endereco : string [50];
        bairro : string [20];
    end;

label ImpOuSai;

const
    ENTER = #$0d;
    esc = #27;

var
    padrao, mascaras : text;
    pessoal : text;

    tabmasc : array [1..20] of regmasc;
    parm, dados : regmasc;
    pessoa : regpessoal;
    valorfalado, favorecido, resposta : string;
    datapag, mespalavra, quantia : string  [15];
    alterado: boolean;
    opcao : char;
    valornumerico : longint;
    respnum, indmasc, indmaxi, indmove : integer;
    comVerso: boolean;
    diretorio: string;
    nomeSaida: string;

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

Procedure titulo;
begin
    clrscr;
    textbackground (BLUE);
    writeln (' ***   *   * *****  ***   *   *  *****     *   *  ***  *   *');
    writeln ('*   *  *   * *     *   *  *   *  *         *   * *   *  * * ');
    writeln ('*      *   * *     *   *  *   *  *         *   * *   *  *** ');
    writeln ('*      ***** ****  *   *  *   *  ***        * *  *   *   *  ');
    writeln ('*      *   * *     *   *  *   *  *          * *  *   *  *** ');
    writeln ('*   *  *   * *     *  **  *   *  *           *   *   *  * * ');
    writeln (' ***   *   * *****  ****   ***   *****       *    ***  *   *');
    textbackground (BLACK); clreol;
    writeln;
end;

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

procedure finaliza;
begin
    writeln ('Fim do programa');
    while keypressed do
        opcao := readkey;
    sintsom ('chfim');
    sintfim;
    doneWinCrt;
end;
   
{--------------------------------------------------------}

function letecla (npula: integer): char;
var 
    i: integer;
    c: char;
begin
    c := readkey;
    write(c);
    if c <> #13 then   {enter}
        sintcarac (c);
    for i := 1 to npula do writeln;
    letecla := upcase(c);
end;

{--------------------------------------------------------}
function confirma: char;
begin
    textbackground (RED);
    write ('Confirme (s/n)');
    textbackground (BLACK);
    sintsom ('chsimnao');
    confirma := letecla (1);
end;

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

Procedure fala ( frase  : string);
var
   compila : string;
begin
   sintWriteln (frase);
end;

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

{ *** obtem valores e testa esc ***}
function obtemNum (var respnum: integer): char;
var opcao: char;
    posicaoc, resp: integer;
begin
    repeat
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 15, true);
        obtemNum := opcao;
        if opcao = ESC then exit;

        while resposta [length(resposta)] = ' ' do
             delete (resposta, length(resposta), 1);
        writeln;

        if resposta = '' then exit;

        val (resposta, resp, posicaoc);
        if posicaoc <> 0 then
            sintsom ('chapnum');
    until posicaoc = 0;

    respnum := resp;
end;

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

procedure DadosBanco;
const
    campo : array [1..8] of string [8] =
            ('chvalor', 'chplinha', 'chslinha', 'chfavore', 'chcidade',
            'chdia', 'chmes', 'chano');

    item : array [1..3] of string [8] =
            ('chlinha', 'chcoluna', 'chtaman');

    writecampo : array [1..8] of string [40] =
            ('do valor numerico do cheque',
             'da primeira linha do valor em palavras',
             'da segunda linha do valor em palavras',
             'do favorecido',
             'da cidade',
             'do dia',
             'do mes',
             'do ano');

    writeitem : array [1..3] of string [20] =
            ('Informe a linha ',
             'Informe a coluna ',
             'Informe o tamanho ');

    var
    numerofalado : string [3];
    indvalor, indcampo, inditem : integer;
    compila: string;

    begin
    alterado := false;
    repeat
        write ('Nome do banco: ');
        sintSom ('chnomban');
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 25, true);
        writeln;
        if opcao = esc then
            exit;
        if resposta <> '' then
            begin
            sintsom ('chconfir');
            write ('Novo nome: ');
            fala (resposta);
            opcao := confirma;
            if opcao = esc then
                exit;
            end
        else
            begin
                resposta := dados.nomebanco;
                writeln ('Assumido: ', resposta);
            end;

    until (opcao = 'S') or (opcao = enter);

    dados.nomebanco := resposta;
    alterado := true;

{ *** os campos e itens estao dispostos em vetor (8/3) ***}
    indvalor := 0;
    for indcampo := 1 to 8 do
        begin
        for inditem := 1 to 3 do
            begin
            indvalor :=indvalor + 1;
            repeat
                repeat
                    write (writeItem [inditem], writecampo [indCampo]);
                    sintsom (item  [inditem]);
                    sintsom (campo [indcampo]);
                    str (dados.valor [indvalor], numerofalado);
                    valornumerico := dados.valor [indvalor];
                    valorfalado := numeroparastring (valornumerico);
                    writeln (': sugiro ', valornumerico);
                    sintsom ('chsugiro');
                    sintetiza (valorFalado);
                    respnum := valornumerico;
                    opcao := obtemnum (respnum);
                    if opcao = esc then
                        exit;
                until (respnum > 0) or (opcao = enter);
            until (opcao = 'S') or (opcao = enter);

            dados.valor [indvalor] := respnum;
            alterado := true;
            end;
        end;

{ *** nome da moeda (singular e plural) *** }
    repeat
        write ('Informe nome da moeda, no singular: ');
        sintsom ('chmoedas');
        fala (dados.moeda);

        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 20, true);
        writeln;
        if opcao = esc then
            exit;
    until (opcao = 'S') or (opcao = enter);

    if resposta <> '' then
        begin
            dados.moeda := resposta;
            alterado := true;
        end;

    repeat
        write ('Informe nome da moeda, no plural: ');
        sintsom ('chmoedap');
        fala(dados.moedas);
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 20, true);
        writeln;
        if opcao = esc then
            exit;
    until (opcao = 'S') or (opcao = enter);

    if resposta <> '' then
        begin
            dados.moedas := resposta;
            alterado := true;
        end;

    dados.centmoeda := 'centavo';
    dados.centmoedas := 'centavos';
    end;

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

{*** gravacao do arquivo de mascaras *** }

procedure GravaMascaras;
    var i : integer;

    begin
        assign (mascaras, diretorio + 'mascaras.amb');
        {$i-} rewrite (mascaras); {$i+}
        if ioresult <> 0 then
            begin
            writeln ('Erro de grava‡„o');
            sintsom ('chegrava');
            fala ('"mascaras.amb"');
            finaliza;
            end;
    indmove := 1;
    repeat
        with tabmasc [indmove] do
            begin
                writeln (mascaras, nomebanco);
                writeln (mascaras, moeda);
                writeln (mascaras, moedas);
                writeln (mascaras, centmoeda);
                writeln (mascaras, centmoedas);
                for i := 1 to 8 do
                    writeln (mascaras, valor[i*3-2], ' ',
                                       valor[i*3-1], ' ',
                                       valor[i*3]);
            end;
        indmove := indmove + 1;
    until indmove = indmaxi;
    close (mascaras);
    end;


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

{ *** altera dados de um banco existente ***}
procedure ReconfiguraBanco;
var i: integer;
    begin
    if (indmasc = 0) or (indmasc = indmaxi) then
        begin
        writeln ('Nenhum banco foi selecionado');
        sintsom ('chnemban');
        exit;
        end;
    dados := tabmasc [indmasc];
    writeln ('Reconfigurar:');
    sintsom ('chreconf');
    fala (dados.nomebanco);
    dadosbanco;
    if not alterado then
        exit;
    writeln ('Quer salvar as altera‡”es?');
    sintsom ('chqsalva');
    opcao := confirma;
    if (opcao = esc) or (opcao <> 'S') then
        exit;

    tabmasc [indmasc] := dados;
    GravaMascaras;
    end;

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

{ *** grava banco padrao *** }

procedure Gravapadrao;
    var i : integer;

    begin
    assign (padrao, diretorio + 'padrao.amb');
    {$i-} rewrite (padrao);    {$I+}
    if ioresult <> 0 then
        begin
        write ('Erro de gravacao: ');
        sintsom ('chegrava');
        fala ('padrao.amb');
        finaliza;
        end;

    with parm do
            begin
                writeln (padrao, nomebanco);
                writeln (padrao, moeda);
                writeln (padrao, moedas);
                writeln (padrao, centmoeda);
                writeln (padrao, centmoedas);
                for i := 1 to 8 do
                    writeln (padrao, valor[i*3-2], ' ',
                                       valor[i*3-1], ' ',
                                       valor[i*3]);
            end;
        close (padrao);
    end;

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

{ *** grava banco padrao com novo banco selecionado. *** }
procedure TrocaBanco;
var i: integer;
    begin
    if (indmasc = 0) or (indmasc = indmaxi) then
        begin
        writeln ('Nenhum banco foi selecionado');
        sintsom ('chnemban');
        opcao := 'n';
        exit;
        end;

    parm := tabmasc [indmasc];
GravaPadrao;
            end;

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

{ *** elimina mascara de banco *** }
procedure ApagaBanco;
var i: integer;
    Begin
    if (indmasc = 0) or (indmasc = indmaxi) then
        begin
        sintsom ('chapsele');fala ( 'banco a ser apagado nao foi selecionado');
        opcao := 'x';
        exit;
        end;
    write ('Apagamento: ');
    sintsom ('chconfir');
    sintsom ('chapagam');
    fala (tabmasc [indmasc] .nomebanco);
    opcao := confirma;
    if (opcao = esc) or (opcao <> 'S') then
        exit;
    if tabmasc [indmasc] .nomebanco = parm.nomebanco then
        begin
        writeln ('Banco a ser apagado ‚ o banco padrao');
        sintsom ('chappadr');
        writeln ('Troque o banco');
        sintsom ('chtroqba');
        exit;
        end;
    for indmove := indmasc to (indmaxi - 1) do
        tabmasc [indmove] := tabmasc [(indmove + 1)];
    indmaxi := indmaxi - 1;
        assign (mascaras, diretorio + 'mascaras.amb');
        {$i-} rewrite (mascaras); {$i+}
        if ioresult <> 0 then
            begin
            writeln ('Erro de grava‡„o: ');
            sintsom ('chegrava');
            fala ('mascaras.amb');
            finaliza;
            end;
    indmove := 1;
    repeat
        with tabmasc [indmove] do
            begin
                writeln (mascaras, nomebanco);
                writeln (mascaras, moeda);
                writeln (mascaras, moedas);
                writeln (mascaras, centmoeda);
                writeln (mascaras, centmoedas);
                for i := 1 to 8 do
                    writeln (mascaras, valor[i*3-2], ' ',
                                       valor[i*3-1], ' ',
                                       valor[i*3]);
            end;



        indmove := indmove + 1;
    until indmove = indmaxi;
    close (mascaras);
    end;
{--------------------------------------------------------}

procedure IncluiBanco;
var i: integer;
    begin
    writeln ('Inclus„o de banco');
    sintsom ('chincban');
    if (indmasc = 0) or (indmasc = indmaxi) then
        dados := parm
    else dados := tabmasc [indmasc];
    DadosBanco;
    if not alterado then
        exit;
    writeln ('Quer salvar as altera‡”es?');
    sintsom ('chqsalva');
    opcao := confirma;
    if(opcao = esc) or (opcao = 'N') then
        exit;
    if indmasc = indmaxi then
        tabmasc [indmasc] := dados
    else if indmasc = 0 then
            begin
            for indmove := (indmaxi - 1) downto 1 do
                tabmasc [(indmove + 1)] := tabmasc [indmove];
            indmasc := 1;
            tabmasc [indmasc] := dados;
        end
        else begin
            for indmove := (indmaxi - 1) downto (indmasc + 1) do
                tabmasc [(indmove + 1)] := tabmasc [indmove];
                indmasc := indmasc + 1;
                tabmasc [indmasc] := dados;
                end;
    indmaxi := indmaxi + 1;
    GravaMascaras;
    end;

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

procedure testaErro;
begin
    if ioresult <> 0 then
        begin
        write ('Erro de leitura: ');
        sintsom ('cheleitu');
        fala ('mascaras.amb');
        finaliza;
        end;
end;

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

procedure testaErroDadosPessoais;
begin
    if ioresult <> 0 then
    begin
        sintsom ('cheleitu');
        fala ('"pessoal.amb"');
        close (padrao);
        close (pessoal);
        finaliza;
    end;
end;

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

{ *** leitura do arquivo de mascaras *** }

procedure LeMascaras (var lido : char);
var i: integer;
    begin
    assign (mascaras, diretorio + 'mascaras.amb');
    {$i-} reset (mascaras); {$i+}
    if ioresult <> 0 then
        exit;

    lido := 'S';
    indmasc := 1;
    while not eof (mascaras) do
        begin
            with tabmasc [indmasc] do
                begin
                    {$I-}
                    readln (mascaras, nomebanco);  testaErro;
                    readln (mascaras, moeda);      testaErro;
                    readln (mascaras, moedas);     testaErro;
                    readln (mascaras, centmoeda);  testaErro;
                    readln (mascaras, centmoedas); testaErro;
                    for i := 1 to 8 do
                        readln (mascaras, valor[i*3-2],
                                          valor[i*3-1],
                                          valor[i*3]);    testaErro;
                    {$I+}
                end;

            indmasc := indmasc + 1;
        end;

        close (mascaras);

    indmaxi := indmasc;
    end;

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

{ *** gerenciamento das mascaras de cheques *** }

procedure ConfiguraCheque;
    var lido : char;

    begin
    lido := 'n';
    LeMascaras (lido);
    if lido = 'N' then
        tabmasc [1] := parm;

    indmasc := 0;
    repeat
    writeln ('Selecione o banco com as setas e tecle sua opcao. F1 ajuda.');
    sintsom ('chselban');
    repeat
        opcao := readkey;
        if opcao = esc then
            begin
                writeln;
                exit;
            end;
        if ord (opcao) = 0 then
            begin
            opcao := readkey;
            case ord(opcao) of
                75, 77 : begin
                if indmasc = 0 then
                    sintsom ('chinicio')
                else if indmasc = indmaxi then
                    sintsom ('chfim')
                    else fala (tabmasc [indmasc] .nomebanco);
                end;
                80 : begin
                indmasc := indmasc + 1;
                if indmasc >= indmaxi then
                    begin
                    sintsom ('chfim');
                    indmasc := indmaxi;
                    end
                else fala (tabmasc [indmasc] .nomebanco);
                end;
                72 : begin
                indmasc := indmasc - 1;
                if indmasc < 1 then
                    begin
                    sintsom ('chinicio');
                    indmasc := 0;
                    end
                else fala (tabmasc [indmasc] .nomebanco);
                end;
                59 : begin
                         textBackground (RED);
                         writeln ('A - apaga banco');
                         writeln ('I - inclui novo banco');
                         writeln ('T - troca banco');
                         writeln ('R - reconfigura cheque');
                         writeln ('ESC - termina');
                         textBackground (BLACK); clreol;
                         sintsom ('chmenu02');
                         sintsom ('chsuaopc');
                end;
                else begin
                        writeln ('Fun‡„o inv lida');
                        writeln ('F1: AJUDA');
                        sintsom ('chfuninv');
                        sintsom ('chf1ajud');
                     end;
            end;
            end
        else begin
                 writeln (opcao);
                 case opcao of
                    't', 'T' : TrocaBanco;
                    'a', 'A' : begin
                                 ApagaBanco;
                                 opcao := 'r';
                               end;
                    'i', 'I' : begin
                                 IncluiBanco;
                                 opcao := 'r';
                               end;
                    'r', 'R' : begin
                                 ReconfiguraBanco;
                                 opcao := 'r';
                               end;
                else begin
                       writeln ('Tecla inv lida');
                       writeln ('TF1: AJUDA');
                       sintsom ('chtecinv');
                       sintsom ('chf1ajud');
                     end;
                end;
            end;
        until (opcao = 't') or (opcao = 'r');
    until (opcao = 't');
    end;

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

{ *** obtem dados pessoais (nome da cidade, e dados para o *** }
{ *** preenchimento do verso do cheque                    ***}
procedure DadosPessoais;
begin
    with pessoa do
    begin
    repeat
        write ('Telefone: ');
        sintsom ('chtel');
        fala(tel);
        sintsom ('chqual');
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 20, true);
        writeln;
        if opcao = esc then
            exit;
    until (opcao = 'S') or (opcao = enter);
    if resposta <> '' then
        begin
        alterado := true;
        tel := resposta;
        end;

    repeat
        write ('Endereco: ');
        sintsom ('chendere');
        fala(endereco);
        sintsom ('chqual');
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 50, true);
        writeln;
        if opcao = esc then
            exit;
    until (opcao = 'S') or (opcao = enter);
    if resposta <> '' then
        begin
        alterado := true;
        endereco := resposta;
        end;

    repeat
        write ('Bairro: ');
        sintsom ('chbairro');
        fala(bairro);
        sintsom ('chqual');
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 50, true);
        writeln;
        if opcao = esc then
            exit;
    until (opcao = 'S') or (opcao = enter);
    if resposta <> '' then
        begin
        alterado := true;
        bairro := resposta;
        end;

    repeat
        write ('Cidade: ');
        sintsom ('chcidade');
        fala(localidade);
        sintsom ('chqual');
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 20, true);
        writeln;
        if opcao = esc then
            exit;
    until (opcao = 'S') or (opcao = enter);
    if resposta <> '' then
        begin
        alterado := true;
        localidade := resposta;
        end;

    repeat
        write ('Identidade: ');
        sintsom ('chrg');
        fala (rg);
        sintsom ('chqual');
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 20, true);
        writeln;
        if opcao = esc then
            exit;
    until (opcao = 'S') or (opcao = enter);
    if resposta <> '' then
        begin
        alterado := true;
        rg :=  resposta;
        end;

    repeat
        write ('Orgao Expedidor: ');
        sintsom ('chexpedi');
        fala( expedidor );
        sintsom ('chqual');
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 10, true);
        writeln;
        if opcao = esc then
            exit;
    until (opcao = 'S') or (opcao = enter);
    if resposta <> '' then
        begin
        alterado := true;
        expedidor := resposta;
        end;

    repeat
        write ('CPF: ');
        sintsom ('chcpf');
        fala (cpf);
        sintsom ('chqual');
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 20, true);
        writeln;
        if opcao = esc then
            exit;
    until (opcao = 'S') or (opcao = enter);
    if resposta <> '' then
        begin
        alterado := true;
        cpf := resposta;
        end;
    end;
end;

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

{ *** grava dados pessoais *** }
procedure GravaDadosPessoais;
    begin
        assign (pessoal, diretorio + 'pessoal.amb');
        {$i-} rewrite (pessoal);
        if ioresult <> 0 then
            begin
            sintsom ('chegrava');
            finaliza;
            end;

    with pessoa do
        begin
            writeln (pessoal, localidade);
            writeln (pessoal, rg);
            writeln (pessoal, expedidor);
            writeln (pessoal, cpf);
            writeln (pessoal, tel);
            writeln (pessoal, endereco);
            writeln (pessoal, bairro);
        end;

    close (pessoal);
end;

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

{ *** faz processamento dos dados pessoais *** }
procedure AtualizaDadosPessoais;
begin
    sintsom ('chdadosp');
    alterado := false;
    DadosPessoais;
    if alterado then
    begin
        sintsom ('chqsalva');
        opcao := confirma;
        if (opcao = 'S') or (opcao = enter) then
            GravaDadosPessoais
    end;
    opcao := esc;
end;

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

procedure criaPadrao;
    var
    i : integer;
    lido : char;

    begin
    writeln ('Arquivo "padrao.amb" não foi encontrado');
    writeln ('Deseja criar novo padrao?');
    sintsom ('chpadnec');
    sintsom ('chnovopa');
    opcao := confirma;
    if(opcao = esc) or (upcase (opcao) = 'N') then
        finaliza;
    with dados do
        begin
        nomebanco := 'novobanco';
        moeda := 'real';
        moedas := 'reais';
        centmoeda := 'centavo';
        centmoedas := 'centavos';
{        (valor numerico: linnha, coluna, tamanho) }
        valor [1] := 1; valor [2] := 50; valor [3] := 12;
{        (primeira linha valor palavras: linha, coluuna, tamanho) }
        valor [4] := 2;  valor [5] := 15;  valor[6] := 60;
{        (segunda valor palavras : linha, coluna, tamanho) }
        valor [7] := 3;  valor [8] := 1;  valor [9] := 75;
{        (favorecido: linha, coluna, tamanho) }
        valor [10] := 4;  valor [11] := 10;  valor [12] := 65;
{        (cidade: linnha, coluuna, tamanho) }
        valor [13] := 5;  valor [14] := 12;  valor [15] := 17;
{        dia: (linha, coluna, tamanho) }
        valor [16] := 5;  valor [17] := 36;  valor [18] := 2;
{        (mes: linha, coluna, tamanho)}
        valor [19] := 5;  valor [20] := 40;  valor [21] := 9;
{        (ano: linha, coluna, tamanho }
        valor [22] := 5;  valor [23] := 56;  valor [24] := 2;

        end;
    DadosBanco;
    if not alterado then
        finaliza;
    parm := dados;
    GravaPadrao;
    lido := 'N';
    Lemascaras (lido);
    if lido = 'N' then
        begin
        tabmasc [1] := dados;
        indmaxi := 2;
        GravaMascaras;
        exit;
        end;
    tabmasc [indmaxi] := dados;
    indmaxi := indmaxi +1;
    GravaMascaras;
end;

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

procedure criaPessoal;
begin
    writeln ('Arquivo "pessoal.amb" nao foi encontrado');
    writeln ('Deseja criar novo arquivo com dados pessoais?');
    sintsom ('chpesnec');
    sintsom ('chnovope');
    opcao := confirma;
    if (opcao = esc) or (upcase (opcao) = 'N') then
        finaliza;
    with pessoa do
        begin
           localidade := '';
            rg := '';
            expedidor := '';
            cpf := '';
            tel := '';
            endereco := '';
            bairro := '';
        end;
    dadospessoais;
    if not alterado then
        finaliza;
    GravaDadosPessoais;
end;

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

{ *** configura ambiente e trata opcoes (sim, configura, dados pessoais) *** }
procedure inicializa;
var c: char;
var i: integer;
begin
    titulo;
    sintinic(0, sintAmbiente ('CHEQVOX', 'DIRCHEQVOX'));

    diretorio := sintAmbiente ('DOSVOX', 'PGMDOSVOX');
    if diretorio [length(diretorio)] <> '\' then
        diretorio := diretorio + '\';

    sintsom ('chcheque');
    assign (padrao, diretorio + 'padrao.amb');
    {$i-} reset (padrao);    {$I+}
    if ioresult <> 0 then
        CriaPadrao;
    {$i-} reset (padrao);    {$I+}

    assign (pessoal, diretorio + 'pessoal.amb');
    {$i-} reset (pessoal);  {$I+}
    if ioresult <> 0 then
        CriaPessoal;
    {$i-} reset (pessoal);  {$I+}

    with pessoa do
        begin
            readln (pessoal, localidade);   testaErroDadosPessoais;
            readln (pessoal, rg);           testaErroDadosPessoais;
            readln (pessoal, expedidor);    testaErroDadosPessoais;
            readln (pessoal, cpf);          testaErroDadosPessoais;
            readln (pessoal, tel);          testaErroDadosPessoais;
            readln (pessoal, endereco);     testaErroDadosPessoais;
            readln (pessoal, bairro);       testaErroDadosPessoais;
        end;
    close (pessoal);

{ ***  exibe o nome do banco do padrao. ***}
    with parm do
        begin
            readln (padrao, nomebanco);
            readln (padrao, moeda);
            readln (padrao, moedas);
            readln (padrao, centmoeda);
            readln (padrao, centmoedas);
            for i := 1 to 8 do
                readln (padrao, valor[i*3-2], valor[i*3-1], valor[i*3]);
        end;

    close (padrao);
    while keypressed do c := readkey;
    repeat
        write ('Banco atual: ');
        sintsom ('chbanatu');
        fala ( parm.nomebanco);
        writeln ('    Enter - confirma');
        writeln ('    C - conf. cheque');
        write   ('    A - atual. dados pessoais:  ');
        sintsom ('chmenu01');

        sintsom ('chsuaopc');
        opcao := letecla (1);
        writeln;

        case ord (opcao) of
            27 : finaliza;
            13, 83, 115 : exit;
            67, 99 : ConfiguraCheque;
            65, 97  : atualizaDadosPessoais;
            0 : begin
                opcao := readkey;
                if ord (opcao) = 59 then
                    begin
                    writeln ('    Enter - confirma');
                    writeln ('    C - configura cheque');
                    write   ('    A - atualiza‡„o de dados pessoais:  ');
                    sintsom ('chmenu01');
                    end;
                end;
            else begin
                writeln ('Op‡„o inv lida...');
                sintsom ('chopcinv');
                opcao := 't';
                end;
            end;
        until (opcao <> 't') and (opcao <> esc);
end;
{--------------------------------------------------------}

{*** coloca pontos e vírgula no valor criticado *** }

procedure SeparaClasses (valorcheque : string);
    var tamanhov : integer;

    begin
    quantia := valorcheque;
    tamanhov := length (quantia);
    quantia := copy (quantia, 1, (tamanhov -2)) + ','
            + copy (quantia, (tamanhov -1), tamanhov);
    tamanhov := length (quantia);
    if tamanhov < 7 then
        exit;
    quantia := copy (quantia, 1, (tamanhov -6)) + '.'
            + copy (quantia, (tamanhov -5), tamanhov);
    tamanhov := length (quantia);
    if tamanhov < 11 then
        exit;
    quantia := copy (quantia, 1, (tamanhov -10)) + '.'
            + copy (quantia, (tamanhov -9), tamanhov);
    end;

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

{*** critica valor do cheque ***}

procedure PedeValor (var valorreal : string; var valorn : longint);
    var
    valorcentavo : string;
    reais, centavos : longint;
    tamanhov, posicaoc, posicaor : integer;
    valorcheque, tpmoeda, centmoeda : string;

begin
    repeat
    centmoeda := parm.centmoeda;
    tpmoeda := parm.moeda;
    write ('Valor: ');
    sintsom ('chqvalor');
    valorcheque := '';
    opcao := sintEdita (valorcheque, wherex, wherey, 15, true);
    writeln;
    if opcao = esc then
        finaliza;

{ *** procura , (virgula e remove) }
    posicaor := length (valorcheque) - 2;
    posicaoc := pos (',', copy (valorcheque, posicaor ,3));
    if posicaoc > 0 then
        begin
        if posicaoc = 1 then
            valorcheque := copy (valorcheque, 1, (posicaor - 1)) +
                copy (valorcheque, (posicaor + 1), 2)
        else begin
            writeln ('v¡rrgula inv lida');
            sintsom ('chvirinv');
            end;
        end
    else valorcheque := valorcheque + '00';

{ *** procura . (ponto) separador de classe milhar para retirar .}
    posicaor := length (valorcheque) - 5;
    posicaoc := pos ('.', copy (valorcheque, posicaor, 6));
    if posicaoc > 0 then
        begin
        if posicaoc = 1 then
            valorcheque := copy (valorcheque, 1, (posicaor - 1)) +
                copy (valorcheque, (posicaor + 1), 5)
        else begin
            writeln ('ponto inv lido');
            sintsom ('chponinv');
            end;
        end;

{ *** procura . (ponto classe milhao para retirar.}
    posicaor := length (valorcheque) - 8;
    posicaoc := pos ('.', copy (valorcheque, posicaor, 9));
    if posicaoc > 0 then
        begin
        if posicaoc = 1 then
            valorcheque := copy (valorcheque, 1, (posicaor - 1)) +
                copy (valorcheque, (posicaor +1), 8)
        else begin
            writeln ('ponto inv lido');
            sintsom ('chponinv');
            end;
        end;

    val (valorcheque, valorn, posicaoc);
    tamanhov := length (valorcheque);
    if posicaoc > 0 then
        begin
        writeln ('valor inv lido');
        sintsom ('chverval');
        end
    else begin
        SeparaClasses (valorcheque);
        val (copy (valorcheque, 1, (tamanhov - 2)), reais, posicaor);
        val (copy (valorcheque, (tamanhov - 1), 2), centavos, posicaor);
        if reais > 1 then
            tpmoeda := parm.moedas;
        if centavos > 1 then
            centmoeda := parm.centmoedas;
       valorreal := numeroparastring (reais) + ' ' + tpmoeda;
        if centavos > 0 then
            begin
            valorcentavo := numeroparastring (centavos) + ' ' + centmoeda;
            valorreal := valorreal + ' e ' + valorcentavo;
            end;
        sintsom ('chconfir');
        fala ( valorreal );
        opcao := confirma;
        if opcao = esc then
            finaliza;
        end;
    until ((opcao = 'S') or (opcao = enter)) and (posicaoc = 0);
end;

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

procedure completadata;
    var
    anocor, mescor, diacor, diasem : word;
    posicaoc, ano, mes, dia : integer;
    messtr, diastr : string [2];
    anostr : string [4];

    begin
    getdate (anocor, mescor, diacor, diasem);
    str (anocor, anostr);
    anostr := copy (anostr, 3,2);
    str (mescor, messtr);
    if mescor < 10 then
        messtr := '0' + messtr;
    str (diacor, diastr);
    if diacor < 10 then
        diastr := '0' + diastr;

{ *** verificacao de complemento de mes e ano.}
    if length (datapag) = 0 then
        datapag := diastr + messtr + anostr;
    if length (datapag) = 1 then
        datapag := '0' + datapag;
    if length (datapag) = 2 then
        begin
        val (datapag, dia, posicaoc);
        if dia < diacor then
            begin
            mescor := mescor +1;
            if mescor > 12 then
                begin
                anocor := anocor + 1;
                mescor := 1;
                str (anocor, anostr);
                anostr := copy (anostr, 3,2);
                end;
            str (mescor, messtr);
            if mescor < 10 then
                messtr := '0' + messtr;
            end;
        datapag := datapag + messtr + anostr;
        end;

    if length (datapag) = 3 then
        begin
        posicaoc := pos ('/', datapag);
        if posicaoc = 2 then
            datapag := '0' + copy (datapag, 1,1) + '0'
                    + copy (datapag, 3, 1)
        else datapag := '0' + datapag;
        end;

    if length (datapag) = 4 then
        begin
        val (copy (datapag, 3,2), mes, posicaoc);
        if mes < mescor then
            begin
            anocor := anocor + 1;
            str (anocor, anostr);
            anostr := copy (anostr, 3,2);
            end;
        datapag := datapag + anostr;
        end;

    if length (datapag) = 5 then
        begin
        posicaoc := pos ('/', datapag);
        if posicaoc = 3 then
            datapag := copy (datapag, 1,2) + copy (datapag , 4,2)
                + anostr
        else datapag := '0' + datapag;
        end;

    if length (datapag) = 6 then
        begin
        posicaoc := pos ('/', datapag);
        if posicaoc = 0 then
            exit
        else datapag := '0' + copy (datapag, 1, 1) + '0' +
            copy (datapag, 3, 1) + copy (datapag, 5, 2);
        end;

    if length (datapag) = 7 then
        begin
        posicaoc := pos ('/', datapag);
        if posicaoc = 2 then
            datapag := '0' + copy (datapag, 1, 1) + copy (datapag, 3,2)
                + copy (datapag, 6, 2)
        else datapag := copy (datapag, 1, 2) + '0' +
                copy (datapag, 4, 1) + copy (datapag, 6, 2);
        end;

    if length (datapag) = 8 then
        datapag := copy (datapag, 1, 2) + copy (datapag, 4, 2) +
            copy (datapag, 7, 2);
end;

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

{ *** consistencia da data *** }
procedure dataok (var resultdata : byte);

    const
    diasmes : array [1..12] of integer =
        (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

    var
    dia, mes, ano, resto : integer;
    posicaoc: integer;

begin
    val (copy (datapag, 1,2), dia, posicaoc);
    if posicaoc > 0 then
        begin
        resultdata := 1;
        exit;
        end;
    val (copy (datapag, 3, 2), mes, posicaoc);
    if posicaoc > 0 then
        begin
        resultdata := 2;
        exit;
        end;
    val (copy (datapag, 5, 2), ano, posicaoc);
    if posicaoc > 0 then
        begin
        resultdata := 3;
        exit;
        end;

{ *** verifica se ano e bissexto }
    resto := ano mod 4;
    if resto = 0 then
    diasmes [2] := 29;

    if mes > 12 then
        begin
        resultdata := 2;
        exit;
        end;

    if dia > diasmes [mes] then
        begin
        resultdata := 1;
        exit;
        end;
end;

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

{ ***controla o recebimento dos dados do cheque *** }
procedure PedeDadosCheque;
    const
    nomemes : array [1..12] of string [10] =
            ('janeiro', 'fevereiro', 'marco', 'abril', 'maio',
            'junho', 'julho', 'agosto', 'setembro', 'outubro',
            'novembro', 'dezembro');

    var
    resultdata : byte;
    dianum, mesnum, anonum : longint;
    diafalado, anofalado : string [20];
    posicaoc: integer;

    begin
    pedeValor (valorfalado, valornumerico);

    write ('Favorecido: ');
    sintsom ('chfavore');
    resposta := '';
    opcao := sintEdita (resposta, wherex, wherey, 60, true);
    writeln;

    if opcao = esc then
        finaliza;
    favorecido := resposta;
    if pessoa.localidade = '' then
        begin
        repeat
            write ('Cidade: ');
            sintsom ('chcidade');
            resposta := '';
            opcao := sintEdita (resposta, wherex, wherey, 25, true);
            writeln;
            if opcao = esc then
                finaliza;
            pessoa.localidade := resposta;
        until pessoa.localidade <> '';
        end;

{ *** pede data de pagamento}
    repeat
        write ('Data de pagamento: ');
        sintsom ('chdatapa');
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 25, true);
        writeln;
        if opcao = esc then
            finaliza;

        datapag := resposta;
        opcao := 'N';
        resultdata := 0;
        completadata;
        dataok (resultdata);
        if resultdata = 1 then sintsom ('chdiainv');
        if resultdata = 2 then sintsom ('chmesinv');
        if resultdata = 3 then fala('ano inconsistente');
        if resultdata = 0 then
            begin
            val (copy (datapag, 3,2), mesnum, posicaoc);
            val (copy (datapag, 1, 2), dianum, posicaoc);
            val (copy (datapag, 5, 2), anonum, posicaoc);
            diafalado := numeroparastring (dianum);
            anofalado := numeroparastring (anonum);
            mespalavra := nomemes [mesnum];
            sintsom ('chconfir');
            fala (diafalado + ' de ' + mespalavra +
                    ' de ' + anofalado);
            opcao := confirma;
            if opcao = esc then
                finaliza;
        end;
    until (opcao = 'S') or (opcao = enter);
end;

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

{ *** Imprime o cheque ***}
procedure ImprimeCheque;
type
    tpcheq = text;

const
    brancos : string [65] =
        '                                                                  ';

var
    frente :tpcheq;
    indlinha, indespaco : integer;
    linmasc : string [80];
    linvalp1, linvalp2 : string [80];

begin
    with parm do
    begin
        valor [6] := valor [6] + 1;
        valorfalado := valorfalado + brancos;
        repeat
            valor [6] := valor [6] - 1;
        until valorfalado [valor [6] ] = ' ';
        linvalp1 := copy (valorfalado, 1, valor [6]);
        linvalp2 := copy (valorfalado, (valor [6]  + 1),
                length (valorfalado));

        assign (frente, 'frente.che');
        {$i-} rewrite (frente); {$i+}
        if ioresult <> 0 then
           begin
               sintsom ('chegrava');
               fala ('frente.che');
               finaliza;
           end;

    { *** linha, coluna tamanho para valor numerico, (valor 1..3)}
        indlinha := 1;
        for indlinha := (indlinha + 1) to valor [1] do
            writeln (frente, brancos);
        linmasc := copy (brancos, 1, (valor [2] -1)) + quantia;
        writeln (frente, linmasc);

    { *** linha coluna tamanho para linha1 valor palavras (valor 4..6) *** }
        indlinha := indlinha + 1;
        for indlinha  := (indlinha +1) to valor [4] do
            writeln (frente, brancos);
        linmasc := copy (brancos, 1, (valor [5] - 1)) + linvalp1;
        writeln (frente, linmasc);

    { *** linha coluna tamanho para linha2 valor palavras (valor 7..9) *** }
        indlinha := indlinha + 1;
        for indlinha := (indlinha + 1) to valor [7] do
            writeln (frente, brancos);
        linmasc := copy (brancos, 1, (valor [8] - 1)) + linvalp2;
        writeln (frente, linmasc);

    { *** linha coluna tamanho para favorecido (valor 10..12) *** }
        indlinha := indlinha + 1;
        for indlinha := (indlinha + 1) to valor [10] do
            writeln (frente, brancos);
        linmasc := copy (brancos, 1, (valor [11] - 1)) + favorecido;
        writeln (frente, linmasc);

    { *** linha coluna tamanho para cidade e data (valor 13..15) *** }
    { *** dia (valor 16..18) mes (valor 19..21) ano (valor 22..24)  *** }
        indlinha := indlinha + 1;
        for indlinha := (indlinha + 1) to valor [13] do
            writeln (frente, brancos);
        linmasc := copy (brancos, 1, (valor [14] - 1)) +
            copy (pessoa.localidade, 1, valor [15]);
        indespaco := (valor [17] -1) - length (linmasc);
        linmasc := linmasc + copy (brancos, 1, indespaco) + copy (datapag, 1, 2);
        indespaco := (valor[20] - 1) - length (linmasc);
        linmasc := linmasc + copy (brancos, 1, indespaco) + mespalavra;
        indespaco := (valor [23] - 1) - length (linmasc);
        linmasc := linmasc + copy (brancos, 1, indespaco) + copy (datapag, 5, 2);
        writeln (frente, linmasc);
        close (frente);
    end;
end;

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

{ *** imprime no verso do cheque ***}
procedure imprimeVerso;
    type
    tpcheq = text;

    const
    brancos : string [65] =
        '                                                                  ';

    var
    verso : tpcheq;
    linmasc : string [80];

    begin
        assign (verso, 'verso.che');
        {$i-} rewrite (verso); {$i+}
        if     ioresult <> 0 then
            begin
            sintsom ('chegrava');
            fala ('"verso.che"');
            finaliza;
            end;

    with pessoa do
        begin
        writeln ('Descreva a finalidade deste cheque: ');
        sintsom ('chfinali');
        resposta := '';
        opcao := sintEdita (resposta, wherex, wherey, 60, true);
        if resposta <> '' then
            begin
            linmasc := '    ** ' + resposta + ' **';
            writeln (verso, linmasc);
            writeln (verso);
        end;

        linmasc := '    R.G.: ' + rg + ' - Exp. : ' + expedidor + ' - CPF: '
                + cpf;
        writeln (verso, linmasc);
        writeln (verso);
        linmasc := '    '+endereco;
        writeln (verso, linmasc);
        writeln (verso);
        linmasc := '    '+bairro;
        writeln (verso, linmasc);
        writeln (verso);
        linmasc := '    Fone: ' + tel;
        writeln (verso, linmasc);
        end;
    close (verso);
end;

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

procedure abandonaImpressao;
begin
    writeln ('Impress„o abandonada.');
    sintSom ('chiaban');
    writeln ('Arquivo FRENTE.CHE contem cheque preenchido');
    sintSom ('chafrent');
    if comVerso then
        begin
            writeln ('Arquivo VERSO.CHE contem informacoes do verso do cheque');
            sintSom ('chaverso');
        end;
end;

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

procedure jogaNaImpressora;
var c: char;
    arq: file;

begin
    writeln;
    writeln ('Nome do arquivo de impressora (sugiro PRN): ');
    sintSom ('charqimp');

    nomeSaida := '';
    opcao := sintEdita (nomeSaida, wherex, wherey, 30, true);
    if nomeSaida = '' then nomeSaida := 'PRN';

    writeln;
    writeln ('Monte o cheque na impressora e aperte ENTER.');
    sintSom ('chmonchq');
    c := readkey;
    if c = ESC then
        begin
            abandonaImpressao;
            exit;
        end;
    imprimeArquivo ('frente.che', nomeSaida);

    if comVerso then
        begin
            writeln ('Monte o verso do cheque na impressora e aperte ENTER.');
            sintSom ('chmonver');
            c := readkey;
            if c = ESC then
                begin
                    abandonaImpressao;
                    exit;
                end;
            imprimeArquivo ('verso.che', nomeSaida);
        end;

    { remove os arquivos gravados }

    assign (arq, 'frente.che');
    {$I-} erase (arq); {$I+}
    if ioresult <> 0 then;

    if comVerso then
        begin
            assign (arq, 'verso.che');
            {$I-} erase (arq); {$I+}
            if ioresult <> 0 then;
        end;
end;

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

{ *** inicio do programa ***}
begin
    inicializa;
    PedeDadosCheque;
    ImpOuSai :
        write ('Tecle ENTER para imprimir ou ESC para sair: ');
        sintsom ('chentesc');
        opcao := letecla (1);
        if opcao = enter then
            imprimeCheque
        else if opcao = esc then
                finaliza
            else begin
                sintsom ('chtecinv');
                goto ImpOuSai;
                end;

    writeln ('Deseja imprimir no verso ?');
    sintsom ('chverso');
    comVerso := confirma = 'S';
    if comVerso then
        ImprimeVerso;

    jogaNaImpressora;
    finaliza;
end.