Translate this Page

Rating: 4.3/5 (314 votos)

ONLINE
1

 

 

 

 *****

Sempre

Em

Constante

Atualização!

*****

(Brasil)

Campo Grande

(MS)

*****
Copyright

by

Claudionor

Araújo

da

Silva

 

Obrigado Pela Visita!!!

Última

Publicação

No

Google:

09/19/2021

8:20:01 PM

[Fred]

ThirdLogo



Programação

Programação

 

 

 






 

Role Para Cima

O Texto Que Está

Em Azul!!! 

 






 

O Código Do Player

Que Deu Autostart

No Firefox (PC)

E No

Android

(Acesso Pelo Facebook)!!!

 

 






 

O Interessante Desse Player

São Os Botões

[Play - Pause - Aumentar volume - Diminuir volume]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Melhor Desempenho

Com o

Firefox!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Copyright by titio.info!

Programação

No Comunidades.net!!!

Com um Pouco de Conhecimento e Muita Boa Vontade, Você Pode Fazer Milagres!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

10/09/2021

 

A Documentação

Do

Sistema

Apaga!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

24/08/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Media De Consumo
* DATA : 10/08/21
* PROGRAMA : APAGASOS.PRG
* COMENTARIO : ROTINA DE HELP

FUNCTION HELP
PARA PROG,LIN,VAR
IF M->PROG=="HELP" .OR. M->PROG=="MEMOEDIT"
RETURN .F.
ENDIF
**
** Bloco de inserçäo SOS.B01
**
SET KEY -2 TO
SET KEY -3 TO
SET KEY -5 TO
IF SUBS(M->PROG,1,6)=="CARGET"
***
*** Inicio do bloco de substituiçäo SOS07.B
M->SOS=""
SOS("")
SOS(" TECLAS DE CONTROLE DO PROGRAMA")
SOS(" ??????????????????????????????")
SOS("")
SOS(" F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-")
SOS(" nuseio do aplicativo.")
SOS("")
SOS(" F3 > Apresenta Calendário.")
SOS("")
SOS(" F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-")
SOS(" temáticas.")
SOS("")
SOS("")
SOS(" TECLAS DE CONTROLE DE EDIÇÄO")
SOS(" ????????????????????????????")
SOS("")
SOS(" Enter : Efetua a entrada de dados.")
SOS(" Setas : Movimentam o cursor para a direçäo indicada.")
SOS(" Home : Move o cursor para o início do campo.")
SOS(" End : Move o cursor para o final do campo.")
SOS(" <-- :="" apaga="" o="" caracter="" a="" esquerda="" do="" cursor="" span="">
SOS(" Ins : Liga ou Desliga o modo de inserçäo de caracteres.")
SOS(" Del : Apaga o caracter sob o cursor.")
SOS(" CTRL T : Apaga a palavra à direita do cursor.")
SOS(" CTRL Y : Apaga todo o conteúdo de um campo.")
SOS(" Esc : Abandona a Ediçäo.")
ELSEIF M->PROG=="ACHOICE"
***
*** Inicio do bloco de substituiçäo SOS08.B
M->SOS=""
SOS("")
SOS(" TECLAS DE CONTROLE DO PROGRAMA")
SOS(" ??????????????????????????????")
SOS("")
SOS(" F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-")
SOS(" nuseio do aplicativo.")
SOS("")
SOS(" F3 > Apresenta Calendário.")
SOS("")
SOS(" F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-")
SOS(" temáticas.")
SOS("")
SOS("")
SOS(" TECLAS DE NAVEGAÇÄO DO MENU")
SOS(" ???????????????????????????")
SOS("")
SOS(" Seta p/cima : Retorna a opçäo anterior.")
SOS("")
SOS(" Seta p/baixo : Acesso a opçäo seguinte.")
SOS("")
SOS(" PgUp : Retorna a página anterior.")
SOS("")
SOS(" PgDn : Acesso a página seguinte.")
SOS("")
SOS(" Enter : Confirma opçäo escolhida.")
SOS("")
SOS(" Esc : Retorna.")
*** Final do bloco de substituiçäo SOS08.B
***
ELSEIF M->SOS_MENU=="CALENDARIO"
***
*** Inicio do bloco de substituiçäo SOS01.B
M->SOS=""
SOS(" ")
SOS(" ")
SOS(" MANUSEIO DO CALENDARIO")
SOS(" ??????????????????????")
SOS(" ")
SOS(" (+) Mês : Passa para o próximo mês.")
SOS(" ")
SOS(" (-) Mês : Volta para o mês anterior.")
SOS(" ")
SOS(" (+) Ano : Passa para o próximo ano.")
SOS(" ")
SOS(" (-) Ano : Volta para o ano anteiror.")
SOS(" ")
SOS(" Ano : Permite definir o ano desejado.")
*** Final do bloco de substituiçäo SOS01.B
***
ELSEIF M->PROG=="CALCULADORA"
***
*** Inicio do bloco de substituiçäo SOS02.B
M->SOS=""
SOS(" ")
SOS(" TECLAS DE CONTROLE DA CALCULADORA")
SOS(" ?????????????????????????????????")
SOS(" ")
SOS(" * : Sinal de multiplicaçäo.")
SOS(" ")
SOS(" / : Sinal de divisäo.")
SOS(" ")
SOS(" + : Sinal de soma.")
SOS(" ")
SOS(" - : Sinal de subtraçäo.")
SOS(" ")
SOS(" E : Cancela o último valor digitado na calculadora.")
SOS(" ")
SOS(" C : Zera a calculadora.")
SOS(" ")
SOS(" Esc : Abandona o manuseio da calculadora.")
SOS(" ")
SOS(" ou = : Sinal de igualdade.")
SOS(" ")
SOS(" Ctrl + setas : Move a calculadora na tela.")
*** Final do bloco de substituiçäo SOS02.B
***
ELSEIF M->PROG=="DBEDIT" .AND. M->SOS_MENU<>"RELATORIO"
***
*** Inicio do bloco de substituiçäo SOS05.B
M->SOS=""
SOS("")
SOS(" TECLAS DE CONTROLE DO PROGRAMA")
SOS(" ??????????????????????????????")
SOS("")
SOS(" F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-")
SOS(" nuseio do aplicativo.")
SOS("")
SOS(" F3 > Apresenta Calendário.")
SOS("")
SOS(" F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-")
SOS(" temáticas.")
SOS("")
SOS("")
SOS(" TECLAS DE CONTROLE DA CONSULTA")
SOS(" ??????????????????????????????")
SOS("")
SOS(" Seta p/cima : Move para o registro anterior.")
SOS("")
SOS(" Seta p/baixo : Move para o registro seguinte.")
SOS("")
SOS(" PgUp : Move para a página anterior.")
SOS("")
SOS(" PgDn : Move para a página seguinte.")
SOS("")
SOS(" Home : Move para o início do arquivo.")
SOS("")
SOS(" End : Move para o final do arquivo.")
SOS("")
SOS(" Enter : Apresenta o conteúdo do registro.")
SOS("")
SOS(" Esc : Finaliza consulta.")
*** Final do bloco de substituiçäo SOS05.B
***
ELSE
***
*** Inicio do bloco de substituiçäo SOS06.B
M->SOS=""
SOS("")
SOS(" TECLAS DE CONTROLE DO PROGRAMA")
SOS(" ??????????????????????????????")
SOS("")
SOS(" F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-")
SOS(" nuseio do aplicativo.")
SOS("")
SOS(" F3 > Apresenta Calendário.")
SOS("")
SOS(" F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-")
SOS(" temáticas.")
*** Final do bloco de substituiçäo SOS06.B
***
ENDIF
SAVE SCREEN
M->COR=SETCOLOR()
SET CURSOR OFF
JANELA(03,02,21,77,"Auxilio ao usuário")
SETCOLOR(CONTECOR[4]+","+CONTECOR[4])
**
** Bloco de inserçäo SOS.B08
**
MEMOEDIT(M->SOS,04,04,20,75,.F.)
SETCOLOR(M->COR)
ON_CURSOR()
RESTORE SCREEN
SET KEY -2 TO CALEN
SET KEY -3 TO CALCU
**
** Bloco de inserçäo SOS.B09
**

FUNCTION SOS
PARA TEX_TO
M->SOS=M->SOS+M->TEX_TO+CHR(13)+CHR(10)


* Final do programa APAGASOS.PRG

 

A Décima Postagem De PRG

Do

Sistema Apaga!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

23/08/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Media De Consumo
* DATA : 10/08/21
* PROGRAMA : APAGAREL.PRG
* COMENTARIO : MENU DE RELATORIOS

**
** Bloco de inserçäo REL.B01
**
MENSAGEM("Tecle para sair")
DECLARE ME_NU[1]
ME_NU[1]="> Media De Consumo"
M->MENU_S=MENU()
IF M->MENU_S=0
RETURN
ENDIF
IF M->MENU_S=1
DECLARE ME_NU[1]
ME_NU[1]=" Apaga"
S_MENU=MENU(1)
IF M->S_MENU=1
DO APAGAR02.PRG
ENDIF
ENDIF
CLOSE DATABASES
**
** Bloco de inserçäo REL.B02
**

* Final do programa APAGAREL.PRG

 

A Nona Postagem De PRG

Do

Sistema Apaga!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

22/08/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Media De Consumo
* DATA : 10/08/21
* PROGRAMA : APAGAR02.PRG
* COMENTARIO : RELATORIO ( Apaga)

**
** Bloco de inserçäo R02.B01
**
MENSAGEM("Aguarde abertura de arquivos")
SELE 1
USE APAGA
***
*** Inicio do bloco de substituiçäo R02.B
MENSAGEM("Tecle para retornar")
COR("MENU")
@ LIN_MENU,00
@ LIN_MENU,01 SAY "Relatório │ Apaga"
SELE 1
SET ORDER TO 0
**
** Bloco de inserçäo R02.B02
**
GOTO TOP
M->TIPO_PRN="I"
IF .NOT. MENU_PRN("APAGA_02")
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
RETURN
ENDIF
SET DEVI TO PRINT
M->LI_NHA=1
M->PAG=1
M->TOT_0001=0
M->TOT_0002=0
M->TOT_0003=0
M->TOT_0004=0
M->TOT_0005=0
M->TOT_0006=0
**
** Bloco de inserçäo R02.B05
**
M->SAI_DA="S"
*** Final do bloco de substituiçäo R02.B
***
DO WHILE .NOT. EOF()
**
** Bloco de inserçäo R02.B06
**
IF INKEY()=27
**
** Bloco de inserçäo R02.B07
**
SET DEVI TO SCREEN
M->SAI_DA=PERG("Continua a impressäo ?")
MENSAGEM("Tecle para pausa ou interrupçäo")
SET DEVI TO PRINT
IF M->SAI_DA="N"
EXIT
ENDIF
ENDIF
IF M->LI_NHA=1
**
** Bloco de inserçäo R02.B09
**
IF TIPO_PRN<>"T"
@ 00,01 SAY CHR(18)
ENDIF
@ 01,01 SAY "Media De Consumo"
@ 01,112 SAY "Pagina: "+SUBS(STR(M->PAG+10000,5),2)
M->PAG=M->PAG+1
@ 02,01 SAY "Apaga"
@ 02,112 SAY "Data: "+DTOC(DAT_HOJE)
@ 04,01 SAY REPL("-",125)
@ 05,001 SAY "Data Anterior"
@ 05,016 SAY "Data Atual"
@ 05,028 SAY "Quantidade De Dias"
@ 05,048 SAY "Leitura Anterior"
@ 05,066 SAY "Leitura Atual"
@ 05,081 SAY "Consumo"
@ 05,093 SAY "Media Diaria"
@ 05,107 SAY "Projecao Para o Mes"
@ 06,01 SAY REPL("-",125)
M->LI_NHA=07
**
** Bloco de inserçäo R02.B10
**
ENDIF
**
** Bloco de inserçäo R02.B20
**
@ M->LI_NHA,001 SAY DATA1
@ M->LI_NHA,016 SAY DATA2
@ M->LI_NHA,028 SAY QUANTDIAS2 PICTURE "@E 99"
@ M->LI_NHA,048 SAY LEITANT PICTURE "@E 99999"
@ M->LI_NHA,066 SAY LEITATU PICTURE "@E 99999"
@ M->LI_NHA,081 SAY CONSUMO PICTURE "@E 9999999999"
@ M->LI_NHA,093 SAY MEDIADIAR PICTURE "@E 9999999.99"
@ M->LI_NHA,107 SAY PROJECAO PICTURE "@E 9999999.99"
**
** Bloco de inserçäo R02.B21
**
M->TOT_0001=M->TOT_0001+QUANTDIAS2
M->TOT_0002=M->TOT_0002+LEITANT
M->TOT_0003=M->TOT_0003+LEITATU
M->TOT_0004=M->TOT_0004+CONSUMO
M->TOT_0005=M->TOT_0005+MEDIADIAR
M->TOT_0006=M->TOT_0006+PROJECAO
M->LI_NHA=M->LI_NHA+1
**
** Bloco de inserçäo R02.B12
**
SKIP
IF M->LI_NHA>58 .OR. EOF()
IF EOF()
TOT_02(2)
ELSE
TOT_02(1)
ENDIF
M->LI_NHA=1
ENDIF
ENDDO
**
** Bloco de inserçäo R02.B18
**
EJECT
SET DEVI TO SCREEN
IF M->TIPO_PRN = "A"
SET PRINTER TO
ELSEIF M->TIPO_PRN = "T" .AND. M->SAI_DA="S"
SET PRINTER TO
IMP_TELA("APAGA_02",126)
ENDIF
**
** Bloco de inserçäo R02.B19
**
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)

FUNCTION TOT_02
PARA PAR1
IF PAR1=2
M->LI_NHA=59
ENDIF
@ M->LI_NHA+0,01 SAY REPL("-",125)
IF PAR1=2
@ M->LI_NHA+1,001 SAY "TOTAL"
ELSE
@ M->LI_NHA+1,001 SAY "SUBTOTAL"
ENDIF
@ M->LI_NHA+1,025 SAY M->TOT_0001 PICTURE "@E 9,999"
@ M->LI_NHA+1,046 SAY M->TOT_0002 PICTURE "@E 9999999"
@ M->LI_NHA+1,064 SAY M->TOT_0003 PICTURE "@E 9999999"
@ M->LI_NHA+1,079 SAY M->TOT_0004 PICTURE "@E 999999999999"
@ M->LI_NHA+1,091 SAY M->TOT_0005 PICTURE "@E 999999999.99"
@ M->LI_NHA+1,105 SAY M->TOT_0006 PICTURE "@E 999999999.99"
@ M->LI_NHA+2,01 SAY REPL("-",125)

* Final do programa APAGAR02.PRG


 

A Oitava Postagem De PRG

Do

Sistema Apaga!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

20/08/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Media De Consumo
* DATA: 10/08/21
* PROGRAMA: APAGAINC.PRG
* COMENTARIO: MENU DE INCLUSAO

**
** Bloco de inserçäo INC.B01
**
MENSAGEM("Tecle para sair")
DECLARE ME_NU[1]
ME_NU[1]="> Media De Consumo"
M->MENU_S=MENU()
IF M->MENU_S=0
RETURN
ENDIF
IF M->MENU_S=1
DECLARE ME_NU[1]
ME_NU[1]=" Apaga"
S_MENU=MENU(1)
IF M->S_MENU=1
DO APAGAI02.PRG
ENDIF
ENDIF
CLOSE DATABASES
**
** Bloco de inserçäo INC.B02
**

* Final do programa APAGAINC.PRG


 

A Sétima Postagem De PRG

Do

Sistema Apaga!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

19/08/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Media De Consumo
* DATA : 10/08/21
* PROGRAMA : APAGAI02.PRG
* COMENTARIO : INCLUSAO ( Apaga)

**
** Bloco de inserçäo I02.B01
**
MENSAGEM("Aguarde abertura de arquivos")
SELE 1
USE APAGA
SELE 1
**
** Bloco de inserçäo I02.B02
**
***
*** Inicio do bloco de substituiçäo I02.B
COR("MENU")
@ LIN_MENU,00
@ LIN_MENU,01 SAY "Inclusäo ? Apaga"
M->P_VERI = .T.
M->X_VERI = .F.
DO WHILE .T.
**
** Bloco de inserçäo I02.B03
**
MENSAGEM("Tecle para retornar")
IF M->P_VERI
**
** Bloco de inserçäo I02.B04
**
CARREG02(1)
ELSE
M->X_VERI = .T.
**
** Bloco de inserçäo I02.B05
**
ENDIF
IF CARGET02(1)=.F.
EXIT
ENDIF
**
** Bloco de inserçäo I02.B10
**
IF PERG("Confirma as informaçöes ?")="N"
M->P_VERI = .F.
**
** Bloco de inserçäo I02.B11
**
LOOP
ENDIF
M->P_VERI = .T.
M->X_VERI = .F.
**
** Bloco de inserçäo I02.B12
**
APPEND BLANK
SALVAR02()
COMMIT
ENDDO
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
**
** Bloco de inserçäo I02.B13
**
*** Final do bloco de substituiçäo I02.B
***

FUNCTION IFU02001
IF .NOT.(.NOT.EMPTY(M->DATA1)) .AND. LASTKEY()<>5
BEEP()
MENSAGEM("Entre Com a Data!!!",3)
MENSAGEM("Tecle para retornar")
RETURN .F.
ENDIF
RETURN .T.

FUNCTION IFU02002
IF .NOT.(.NOT.EMPTY(M->DATA2)) .AND. LASTKEY()<>5
BEEP()
MENSAGEM("Entre Com a Data!!!",3)
MENSAGEM("Tecle para retornar")
RETURN .F.
ENDIF
RETURN .T.

FUNCTION IFU02003
IF .NOT.(M->QUANTDIAS1=CTOD(" / / ")) .AND. LASTKEY()<>5
BEEP()
MENSAGEM("Nao Digita Nada Aqui!",3)
MENSAGEM("Tecle para retornar")
RETURN .F.
ENDIF
IF M->DATA2=CTOD(" / / ") .OR. M->DATA1=CTOD(" / / ")
M->QUANTDIAS2 = 0
RETURN .T.
ENDIF
M->QUANTDIAS2 = M->DATA2-M->DATA1
COR("GETS")
RETURN .T.

FUNCTION IFU02005
IF .NOT.(.NOT.EMPTY(M->LEITANT)) .AND. LASTKEY()<>5
BEEP()
MENSAGEM("Entre Com a Leitura!",3)
MENSAGEM("Tecle para retornar")
RETURN .F.
ENDIF
RETURN .T.

FUNCTION IFU02006
IF .NOT.(.NOT.EMPTY(M->LEITATU)) .AND. LASTKEY()<>5
BEEP()
MENSAGEM("Entre Com a Leitura!",3)
MENSAGEM("Tecle para retornar")
RETURN .F.
ENDIF
RETURN .T.

FUNCTION IFU02007
M->CONSUMO = M->LEITATU-M->LEITANT
COR("GETS")
RETURN .T.

FUNCTION IFU02008
M->MEDIADIAR = M->CONSUMO/M->QUANTDIAS2
COR("GETS")
RETURN .T.

FUNCTION IFU02009
M->PROJECAO = 30*M->MEDIADIAR
COR("GETS")
RETURN .T.

FUNCTION CARREG02
PARA R_CAR
**
** Bloco de inserçäo I02.B14
**
PUBLIC DATA1,DATA2,QUANTDIAS1,QUANTDIAS2,LEITANT,LEITATU,CONSUMO,MEDIA DIAR,PROJECAO
IF M->R_CAR=1
M->DATA1=CTOD(" / / ")
M->DATA2=CTOD(" / / ")
M->QUANTDIAS1=CTOD(" / / ")
M->QUANTDIAS2=0
M->LEITANT=0
M->LEITATU=0
M->CONSUMO=0
M->MEDIADIAR=0
M->PROJECAO=0
**
** Bloco de inserçäo I02.B15
**
ELSE
M->DATA1=DATA1
M->DATA2=DATA2
M->QUANTDIAS1=QUANTDIAS1
M->QUANTDIAS2=QUANTDIAS2
M->LEITANT=LEITANT
M->LEITATU=LEITATU
M->CONSUMO=CONSUMO
M->MEDIADIAR=MEDIADIAR
M->PROJECAO=PROJECAO
**
** Bloco de inserçäo I02.B16
**
ENDIF

FUNCTION CARGET02
PARA R_CAR
**
** Bloco de inserçäo I02.B17
**
JANELA( 4, 1,20,78," Apaga")
COR("CERCADURAS")
@ 5, 2 TO 19,77 DOUBL
**
** Bloco de inserçäo I02.B18
**
COR("GETS")
@ 10,39 SAY "[NAO DIGITE NADA AQUI]"
@ 16,56 SAY "[PROJECAO PARA O MES]"
**
** Bloco de inserçäo I02.B21
**
IF M->X_VERI
IFU02007()
IFU02008()
IFU02009()
IFU02003()
ENDIF
@ 6, 3 SAY "Data Da Leitura Anterior:" GET M->DATA1 VALID IFU02001()
@ 8, 3 SAY "Data Da Leitura Atual...:" GET M->DATA2 VALID IFU02002()
@ 10, 3 SAY "Diferenca Entre As Datas:" GET M->QUANTDIAS1 VALID IFU020 03()
@ 12, 3 SAY "Diferenca Entre As Datas:" GET M->QUANTDIAS2 PICTURE "@E 99"
@ 14, 3 SAY "Leitura Anterior........:" GET M->LEITANT PICTURE "@E 999 99" VALID IFU02005()
@ 16, 3 SAY "Leitura Atual...........:" GET M->LEITATU PICTURE "@E 999 99" VALID IFU02006()
@ 18, 3 SAY "Consumo (KWh)...........:" GET M->CONSUMO PICTURE "@E 999 9999999" VALID IFU02007()
@ 6,53 SAY "Media Diaria:" GET M->MEDIADIAR PICTURE "@E 9999999.99" V ALID IFU02008()
@ 18,54 SAY "Projecao...:" GET M->PROJECAO PICTURE "@E 9999999.99" VAL ID IFU02009()
**
** Bloco de inserçäo I02.B24
**
IF M->R_CAR=3 .OR. M->R_CAR=0
CLEAR GETS
IF M->R_CAR=0
RETURN .T.
ENDIF
MENSAGEM("Tecle algo para continuar")
M->R_X=INKEY(0)
IF M->R_X=27
RETURN .F.
ENDIF
ELSE
SET CURSOR ON
READ
SET CURSOR OFF
IF LASTKEY()=27
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION SALVAR02
**
** Bloco de inserçäo I02.B27
**
REPLACE DATA1 WITH M->DATA1
REPLACE DATA2 WITH M->DATA2
REPLACE QUANTDIAS1 WITH M->QUANTDIAS1
REPLACE QUANTDIAS2 WITH M->QUANTDIAS2
REPLACE LEITANT WITH M->LEITANT
REPLACE LEITATU WITH M->LEITATU
REPLACE CONSUMO WITH M->CONSUMO
REPLACE MEDIADIAR WITH M->MEDIADIAR
REPLACE PROJECAO WITH M->PROJECAO
**
** Bloco de inserçäo I02.B28
**

* Final do programa APAGAI02.PRG


 

A Sexta Postagem De PRG

Do

Sistema Apaga!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

18/08/2021

Role Para Cima

O Texto Que Está

Em Azul!!!


* TITULO : Media De Consumo
* DATA : 10/08/21
* PROGRAMA : APAGAFUN.PRG
* COMENTARIO : FUNCOES

**
** Bloco de inserçäo FUN.B01
**
FUNCTION T_DIR
KEYBOARD CHR(27)
BUFFER=CHR(4)+CHR(13)

FUNCTION T_ESQ
KEYBOARD CHR(27)
BUFFER=CHR(19)+CHR(13)

FUNCTION CALEN
M->CALEN_X=ROW()
M->CALEN_Y=COL()
M->CLEN_COR=SETCOLOR()
SET CURSOR OFF
SET DATE BRIT
SET CENTURY ON
M->CA_MES=MONTH(M->DAT_HOJE)
M->CA_ANO=YEAR(M->DAT_HOJE)
M->CA_DATA=CTOD("01/"+STR(M->CA_MES,2)+"/"+STR(M->CA_ANO,4))
M->CA_TELA1=SAVESCREEN(04,11,21,66)
JANELA(04,13,20,66,"Calendário")
BOTAO(10,53,"(+) Mês",1)
BOTAO(12,53,"(-) Mês",2)
BOTAO(14,53,"(+) Ano",3)
BOTAO(16,53,"(-) Ano",4)
BOTAO(18,53,"Ano",5)
M->OPC_BOT=1
M->SOS_MENU="CALENDARIO"
DO WHILE .T.
COR("JANELA DE DIALOGO")
@ 06,16 SAY "Dom Seg Ter Qua Qui Sex Sab"
SETCOLOR(SUBS(CONTECOR[6],4,2)+"/"+SUBS(CONTECOR[4],4,2))
FOR F_CALEN=8 TO 18 STEP 2
@ F_CALEN+0,16 SAY "████ ████ ████ ████ ████ ████ ████"
@ F_CALEN+1,16 SAY "▀▀▀▀ ▀▀▀▀ ▀▀▀▀ ▀▀▀▀ ▀▀▀▀ ▀▀▀▀ ▀▀▀▀"
NEXT
IF AT(SUBS(STR(M->CA_MES+100,3),2),"01 03 05 07 08 10 12")<>0
M->ULT_DIA = 31
ELSE
M->ULT_DIA=IIF(M->CA_MES#2,30,IIF(MOD(M->CA_ANO,4)=0,29,28))
ENDIF
M->X_X=DOW(M->CA_DATA)
M->Y_Y=8
COR("BOTOES")
FOR F_CALEN=1 TO M->ULT_DIA
IF M->X_X=1
COR("BOTAO EM DESTAQUE")
@ M->Y_Y,(M->X_X*5)+13 SAY STR(F_CALEN,2)
COR("BOTOES")
ELSE
@ M->Y_Y,(M->X_X*5)+13 SAY STR(F_CALEN,2)
ENDIF
M->X_X=M->X_X+1
IF M->X_X>7
M->X_X=1
M->Y_Y=M->Y_Y+2
ENDIF
NEXT
COR("BOTOES")
@ 06,53 CLEAR TO 07,63
@ 06,57 SAY SUBS("JanFevMarAbrMaiJunJulAgoSetOutNovDez",MONTH(M->CA_DATA)*3-2,3)
@ 07,56 SAY TRAN(YEAR(M->CA_DATA),"@E 9,999")
M->OPC_BOT=BOTAO(M->OPC_BOT)
IF M->OPC_BOT=0
EXIT
ELSEIF M->OPC_BOT=5
SETCOLOR(CONTECOR[2])
@ 07,54 SAY CHR(26)
M->CA_TEMP=""
M->TECLA=0
SET CURSOR ON
DO WHILE M->TECLA<>13 .AND. M->TECLA<>27
IF AT(CHR(M->TECLA),"0123456789")<>0
M->CA_TEMP=M->CA_TEMP+CHR(M->TECLA)
IF LEN(M->CA_TEMP)=4
EXIT
ENDIF
ENDIF
IF (M->TECLA=19 .OR. M->TECLA=8) .AND. LEN(M->CA_TEMP)>0
M->CA_TEMP=SUBS(M->CA_TEMP,1,LEN(M->CA_TEMP)-1)
ENDIF
@ 07,56 SAY " . "
IF LEN(M->CA_TEMP)=0
@ 07,56 SAY ""
ELSE
@ 07,56 SAY TRIM(SUBS(M->CA_TEMP,1,1)+"."+SUBS(M->CA_TEMP,2))
ENDIF
M->TECLA=INKEY(0)
ENDDO
SET CURSOR OFF
M->CA_ANO=VAL(M->CA_TEMP)
@ 07,54 SAY " "
ENDIF
M->CA_ANO=M->CA_ANO+IIF(M->OPC_BOT=4,-1,IIF(M->OPC_BOT=3,1,0))
M->CA_ANO=IIF(M->CA_ANO<100,100,IIF(M->CA_ANO>2999,2999,M->CA_ANO))
M->CA_MES=M->CA_MES+IIF(M->OPC_BOT=2,-1,IIF(M->OPC_BOT=1,1,0))
M->CA_MES=IIF(M->CA_MES<1,12,IIF(M->CA_MES>12,1,M->CA_MES))
M->CA_DATA=CTOD("01/"+STR(M->CA_MES,2)+"/"+STR(M->CA_ANO,4))
ENDDO
M->SOS_MENU=""
RESTSCREEN(04,11,21,66,M->CA_TELA1)
SETCOLOR(M->CLEN_COR)
ON_CURSOR()
SET CENTURY OFF
@ M->CALEN_X,M->CALEN_Y SAY ""

FUNCTION BEEP
TONE(250,4)

FUNCTION ON_CURSOR
M->GET_VAR=READVAR()
IF LEN(M->GET_VAR)>0 .AND. M->GET_VAR<>"MENU_OPC"
SET CURSOR ON
ENDIF

FUNCTION MENSAGEM
COR_MENS=SETCOLOR()
COR("MENU")
SET CURSOR OFF
IF PCOUNT()=0
@ 24,11 SAY SPACE(58)
SETCOLOR(COR_MENS)
ON_CURSOR()
RETURN .T.
ENDIF
IF PCOUNT()=1
PARA TEX_TO
M->PAUSA=0
ELSE
PARA TEX_TO,PAUSA
ENDIF
@ 24,11 SAY SPACE(58)
@ 24,((80-LEN(M->TEX_TO))/2) SAY M->TEX_TO
IF M->PAUSA<>0
M->X=INKEY(M->PAUSA)
ENDIF
SETCOLOR(COR_MENS)
ON_CURSOR()
RETURN .T.

FUNCTION DELE_TAR
RETURN IIF(DELETED(),"*"," ")

FUNCTION PERGUNTA
PER_COR=SETCOLOR()
SET CURSOR OFF
SAVE SCREEN TO PER_TELA
M->RES_POSTA="S"
PARA TEX_TO,RES_POSTA
M->SIM_NAO=IIF(M->RES_POSTA="N",2,1)
M->LAR_G=LEN(M->TEX_TO)
IF M->LAR_G<37
M->LAR_G=51
ELSE
M->LAR_G=M->LAR_G+14
ENDIF
COL_SUP=INT((80-M->LAR_G)/2)
COL_INF=COL_SUP+LAR_G-1
JANELA(08,COL_SUP,16,COL_INF)
COR("JANELA DE DIALOGO")
@ 11,(80-LEN(TEX_TO))/2 SAY TEX_TO
BOTAO(13,25,"Sim",1)
BOTAO(13,42,"Näo",2)
SIM_NAO=BOTAO()
RESTORE SCREEN FROM PER_TELA
SETCOLOR(PER_COR)
RETURN IIF(M->SIM_NAO=1,"S","N")

FUNCTION BOTAO
PARA LIN_BOT,COL_BOT,NOM_BOT,NUM_BOT
IF PCOUNT()=0
NUM_BOT=0
ENDIF
IF PCOUNT()=3
NUM_BOT=-1
ENDIF
IF PCOUNT()=4
IF NUM_BOT<1
Q_BOTOES=1
ELSE
Q_BOTOES=NUM_BOT
ENDIF
BOTOES[Q_BOTOES]=STR(COL_BOT,3)+STR(LIN_BOT,3)+NOM_BOT
ENDIF
IF PCOUNT()=1
X_BOT=LIN_BOT
NUM_BOT=0
ELSE
X_BOT=1
ENDIF
IF NUM_BOT>0 .OR. NUM_BOT=-1
COR("BOTOES")
@ LIN_BOT,COL_BOT SAY SPACE(11)
@ LIN_BOT,COL_BOT+1 SAY NOM_BOT
SETCOLOR("N/"+ALLTRIM(SUBS(CONTECOR[4],4)))
@ LIN_BOT,COL_BOT-1 SAY "▄"
@ LIN_BOT+1,COL_BOT-1 SAY "▀▀▀▀▀▀▀▀▀▀▀ "
ELSE
TECLA=0
DO WHILE .T.
COL_BOT=VAL(SUBS(BOTOES[X_BOT],1,3))
LIN_BOT=VAL(SUBS(BOTOES[X_BOT],4,3))
NOM_BOT=SUBS(BOTOES[X_BOT],7)
COR("BOTAO EM DESTAQUE")
@ LIN_BOT,COL_BOT SAY SPACE(11)
@ LIN_BOT,COL_BOT+1 SAY NOM_BOT
SETCOLOR("N/"+ALLTRIM(SUBS(CONTECOR[4],4)))
@ LIN_BOT,COL_BOT-1 SAY "▄"
@ LIN_BOT+1,COL_BOT-1 SAY "▀▀▀▀▀▀▀▀▀▀▀ "
IF TECLA=13
INKEY(.2)
RETURN X_BOT
ENDIF
IF NUM_BOT=-2
TECLA=13
ELSE
TECLA=INKEY(0)
ENDIF
IF TECLA=27
RETURN 0
ENDIF
IF TECLA=28
DO HELP WITH "CALENDARIO",1,""
ENDIF
COR("BOTOES")
@ LIN_BOT,COL_BOT+1 SAY NOM_BOT
FOR F_BOT=1 TO Q_BOTOES
IF SUBS(BOTOES[F_BOT],7,1)=UPPER(CHR(TECLA))
X_BOT=F_BOT
TECLA=13
COL_BOT=VAL(SUBS(BOTOES[X_BOT],1,3))
LIN_BOT=VAL(SUBS(BOTOES[X_BOT],4,3))
NOM_BOT=SUBS(BOTOES[X_BOT],7)
EXIT
ENDIF
NEXT
IF TECLA=13
COR("JANELA DE DIALOGO")
@ LIN_BOT,COL_BOT SAY " "
@ LIN_BOT+1,COL_BOT-1 SAY " "
@ LIN_BOT,COL_BOT+10 SAY " "
COR("BOTAO EM DESTAQUE")
@ LIN_BOT,COL_BOT-1 SAY " "+NOM_BOT+" "
INKEY(.2)
LOOP
ENDIF
IF TECLA=19 .OR. TECLA=5
X_BOT=X_BOT-1
ELSEIF TECLA=4 .OR. TECLA=24
X_BOT=X_BOT+1
ENDIF
X_BOT=IIF(X_BOT<1,Q_BOTOES,IIF(X_BOT>Q_BOTOES,1,X_BOT))
ENDDO
ENDIF

FUNCTION FUN_ACHO
PARA PAR1,PAR2,PAR3
M->TEC_ACHO=UPPER(CHR(LASTKEY()))
IF (M->TEC_ACHO>="A" .AND. M->TEC_ACHO<="Z") .OR. (M->TEC_ACHO>="0" .AND. M->TEC_ACHO<="9")
FOR M->X_ACHO=1 TO LEN(ME_NU)
FOR M->ACHO_X=1 TO LEN(ME_NU[M->X_ACHO])
IF (SUBS(ME_NU[M->X_ACHO],M->ACHO_X,1)>="A" .AND. SUBS(ME_NU[M->X_ACHO],M->ACHO_X,1)<="Z") .OR. (SUBS(ME_NU[M->X_ACHO],M->ACHO_X,1)>="0" .AND. SUBS(ME_NU[M->X_ACHO],M->ACHO_X,1)<="9")
IF SUBS(ME_NU[M->X_ACHO],M->ACHO_X,1) = M->TEC_ACHO
M->OPC_ACHO = M->X_ACHO
RETURN 0
ENDIF
EXIT
ENDIF
NEXT
NEXT
ENDIF
IF LASTKEY()=13
M->INC_COL=ROW()
RETURN 1
ELSEIF LASTKEY()=27 .OR. M->TEC_ACHO="R"
RETURN 0
ELSEIF PAR1=1
KEYBOARD CHR(30)
ELSEIF PAR1=2
KEYBOARD CHR(31)
ENDIF
RETURN 2

FUNCTION MENU
PARA N_TELA
IF PCOUNT()=0
N_TELA=0
SET KEY 4 TO T_DIR
SET KEY 19 TO T_ESQ
ENDIF
M->M_POS=MENU_POS[M->MENU_P]
M->LIN_INIC=LIN_MENU+1
IF N_TELA=1 .OR. N_TELA=2
M->M_POS=M->M_POS+10
IF N_TELA=1
M->LIN_INIC=LIN_MENU+MENU_S+2
ELSE
M->LIN_INIC=LIN_MENU+2
ENDIF
ENDIF
M->LAR_G=0
M->AL_TU=LEN(ME_NU)
DECLARE MEN_U[M->AL_TU] , MAR_C[M->AL_TU]
AFILL(MAR_C,.T.)
FOR M->X_X=1 TO M->AL_TU
MEN_U[M->X_X]=" "+TRIM(ME_NU[M->X_X])+" "
IF LEN(MEN_U[M->X_X]) > M->LAR_G
M->LAR_G=LEN(MEN_U[M->X_X])
IF SUBS(MEN_U[M->X_X],2,1)=">"
M->LAR_G=M->LAR_G+1
ENDIF
ENDIF
NEXT
IF M->LAR_G < 18
M->LAR_G=18
ENDIF
FOR M->X_X=1 TO M->AL_TU
IF MEN_U[M->X_X]=" - "
MAR_C[M->X_X]=.F.
MEN_U[M->X_X]=REPL("─",M->LAR_G)
ENDIF
IF SUBS(MEN_U[M->X_X],2,1)=">"
MEN_U[M->X_X]=" "+SUBS(MEN_U[M->X_X],3)+SPACE((M->LAR_G-LEN(ALLTRIM(MEN_U[M->X_X])))-3)+CHR(16)+" "
ENDIF
NEXT
M->AL_TU=M->AL_TU+2
IF M->AL_TU>15
M->AL_TU=15
ENDIF
M->ULT_OPC=M->AL_TU
IF M->M_POS + M->LAR_G + 3 > 79
IF M->N_TELA=0
M->M_POS = M->M_POS - ((M->LAR_G+2) - LEN(MENU_PRI[M->MENU_P]))
ELSE
M->M_POS = M->M_POS - ((M->M_POS+M->LAR_G+3)-79)
ENDIF
ENDIF
M->X_X=M->M_POS+M->LAR_G+2
COR("MENU")
@ M->LIN_INIC,M->M_POS CLEAR TO M->AL_TU+M->LIN_INIC-1,M->M_POS+M->LAR_G+3
@ M->LIN_INIC,M->M_POS+1 TO M->AL_TU+M->LIN_INIC-1,M->M_POS+M->LAR_G+2
IF M->AL_TU<15
FOR M->X_X=1 TO M->AL_TU-2
IF SUBS(MEN_U[M->X_X],1,1)="─"
@ M->X_X+M->LIN_INIC,M->M_POS+1 SAY "├"
@ M->X_X+M->LIN_INIC,M->M_POS+M->LAR_G+2 SAY "┤"
ENDIF
NEXT
ENDIF
IF LEN(MEN_U) > M->AL_TU-2
@ M->LIN_INIC+1,M->M_POS+M->LAR_G+3 SAY CHR(24)
@ M->LIN_INIC+M->AL_TU-2,M->M_POS+M->LAR_G+3 SAY CHR(25)
ENDIF
M->OPC_ACHO=0
M->MENU_OPC=ACHOICE(M->LIN_INIC+1,M->M_POS+2,M->LIN_INIC+M->AL_TU-2,M->M_POS+M->LAR_G+1,MEN_U,MAR_C,"FUN_ACHO")
IF M->MENU_OPC=0
M->MENU_OPC = M->OPC_ACHO
IF N_TELA=0 .AND. BUFFER=CHR(13) .AND. M->MENU_OPC=0
BUFFER="S"+CHR(13)
ENDIF
ENDIF
IF MENU_OPC<>0
IF .NOT.(N_TELA=0 .AND. SUBS(MEN_U[MENU_OPC],LEN(MEN_U[MENU_OPC])-1,1)=CHR(16))
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
ELSE
IF LEN(MEN_U) <= M->AL_TU
COR("DESTAQUE DO MENU")
@ LIN_MENU+MENU_OPC+1,COL() SAY MEN_U[MENU_OPC]
ENDIF
ENDIF
ELSE
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
ENDIF
SET KEY 4 TO
SET KEY 19 TO
RETURN M->MENU_OPC

FUNCTION CONFCOR
DECLARE ME_NU[13]
ME_NU[01]="Papel de parede"
ME_NU[02]="Menu"
ME_NU[03]="Destaque do menu"
ME_NU[04]="Janela de dialogo"
ME_NU[05]="Box da janela de dialogo"
ME_NU[06]="Botoes"
ME_NU[07]="Botao em destaque"
ME_NU[08]="Get's"
ME_NU[09]="Get em destaque"
ME_NU[10]="Tela de apresentacao"
ME_NU[11]="Caracteres avulsos"
ME_NU[12]="Cercaduras"
ME_NU[13]="Titulo"
OPC_COR=MENU(1)
IF OPC_COR=0
RETURN.T.
ENDIF
SET COLOR TO W
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
COR("MENU")
@ LIN_MENU,00
@ LIN_MENU,01 SAY "Configuraçäo de cores │ "+ME_NU[OPC_COR]
COR("FUNDO DA TELA")
IF FUNDO=10
FUN_DO="░░░░"
ELSE
FUN_DO="└┐└┐"
ENDIF
MENSAGEM("Utilize as setas para configurar as cores")
IF OPC_COR<>10
FOR F=1+LIN_MENU TO 17
@ F+03,20 SAY REPL(SUBS(FUN_DO,1,2),30)
FUN_DO=SUBS(FUN_DO,3)+SUBS(FUN_DO,1,2)
NEXT
FUN_DO=SUBS(FUN_DO,3)+SUBS(FUN_DO,1,2)
COR("TITULO")
@ 03,20 SAY " Titulo do aplicativo "
COR("MENU")
@ LIN_MENU+03,20 SAY " Inclusöes Consultas Alteraçöes Exclusöes Relatórios "
@ 21,20 SAY SPACE(60)
@ 21,21 SAY DTOC(DATE())+" │"
@ 21,38 SAY "Escolha a opçäo desejada"
@ 21,69 SAY "│ F1-Ajuda"
ENDIF
IF OPC_COR=3
@ LIN_MENU+04,22 SAY " ┌─────────────────────┐ "
@ LIN_MENU+05,22 SAY " │ Opçäo um                                         │ "
@ LIN_MENU+06,22 SAY " ├─────────────────────┤ "
@ LIN_MENU+07,22 SAY " │ Opçäo dois                                        │ "
@ LIN_MENU+08,22 SAY " │ Opçäo tres                                         │ "
@ LIN_MENU+09,22 SAY " └─────────────────────┘ "
ENDIF
IF OPC_COR=4 .OR. OPC_COR=5 .OR. OPC_COR=6 .OR. OPC_COR=7
COR("BOX DA JANELA DE DIALOGO")
@ 08,28,16,71 BOX " "
@ 08,28 SAY "■"
COR("JANELA DE DIALOGO")
@ 09,29 CLEAR TO 15,70
@ 11,38 SAY "Confirma o encerramento ?"
BOTAO(13,36,"Sim")
BOTAO(13,53,"Näo")
COR("BOTAO EM DESTAQUE")
@ 13,37 SAY "Sim"
ENDIF
IF OPC_COR=8 .OR. OPC_COR=9 .OR. OPC_COR=11 .OR. OPC_COR=12
COR("JANELA DE DIALOGO")
@ 06,23 CLEAR TO 18,76
COR("BOX DA JANELA DE DIALOGO")
@ 06,23,18,76 BOX " "
@ 06,23 SAY "■"
@ 06,41 SAY "Cadastro de clientes"
COR("CERCADURAS")
@ 11,27 TO 11,48
@ 11,52 TO 11,72
@ 15,27 TO 15,48
@ 15,52 TO 15,63
@ 15,66 TO 15,72
COR("CARACTERES AVULSOS")
@ 10,27 SAY "Nome"
@ 10,52 SAY "Empresa"
@ 14,27 SAY "Endereço"
@ 14,52 SAY "Bairro"
@ 14,66 SAY "Cep"
COR("GET EM DESTAQUE")
@ 12,27 SAY "TESTE"+SPACE(17)
SETCOLOR(CONTECOR[8])
@ 12,52 SAY "TESTE"+SPACE(16)
@ 16,27 SAY "TESTE"+SPACE(17)
@ 16,52 SAY "TESTE"+SPACE(7)
@ 16,66 SAY "9999999"
ENDIF
X_COR=07
Y_COR=0
SET CURSOR OFF
SET COLOR TO BG/RB
@ X_COR,Y_COR,X_COR+9,Y_COR+17 BOX "█"
FOR F_COR=0 TO 7
FOR C_COR=0 TO 15
AA=ALLTRIM(STR(C_COR,2))+"/"+ALLTRIM(STR(F_COR,2))
SETCOLOR(AA)
@ F_COR+X_COR+1,C_COR+Y_COR+1 SAY "■"
NEXT
NEXT
C_COR=VAL(SUBS(CONTECOR[OPC_COR],1,2))
F_COR=VAL(SUBS(CONTECOR[OPC_COR],4))
DO WHILE .T.
SET COLOR TO N/BG
@ X_COR,Y_COR,X_COR+9,Y_COR+17 BOX " "
@ F_COR+X_COR+1,Y_COR+17 SAY CHR(17)
@ X_COR,Y_COR+C_COR+1 SAY CHR(31)
SETCOLOR(ALLTRIM(STR(C_COR,3))+"/"+ALLTRIM(STR(F_COR,3)))
CONTECOR[OPC_COR]=STRZERO(C_COR,2)+"/"+STRZERO(F_COR,2)
IF OPC_COR=1
FOR F=1+LIN_MENU TO 17
@ F+03,20 SAY REPL(SUBS(FUN_DO,1,2),30)
FUN_DO=SUBS(FUN_DO,3)+SUBS(FUN_DO,1,2)
NEXT
FUN_DO=SUBS(FUN_DO,3)+SUBS(FUN_DO,1,2)
ELSEIF OPC_COR=2
@ LIN_MENU+03,20 SAY " Inclusöes Consultas Alteraçöes Exclusöes Relatórios "
@ 21,20 SAY SPACE(60)
@ 21,21 SAY DTOC(DATE())+" │"
@ 21,38 SAY "Escolha a opçäo desejada"
@ 21,69 SAY "│ F1-Ajuda"
IF OPC_COR=2
@ LIN_MENU+04,22 SAY " ┌─────────────────────┐ "
@ LIN_MENU+05,22 SAY " │ Opçäo um                                         │ "
@ LIN_MENU+06,22 SAY " ├─────────────────────┤ "
@ LIN_MENU+07,22 SAY " │ Opçäo dois                                        │ "
@ LIN_MENU+08,22 SAY " │ Opçäo tres                                        │ "
@ LIN_MENU+09,22 SAY " └─────────────────────┘ "
COR("DESTAQUE DO MENU")
@ LIN_MENU+03,22 SAY " Inclusöes "
@ LIN_MENU+05,24 SAY " Opçäo um "
ENDIF
ELSEIF OPC_COR=3
@ LIN_MENU+03,22 SAY " Inclusöes "
@ LIN_MENU+05,24 SAY " Opçäo um "
ELSEIF OPC_COR=5
@ 08,28,16,71 BOX " "
@ 08,28 SAY "■"
ELSEIF OPC_COR=4
@ 09,29 CLEAR TO 15,70
@ 11,38 SAY "Confirma o encerramento ?"
BOTAO(13,36,"Sim")
BOTAO(13,53,"Näo")
COR("BOTAO EM DESTAQUE")
@ 13,37 SAY "Sim"
ELSEIF OPC_COR=6
BOTAO(13,53,"Näo")
ELSEIF OPC_COR=7
BOTAO(13,36,"Sim")
COR("BOTAO EM DESTAQUE")
@ 13,36 SAY " Sim "
ELSEIF OPC_COR=12
@ 11,27 TO 11,48
@ 11,52 TO 11,72
@ 15,27 TO 15,48
@ 15,52 TO 15,63
@ 15,66 TO 15,72
ELSEIF OPC_COR=11
@ 10,27 SAY "Nome"
@ 10,52 SAY "Empresa"
@ 14,27 SAY "Endereço"
@ 14,52 SAY "Bairro"
@ 14,66 SAY "Cep"
ELSEIF OPC_COR=9
@ 12,27 SAY "TESTE"+SPACE(17)
ELSEIF OPC_COR=8
@ 12,52 SAY "TESTE"+SPACE(16)
@ 16,27 SAY "TESTE"+SPACE(17)
@ 16,52 SAY "TESTE"+SPACE(7)
@ 16,66 SAY "9999999"
ELSEIF OPC_COR=10
COR("TELA DE APRESENTACAO")
ELSEIF OPC_COR=13
@ 03,20 SAY " Titulo do aplicativo "
ENDIF
TECLA=INKEY(0)
SET COLOR TO W/BG
@ X_COR+F_COR+1,Y_COR+17 SAY " "
@ X_COR,C_COR+Y_COR+1 SAY " "
F_COR=F_COR+IIF(TECLA=5,-1,IIF(TECLA=24,1,0))
C_COR=C_COR+IIF(TECLA=19,-1,IIF(TECLA=4,1,0))
F_COR=IIF(F_COR<0,7,IIF(F_COR>7,0,F_COR))
C_COR=IIF(C_COR<0,15,IIF(C_COR>15,0,C_COR))
IF TECLA=27 .OR. TECLA=13
EXIT
ENDIF
ENDDO
CONTECOR[OPC_COR]=STRZERO(C_COR,2)+"/"+STRZERO(F_COR,2)
COR("TITULO")
@ 00,00
@ 00,(80-LEN(TITU_LO))/2 SAY TITU_LO
FUNDO()
COR("MENU")
@ LIN_MENU,00
FOR F_MENU=1 TO LEN(MENU_PRI)
@ LIN_MENU,MENU_POS[F_MENU]+1 SAY MENU_PRI[F_MENU]
NEXT
@ 24,00
@ 24,01 SAY DATE()
@ 24,10 SAY "│"
@ 24,69 SAY "│"
@ 24,71 SAY "F1-Ajuda"
TELA_PRI=SAVESCREEN(LIN_MENU+1,00,23,79)
BUFFER=CHR(13)+"C"
RETURN .T.

FUNCTION FUNDO
PARA PAR1
IF PCOUNT()=0
PAR1=0
ENDIF
DECLARE ME_NU[15]
ME_NU[1]="Apaga"
ME_NU[2]="░░░░░░░░░░▒▒▒▒▒▒▒▒▒▓▓▓▓▓▓▓▓▓▓▒▒▒▒▒▒▒▒▒▒"
ME_NU[3]="░░░░░░░░░░▒▒▒▒▒▒▒▒▒░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓"
ME_NU[4]="▓▓▓▓▓▓▓▓▓▓░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▒▒▒▒▒▒▒▒▒▒"
ME_NU[5]="▓▓▓▓▓▓▓▓▓▓ ░░░░░░░░░░▒▒▒▒▒▒▒▒▒▒"
ME_NU[6]="░"
ME_NU[7]="▒"
ME_NU[8]="▓"
ME_NU[9]=" "
ME_NU[10]="└┐└┐"
ME_NU[11]="╩╦╦╩"
ME_NU[12]="┴┬┬┴"
ME_NU[13]="├┤┤├"
ME_NU[14]="╣╠╠╣"
ME_NU[15]="Tela de apresentaçäo"
IF PAR1=1
S_MENU=MENU(1)
IF S_MENU=0
RETURN .F.
ENDIF
FUNDO=S_MENU
ENDIF
COR("FUNDO DA TELA")
IF FUNDO=15
TELA_ENT(1)
TELA_PRI=SAVESCREEN(LIN_MENU+1,00,23,79)
RETURN .T.
ENDIF
IF FUNDO=1
FUN_DO="Apaga "
ELSE
FUN_DO=ME_NU[FUNDO]
ENDIF
IF FUNDO<10
FUN_DO=SUBS(FUN_DO+REPL(FUN_DO,1840/LEN(FUN_DO)),1,1840)
ENDIF
FOR F=LIN_MENU+1 TO 23
IF FUNDO<10
@ F,00 SAY SUBS(FUN_DO,F*80-79,80)
ELSE
@ F,00 SAY REPL(SUBS(FUN_DO,1,2),40)
FUN_DO=SUBS(FUN_DO,3)+SUBS(FUN_DO,1,2)
ENDIF
NEXT
IF PAR1=1
TELA_PRI=SAVESCREEN(LIN_MENU+1,00,23,79)
ENDIF
RETURN .T.

FUNCTION COR
PARA NOM_COR
QUAL_COR=ASCAN(NOMECOR,UPPER(NOM_COR))
IF QUAL_COR<>0
IF QUAL_COR=2
SETCOLOR(CONTECOR[2]+","+CONTECOR[3]+",,,"+CONTECOR[2])
ELSEIF QUAL_COR=8
SETCOLOR(CONTECOR[11]+","+CONTECOR[9]+",,,"+CONTECOR[8])
ELSE
SETCOLOR(CONTECOR[QUAL_COR])
ENDIF
ENDIF
RETURN .T.

FUNCTION FUN_CFG
PARA PAR1
IF LASTKEY()=13
RETURN 1
ELSEIF LASTKEY()=27
RETURN 0
ELSEIF PAR1=1
KEYBOARD CHR(30)
ELSEIF PAR1=2
KEYBOARD CHR(31)
ENDIF
CFG_COR=SETCOLOR()
COR("MENU")
FOR F_CFG=1 TO LEN(MENU_CFG)
@ 09+F_CFG,34 SAY " "
NEXT
SETCOLOR(CFG_COR)
RETURN 2

FUNCTION CALCU
M->CALCU_X=ROW()
M->CALCU_Y=COL()
M->CACU_COR=SETCOLOR()
M->CA_TELA=SAVESCREEN(MOVCAL_X+0,MOVCAL_Y+47,MOVCAL_X+16,MOVCAL_Y+79)
SET CURSOR OFF
JANELA(00+MOVCAL_X,49+MOVCAL_Y,15+MOVCAL_X,79+MOVCAL_Y,"Calculadora")
SETCOLOR(ALLTRIM(SUBS(CONTECOR[5],4))+"/"+ALLTRIM(SUBS(CONTECOR[4],4)))
@ 02+MOVCAL_X,53+MOVCAL_Y SAY REPL(CHR(220),23)
@ 03+MOVCAL_X,53+MOVCAL_Y SAY CHR(219)+SPACE(21)+CHR(219)
@ 04+MOVCAL_X,53+MOVCAL_Y SAY REPL(CHR(223),23)
BOT_CALC(06+MOVCAL_X,53+MOVCAL_Y," 7 ")
BOT_CALC(06+MOVCAL_X,58+MOVCAL_Y," 8 ")
BOT_CALC(06+MOVCAL_X,63+MOVCAL_Y," 9 ")
BOT_CALC(08+MOVCAL_X,53+MOVCAL_Y," 4 ")
BOT_CALC(08+MOVCAL_X,58+MOVCAL_Y," 5 ")
BOT_CALC(08+MOVCAL_X,63+MOVCAL_Y," 6 ")
BOT_CALC(10+MOVCAL_X,53+MOVCAL_Y," 1 ")
BOT_CALC(10+MOVCAL_X,58+MOVCAL_Y," 2 ")
BOT_CALC(10+MOVCAL_X,63+MOVCAL_Y," 3 ")
BOT_CALC(12+MOVCAL_X,53+MOVCAL_Y," 0 ")
BOT_CALC(12+MOVCAL_X,61+MOVCAL_Y," . ")
BOT_CALC(06+MOVCAL_X,MOVCAL_Y+69," - ")
BOT_CALC(12+MOVCAL_X,MOVCAL_Y+74," % ")
BOT_CALC(08+MOVCAL_X,MOVCAL_Y+69," + ")
BOT_CALC(08+MOVCAL_X,MOVCAL_Y+74," * ")
BOT_CALC(10+MOVCAL_X,MOVCAL_Y+74," / ")
BOT_CALC(10+MOVCAL_X,MOVCAL_Y+69," = ")
BOT_CALC(06+MOVCAL_X,MOVCAL_Y+74,"C/E")
M->C_RESULT=0
M->C_ALGA=SPACE(14)
M->C_DEC=""
M->C_DIG=CHR(0)
M->C_VAR="C_ALGA"
M->C_VERDAD=.F.
SET COLOR TO W
@ 03+MOVCAL_X,54+MOVCAL_Y SAY " "+STR(M->C_RESULT,19,4)+" "
M->C_UOPER=""
M->C_PERC=" "
DO WHILE M->C_DIG<>CHR(27)
M->C_DIG=CHR(INKEY(0))
IF M->C_DIG="7" .OR. M->C_DIG=CHR(1)
BOT_CALC(06+MOVCAL_X,53+MOVCAL_Y," 7 ",.T.)
ELSEIF M->C_DIG="8" .OR. M->C_DIG=CHR(5)
BOT_CALC(06+MOVCAL_X,58+MOVCAL_Y," 8 ",.T.)
ELSEIF M->C_DIG="9" .OR. M->C_DIG=CHR(18)
BOT_CALC(06+MOVCAL_X,63+MOVCAL_Y," 9 ",.T.)
ELSEIF M->C_DIG="4" .OR. M->C_DIG=CHR(19)
BOT_CALC(08+MOVCAL_X,53+MOVCAL_Y," 4 ",.T.)
ELSEIF M->C_DIG="5" .OR. M->C_DIG=CHR(76)
BOT_CALC(08+MOVCAL_X,58+MOVCAL_Y," 5 ",.T.)
ELSEIF M->C_DIG="6" .OR. M->C_DIG=CHR(4)
BOT_CALC(08+MOVCAL_X,63+MOVCAL_Y," 6 ",.T.)
ELSEIF M->C_DIG="1" .OR. M->C_DIG=CHR(6)
BOT_CALC(10+MOVCAL_X,53+MOVCAL_Y," 1 ",.T.)
ELSEIF M->C_DIG="2" .OR. M->C_DIG=CHR(24)
BOT_CALC(10+MOVCAL_X,58+MOVCAL_Y," 2 ",.T.)
ELSEIF M->C_DIG="3" .OR. M->C_DIG=CHR(3)
BOT_CALC(10+MOVCAL_X,63+MOVCAL_Y," 3 ",.T.)
ELSEIF M->C_DIG="0" .OR. M->C_DIG=CHR(22)
BOT_CALC(12+MOVCAL_X,53+MOVCAL_Y," 0 ",.T.)
ELSEIF M->C_DIG="." .OR. M->C_DIG=CHR(7)
BOT_CALC(12+MOVCAL_X,61+MOVCAL_Y," . ",.T.)
ELSEIF M->C_DIG="-"
BOT_CALC(06+MOVCAL_X,MOVCAL_Y+69," - ",.T.)
ELSEIF M->C_DIG="%"
BOT_CALC(12+MOVCAL_X,MOVCAL_Y+74," % ",.T.)
ELSEIF M->C_DIG="+"
BOT_CALC(08+MOVCAL_X,MOVCAL_Y+69," + ",.T.)
ELSEIF M->C_DIG="*"
BOT_CALC(08+MOVCAL_X,MOVCAL_Y+74," * ",.T.)
ELSEIF M->C_DIG="/"
BOT_CALC(10+MOVCAL_X,MOVCAL_Y+74," / ",.T.)
ELSEIF M->C_DIG="=" .OR. ASC(M->C_DIG)=13
BOT_CALC(10+MOVCAL_X,MOVCAL_Y+69," = ",.T.)
ELSEIF AT(M->C_DIG,"cCeE")<>0
BOT_CALC(06+MOVCAL_X,MOVCAL_Y+74,"C/E",.T.)
ENDIF
SET COLOR TO W
IF AT(M->C_DIG,CHR(26)+CHR(2)+CHR(141)+CHR(145))<>0
M->MOV_TELA=SAVESCREEN(MOVCAL_X+0,MOVCAL_Y+49,MOVCAL_X+15,MOVCAL_Y+79)
RESTSCREEN(MOVCAL_X+0,MOVCAL_Y+47,MOVCAL_X+16,MOVCAL_Y+79,M->CA_TELA)
IF M->C_DIG=CHR(26)
MOVCAL_Y=MOVCAL_Y-1
ELSEIF M->C_DIG=CHR(2)
MOVCAL_Y=MOVCAL_Y+1
ELSEIF M->C_DIG=CHR(141)
MOVCAL_X=MOVCAL_X-1
ELSEIF M->C_DIG=CHR(145)
MOVCAL_X=MOVCAL_X+1
ENDIF
IF MOVCAL_X+0<0
MOVCAL_X=0
ELSEIF MOVCAL_X+17>24
MOVCAL_X=24-17
ELSEIF MOVCAL_Y+47<0
MOVCAL_Y=-47
ELSEIF MOVCAL_Y+79>79
MOVCAL_Y=0
ENDIF
M->CA_TELA=SAVESCREEN(MOVCAL_X+0,MOVCAL_Y+47,MOVCAL_X+16,MOVCAL_Y+79)
RESTSCREEN(MOVCAL_X+0,MOVCAL_Y+49,MOVCAL_X+15,MOVCAL_Y+79,M->MOV_TELA)
ENDIF
IF M->C_DIG=CHR(28)
DO HELP WITH "CALCULADORA"
ENDIF
IF M->C_DIG=CHR(27)
EXIT
ENDIF
M->C_XX=AT(M->C_DIG,CHR(22)+CHR(7)+CHR(6)+CHR(24)+CHR(3)+CHR(19)+CHR(76)+CHR(4)+CHR(1)+CHR(5)+CHR(18))
IF M->C_XX<>0
M->C_DIG=SUBS("0.123456789",M->C_XX,1)
ENDIF
M->C_VAR=IIF(M->C_DIG=".","M->C_DEC",M->C_VAR)
M->C_ALGA=IIF(M->C_DIG="." .AND. M->C_ALGA=SPACE(14),SPACE(13)+"0",M->C_ALGA)
IF M->C_DIG="%"
IF M->C_VERDAD
M->C_PERC=IIF(M->C_PERC="%"," ","%")
SETCOLOR(ALLTRIM(SUBS(CONTECOR[6],1,2))+"/"+ALLTRIM(SUBS(CONTECOR[5],4)))
@ 03+MOVCAL_X,75+MOVCAL_Y SAY M->C_PERC
SET COLOR TO W
ELSE
@ 03+MOVCAL_X,55+MOVCAL_Y SAY SPACE(13)+"0.0000"
ENDIF
ELSEIF M->C_DIG $ "0123456789" .AND. LEN(LTRIM(&C_VAR))<>IIF(M->C_VAR="M->C_DEC",4,14)
&C_VAR=IIF(M->C_VAR="M->C_DEC",&C_VAR+M->C_DIG,SUBS(&C_VAR+M->C_DIG,2))
@ 03+MOVCAL_X,55+MOVCAL_Y SAY M->C_ALGA+"."+SUBS(M->C_DEC+SUBS("00000",LEN(M->C_DEC)+1),1,4)
M->C_VERDAD=IIF(M->C_VERDAD .AND. M->C_UOPER $ "="+CHR(13),.F.,M->C_VERDAD)
ELSEIF M->C_DIG $ "+-/*="+CHR(13)
IF M->C_VERDAD
IF VAL(M->C_ALGA+"."+M->C_DEC)<>0
IF M->C_PERC="%"
M->OPE_RA=STR(M->C_RESULT,19,4)+M->C_UOPER+"("+STR(M->C_RESULT,19,4)+"*"+M->C_ALGA+"."+SUBS(M->C_DEC+SUBS("00000",LEN(M->C_DEC)+1),1,4)+")/100.000"
ELSE
M->OPE_RA=STR(M->C_RESULT,19,4)+M->C_UOPER+M->C_ALGA+"."+SUBS(M->C_DEC+SUBS("00000",LEN(M->C_DEC)+1),1,4)
ENDIF
M->C_RESULT=&OPE_RA
IF STR(M->C_RESULT,19,4)=REPL("*",19)
@ 03+MOVCAL_X,55+MOVCAL_Y SAY " * E R R O * "
M->C_RESULT=0
SETCOLOR(ALLTRIM(SUBS(CONTECOR[6],1,2))+"/"+ALLTRIM(SUBS(CONTECOR[5],4)))
@ 03+MOVCAL_X,53+MOVCAL_Y SAY " "
@ 03+MOVCAL_X,75+MOVCAL_Y SAY " "
SET COLOR TO W
ELSE
@ 03+MOVCAL_X,55+MOVCAL_Y SAY STR(M->C_RESULT,19,4)
ENDIF
ENDIF
ELSEIF M->C_DIG $ "+-/*"
M->C_VERDAD=.T.
M->C_RESULT=VAL(M->C_ALGA+"."+M->C_DEC)
ENDIF
SETCOLOR(ALLTRIM(SUBS(CONTECOR[6],1,2))+"/"+ALLTRIM(SUBS(CONTECOR[5],4)))
@ 03+MOVCAL_X,53+MOVCAL_Y SAY IIF(M->C_DIG $ "+-/*",M->C_DIG," ")
@ 03+MOVCAL_X,75+MOVCAL_Y SAY " "
SET COLOR TO W
M->C_VAR="M->C_ALGA"
M->C_ALGA=SPACE(14)
M->C_DEC=""
M->C_UOPER=M->C_DIG
M->C_PERC=" "
ELSEIF M->C_DIG $ "EeCc"
M->C_VAR="M->C_ALGA"
M->C_ALGA=SPACE(14)
M->C_DEC=""
M->C_PERC=" "
IF M->C_DIG $ "Cc"
M->C_VERDAD=.F.
SETCOLOR(ALLTRIM(SUBS(CONTECOR[6],1,2))+"/"+ALLTRIM(SUBS(CONTECOR[5],4)))
@ 03+MOVCAL_X,53+MOVCAL_Y SAY " "
@ 03+MOVCAL_X,75+MOVCAL_Y SAY " "
SET COLOR TO W
ENDIF
@ 03+MOVCAL_X,55+MOVCAL_Y SAY SPACE(13)+"0.0000"
ENDIF
ENDDO
SETCOLOR(M->CACU_COR)
RESTSCREEN(0+MOVCAL_X,47+MOVCAL_Y,16+MOVCAL_X,79+MOVCAL_Y,M->CA_TELA)
ON_CURSOR()
@ M->CALCU_X,M->CALCU_Y SAY ""

FUNCTIO BOT_CALC
PARA BOT_X,BOT_Y,BOT_N
IF PCOUNT()=4
IF BOT_N=" = "
SETCOLOR("N/"+ALLTRIM(SUBS(CONTECOR[4],4)))
@ BOT_X+0,BOT_Y+2 SAY " "
@ BOT_X+1,BOT_Y+2 SAY " "
@ BOT_X+2,BOT_Y+2 SAY " "
@ BOT_X+3,BOT_Y-1 SAY " "
COR("BOTOES")
@ BOT_X+0,BOT_Y-1 SAY " "
@ BOT_X+1,BOT_Y-1 SAY " = "
@ BOT_X+2,BOT_Y-1 SAY " "
ELSE
SETCOLOR("N/"+ALLTRIM(SUBS(CONTECOR[4],4)))
@ BOT_X,BOT_Y+LEN(BOT_N)-1 SAY " "
@ BOT_X+1,BOT_Y-1 SAY REPL(" ",LEN(BOT_N))
COR("BOTOES")
@ BOT_X,BOT_Y-1 SAY BOT_N
ENDIF
INKEY(.1)
SETCOLOR("N/"+ALLTRIM(SUBS(CONTECOR[4],4)))
IF BOT_N=" = "
@ BOT_X+0,BOT_Y-1 SAY "▄"
@ BOT_X+1,BOT_Y-1 SAY "█"
@ BOT_X+2,BOT_Y-1 SAY "█"
@ BOT_X+3,BOT_Y-1 SAY "▀▀▀"
ELSE
@ BOT_X,BOT_Y-1 SAY "▄"
@ BOT_X+1,BOT_Y-1 SAY REPL("▀",LEN(BOT_N))
ENDIF
ENDIF
COR("BOTOES")
IF BOT_N=" = "
@ BOT_X+0,BOT_Y SAY " "
@ BOT_X+1,BOT_Y SAY " = "
@ BOT_X+2,BOT_Y SAY " "
ELSE
@ BOT_X,BOT_Y SAY BOT_N
ENDIF
SETCOLOR("N/"+ALLTRIM(SUBS(CONTECOR[4],4)))
IF BOT_N=" = "
@ BOT_X+0,BOT_Y-1 SAY "▄"
@ BOT_X+1,BOT_Y-1 SAY "█"
@ BOT_X+2,BOT_Y-1 SAY "█"
@ BOT_X+3,BOT_Y-1 SAY "▀▀▀"
ELSE
@ BOT_X,BOT_Y-1 SAY "▄"
@ BOT_X+1,BOT_Y-1 SAY REPL("▀",LEN(BOT_N))
ENDIF
RETURN .T.

FUNCTION MENU_PRN
PARA ARQ_PRN
FUNDO()
JANELA(06,21,18,59,"Saidas")
COR("MENU")
@ 09,26 CLEAR TO 13,54
DO WHILE .T.
BOTAO(15,35,"Enter")
DECLARE MENU_CFG[3]
MENU_CFG[1]=" ("+CHR(7)+") Impressora"
MENU_CFG[2]=" ("+CHR(7)+") Tela "
MENU_CFG[3]=" ("+CHR(7)+") Arquivo "
SETCOLOR(CONTECOR[2]+","+CONTECOR[7])
KEYBOARD CHR(32)
M->OPC_PRN=ACHOICE(10,28,12,52,MENU_CFG,.T.,"FUN_CFG")
IF M->OPC_PRN<>0
BOTAO(15,35,"Enter",-2)
ENDIF
IF M->OPC_PRN=0
RETURN .F.
ELSEIF M->OPC_PRN = 1
M->TIPO_PRN = "I"
IF .NOT. ISPRINTER()
BEEP()
MENSAGEM("Impressora desligada ou desconectada",3)
MENSAGEM("Tecle para sair")
LOOP
ENDIF
ELSEIF M->OPC_PRN = 2
M->TIPO_PRN = "T"
ARQ_PRN=ARQ_PRN+".$TX"
SET PRINTER TO &ARQ_PRN
ELSEIF M->OPC_PRN = 3
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
JANELA(07,16,17,62,"Saidas")
COR("MENU")
@ 10,20 CLEAR TO 14,58
@ 11,23 SAY "Digite o nome do arquivo de saida"
ARQ_PRN=SPACE(8)
DO WHILE .T.
@ 13,35 GET ARQ_PRN PICT "@!" VALID ISALPHA(ARQ_PRN)
SET CURSOR ON
READ
SET CURSOR OFF
IF LASTKEY()=27
RETURN .F.
ENDIF
IF AT(".",ARQ_PRN)<>0
BEEP()
MENSAGEM("Digite o nome do arquivo sem extensäo",3)
MENSAGEM("Tecle para sair")
LOOP
ENDIF
EXIT
ENDDO
ARQ_PRN=ARQ_PRN+".PRN"
M->TIPO_PRN = "A"
SET PRINTER TO &ARQ_PRN
ENDIF
MENSAGEM("Tecle para pausa ou interrupçäo")
RETURN .T.
ENDDO

FUNCTION IMP_TELA
PARA ARQ_PRN,TAM_LIN,MARG_ESQ
IF PCOUNT()=2
M->MARG_ESQ=0
ENDIF
M->MARG_ESQ=M->MARG_ESQ+1
MENSAGEM("Aguarde processamento")
SELE 100
PUBL QUAN_REG,ULT_POS
M->ARQ_PRN1=M->ARQ_PRN+".$TX"
M->ARQ_PRN2=M->ARQ_PRN+".$AQ"
CREATE ARQ_STRU
USE ARQ_STRU
APPE BLANK
REPLACE FIELD_NAME WITH "LI_NHA",FIELD_TYPE WITH "C"
REPLACE FIELD_LEN WITH M->TAM_LIN+1,FIELD_DEC WITH 0
CREATE &ARQ_PRN2 FROM ARQ_STRU
USE
ERASE ARQ_STRU.DBF
USE &ARQ_PRN2
APPEND FROM &ARQ_PRN1 SDF
M->QUAN_REG=LASTREC()
IF M->QUAN_REG=0
M->QUAN_REG=1
ENDIF
GOTO TOP
JANELA(LIN_MENU+3,02,21,77)
@ LIN_MENU+4,77 SAY CHR(30)
@ 20,77 SAY CHR(31)
IF M->TAM_LIN<72
DECLARE EDI_TAR[1]
EDI_TAR[1]="SUBS(LI_NHA,M->MARG_ESQ)"
ELSE
IF INT(M->TAM_LIN/36)=M->TAM_LIN/36
M->NUM_COL=M->TAM_LIN/36
ELSE
M->NUM_COL=INT(M->TAM_LIN/36)+1
ENDIF
DECLARE EDI_TAR[M->NUM_COL]
M->X=1
DO WHILE M->XNUM_COL
M->NUM_MAT=(M->X*36)-34
EDI_TAR[M->X]="SUBS(LI_NHA,"+STR(M->NUM_MAT,3)+",36)"
M->X=M->X+1
ENDDO
M->NUM_MAT=(M->X*36)-34
EDI_TAR[M->X]="SUBS(LI_NHA,"+STR(M->NUM_MAT,3)+")+SPACE("+STR((M->NUM_COL*36)-M->TAM_LIN,2)+")"
ENDIF
KEYBOARD CHR(65)
M->ULT_POS=LIN_MENU+5
MENSAGEM("Tecle para sair")
M->SOS_MENU="RELATORIO"
SETCOLOR(CONTECOR[4]+","+CONTECOR[7])
DBEDIT(LIN_MENU+4,04,20,75,EDI_TAR,"FUN_IMP","","","","")
M->SOS_MENU=" "
USE
ERASE &ARQ_PRN1
ERASE &ARQ_PRN2
RELEASE QUAN_REG,ULT_POS

FUNCTION FUN_IMP
IF LASTKEY()=27
RETURN 0
ELSEIF LASTKEY()=1
GOTO TOP
ELSEIF LASTKEY()=6
GOTO BOTT
ENDIF
COR("BOX DA JANELA DE DIALOGO")
@ M->ULT_POS,77 SAY " "
M->ULT_POS=LIN_MENU+5+(((RECN()*100)/M->QUAN_REG)/(100/(19-(LIN_MENU+5))))
IF RECN()=1
M->ULT_POS=LIN_MENU+5
ENDIF
@ M->ULT_POS,77 SAY CHR(4)
SETCOLOR(CONTECOR[4]+","+CONTECOR[7])
RETURN 1
**
** Bloco de inserçäo FUN.B03
**

* Final do programa APAGAFUN.PRG


 

A Quinta Postagem De PRG

Do

Sistema Apaga!

Aberto No

Excel

[Largura Fixa]

MS-DOS

(PC-8)

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

15/08/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO     : Media De Consumo
* DATA       : 10/08/21
* PROGRAMA   : APAGACON.PRG
* COMENTARIO : MENU DE CONSUTAS,ALTERACOES E EXCLUSOES
 
**
** Bloco de insercao MCO.B01
**
PARA R_CA
MENSAGEM("Tecle para sair")
DECLARE ME_NU[1]
ME_NU[1]="> Media De Consumo"
M->MENU_S=MENU()
IF M->MENU_S=0
   RETURN
ENDIF
IF M->MENU_S=1
   DECLARE ME_NU[1]
   ME_NU[1]=" Apaga"
   S_MENU=MENU(1)
   IF M->S_MENU=1
      DO APAGAC02.PRG WITH R_CA
   ENDIF
ENDIF
CLOSE DATABASES
**
** Bloco de insercao MCO.B02
**
 
* Final do programa APAGACON.PRG
 

 

A Quarta Postagem De PRG

Do

Sistema Apaga!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

14/08/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO     : Media De Consumo
* DATA       : 10/08/21
* PROGRAMA   : APAGAC02.PRG
* COMENTARIO : CONSULTA (  Apaga)
 
PARA R_CA
IF M->R_CA="E"
   SET DELETED OFF
   OK_PACK=.T.
ENDIF
**
** Bloco de insercao C02.B01
**
MENSAGEM("Aguarde abertura de arquivos")
SELE 1
USE APAGA
SELE 1
**
** Bloco de insercao C02.B02
**
SET ORDER TO 0
M->X_VERI = .T.
COR("MENU")
@ LIN_MENU,00
@ LIN_MENU,01 SAY IIF(R_CA="C","Consulta",IIF(R_CA="A","Alteracao","Exclusao"))+" ³   Apaga"
JANELA(03,02,21,77,"  Apaga")
COR("MENU")
@ 05,04 CLEAR TO 19,75
@ 05,04 TO 07,75
@ 07,04 TO 19,75
@ 07,04 SAY "Ã"
@ 07,75 SAY "´"
DECLARE DB_CONTE[8],DB_CAB[8]
DB_CAB[1]="Data Anterior"
DB_CAB[2]="Data Atual"
DB_CAB[3]="Quantidade De Dias"
DB_CAB[4]="Leitura Anterior"
DB_CAB[5]="Leitura Atual"
DB_CAB[6]="Consumo"
DB_CAB[7]="Media Diaria"
DB_CAB[8]="Projecao Para o Mes"
DB_CONTE[1]='DTOC(DATA1)'
DB_CONTE[2]='DTOC(DATA2)'
DB_CONTE[3]='STR(QUANTDIAS2,2,0)'
DB_CONTE[4]='STR(LEITANT,5,0)'
DB_CONTE[5]='STR(LEITATU,5,0)'
DB_CONTE[6]='STR(CONSUMO,10,0)'
DB_CONTE[7]='STR(MEDIADIAR,10,2)'
DB_CONTE[8]='STR(PROJECAO,10,2)'
IF M->R_CA="E"
   DB_CAB[1]="  "+DB_CAB[1]
   DB_CONTE[1]='DELE_TAR()+" "+'+DB_CONTE[1]
   DB_CAB[8]=DB_CAB[8]+"  "
   DB_CONTE[8]=DB_CONTE[8]+'+" "+DELE_TAR()'
ENDIF
SAI_DB=.T.
**
** Bloco de insercao C02.B03
**
DO WHILE .T.
   **
   ** Bloco de insercao C02.B04
   **
   MENSAGEM("Posicione sobre o registro desejado e tecle ")
   COR("MENU")
   KEYBOARD CHR(65)
   ***
   *** Inicio do bloco de substituicao DB02.B
   DBEDIT(06,05,19,74,DB_CONTE,"EDITAR02",.T.,DB_CAB,"ÄÂÄ"," ³ ","ÄÁÄ")
   *** Final do bloco de substituicao DB02.B
   ***
   ***
   *** Inicio do bloco de substituicao C02.B
   SAI_DB=.F.
   MENSAGEM("Tecle para sair")
   DO WHILE .T.
      IF LASTKEY()=27
         EXIT
      ENDIF
      EXIT
   ENDDO
   IF LASTKEY()=27
      EXIT
   ENDIF
ENDDO
SET DELETED ON
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
**
** Bloco de insercao C02.B05
**
*** Final do bloco de substituicao C02.B
***
 
FUNCTION EDITAR02
**
** Bloco de insercao C02.B06
**
IF SAI_DB .OR. LASTKEY()=27
   RETURN 0
ELSEIF LASTKEY()=13
   SAVE SCREEN TO TE_LA
   FUNDO()
   DO WHILE .T.
      MENSAGEM("Tecle para sair")
      CARREG02(2)
      IF M->R_CA="A"
         OK_GETS=CARGET02(2)
         IF OK_GETS
            IF PERG("Confirma alteracoes ?")="S"
               SALVAR02()
               COMMIT
               COR("MENU")
               RESTORE SCREEN FROM TE_LA
               KEYBOARD CHR(0)
               RETURN 2
            ELSE
               LOOP
            ENDIF
         ELSE
            COR("MENU")
            RESTORE SCREEN FROM TE_LA
            KEYBOARD CHR(0)
            RETURN 1
         ENDIF
      ELSEIF M->R_CA="E"
         CARGET02(0)
         CLEAR GETS
         IF PERG("Deseja marcar este registro para EXCLUSAO ?")="S"
            DELE
         ELSE
            RECALL
         ENDIF
         COR("MENU")
         RESTORE SCREEN FROM TE_LA
         KEYBOARD CHR(0)
         RETURN 2
      ELSE
         CARGET02(3)
         COR("MENU")
         RESTORE SCREEN FROM TE_LA
         KEYBOARD CHR(0)
         RETURN 1
      ENDIF
   ENDDO
ELSEIF LASTKEY()=1
   GOTO TOP
ELSEIF LASTKEY()=6
   GOTO BOTT
ENDIF
RETURN 1
 
* Final do programa APAGAC02.PRG
 

 

A Terceira Postagem De PRG

Do

Sistema Apaga!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

13/08/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO     : Media De Consumo
* DATA       : 10/08/21
* PROGRAMA   : APAGAARQ.PRG
* COMENTARIO : CRIACAO DE ARQUIVOS
 
FUNCTION CRIARQ
**
** Bloco de insercao ARQ.B01
**
IF .NOT. FILE("APAGA.DBF")
   CREATE ARQ_STRU
   USE ARQ_STRU
   REPARQ("DATA1","D",  8,  0)
   REPARQ("DATA2","D",  8,  0)
   REPARQ("QUANTDIAS1","D",  8,  0)
   REPARQ("QUANTDIAS2","N",  2,  0)
   REPARQ("LEITANT","N",  5,  0)
   REPARQ("LEITATU","N",  5,  0)
   REPARQ("CONSUMO","N", 10,  0)
   REPARQ("MEDIADIAR","N", 10,  2)
   REPARQ("PROJECAO","N", 10,  2)
   CREATE APAGA FROM ARQ_STRU
ENDIF
USE
ERASE ARQ_STRU.DBF
 
FUNCTION REPARQ
PARA REP1,REP2,REP3,REP4
APPE BLANK
REPLACE FIELD_NAME WITH M->REP1,FIELD_TYPE WITH M->REP2
REPLACE FIELD_LEN  WITH M->REP3,FIELD_DEC  WITH M->REP4
**
** Bloco de insercao ARQ.B02
**
 
* Final do programa APAGAARQ.PRG
 

 

A Segunda Postagem De PRG

Do

Sistema Apaga!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

12/08/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO     : Media De Consumo
* DATA       : 10/08/21
* PROGRAMA   : APAGA.PRG
* COMENTARIO : MENU PRINCIPAL
 
**
** Bloco de insercao MENU.B01
**
AMBIENTE()
SET PROCEDURE TO APAGAARQ
SET PROCEDURE TO APAGASOS
SET PROCEDURE TO APAGAFUN
FUNDO=1
DECLARE NOMECOR[13],CONTECOR[13]
NOMECOR[01]="FUNDO DA TELA"
NOMECOR[02]="MENU"
NOMECOR[03]="DESTAQUE DO MENU"
NOMECOR[04]="JANELA DE DIALOGO"
NOMECOR[05]="BOX DA JANELA DE DIALOGO"
NOMECOR[06]="BOTOES"
NOMECOR[07]="BOTAO EM DESTAQUE"
NOMECOR[08]="GETS"
NOMECOR[09]="GET EM DESTAQUE"
NOMECOR[10]="TELA DE APRESENTACAO"
NOMECOR[11]="CARACTERES AVULSOS"
NOMECOR[12]="CERCADURAS"
NOMECOR[13]="TITULO"
PADRAO()
SET KEY -2 TO CALEN
SET KEY -3 TO CALCU
MOVCAL_X=5
MOVCAL_Y=0
IF FILE("APAGA.CFG")
   VAR=MEMOREAD("APAGA.CFG")
   FOR F=1 TO 12
      CONTECOR[F]=SUBS(VAR,(F*5)-4,5)
   NEXT
   MOVCAL_X=VAL(SUBS(VAR,61,2))
   MOVCAL_Y=VAL(SUBS(VAR,63,2))
   FUNDO=VAL(SUBS(VAR,69,2))
   CONTECOR[13]=SUBS(VAR,72,5)
ENDIF
TELA_ENT()
TITU_LO="Media De Consumo"
LIN_MENU=1
COR("TITULO")
@ 00,00
@ 00,(80-LEN(TITU_LO))/2 SAY TITU_LO
COR("MENU")
@ LIN_MENU,00
@ 24,00
@ 24,01 SAY DATE()
@ 24,10 SAY "³"
@ 24,69 SAY "³"
@ 24,71 SAY "F1-Ajuda"
FUNDO()
PUBL MENU_POS
DECLARE BOTOES[10]
Q_BOTOES=1
MENU_P=1
X=1
M->SOS_MENU=" "
***
*** Inicio do bloco de substituicao MENUPRI1.B
BUFFER=CHR(13)
DECLARE MENU_PRI[7],MENU_POS[7]
MENU_PRI[1]="Inclusoes"
MENU_PRI[2]="Consultas"
MENU_PRI[3]="Alteracoes"
MENU_PRI[4]="Exclusoes"
MENU_PRI[5]="Relatorios"
MENU_PRI[6]="Utilitarios"
MENU_PRI[7]="Sair"
COL_MENU=2
COR("MENU")
FOR F_MENU=1 TO LEN(MENU_PRI)
   MENU_POS[F_MENU]=COL_MENU
   COL_MENU=COL_MENU+LEN(MENU_PRI[F_MENU])+2
   @ LIN_MENU,MENU_POS[F_MENU] SAY " "+MENU_PRI[F_MENU]+" "
NEXT
*** Final do bloco de substituicao MENUPRI1.B
***
TELA_PRI=SAVESCREEN(LIN_MENU+1,00,23,79)
M->DAT_HOJE=DATE()
***
*** Inicio do bloco de substituicao AT_DATA.B
MENSAGEM("Digite a data")
JANELA(06,17,18,61,"Atualizacao de data")
BOTAO(15,34,"Enter")
COR("MENU")
@ 09,22 CLEAR TO 13,56
M->SEM_ANA="DomingoSegundaTerca  Quarta Quinta Sexta  S bado "
M->DIA_EXT=TRIM(SUBS(M->SEM_ANA,DOW(M->DAT_HOJE)*7-6,7))+", "+ALLTRIM(STR(DAY(M->DAT_HOJE),2))
M->ME_SES="Janeiro  FevereiroMar‡o    Abril    Maio     Junho    "
M->ME_SES=M->ME_SES+"Julho    Agosto   Setembro Outubro  Novembro Dezembro "
M->DIA_EXT=M->DIA_EXT+" de "+TRIM(SUBS(ME_SES,MONTH(DAT_HOJE)*9-8,9))+" de "
M->DIA_EXT=M->DIA_EXT+TRAN(YEAR(M->DAT_HOJE),"@E 9,999")+"."
@ 12,22 SAY SPACE(35)
@ 12,(80-LEN(M->DIA_EXT))/2 SAY M->DIA_EXT
@ 10,29 SAY "Data de hoje " GET M->DAT_HOJE
SET CURSOR ON
READ
SET CURSOR OFF
IF LASTKEY()=13
   BOTAO(15,34,"Enter",-2)
ENDIF
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
COR("MENU")
@ 24,01 SAY M->DAT_HOJE
*** Final do bloco de substituicao AT_DATA.B
***
MENSAGEM("Aguarde acesso aos arquivos")
CRIARQ()
M->OPC_ACHO=0
M->OK_PACK=.F.
**
** Bloco de insercao MENU.B02
**
DO WHILE .T.
   **
   ** Bloco de insercao MENU.B03
   **
   ***
   *** Inicio do bloco de substituicao MENUPRI2.B
   COR("MENU")
   @ LIN_MENU,00 SAY "  "
   @ LIN_MENU,78 SAY "  "
   FOR F_MENU=1 TO LEN(MENU_PRI)
      @ LIN_MENU,MENU_POS[F_MENU] PROMPT " "+MENU_PRI[F_MENU]+" "
   NEXT
   KEYBOARD BUFFER
   MENU TO MENU_P
   BUFFER=CHR(13)
   *** Final do bloco de substituicao MENUPRI2.B
   ***
   **
   ** Bloco de insercao MENU.B04
   **
   IF MENU_P=1
      DO APAGAINC
   ELSEIF MENU_P=2 .OR. MENU_P=3 .OR. MENU_P=4
      DO APAGACON WITH SUBS(" CAE",MENU_P,1)
      ***
      *** Inicio do bloco de substituicao EXCLUIR.B
      IF M->OK_PACK
         M->OK_PACK=.F.
         IF MENU_P=4
            IF PERGUNTA("Confirma a exclusao dos registros marcados ?","N")="N"
               LOOP
            ELSE
               CLOSE DATABASES
               MENSAGEM("Compactando o arquivo APAGA.DBF")
               USE APAGA   
               PACK
            ENDIF
         ENDIF
      ENDIF
      *** Final do bloco de substituicao EXCLUIR.B
      ***
   ELSEIF MENU_P=5
      DO APAGAREL
   ELSEIF MENU_P=6
      MENSAGEM("Tecle para sair")
      DECLARE ME_NU[5]
      ME_NU[1]="Reorganizar"
      ME_NU[2]="-"
      ME_NU[3]=">Papel de parede"
      ME_NU[4]=">Configuracao de cores"
      ME_NU[5]="Configuracao padrao"
      **
      ** Bloco de insercao MENU.B05
      **
      MENU_S=MENU()
      IF MENU_S=1
         IF PERGUNTA("Comfirma a reorganizacao dos arquivos ?")="S"
         ENDIF
      ELSEIF MENU_S=5
         IF PERGUNTA("Ativar configuracao padrao de cores ?")="S"
            PADRAO()
            FUNDO()
            COR("TITULO")
            @ 00,00
            @ 00,(80-LEN(TITU_LO))/2 SAY TITU_LO
            COR("MENU")
            @ LIN_MENU,00
            FOR F_MENU=1 TO LEN(MENU_PRI)
               @ LIN_MENU,MENU_POS[F_MENU]+1 SAY MENU_PRI[F_MENU]
            NEXT
            @ 24,00
            @ 24,01 SAY "F1-Ajuda ³"
            @ 24,69 SAY "³"
            @ 24,71 SAY DATE()
            TELA_PRI=SAVESCREEN(LIN_MENU+1,00,23,79)
         ENDIF
      ELSEIF MENU_S=3
         FUNDO(1)
      ELSEIF MENU_S=4
         CONFCOR()
      ENDIF
   ELSEIF MENU_P=7
      DECLARE ME_NU[1]
      ME_NU[1]="Fim de execucao"
      MENU_S=MENU()
      IF MENU_S=1
         IF PERGUNTA("Confirma o encerramento ?")="S"
            EXIT
         ENDIF
      ENDIF
   ENDIF
ENDDO
SET COLOR TO W
CLEAR
SET CURSOR ON
VAR=""
FOR F=1 TO 12
   VAR=VAR+CONTECOR[F]
NEXT
VAR=VAR+STR(MOVCAL_X,2)
VAR=VAR+STR(MOVCAL_Y,2)
VAR=VAR+"FF  "
VAR=VAR+STR(FUNDO,2)
VAR=VAR+"A"
VAR=VAR+CONTECOR[13]
MEMOWRIT("APAGA.CFG",VAR)
**
** Bloco de insercao MENU.B06
**
 
FUNCTION JANELA
PARA PJAN1,PJAN2,PJAN3,PJAN4,PJAN5
IF PCOUNT()<>5
   PJAN5=""
ENDIF
SETCOLOR(CONTECOR[4])
@ PJAN1,PJAN2 CLEAR TO PJAN3,PJAN4
SETCOLOR(CONTECOR[5])
@ PJAN1,PJAN2,PJAN3,PJAN4 BOX " "
@ PJAN1,PJAN2 SAY "þ"
IF LEN(TRIM(PJAN5)) > 0
   @ PJAN1,PJAN2+(((PJAN4+1-PJAN2)-LEN(PJAN5))/2) SAY PJAN5
ENDIF
 
FUNCTION AMBIENTE
SET TALK OFF
SET DATE BRIT
SET BELL OFF
SET STAT OFF
SET SCORE OFF
SET WRAP ON
SET CURSOR OFF
SET DELETED ON
**
** Bloco de insercao MENU.B07
**
RETURN .F.

FUNCTION TELA_ENT
PARA PAR
IF PCOUNT()>0
   @ 01+LIN_MENU,00 CLEAR TO 23,79
ENDIF
IF PCOUNT()=0
   COR("TELA DE APRESENTACAO")
   CLEAR
ENDIF
IF PCOUNT()=0
   INKEY(7)
ENDIF
RETURN .T.

FUNCTION PADRAO
CONTECOR[01]="09/01"
CONTECOR[02]="00/07"
CONTECOR[03]="15/04"
CONTECOR[04]="07/01"
CONTECOR[05]="00/03"
CONTECOR[06]="00/07"
CONTECOR[07]="15/07"
CONTECOR[08]="00/07"
CONTECOR[09]="15/04"
CONTECOR[10]="15/01"
CONTECOR[11]="07/01"
CONTECOR[12]="07/01"
CONTECOR[13]="15/03"
RETURN .T.

FUNCTION PERG
COR("MENU")
SET CURSOR OFF
M->RES_POSTA="S"
PARA TEX_TO,RES_POSTA
M->SIM_NAO=IIF(M->RES_POSTA="N",2,1)
@ 24,11 SAY SPACE(58)
M->LI=(80-(LEN(M->TEX_TO)+11))/2
@ 24,M->LI SAY M->TEX_TO
M->LI=M->LI+LEN(M->TEX_TO)+2
DO WHILE .T.
   @ 24,M->LI   PROMPT "Sim"
   @ 24,M->LI+6 PROMPT "Nao"
   @ 24,M->LI+4 SAY "-"
   MENU TO M->SIM_NAO
   IF M->SIM_NAO<>0
      EXIT
   ENDIF
ENDDO
ON_CURSOR()
RETURN IIF(M->SIM_NAO=1,"S","N")
 
* Final do programa APAGA.PRG

 

A Primeira Postagem De PRG

Do

Sistema Apaga!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

10/08/2021

Tabela De Consumo

De

Energia Elétrica

Trabalhando Com a Diferença Entre Duas Datas, o Sistema Apaga Possui Validações e Um Relatório Colunar Com a Totalização Dos Campos Numéricos!

Execução (DOSBox):

 

Download:

Apaga - Meta De Consumo!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

29/07/2021

Uma Página Onde Você Pode Testar o Seu Código HTML!!!

[Teste o Seu Código HTML]

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

07/06/2021

Um Script

Do Tempo

Para Campo Grande/MS!!!

 Observe o Efeito

Na Coluna Do Site!!!

 

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

25/05/2021

Green Lines

Text Area

 

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

24/05/2021

Dark Pinky

Text Area

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool 

 

Update:

23/05/2021

Orange Dark

Text Area

 

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

22/05/2021

Fresh Purple Text Area

 

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

19/05/2021

Ocean Blue Text Area!!! 

Download - Códigos HTML!!!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

18/05/2021

 

 

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

15/05/2021

Mais Um

Código De

Caixa De Texto!!!

 

 

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

27/04/2021

Um Código De Caixa De Texto!!!

001- Você Escolhe a Cor De Fundo

002- Cols é a Largura

003- Rows é a Altura

004- Você Escreve o Texto Que Quiser

 Obs.: Essa Página Disponibiliza Um Link,

Onde Esse e Outros Códigos

Poderão Ser Copiados!!!

Procure Pelo Mesmo

No Conteúdo Da

titio.info/programacao!!!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

21/04/2021

Um Curso Básico

De HTML!!!

HTML - Básico

[Download]

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

13/04/2021

Um PRG de Funções:

Calor - PRG - Funções

[Link Ativo]

Abra No Bloco De Notas

Ou No Notepad++

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

11/04/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Calorias Perdidas
* DATA : 29/03/21
* PROGRAMA : CALORR02.PRG
* COMENTARIO : RELATORIO ( Calorias Perdidas)

**
** Bloco de inserçäo R02.B01
**
MENSAGEM("Aguarde abertura de arquivos")
SELE 1
IF .NOT. USEREDE("CALOR",.F.,10)
BEEP()
MENSAGEM("O arquivo CALOR näo está disponível",3)
RETURN
ELSE
SET INDEX TO CALOR001
ENDIF
***
*** Inicio do bloco de substituiçäo R02.B
MENSAGEM("Tecle para retornar")
COR("MENU")
@ LIN_MENU,00
@ LIN_MENU,01 SAY "Relatório │ Calorias Perdidas"
SELE 1
SET ORDER TO 0
**
** Bloco de inserçäo R02.B02
**
GOTO TOP
M->TIPO_PRN="I"
*
* -> Menu que permite direcionar a saida de impressao
IF .NOT. MENU_PRN("CALOR_02")
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
RETURN
ENDIF
SET DEVI TO PRINT
M->LI_NHA=1
M->PAG=1
*
* -> Inicializa variaveis de totalizacao
M->TOT_0001=0
M->TOT_0002=0
M->TOT_0003=0
M->TOT_0004=0
M->TOT_0005=0
**
** Bloco de inserçäo R02.B05
**
M->SAI_DA="S"
*** Final do bloco de substituiçäo R02.B
***
DO WHILE .NOT. EOF()
**
** Bloco de inserçäo R02.B06
**
IF INKEY()=27
**
** Bloco de inserçäo R02.B07
**
SET DEVI TO SCREEN
*
* -> Permite interromper a impressao
M->SAI_DA=PERG("Continua a impressäo ?")
MENSAGEM("Tecle para pausa ou interrupçäo")
SET DEVI TO PRINT
IF M->SAI_DA="N"
EXIT
ENDIF
ENDIF
IF M->LI_NHA=1
**
** Bloco de inserçäo R02.B09
**
*
* -> Determina o tipo de caracter para impressao
IF TIPO_PRN<>"T"
@ 00,01 SAY CHR(18)
ENDIF
@ 01,01 SAY "Calorias Perdidas"
@ 01, 98 SAY "Pagina: "+SUBS(STR(M->PAG+10000,5),2)
M->PAG=M->PAG+1
@ 02,01 SAY "titio.info"
@ 02, 98 SAY "Data: "+DTOC(DAT_HOJE)
@ 04,01 SAY REPL("-",111)
@ 05,001 SAY "Data"
@ 05,013 SAY "Velocidade"
@ 05,027 SAY "Peso"
@ 05,037 SAY "Perda De Cal Por Minuto"
@ 05,064 SAY "Minutos De Corrida"
@ 05,086 SAY "Total De Calorias Perdidas"
@ 06,01 SAY REPL("-",111)
M->LI_NHA=07
**
** Bloco de inserçäo R02.B10
**
ENDIF
**
** Bloco de inserçäo R02.B20
**
@ M->LI_NHA,001 SAY DATA
@ M->LI_NHA,013 SAY VELOCIDADE PICTURE "@E 99.99"
@ M->LI_NHA,027 SAY PESO PICTURE "@E 999.99"
@ M->LI_NHA,037 SAY CALORIAS PICTURE "@E 9999.99"
@ M->LI_NHA,064 SAY MINUTOSTOT PICTURE "@E 999.9"
@ M->LI_NHA,086 SAY CALORIAS2 PICTURE "@E 9999999.99"
**
** Bloco de inserçäo R02.B21
**
*
* -> Totalizacao de campo numericos
M->TOT_0001=M->TOT_0001+VELOCIDADE
M->TOT_0002=M->TOT_0002+PESO
M->TOT_0003=M->TOT_0003+CALORIAS
M->TOT_0004=M->TOT_0004+MINUTOSTOT
M->TOT_0005=M->TOT_0005+CALORIAS2
M->LI_NHA=M->LI_NHA+1
**
** Bloco de inserçäo R02.B12
**
SKIP
IF M->LI_NHA>58 .OR. EOF()
IF EOF()
TOT_02(2)
ELSE
TOT_02(1)
ENDIF
M->LI_NHA=1
ENDIF
ENDDO
**
** Bloco de inserçäo R02.B18
**
EJECT
SET DEVI TO SCREEN
IF M->TIPO_PRN = "A"
SET PRINTER TO
ELSEIF M->TIPO_PRN = "T" .AND. M->SAI_DA="S"
SET PRINTER TO
IMP_TELA("CALOR_02",112)
ENDIF
**
** Bloco de inserçäo R02.B19
**
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)

FUNCTION TOT_02
*
* -> Funcao de impressao da totalizacao
PARA PAR1
IF PAR1=2
M->LI_NHA=59
ENDIF
@ M->LI_NHA+0,01 SAY REPL("-",111)
IF PAR1=2
@ M->LI_NHA+1,001 SAY "TOTAL"
ELSE
@ M->LI_NHA+1,001 SAY "SUBTOTAL"
ENDIF
@ M->LI_NHA+1,010 SAY M->TOT_0001 PICTURE "@E 9,999.99"
@ M->LI_NHA+1,024 SAY M->TOT_0002 PICTURE "@E 99,999.99"
@ M->LI_NHA+1,035 SAY M->TOT_0003 PICTURE "@E 999999.99"
@ M->LI_NHA+1,061 SAY M->TOT_0004 PICTURE "@E 99,999.9"
@ M->LI_NHA+1,084 SAY M->TOT_0005 PICTURE "@E 999999999.99"
@ M->LI_NHA+2,01 SAY REPL("-",111)

* Final do programa CALORR02.PRG

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

09/04/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Calorias Perdidas
* DATA : 29/03/21
* PROGRAMA : CALORI02.PRG
* COMENTARIO : INCLUSAO ( Calorias Perdidas)

**
** Bloco de inserçäo I02.B01
**
MENSAGEM("Aguarde abertura de arquivos")
SELE 1
IF .NOT. USEREDE("CALOR",.F.,10)
BEEP()
MENSAGEM("O arquivo CALOR näo está disponível",3)
RETURN
ELSE
SET INDEX TO CALOR001
ENDIF
SELE 1
**
** Bloco de inserçäo I02.B02
**
***
*** Inicio do bloco de substituiçäo I02.B
COR("MENU")
@ LIN_MENU,00
@ LIN_MENU,01 SAY "Inclusäo │ Calorias Perdidas"
M->P_VERI = .T.
M->X_VERI = .F.
DO WHILE .T.
**
** Bloco de inserçäo I02.B03
**
MENSAGEM("Tecle para retornar")
IF M->P_VERI
**
** Bloco de inserçäo I02.B04
**
*
* -> Inicializa variaveis
CARREG02(1)
ELSE
M->X_VERI = .T.
**
** Bloco de inserçäo I02.B05
**
ENDIF
*
* -> Carrega tela de cadastro
IF CARGET02(1)=.F.
EXIT
ENDIF
**
** Bloco de inserçäo I02.B10
**
IF PERG("Confirma as informaçöes ?")="N"
*
* -> Faz reedicao
M->P_VERI = .F.
**
** Bloco de inserçäo I02.B11
**
LOOP
ENDIF
M->P_VERI = .T.
M->X_VERI = .F.
**
** Bloco de inserçäo I02.B12
**
IF .NOT. ADIREG(0)
M->P_VERI=.F.
MENSAGEM("Inclusäo näo foi bem sucedida",3)
MENSAGEM("Tecle para retornar")
LOOP
ENDIF
*
* -> Atualiza o banco de dados
SALVAR02()
COMMIT
ENDDO
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
**
** Bloco de inserçäo I02.B13
**
*** Final do bloco de substituiçäo I02.B
***

FUNCTION IFU02001
*
* -> Validacao para o campo DATA
IF .NOT.(.NOT.EMPTY(M->DATA)) .AND. LASTKEY()<>5
BEEP()
MENSAGEM("ENTRE COM A DATA!!!",3)
MENSAGEM("Tecle para retornar")
RETURN .F.
ENDIF
RETURN .T.

FUNCTION IFU02002
*
* -> Validacao para o campo VELOCIDADE
IF .NOT.(M->VELOCIDADE>0.00) .AND. LASTKEY()<>5
BEEP()
MENSAGEM("UM VALOR POSITIVO!!!",3)
MENSAGEM("Tecle para retornar")
RETURN .F.
ENDIF
RETURN .T.

FUNCTION IFU02003
*
* -> Validacao para o campo PESO
IF .NOT.(M->PESO>0.00) .AND. LASTKEY()<>5
BEEP()
MENSAGEM("UM VALOR POSITIVO!!!",3)
MENSAGEM("Tecle para retornar")
RETURN .F.
ENDIF
RETURN .T.

FUNCTION IFU02004
*
* -> Funcao que faz calculo com campos numericos
M->CALORIAS = M->VELOCIDADE*M->PESO*0.0175
COR("GETS")
RETURN .T.

FUNCTION IFU02005
*
* -> Validacao para o campo MINUTOSTOT
IF .NOT.(M->MINUTOSTOT>0.0) .AND. LASTKEY()<>5
BEEP()
MENSAGEM("UM VALOR POSITIVO!!!",3)
MENSAGEM("Tecle para retornar")
RETURN .F.
ENDIF
RETURN .T.

FUNCTION IFU02006
*
* -> Funcao que faz calculo com campos numericos
M->CALORIAS2 = M->CALORIAS*M->MINUTOSTOT
COR("GETS")
RETURN .T.

FUNCTION CARREG02
*
* -> Carrega variaveis para entrada ou altercao de dados
PARA R_CAR
**
** Bloco de inserçäo I02.B14
**
PUBLIC DATA,VELOCIDADE,PESO,CALORIAS,MINUTOSTOT,CALORIAS2
IF M->R_CAR=1
M->DATA=CTOD(" / / ")
M->VELOCIDADE=0
M->PESO=0
M->CALORIAS=0
M->MINUTOSTOT=0
M->CALORIAS2=0
**
** Bloco de inserçäo I02.B15
**
ELSE
M->DATA=DATA
M->VELOCIDADE=VELOCIDADE
M->PESO=PESO
M->CALORIAS=CALORIAS
M->MINUTOSTOT=MINUTOSTOT
M->CALORIAS2=CALORIAS2
**
** Bloco de inserçäo I02.B16
**
ENDIF

FUNCTION CARGET02
*
* -> Formata a tela para entrada ou alteracao de dados
PARA R_CAR
**
** Bloco de inserçäo I02.B17
**
JANELA( 6,18,20,59," Calorias Perdidas")
COR("CERCADURAS")
*
* -> Monta cercaduras
@ 7,19 TO 19,58 DOUBL
**
** Bloco de inserçäo I02.B18
**
COR("GETS")
*
* -> Carrega caracteres avulsos
@ 10,44 SAY "(Km/h)"
@ 12,39 SAY "(Kg)"
**
** Bloco de inserçäo I02.B21
**
IF M->X_VERI
IFU02004()
IFU02006()
ENDIF
*
* -> Monta tela de cadastro
@ 8,20 SAY "Data:" GET M->DATA VALID IFU02001()
@ 10,20 SAY "A Sua Velocidade:" GET M->VELOCIDADE PICTURE "@E 99.99" VALID IFU02002()
@ 12,20 SAY "O Seu Peso:" GET M->PESO PICTURE "@E 999.99" VALID IFU02003()
@ 14,20 SAY "Calorias Perdidas Por Minuto:" GET M->CALORIAS PICTURE "@E 9999.99" VALID IFU02004()
@ 16,20 SAY "Minutos de Corrida:" GET M->MINUTOSTOT PICTURE "@E 999.9" VALID IFU02005()
@ 18,20 SAY "Total de Calorias Perdidas:" GET M->CALORIAS2 PICTURE "@E 9999999.99" VALID IFU02006()
**
** Bloco de inserçäo I02.B24
**
IF M->R_CAR=3 .OR. M->R_CAR=0
CLEAR GETS
IF M->R_CAR=0
RETURN .T.
ENDIF
MENSAGEM("Tecle algo para continuar")
M->R_X=INKEY(0)
IF M->R_X=27
RETURN .F.
ENDIF
ELSE
SET CURSOR ON
READ
SET CURSOR OFF
IF LASTKEY()=27
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION SALVAR02
*
* -> Salva o conteudo das variaveis de entrada no arquivo
**
** Bloco de inserçäo I02.B27
**
REPLACE DATA WITH M->DATA
REPLACE VELOCIDADE WITH M->VELOCIDADE
REPLACE PESO WITH M->PESO
REPLACE CALORIAS WITH M->CALORIAS
REPLACE MINUTOSTOT WITH M->MINUTOSTOT
REPLACE CALORIAS2 WITH M->CALORIAS2
**
** Bloco de inserçäo I02.B28
**

* Final do programa CALORI02.PRG

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

08/04/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Calorias Perdidas
* DATA : 29/03/21
* PROGRAMA : CALORINC.PRG
* COMENTARIO : MENU DE INCLUSAO

**
** Bloco de inserçäo INC.B01
**
MENSAGEM("Tecle para sair")
DECLARE ME_NU[1]
ME_NU[1]="> Tempo"
M->MENU_S=MENU()
IF M->MENU_S=0
RETURN
ENDIF
IF M->MENU_S=1
DECLARE ME_NU[1]
ME_NU[1]=" Calorias Perdidas"
S_MENU=MENU(1)
IF M->S_MENU=1
DO CALORI02.PRG
ENDIF
ENDIF
CLOSE DATABASES
**
** Bloco de inserçäo INC.B02
**

* Final do programa CALORINC.PRG

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

07/04/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Calorias Perdidas
* DATA : 29/03/21
* PROGRAMA : CALORREL.PRG
* COMENTARIO : MENU DE RELATORIOS

**
** Bloco de inserçäo REL.B01
**
MENSAGEM("Tecle para sair")
DECLARE ME_NU[1]
ME_NU[1]="> Tempo"
M->MENU_S=MENU()
IF M->MENU_S=0
RETURN
ENDIF
IF M->MENU_S=1
DECLARE ME_NU[1]
ME_NU[1]=" Calorias Perdidas"
S_MENU=MENU(1)
IF M->S_MENU=1
DO CALORR02.PRG
ENDIF
ENDIF
CLOSE DATABASES
**
** Bloco de inserçäo REL.B02
**

* Final do programa CALORREL.PRG

  

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

06/04/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Calorias Perdidas
* DATA : 29/03/21
* PROGRAMA : CALORSOS.PRG
* COMENTARIO : ROTINA DE HELP

FUNCTION HELP
*
* -> Rotina de auxilio ao usuario
PARA PROG,LIN,VAR
IF M->PROG=="HELP" .OR. M->PROG=="MEMOEDIT"
RETURN .F.
ENDIF
**
** Bloco de inserçäo SOS.B01
**
SET KEY -2 TO
SET KEY -3 TO
SET KEY -5 TO
IF SUBS(M->PROG,1,6)=="CARGET"
***
*** Inicio do bloco de substituiçäo SOS07.B
M->SOS=""
SOS("")
SOS(" TECLAS DE CONTROLE DO PROGRAMA")
SOS(" ──────────────────────────────")
SOS("")
SOS(" F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-")
SOS(" nuseio do aplicativo.")
SOS("")
SOS(" F3 > Apresenta Calendário.")
SOS("")
SOS(" F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-")
SOS(" temáticas.")
SOS("")
SOS("")
SOS(" TECLAS DE CONTROLE DE EDIÇÄO")
SOS(" ────────────────────────────")
SOS("")
SOS(" Enter : Efetua a entrada de dados.")
SOS(" Setas : Movimentam o cursor para a direçäo indicada.")
SOS(" Home : Move o cursor para o início do campo.")
SOS(" End : Move o cursor para o final do campo.")
SOS(" <-- :="" apaga="" o="" caracter="" a="" esquerda="" do="" cursor="" strong="">
SOS(" Ins : Liga ou Desliga o modo de inserçäo de caracteres.")
SOS(" Del : Apaga o caracter sob o cursor.")
SOS(" CTRL T : Apaga a palavra à direita do cursor.")
SOS(" CTRL Y : Apaga todo o conteúdo de um campo.")
SOS(" Esc : Abandona a Ediçäo.")
ELSEIF M->PROG=="ACHOICE"
***
*** Inicio do bloco de substituiçäo SOS08.B
M->SOS=""
SOS("")
SOS(" TECLAS DE CONTROLE DO PROGRAMA")
SOS(" ──────────────────────────────")
SOS("")
SOS(" F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-")
SOS(" nuseio do aplicativo.")
SOS("")
SOS(" F3 > Apresenta Calendário.")
SOS("")
SOS(" F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-")
SOS(" temáticas.")
SOS("")
SOS("")
SOS(" TECLAS DE NAVEGAÇÄO DO MENU")
SOS(" ───────────────────────────")
SOS("")
SOS(" Seta p/cima : Retorna a opçäo anterior.")
SOS("")
SOS(" Seta p/baixo : Acesso a opçäo seguinte.")
SOS("")
SOS(" PgUp : Retorna a página anterior.")
SOS("")
SOS(" PgDn : Acesso a página seguinte.")
SOS("")
SOS(" Enter : Confirma opçäo escolhida.")
SOS("")
SOS(" Esc : Retorna.")
*** Final do bloco de substituiçäo SOS08.B
***
ELSEIF M->SOS_MENU=="CALENDARIO"
***
*** Inicio do bloco de substituiçäo SOS01.B
M->SOS=""
SOS(" ")
SOS(" ")
SOS(" MANUSEIO DO CALENDARIO")
SOS(" ──────────────────────")
SOS(" ")
SOS(" (+) Mês : Passa para o próximo mês.")
SOS(" ")
SOS(" (-) Mês : Volta para o mês anterior.")
SOS(" ")
SOS(" (+) Ano : Passa para o próximo ano.")
SOS(" ")
SOS(" (-) Ano : Volta para o ano anteiror.")
SOS(" ")
SOS(" Ano : Permite definir o ano desejado.")
*** Final do bloco de substituiçäo SOS01.B
***
ELSEIF M->PROG=="CALCULADORA"
***
*** Inicio do bloco de substituiçäo SOS02.B
M->SOS=""
SOS(" ")
SOS(" TECLAS DE CONTROLE DA CALCULADORA")
SOS(" ─────────────────────────────────")
SOS(" ")
SOS(" * : Sinal de multiplicaçäo.")
SOS(" ")
SOS(" / : Sinal de divisäo.")
SOS(" ")
SOS(" + : Sinal de soma.")
SOS(" ")
SOS(" - : Sinal de subtraçäo.")
SOS(" ")
SOS(" E : Cancela o último valor digitado na calculadora.")
SOS(" ")
SOS(" C : Zera a calculadora.")
SOS(" ")
SOS(" Esc : Abandona o manuseio da calculadora.")
SOS(" ")
SOS(" ou = : Sinal de igualdade.")
SOS(" ")
SOS(" Ctrl + setas : Move a calculadora na tela.")
*** Final do bloco de substituiçäo SOS02.B
***
ELSEIF M->PROG=="DBEDIT" .AND. M->SOS_MENU<>"RELATORIO"
***
*** Inicio do bloco de substituiçäo SOS05.B
M->SOS=""
SOS("")
SOS(" TECLAS DE CONTROLE DO PROGRAMA")
SOS(" ──────────────────────────────")
SOS("")
SOS(" F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-")
SOS(" nuseio do aplicativo.")
SOS("")
SOS(" F3 > Apresenta Calendário.")
SOS("")
SOS(" F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-")
SOS(" temáticas.")
SOS("")
SOS("")
SOS(" TECLAS DE CONTROLE DA CONSULTA")
SOS(" ──────────────────────────────")
SOS("")
SOS(" Seta p/cima : Move para o registro anterior.")
SOS("")
SOS(" Seta p/baixo : Move para o registro seguinte.")
SOS("")
SOS(" PgUp : Move para a página anterior.")
SOS("")
SOS(" PgDn : Move para a página seguinte.")
SOS("")
SOS(" Home : Move para o início do arquivo.")
SOS("")
SOS(" End : Move para o final do arquivo.")
SOS("")
SOS(" Enter : Apresenta o conteúdo do registro.")
SOS("")
SOS(" Esc : Finaliza consulta.")
*** Final do bloco de substituiçäo SOS05.B
***
ELSE
***
*** Inicio do bloco de substituiçäo SOS06.B
M->SOS=""
SOS("")
SOS(" TECLAS DE CONTROLE DO PROGRAMA")
SOS(" ──────────────────────────────")
SOS("")
SOS(" F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-")
SOS(" nuseio do aplicativo.")
SOS("")
SOS(" F3 > Apresenta Calendário.")
SOS("")
SOS(" F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-")
SOS(" temáticas.")
*** Final do bloco de substituiçäo SOS06.B
***
ENDIF
SAVE SCREEN
M->COR=SETCOLOR()
SET CURSOR OFF
JANELA(03,02,21,77,"Auxilio ao usuário")
SETCOLOR(CONTECOR[4]+","+CONTECOR[4])
**
** Bloco de inserçäo SOS.B08
**
MEMOEDIT(M->SOS,04,04,20,75,.F.)
SETCOLOR(M->COR)
ON_CURSOR()
RESTORE SCREEN
SET KEY -2 TO CALEN
SET KEY -3 TO CALCU
**
** Bloco de inserçäo SOS.B09
**

FUNCTION SOS
*
* -> Acrescenta uma linha ao texto de help
PARA TEX_TO
M->SOS=M->SOS+M->TEX_TO+CHR(13)+CHR(10)


* Final do programa CALORSOS.PRG

 

[Outra Rotina De Help]

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

04/04/2021

A Documentação

Do Sistema!!!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

04/04/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Calorias Perdidas
* DATA : 29/03/21
* PROGRAMA : CALORCON.PRG
* COMENTARIO : MENU DE CONSUTAS,ALTERACOES E EXCLUSOES

**
** Bloco de inserçäo MCO.B01
**
PARA R_CA
MENSAGEM("Tecle para sair")
DECLARE ME_NU[1]
ME_NU[1]="> Tempo"
M->MENU_S=MENU()
IF M->MENU_S=0
RETURN
ENDIF
IF M->MENU_S=1
DECLARE ME_NU[1]
ME_NU[1]=" Calorias Perdidas"
S_MENU=MENU(1)
IF M->S_MENU=1
DO CALORC02.PRG WITH R_CA
ENDIF
ENDIF
CLOSE DATABASES
**
** Bloco de inserçäo MCO.B02
**

* Final do programa CALORCON.PRG

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

03/04/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Calorias Perdidas
* DATA : 29/03/21
* PROGRAMA : CALORC02.PRG
* COMENTARIO : CONSULTA ( Calorias Perdidas)

PARA R_CA
IF M->R_CA="E"
SET DELETED OFF
OK_PACK=.T.
ENDIF
**
** Bloco de inserçäo C02.B01
**
MENSAGEM("Aguarde abertura de arquivos")
SELE 1
IF .NOT. USEREDE("CALOR",.F.,10)
BEEP()
MENSAGEM("O arquivo CALOR näo está disponível",3)
RETURN
ELSE
SET INDEX TO CALOR001
ENDIF
SELE 1
**
** Bloco de inserçäo C02.B02
**
SET ORDER TO 1
M->X_VERI = .T.
COR("MENU")
@ LIN_MENU,00
@ LIN_MENU,01 SAY IIF(R_CA="C","Consulta",IIF(R_CA="A","Alteraçäo","Exclusäo"))+" │ Calorias Perdidas"
JANELA(03,02,21,77," Calorias Perdidas")
COR("MENU")
@ 05,04 CLEAR TO 17,75
@ 05,04 TO 07,75
@ 07,04 TO 17,75
@ 07,04 SAY "├"
@ 07,75 SAY "┤"
DECLARE DB_CONTE[6],DB_CAB[6]
*
* -> Titulos das colunas
DB_CAB[1]="Data"
DB_CAB[2]="A Sua Velocidade"
DB_CAB[3]="O Seu Peso"
DB_CAB[4]="Calorias Perdidas Por Minuto"
DB_CAB[5]="Tempo de Corrida"
DB_CAB[6]="Total de Calorias Perdidas"
*
* -> Conteudo das colunas
DB_CONTE[1]='DTOC(DATA)'
DB_CONTE[2]='STR(VELOCIDADE,5,2)'
DB_CONTE[3]='STR(PESO,6,2)'
DB_CONTE[4]='STR(CALORIAS,7,2)'
DB_CONTE[5]='STR(MINUTOSTOT,5,1)'
DB_CONTE[6]='STR(CALORIAS2,10,2)'
IF M->R_CA="E"
DB_CAB[1]=" "+DB_CAB[1]
DB_CONTE[1]='DELE_TAR()+" "+'+DB_CONTE[1]
DB_CAB[6]=DB_CAB[6]+" "
DB_CONTE[6]=DB_CONTE[6]+'+" "+DELE_TAR()'
ENDIF
SAI_DB=.T.
**
** Bloco de inserçäo C02.B03
**
DO WHILE .T.
**
** Bloco de inserçäo C02.B04
**
MENSAGEM("Posicione sobre o registro desejado e tecle ")
COR("MENU")
KEYBOARD CHR(65)
***
*** Inicio do bloco de substituiçäo DB02.B
DBEDIT(06,05,17,74,DB_CONTE,"EDITAR02",.T.,DB_CAB,"─┬─"," │ ","─┴─")
*** Final do bloco de substituiçäo DB02.B
***
***
*** Inicio do bloco de substituiçäo C02.B
SAI_DB=.F.
MENSAGEM("Tecle para sair")
DO WHILE .T.
M->DATA=CTOD(" / / ")
COR("GETS")
@ 19,04 SAY "Entre com a data:" GET M->DATA
SET CURSOR ON
READ
SET CURSOR OFF
IF LASTKEY()=27
EXIT
ENDIF
SEEK TRIM(DTOS(M->DATA))
IF EOF()
BEEP()
MENSAGEM("Dados näo encontrados",3)
MENSAGEM("Tecle para sair")
LOOP
ENDIF
EXIT
ENDDO
IF LASTKEY()=27
EXIT
ENDIF
ENDDO
SET DELETED ON
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
**
** Bloco de inserçäo C02.B05
**
*** Final do bloco de substituiçäo C02.B
***

FUNCTION EDITAR02
**
** Bloco de inserçäo C02.B06
**
IF SAI_DB .OR. LASTKEY()=27
*
* -> Finaliza ediçäo
RETURN 0
ELSEIF LASTKEY()=13
*
* -> Mostra o registro detalhadamente
SAVE SCREEN TO TE_LA
FUNDO()
DO WHILE .T.
MENSAGEM("Tecle para sair")
*
* -> Carrega o conteudo do registro em variaveis
CARREG02(2)
IF M->R_CA="A"
*
* -> Monta tela de edicao
IF .NOT. REGLOCK(5)
BEEP()
MENSAGEM("Registro bloqueado, tente novamente",3)
MENSAGEM("Tecle para sair")
RESTORE SCREEN FROM TE_LA
RETURN 1
ENDIF
OK_GETS=CARGET02(2)
IF OK_GETS
IF PERG("Confirma alteraçöes ?")="S"
*
* -> Atualiza o banco de dados
SALVAR02()
COMMIT
UNLOCK
COR("MENU")
RESTORE SCREEN FROM TE_LA
KEYBOARD CHR(0)
RETURN 2
ELSE
UNLOCK
LOOP
ENDIF
ELSE
UNLOCK
COR("MENU")
RESTORE SCREEN FROM TE_LA
KEYBOARD CHR(0)
RETURN 1
ENDIF
ELSEIF M->R_CA="E"
*
* -> Mostra registro detalhadamente
CARGET02(0)
CLEAR GETS
IF PERG("Deseja marcar este registro para EXCLUSAO ?")="S"
IF .NOT. REGLOCK(5)
BEEP()
MENSAGEM("Deleçäo mal sucedida",3)
MENSAGEM("Tecle para sair")
RESTORE SCREEN FROM TE_LA
RETURN 1
ENDIF
DELE
ELSE
IF .NOT. REGLOCK(5)
BEEP()
MENSAGEM("Deleçäo mal sucedida",3)
MENSAGEM("Tecle para sair")
RESTORE SCREEN FROM TE_LA
RETURN 1
ENDIF
RECALL
ENDIF
UNLOCK
COR("MENU")
RESTORE SCREEN FROM TE_LA
KEYBOARD CHR(0)
RETURN 2
ELSE
CARGET02(3)
COR("MENU")
RESTORE SCREEN FROM TE_LA
KEYBOARD CHR(0)
RETURN 1
ENDIF
ENDDO
ELSEIF LASTKEY()=1
*
* Vai para o comeco do arquivo
GOTO TOP
ELSEIF LASTKEY()=6
*
* -> Vai para o final do arquivo
GOTO BOTT
ENDIF
RETURN 1

* Final do programa CALORC02.PRG

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

02/04/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

* TITULO : Calorias Perdidas
* DATA : 29/03/21
* PROGRAMA : CALORARQ.PRG
* COMENTARIO : CRIACAO DE ARQUIVOS

FUNCTION CRIARQ
*
* -> Funcao que cria banco de dados (arquivos "DBF")
**
** Bloco de inserçäo ARQ.B01
**
IF .NOT. FILE("CALOR.DBF")
CREATE ARQ_STRU
IF .NOT. USEREDE("ARQ_STRU",.T.,10)
@ 0,0 SAY ""
? CHR(7)
MENSAGEM("Nao foi possivel criar os arquivos",5)
SET COLOR TO W
CLEAR
SET CURSOR ON
CLOSE ALL
QUIT
ENDIF
REPARQ("DATA","D", 8, 0)
REPARQ("VELOCIDADE","N", 5, 2)
REPARQ("PESO","N", 6, 2)
REPARQ("CALORIAS","N", 7, 2)
REPARQ("MINUTOSTOT","N", 5, 1)
REPARQ("CALORIAS2","N", 10, 2)
CREATE CALOR FROM ARQ_STRU
ENDIF
USE
ERASE ARQ_STRU.DBF

FUNCTION REPARQ
*
* -> Funcao que carrega os dados dos campos no arquivo "ARQ_STRU"
PARA REP1,REP2,REP3,REP4
IF .NOT. ADIREG(0)
@ 0,0 SAY ""
? CHR(7)
MENSAGEM("Nao foi possivel criar os arquivos",5)
SET COLOR TO W
CLEAR
SET CURSOR ON
CLOSE ALL
QUIT
ENDIF
REPLACE FIELD_NAME WITH M->REP1,FIELD_TYPE WITH M->REP2
REPLACE FIELD_LEN WITH M->REP3,FIELD_DEC WITH M->REP4
UNLOCK
**
** Bloco de inserçäo ARQ.B02
**

* Final do programa CALORARQ.PRG

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

31/03/2021

Role Para Cima

O Texto Que Está

Em Azul!!! 

Por Causa De Um

Erro De Cálculo,

Esse PRG Teve

Que Ser Alterado!!!

 

* TITULO : Calorias Perdidas
* DATA : 29/03/21
* PROGRAMA : CALOR.PRG
* COMENTARIO : MENU PRINCIPAL

**
** Bloco de inserçäo MENU.B01
**
AMBIENTE()
*
* -> Modulo de criacao de arquivos
SET PROCEDURE TO CALORARQ
*
* -> Modulo de help
SET PROCEDURE TO CALORSOS
*
* -> Modulo de Funcoes
SET PROCEDURE TO CALORFUN
*
* -> Variavel de controle do papel de parede
FUNDO=1
*
* -> Controle de cores
DECLARE NOMECOR[13],CONTECOR[13]
NOMECOR[01]="FUNDO DA TELA"
NOMECOR[02]="MENU"
NOMECOR[03]="DESTAQUE DO MENU"
NOMECOR[04]="JANELA DE DIALOGO"
NOMECOR[05]="BOX DA JANELA DE DIALOGO"
NOMECOR[06]="BOTOES"
NOMECOR[07]="BOTAO EM DESTAQUE"
NOMECOR[08]="GETS"
NOMECOR[09]="GET EM DESTAQUE"
NOMECOR[10]="TELA DE APRESENTACAO"
NOMECOR[11]="CARACTERES AVULSOS"
NOMECOR[12]="CERCADURAS"
NOMECOR[13]="TITULO"
PADRAO()
*
* -> Ativa o calendario na tecla F3
SET KEY -2 TO CALEN
*
* -> Ativa a calculadora na tecla F4
SET KEY -3 TO CALCU
MOVCAL_X=5
MOVCAL_Y=0
IF FILE("CALOR.CFG")
*
* -> Restaurando configuracao
VAR=MEMOREAD("CALOR.CFG")
*
* -> Cores
FOR F=1 TO 12
CONTECOR[F]=SUBS(VAR,(F*5)-4,5)
NEXT
*
* -> Posicao da Calculadora
MOVCAL_X=VAL(SUBS(VAR,61,2))
MOVCAL_Y=VAL(SUBS(VAR,63,2))
*
* -> Fundo da tela
FUNDO=VAL(SUBS(VAR,69,2))
*
* -> Cor do titulo
CONTECOR[13]=SUBS(VAR,72,5)
ENDIF
TELA_ENT()
TITU_LO="Calorias Perdidas"
LIN_MENU=1
COR("TITULO")
@ 00,00
@ 00,(80-LEN(TITU_LO))/2 SAY TITU_LO
COR("MENU")
@ LIN_MENU,00
@ 24,00
@ 24,01 SAY DATE()
@ 24,10 SAY "│"
@ 24,69 SAY "│"
@ 24,71 SAY "F1-Ajuda"
FUNDO()
PUBL MENU_POS
DECLARE BOTOES[10]
Q_BOTOES=1
MENU_P=1
X=1
M->SOS_MENU=" "
***
*** Inicio do bloco de substituiçäo MENUPRI1.B
BUFFER=CHR(13)
DECLARE MENU_PRI[7],MENU_POS[7]
MENU_PRI[1]="Inclusöes"
MENU_PRI[2]="Consultas"
MENU_PRI[3]="Alteraçöes"
MENU_PRI[4]="Exclusöes"
MENU_PRI[5]="Relatórios"
MENU_PRI[6]="Utilitários"
MENU_PRI[7]="Sair"
COL_MENU=2
COR("MENU")
FOR F_MENU=1 TO LEN(MENU_PRI)
MENU_POS[F_MENU]=COL_MENU
COL_MENU=COL_MENU+LEN(MENU_PRI[F_MENU])+2
@ LIN_MENU,MENU_POS[F_MENU] SAY " "+MENU_PRI[F_MENU]+" "
NEXT
*** Final do bloco de substituiçäo MENUPRI1.B
***
TELA_PRI=SAVESCREEN(LIN_MENU+1,00,23,79)
*
* Desativa acesso exclusivo permitindo acesso multiusuario
SET EXCLUSIVE OFF
M->DAT_HOJE=DATE()
***
*** Inicio do bloco de substituiçäo AT_DATA.B
*
* -> Rotina de atualizacao de data
MENSAGEM("Digite a data")
JANELA(06,17,18,61,"Atualizaçäo de data")
BOTAO(15,34,"Enter")
COR("MENU")
@ 09,22 CLEAR TO 13,56
M->SEM_ANA="DomingoSegundaTerca Quarta Quinta Sexta Sábado "
M->DIA_EXT=TRIM(SUBS(M->SEM_ANA,DOW(M->DAT_HOJE)*7-6,7))+", "+ALLTRIM(STR(DAY(M->DAT_HOJE),2))
M->ME_SES="Janeiro FevereiroMarço Abril Maio Junho "
M->ME_SES=M->ME_SES+"Julho Agosto Setembro Outubro Novembro Dezembro "
M->DIA_EXT=M->DIA_EXT+" de "+TRIM(SUBS(ME_SES,MONTH(DAT_HOJE)*9-8,9))+" de "
M->DIA_EXT=M->DIA_EXT+TRAN(YEAR(M->DAT_HOJE),"@E 9,999")+"."
@ 12,22 SAY SPACE(35)
@ 12,(80-LEN(M->DIA_EXT))/2 SAY M->DIA_EXT
@ 10,29 SAY "Data de hoje " GET M->DAT_HOJE
SET CURSOR ON
READ
SET CURSOR OFF
IF LASTKEY()=13
BOTAO(15,34,"Enter",-2)
ENDIF
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
COR("MENU")
@ 24,01 SAY M->DAT_HOJE
*** Final do bloco de substituiçäo AT_DATA.B
***
MENSAGEM("Aguarde acesso aos arquivos")
*
* -> Funcao que cria DBF'S inexistentes
CRIARQ()
*
* -> Funcao que cria indices inexistentes
INDICES()
M->EX_T=0
M->OPC_ACHO=0
M->OK_PACK=.F.
**
** Bloco de inserçäo MENU.B02
**
DO WHILE .T.
**
** Bloco de inserçäo MENU.B03
**
***
*** Inicio do bloco de substituiçäo MENUPRI2.B
COR("MENU")
@ LIN_MENU,00 SAY " "
@ LIN_MENU,78 SAY " "
FOR F_MENU=1 TO LEN(MENU_PRI)
@ LIN_MENU,MENU_POS[F_MENU] PROMPT " "+MENU_PRI[F_MENU]+" "
NEXT
KEYBOARD BUFFER
MENU TO MENU_P
BUFFER=CHR(13)
*** Final do bloco de substituiçäo MENUPRI2.B
***
**
** Bloco de inserçäo MENU.B04
**
IF MENU_P=1
DO CALORINC
ELSEIF MENU_P=2 .OR. MENU_P=3 .OR. MENU_P=4
DO CALORCON WITH SUBS(" CAE",MENU_P,1)
***
*** Inicio do bloco de substituiçäo EXCLUIR.B
IF M->OK_PACK
M->OK_PACK=.F.
IF MENU_P=4
IF PERGUNTA("Confirma a exclusäo dos registros marcados ?","N")="N"
LOOP
ELSE
*
* -> Executa a exclusao fisica
CLOSE DATABASES
MENSAGEM("Compactando o arquivo CALOR.DBF")
IF USEREDE("CALOR",.T.,10)
PACK
ELSE
BEEP()
MENSAGEM("O arquivo CALOR näo esta disponível",3)
ENDIF
MENSAGEM("Aguarde organizaçäo dos arquivos")
USE
INDICES(.T.)
ENDIF
ENDIF
ENDIF
*** Final do bloco de substituiçäo EXCLUIR.B
***
ELSEIF MENU_P=5
DO CALORREL
ELSEIF MENU_P=6
MENSAGEM("Tecle para sair")
DECLARE ME_NU[5]
ME_NU[1]="Reorganizar"
ME_NU[2]="-"
ME_NU[3]=">Papel de parede"
ME_NU[4]=">Configuraçäo de cores"
ME_NU[5]="Configuraçäo padräo"
**
** Bloco de inserçäo MENU.B05
**
MENU_S=MENU()
IF MENU_S=1
IF PERGUNTA("Comfirma a reorganizaçäo dos arquivos ?")="S"
MENSAGEM("Aguarde organizaçäo dos arquivos")
*
* -> Ativa organizaçäo dos arquivos
INDICES(.T.)
ENDIF
ELSEIF MENU_S=5
IF PERGUNTA("Ativar configuraçäo padräo de cores ?")="S"
PADRAO()
FUNDO()
COR("TITULO")
@ 00,00
@ 00,(80-LEN(TITU_LO))/2 SAY TITU_LO
COR("MENU")
@ LIN_MENU,00
FOR F_MENU=1 TO LEN(MENU_PRI)
@ LIN_MENU,MENU_POS[F_MENU]+1 SAY MENU_PRI[F_MENU]
NEXT
@ 24,00
@ 24,01 SAY "F1-Ajuda │"
@ 24,69 SAY "│"
@ 24,71 SAY DATE()
TELA_PRI=SAVESCREEN(LIN_MENU+1,00,23,79)
ENDIF
ELSEIF MENU_S=3
FUNDO(1)
ELSEIF MENU_S=4
CONFCOR()
ENDIF
ELSEIF MENU_P=7
DECLARE ME_NU[1]
ME_NU[1]="Fim de execuçäo"
MENU_S=MENU()
IF MENU_S=1
IF PERGUNTA("Confirma o encerramento ?")="S"
EXIT
ENDIF
ENDIF
ENDIF
ENDDO
SET COLOR TO W
CLEAR
SET CURSOR ON
*
* -> Salvando configuracao
VAR=""
* -> Cores
FOR F=1 TO 12
VAR=VAR+CONTECOR[F]
NEXT
*
* -> Posicao da Calculadora
VAR=VAR+STR(MOVCAL_X,2)
VAR=VAR+STR(MOVCAL_Y,2)
VAR=VAR+"FF "
*
* -> Fundo da tela
VAR=VAR+STR(FUNDO,2)
VAR=VAR+"A"
*
* -> Cor do titulo
VAR=VAR+CONTECOR[13]
*
* -> Gravando configuracao
MEMOWRIT("CALOR.CFG",VAR)
**
** Bloco de inserçäo MENU.B06
**

FUNCTION JANELA
PARA PJAN1,PJAN2,PJAN3,PJAN4,PJAN5
IF PCOUNT()<>5
PJAN5=""
ENDIF
SETCOLOR(CONTECOR[4])
@ PJAN1,PJAN2 CLEAR TO PJAN3,PJAN4
SETCOLOR(CONTECOR[5])
@ PJAN1,PJAN2,PJAN3,PJAN4 BOX " "
@ PJAN1,PJAN2 SAY "■"
IF LEN(TRIM(PJAN5)) > 0
@ PJAN1,PJAN2+(((PJAN4+1-PJAN2)-LEN(PJAN5))/2) SAY PJAN5
ENDIF

FUNCTION AMBIENTE
SET TALK OFF
SET DATE BRIT
SET BELL OFF
SET STAT OFF
SET SCORE OFF
SET WRAP ON
SET CURSOR OFF
SET DELETED ON
**
** Bloco de inserçäo MENU.B07
**
RETURN .F.

FUNCTION TELA_ENT
PARA PAR
*
* -> Tela de apresentacao
IF PCOUNT()>0
@ 01+LIN_MENU,00 CLEAR TO 23,79
ENDIF
IF PCOUNT()=0
COR("TELA DE APRESENTACAO")
CLEAR
ENDIF
IF PCOUNT()=0
INKEY(7)
ENDIF
RETURN .T.

FUNCTION PADRAO
CONTECOR[01]="09/01"
CONTECOR[02]="00/07"
CONTECOR[03]="15/04"
CONTECOR[04]="07/01"
CONTECOR[05]="00/03"
CONTECOR[06]="00/07"
CONTECOR[07]="15/07"
CONTECOR[08]="00/07"
CONTECOR[09]="15/04"
CONTECOR[10]="15/01"
CONTECOR[11]="07/01"
CONTECOR[12]="07/01"
CONTECOR[13]="15/03"
RETURN .T.

FUNCTION PERG
*
* -> Funcao que executa uma pergunta
COR("MENU")
SET CURSOR OFF
M->RES_POSTA="S"
PARA TEX_TO,RES_POSTA
M->SIM_NAO=IIF(M->RES_POSTA="N",2,1)
@ 24,11 SAY SPACE(58)
M->LI=(80-(LEN(M->TEX_TO)+11))/2
@ 24,M->LI SAY M->TEX_TO
M->LI=M->LI+LEN(M->TEX_TO)+2
DO WHILE .T.
@ 24,M->LI PROMPT "Sim"
@ 24,M->LI+6 PROMPT "Näo"
@ 24,M->LI+4 SAY "-"
MENU TO M->SIM_NAO
IF M->SIM_NAO<>0
EXIT
ENDIF
ENDDO
ON_CURSOR()
RETURN IIF(M->SIM_NAO=1,"S","N")

* Final do programa CALOR.PRG

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

29/03/2021

Vamos Perder Calorias? O Vigésimo Primeiro Sistema Que Está Postado No titio.info, Trata Desse Assunto!!! Quatro Campos Estão Validados!!! Um Relatório Colunar Irá Somar As Calorias Que Você Perder!!! Exemplo De Execução:

I Love DOSBox!!!

Download:

Calor - Perda de Calorias!!! 

Obs.:

Unidade Da velocidade = Km/h.

Unidade Do Peso = Kg.

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

24/03/2021

Algoritmos

&

Programação

Download da Apostila - By titio.info!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

19/03/2021

[Download - Apostila de HTML5]

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

13/03/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

A Mensagem Que Aparece

De Acordo Com

A Hora Do Dia

 

Observe a Mensagem

No Topo Da Página!!!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

11/03/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

A Segunda Parte

Do PRG De Funções

/*
TITULO : Emissao de recibos
DATA : 24/02/21
PROGRAMA : RECIBFU2.PRG
COMENTARIO : FUNCOES - PARTE 2
*/

#include "RECIB.CH"
#include "RECIBMOU.CH"
**
**BI [INI] FUN.B04
**BI [FIM] FUN.B04
**

FUNCTION MENU( OBJETO_MENU )
//
// -> Funcao que monta menu
LOCAL COL_MENU, CONTAR, LIN_INICIA, LAR_GURA, AL_TURA, NAO_EDITA := {},;
ES_COLHA, DESTAQUE_MENU := {}, POS_DESTAQUE, OPCOES_MENU, ROTINAS_MENU
TIPO_MENU := OBJETO_MENU[ _TIPO_MENU ]
OPCOES_MENU := OBJETO_MENU[ _OPCOES_MENU ]
ROTINAS_MENU := OBJETO_MENU[ _CHAMADA_MENU ]
FOR CONTAR := 1 TO LEN( OPCOES_MENU )
AADD( DESTAQUE_MENU, OPCOES_MENU[ CONTAR ] )
IF SUBS( DESTAQUE_MENU[ CONTAR ], 1, 1 ) = ">"
DESTAQUE_MENU[ CONTAR ] := SUBS( DESTAQUE_MENU[ CONTAR ], 2 )
ENDIF
IF ( POS_DESTAQUE := AT( "~", OPCOES_MENU[ CONTAR ] ) ) != 0
OPCOES_MENU[ CONTAR ] := STUFF( OPCOES_MENU[ CONTAR ], POS_DESTAQUE,;
1, "" )
ENDIF
NEXT
IF TIPO_MENU = NIL; TIPO_MENU := MENU_PRINCIPAL; ENDIF
COL_MENU := MENU_POS[ MENU_P ]
LIN_INICIA := LIN_MENU + 1
//
// -> Para edicao de sub-menu
IF TIPO_MENU = SUB_MENU
COL_MENU += 10
IF LEN( OPCOES_MENU ) > 13 .OR. POS_ULT_MENU > 13
LIN_INICIA := LIN_MENU + 2
ELSE
LIN_INICIA := LIN_MENU + POS_ULT_MENU + 2
ENDIF
ENDIF
//
// -> Verfica a largura maxima do menu
LAR_GURA := 0
AL_TURA := LEN( OPCOES_MENU )
FOR CONTAR = 1 TO AL_TURA
AADD( NAO_EDITA, .T. )
OPCOES_MENU[ CONTAR ] := " " + TRIM( OPCOES_MENU[ CONTAR ] ) + " "
IF LEN( OPCOES_MENU[ CONTAR ] ) > LAR_GURA
LAR_GURA = LEN( OPCOES_MENU[ CONTAR ] )
IF SUBS( OPCOES_MENU[ CONTAR ], 2, 1 ) = ">"
LAR_GURA++
ENDIF
ENDIF
NEXT
//
// -> Verfica se a largura esta abaixo da largura minima
IF LAR_GURA < 18; LAR_GURA := 18; ENDIF
//
// -> Prepara os separadores de menu e simbolos de sub-menu
FOR CONTAR = 1 TO AL_TURA
IF OPCOES_MENU[ CONTAR ] = " - "
NAO_EDITA[ CONTAR ] := .F.
OPCOES_MENU[ CONTAR ] := REPL( "─", LAR_GURA )
ELSEIF SUBS( OPCOES_MENU[ CONTAR ], 2, 1 ) = ">"
OPCOES_MENU[ CONTAR ] := " " + PADR( SUBS( OPCOES_MENU[ CONTAR ], 3 ), ;
LAR_GURA - 3 ) + CHR( 16 ) + " "
ELSE
OPCOES_MENU[ CONTAR ] := PADR( OPCOES_MENU[ CONTAR ], LAR_GURA )
ENDIF
NEXT
//
// -> Verrifica se a altura ultrapassa a altura maxima
AL_TURA += 2
IF AL_TURA > 15; AL_TURA := 15; ENDIF
//
// -> Verfica se a largura do menu ultrapassa a tela e faz ajuste
IF COL_MENU + LAR_GURA + 3 > 79
IF TIPO_MENU = MENU_PRINCIPAL
COL_MENU -= ( ( LAR_GURA + 2 ) - LEN( MENU_PRI[ MENU_P ] ) )
ELSE
COL_MENU -= ( ( COL_MENU + LAR_GURA + 3 ) - 79 )
ENDIF
ENDIF
SOMBRA( LIN_INICIA, COL_MENU, AL_TURA + LIN_INICIA - 1,;
COL_MENU + LAR_GURA + 3)
COR( "MENU" )
@ LIN_INICIA, COL_MENU CLEAR TO AL_TURA + LIN_INICIA - 1, COL_MENU + LAR_GURA + 3
@ LIN_INICIA, COL_MENU + 1 TO AL_TURA + LIN_INICIA - 1,COL_MENU + LAR_GURA + 2
IF AL_TURA < 15
FOR CONTAR = 1 TO AL_TURA - 2
IF SUBS( OPCOES_MENU[ CONTAR ], 1, 1 ) = "─"
@ CONTAR + LIN_INICIA, COL_MENU + 1 SAY "├"
@ CONTAR + LIN_INICIA, COL_MENU + LAR_GURA + 2 SAY "┤"
ENDIF
NEXT
ENDIF
//
// -> Imprime setas para cima e para baixo indicando que o menu ultrapassa
// o tamanho da janela
IF LEN( OPCOES_MENU ) > AL_TURA - 2
@ LIN_INICIA + 1, COL_MENU + LAR_GURA + 3 SAY CHR( 24 )
@ LIN_INICIA + AL_TURA - 2, COL_MENU + LAR_GURA + 3 SAY CHR( 25 )
ENDIF
//
// -> Faz a edicao efetiva do menu
ES_COLHA := MIROMENU( LIN_INICIA + 1, COL_MENU + 2,;
LIN_INICIA + AL_TURA - 2, COL_MENU + LAR_GURA + 1,;
OPCOES_MENU, DESTAQUE_MENU )
//
// -> Verifica se a tecla ESC foi pressicionada e se a edicao e' referente
// a um menu principal para entao ativar a janela de saida
IF ES_COLHA = 0 .AND. TIPO_MENU = MENU_PRINCIPAL .AND. BUFFER = CHR( T_ENTER )
//
// -> Ativa a janela de saida
BUFFER := "S" + CHR( T_ENTER )
ENDIF
IF ES_COLHA > 0 .AND. ES_COLHA < 999
//
// -> Verfica se sera ativado um sub-menu
IF !( TIPO_MENU = MENU_PRINCIPAL .AND. SUBS( OPCOES_MENU[ ES_COLHA ],;
LEN( OPCOES_MENU[ ES_COLHA ] ) - 1, 1 ) = CHR( 16 ) )
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
MOUSE( LIGA )
ELSE
SOMBRA( L_SOM, C_SOM, .T. )
IF LEN( OPCOES_MENU ) <= AL_TURA
COR( "DESTAQUE DO MENU" )
@ LIN_MENU + ES_COLHA + 1, COL() SAY OPCOES_MENU[ ES_COLHA ]
ENDIF
ENDIF
IF TIPO_MENU = MENU_PRINCIPAL
POS_ULT_MENU := ES_COLHA
ENDIF
ELSE
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
MOUSE( LIGA )
ENDIF
menu:LIMPA()
IF TIPO_MENU = SUB_MENU .AND. ES_COLHA = 999
ES_COLHA := 0
ENDIF
IF ES_COLHA > 0 .AND. ES_COLHA < 999
EVAL( ROTINAS_MENU[ ES_COLHA ] )
ENDIF
RETURN IIF( ES_COLHA = -1, 0, ES_COLHA )

FUNCTION MIROMENU( LIN_SUP, COL_ESQ, LIN_INF, COL_DIR, DADOS_MENU, DESTAQUE_MENU )
LOCAL CONTAR, ULT_CURSOR := SETCURSOR(), TECLA := 0, OP_CAO := 1,;
OBJ_MENU := TBROWSENEW( LIN_SUP, COL_ESQ, LIN_INF, COL_DIR ),;
ULT_OPCAO := 1, ULT_LINHA := LIN_SUP, POS_DESTAQUE, CONTADOR,;
BO_TAO := 0, LIN := 0, COL := 0, DADO_CUR, LE_TRA
//
// -> Define os dados principais do BROWSE
OBJ_MENU:ADDCOLUMN( TBCOLUMNNEW( , { || DADOS_MENU[ OP_CAO ] } ) )
OBJ_MENU:GOTOPBLOCK := { || OP_CAO := 1 }
OBJ_MENU:GOBOTTOMBLOCK := { || OP_CAO := LEN( DADOS_MENU ) }
OBJ_MENU:SKIPBLOCK := { | SALTO | SKIPMENU( SALTO, LEN( DADOS_MENU ), @OP_CAO ) }
CURSOR( DESLIGA )
WHILE .T.
MOUSE( DESLIGA )
IF ( POS_DESTAQUE := AT( "~", DESTAQUE_MENU[ ULT_OPCAO ] ) ) != 0
@ ULT_LINHA, COL_ESQ + POS_DESTAQUE SAY SUBS( DESTAQUE_MENU[ ULT_OPCAO ],;
POS_DESTAQUE + 1, 1 ) COLOR CONTECOR[ 7 ]
ENDIF
//
// -> Estabiliza o BROWSE
WHILE ( !OBJ_MENU:STABILIZE() )
IF ( POS_DESTAQUE := AT( "~", DESTAQUE_MENU[ OP_CAO ] ) ) != 0
@ ROW(), COL_ESQ + POS_DESTAQUE SAY SUBS( DESTAQUE_MENU[ OP_CAO ],;
POS_DESTAQUE + 1, 1 ) COLOR CONTECOR[ 7 ]
ENDIF
ENDDO
MOUSE( LIGA )
//
// -> Verifica se a opcao corrente e' editavel ou nao para saltar
// as nao editaveis
IF SUBS( DADOS_MENU[ OP_CAO ], 1, 1 ) = "─"
IF TECLA = T_CIMA .OR. TECLA = T_HOME .OR. TECLA = T_PGUP
IF OP_CAO = 1
OBJ_MENU:GOBOTTOM()
ELSE
OBJ_MENU:UP()
ENDIF
ELSE
IF OP_CAO = LEN( DADOS_MENU )
OBJ_MENU:GOTOP()
ELSE
OBJ_MENU:DOWN()
ENDIF
ENDIF
LOOP
ENDIF
ULT_LINHA := LIN_SUP + OBJ_MENU:ROWPOS - 1
ULT_OPCAO := OP_CAO
//
// -> Verifica se o BROWSE esta estavel
IF OBJ_MENU:STABLE
//
// -> Verfica se foi pressionado uma tecla
WHILE( TECLA := INKEY() ) == 0
IF TECLA = 0
//
// -> Lê buffer do mouse
MOUSE( @BO_TAO, @LIN, @COL )
ENDIF
//
// -> Verifica se os botoes do mouse foram pressionados para ativar
// a acao equivalente a posicao do cursor do mouse
IF BO_TAO = M_ESQUERDO .OR. BO_TAO = M_OS_DOIS
DADO_CUR := SUBS( SAVESCREEN( LIN, COL, LIN, COL ), 1, 1 )
IF DADO_CUR = CHR( 254 ) .OR. BO_TAO = M_OS_DOIS
TECLA := T_ESC
ELSEIF LIN = 24 .AND. ( COL >= 71 .AND. COL <= 78 )
TECLA := T_F1
ELSEIF ( LIN = LIN_SUP - 1 .AND. ( COL >= COL_ESQ .AND.;
COL <= COL_DIR ) ) .OR. DADO_CUR = CHR( 24 )
TECLA := T_CIMA
ELSEIF ( LIN = LIN_INF + 1 .AND. ( COL >= COL_ESQ .AND.;
COL <= COL_DIR ) ) .OR. DADO_CUR = CHR( 25 )
TECLA := T_BAIXO
ELSEIF ( COL >= COL_ESQ .AND. COL <= COL_DIR ) .AND.;
( LIN >= LIN_SUP .AND. LIN <= LIN_INF )
OBJ_MENU:ROWPOS := ( LIN - LIN_SUP ) + 1
OBJ_MENU:REFRESHALL()
MOUSE( DESLIGA )
WHILE ( !OBJ_MENU:STABILIZE() )
IF ( POS_DESTAQUE := AT( "~", DESTAQUE_MENU[ OP_CAO ] ) ) != 0
@ ROW(), COL_ESQ + POS_DESTAQUE SAY SUBS(;
DESTAQUE_MENU[ OP_CAO ], POS_DESTAQUE + 1, 1 );
COLOR CONTECOR[ 7 ]
ENDIF
ENDDO
MOUSE( LIGA )
TECLA := T_ENTER
ELSEIF LIN = LIN_MENU
FOR CONTAR = 1 TO LEN( MENU_PRI )
IF COL >= MENU_POS[ CONTAR ] + 1 .AND.;
COL <= LEN( MENU_PRI[ CONTAR ] ) + MENU_POS[ CONTAR ]
MENU_P := CONTAR
OP_CAO := -1
EXIT
ENDIF
NEXT
ELSE
BEEP_MOUSE()
LOOP
ENDIF
EXIT
ELSEIF BO_TAO = M_DIREITO
TECLA := T_ENTER
EXIT
ENDIF
ENDDO
IF OP_CAO = -1
EXIT
ENDIF
ENDIF
//
// -> Verifica se foi pressionamento uma tecla marcada com o caracter " ~ "
FOR CONTADOR := 1 TO LEN( DESTAQUE_MENU )
IF ( POS_DESTAQUE := AT( "~", DESTAQUE_MENU[ CONTADOR ] ) ) != 0
LE_TRA := SUBS( DESTAQUE_MENU[ CONTADOR ], POS_DESTAQUE + 1, 1 )
IF UPPER( LE_TRA ) = UPPER( CHR( TECLA ) )
ULT_OPCAO := CONTADOR
CONTADOR = ( CONTADOR - OP_CAO )
IF CONTADOR < 0
CONTADOR *= ( -1 )
TECLA = T_CIMA
ELSE
TECLA = T_BAIXO
ENDIF
FOR CONTAR := 1 TO CONTADOR
IF TECLA = T_CIMA
OBJ_MENU:UP()
ELSE
OBJ_MENU:DOWN()
ENDIF
NEXT
MOUSE( DESLIGA )
OBJ_MENU:REFRESHALL()
WHILE ( !OBJ_MENU:STABILIZE() )
IF ( POS_DESTAQUE := AT( "~", DESTAQUE_MENU[ OP_CAO ] ) ) != 0
@ ROW(), COL_ESQ + POS_DESTAQUE SAY SUBS(;
DESTAQUE_MENU[ OP_CAO ], POS_DESTAQUE + 1, 1 );
COLOR CONTECOR[ 7 ]
ENDIF
IF OP_CAO = ULT_OPCAO
OBJ_MENU:ROWPOS := ( ROW() - LIN_SUP ) + 1
ENDIF
ENDDO
MOUSE( LIGA )
TECLA := T_ENTER
EXIT
ENDIF
ENDIF
NEXT
//
// -> Verifica a tecla pressionada e executa a acao indicada
IF TECLA = T_ESC
OP_CAO := 0
EXIT
ELSEIF TECLA = T_ENTER
EXIT
ELSEIF TECLA == T_F1
HELP( "MENU" )
ELSEIF TECLA == T_F3
CALEN()
ELSEIF TECLA == T_F4
CALCU()
ELSEIF TECLA = T_DIREITA
BUFFER := CHR( T_DIREITA ) + CHR( T_ENTER )
OP_CAO := 0
EXIT
ELSEIF TECLA = T_ESQUERDA
BUFFER := CHR( T_ESQUERDA ) + CHR( T_ENTER )
OP_CAO := 0
EXIT
ELSEIF TECLA = T_CIMA
IF OP_CAO = 1
OBJ_MENU:GOBOTTOM()
ELSE
OBJ_MENU:UP()
ENDIF
ELSEIF TECLA = T_BAIXO
IF OP_CAO = LEN( DADOS_MENU )
OBJ_MENU:GOTOP()
ELSE
OBJ_MENU:DOWN()
ENDIF
ELSEIF TECLA = T_HOME
OBJ_MENU:GOTOP()
ELSEIF TECLA = T_END
OBJ_MENU:GOBOTTOM()
ELSEIF TECLA = T_PGUP
OBJ_MENU:PAGEUP()
ELSEIF TECLA = T_PGDN
OBJ_MENU:PAGEDOWN()
ENDIF
ENDDO
SETCURSOR( ULT_CURSOR )
RETURN OP_CAO

FUNCTION SKIPMENU( SALTO, ULT_OPCAO, OP_CAO )
LOCAL TOT_SALTO := 0
IF SALTO + OP_CAO < 1
TOT_SALTO := ( OP_CAO - 1 ) * ( -1 )
OP_CAO := 1
ELSEIF SALTO + OP_CAO > ULT_OPCAO
TOT_SALTO := ULT_OPCAO - OP_CAO
OP_CAO := ULT_OPCAO
ELSE
TOT_SALTO := SALTO
OP_CAO += SALTO
ENDIF
RETURN TOT_SALTO

FUNCTION SOMBRA( LIN_SUP, COL_SUP, LIN_INF, COL_INF )
MOUSE( DESLIGA )
IF PCOUNT() = 2 .OR. PCOUNT() = 3
C_SOM := COL_SUP; L_SOM := LIN_SUP
LIN_SUP := VAL( SUBS( C_SOM, 1, 2 ) )
COL_SUP := VAL( SUBS( C_SOM, 3, 2 ) )
LIN_INF := VAL( SUBS( C_SOM, 5, 2 ) )
COL_INF := VAL( SUBS( C_SOM, 7, 2 ) )
COL_SOM := SUBS( C_SOM, 9 )
LIN_SOM := L_SOM
ENDIF
IF COL_SUP < 2 .OR. LIN_INF > 22
C_SOM := ""; L_SOM := ""
MOUSE( LIGA )
RETURN .F.
ENDIF
IF PCOUNT() = 3
RESTSCREEN( LIN_SUP + 1, COL_SUP - 2, LIN_INF + 1, COL_SUP - 1, COL_SOM )
RESTSCREEN( LIN_INF + 1, COL_SUP - 2, LIN_INF + 2, COL_INF - 2, LIN_SOM )
MOUSE( LIGA )
RETURN .F.
ENDIF
IF PCOUNT() != 2
COL_SOM := SAVESCREEN( LIN_SUP + 1, COL_SUP - 2, LIN_INF + 1, COL_SUP - 1 )
LIN_SOM := SAVESCREEN( LIN_INF + 1, COL_SUP - 2, LIN_INF + 2, COL_INF - 2 )
ENDIF
IF SUBS( COL_SOM, 2, 1 ) != CHR( 8 )
C_SOM := STR( LIN_SUP, 2 ) + STR( COL_SUP, 2 ) + STR( LIN_INF, 2 ) +;
STR( COL_INF, 2 ) + COL_SOM
L_SOM := LIN_SOM
ENDIF
FOR I = 2 TO LEN( COL_SOM ) STEP 2
COL_SOM := STUFF( COL_SOM, I, 1, CHR( 8 ) )
NEXT
FOR I = 2 TO LEN( LIN_SOM ) / 2 STEP 2
LIN_SOM := STUFF( LIN_SOM, I, 1, CHR( 8 ) )
NEXT
RESTSCREEN( LIN_SUP + 1, COL_SUP - 2, LIN_INF + 1, COL_SUP - 1, COL_SOM )
RESTSCREEN( LIN_INF + 1, COL_SUP - 2, LIN_INF + 2, COL_INF - 2, LIN_SOM )
MOUSE( LIGA )
RETURN .T.

FUNCTION CONFCOR
menu:TIPO_MENU := SUB_MENU
menu:ADD( "~Papel de parede" )
menu:ADD( "~Menu" )
menu:ADD( "~Destaque do menu" )
menu:ADD( "~Janela de dialogo" )
menu:ADD( "~Box da janela de dialogo" )
menu:ADD( "B~otoes" )
menu:ADD( "Bo~tao em destaque" )
menu:ADD( "~Get's" )
menu:ADD( "G~et em destaque" )
menu:ADD( "Te~la de apresentacao" )
menu:ADD( "~Caracteres avulsos" )
menu:ADD( "Ce~rcaduras" )
menu:ADD( "T~itulo" )
ME_NU := menu:CONTEUDO()
OPC_COR := menu:RODA()
IF OPC_COR = 0
RETURN.T.
ENDIF
SETCOLOR( "W" )
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
MOUSE( LIGA )
COR( "MENU" )
@ LIN_MENU, 00
@ LIN_MENU, 01 SAY "Configuraçäo de cores │ "+ME_NU[ _OPCOES_MENU ][ OPC_COR ]
COR( "FUNDO DA TELA" )
IF FUNDO = 10
FUN_DO := "░░░░"
ELSE
FUN_DO := "└┐└┐"
ENDIF
MENSAGEM( "Utilize as setas para configurar as cores" )
IF OPC_COR != 10
SOMBRA( 03, 20, 21, 79 )
FOR F = 1 + LIN_MENU TO 17
@ F + 3, 20 SAY REPL( SUBS( FUN_DO, 1, 2 ), 30 )
FUN_DO := SUBS( FUN_DO, 3 ) + SUBS( FUN_DO, 1, 2 )
NEXT
FUN_DO := SUBS( FUN_DO, 3 ) + SUBS( FUN_DO, 1, 2 )
COR( "TITULO" )
@ 03, 20 SAY " Titulo do aplicativo "
COR( "MENU" )
@ LIN_MENU + 3, 20 SAY " Cadastros Manutençöes Relatórios Utilitários Sair "
@ 21, 20 SAY SPACE( 60 )
@ 21, 21 SAY DTOC( M->DAT_HOJE ) + " │"
@ 21, 38 SAY "Escolha a opçäo desejada"
@ 21, 69 SAY "│ F1-Ajuda"
ENDIF
IF OPC_COR = 3
@ LIN_MENU + 4,22 SAY " ┌─────────────────────┐ "
@ LIN_MENU + 5,22 SAY " │ Opçäo um                                         │ "
@ LIN_MENU + 6,22 SAY " ├─────────────────────┤ "
@ LIN_MENU + 7,22 SAY " │ Opçäo dois                                        │ "
@ LIN_MENU + 8,22 SAY " │ Opçäo tres                                        │ "
@ LIN_MENU + 9,22 SAY " └─────────────────────┘ "
ENDIF
IF OPC_COR = 4 .OR. OPC_COR = 5 .OR. OPC_COR = 6 .OR. OPC_COR = 7
JANELA( 08, 28, 16, 71 )
@ 11, 38 SAY "Confirma o encerramento ?"
botao:ADD( 13, 36, "Sim " )
botao:ADD( 13, 53, "Näo " )
botao:MOSTRA()
COR( "BOTAO EM DESTAQUE" )
@ 13, 37 SAY "Sim"
ENDIF
IF OPC_COR = 8 .OR. OPC_COR = 9 .OR. OPC_COR = 11 .OR. OPC_COR = 12
JANELA( 06, 23, 18, 76, "Cadastro de clientes" )
COR( "CERCADURAS" )
@ 11, 27 TO 11, 48
@ 11, 52 TO 11, 72
@ 15, 27 TO 15, 48
@ 15, 52 TO 15, 63
@ 15, 66 TO 15, 72
COR( "CARACTERES AVULSOS" )
@ 10, 27 SAY "Nome"
@ 10, 52 SAY "Empresa"
@ 14, 27 SAY "Endereço"
@ 14, 52 SAY "Bairro"
@ 14, 66 SAY "Cep"
COR( "GET EM DESTAQUE" )
@ 12, 27 SAY "TESTE" + SPACE( 17 )
SETCOLOR( CONTECOR[ 8 ] )
@ 12, 52 SAY "TESTE" + SPACE( 16 )
@ 16, 27 SAY "TESTE" + SPACE( 17 )
@ 16, 52 SAY "TESTE" + SPACE( 7 )
@ 16, 66 SAY "9999999"
ENDIF
X_COR := 07; Y_COR := 0
CURSOR( DESLIGA )
SETCOLOR( "BG/RB" )
@ X_COR, Y_COR, X_COR + 9, Y_COR + 17 BOX "█"
FOR F_COR = 0 TO 7
FOR C_COR = 0 TO 15
SETCOLOR( ALLTRIM( STR( C_COR, 2 ) ) + "/" + ALLTRIM( STR( F_COR, 2 ) ) )
@ F_COR + X_COR + 1, C_COR + Y_COR + 1 SAY "■"
NEXT
NEXT
C_COR := VAL( SUBS( CONTECOR[ OPC_COR ], 1, 2 ) )
F_COR := VAL( SUBS( CONTECOR[ OPC_COR ], 4 ) )
OK := .T.
WHILE .T.
SETCOLOR( "N/BG" )
@ X_COR, Y_COR, X_COR + 9, Y_COR + 17 BOX " "
@ F_COR + X_COR + 1, Y_COR + 17 SAY CHR( 17 )
@ X_COR, Y_COR + C_COR + 1 SAY CHR( 31 )
SETCOLOR( ALLTRIM( STR( C_COR, 3 ) ) + "/" + ALLTRIM( STR( F_COR, 3 ) ) )
CONTECOR[ OPC_COR ] := STRZERO( C_COR, 2 ) + "/" + STRZERO( F_COR, 2 )
IF OPC_COR = 1
FOR F= 1 + LIN_MENU TO 17
@ F + 3, 20 SAY REPL( SUBS( FUN_DO, 1, 2 ), 30 )
FUN_DO := SUBS( FUN_DO, 3 ) + SUBS( FUN_DO, 1, 2 )
NEXT
FUN_DO := SUBS( FUN_DO, 3 ) + SUBS( FUN_DO, 1, 2 )
ELSEIF OPC_COR = 2
@ LIN_MENU + 3, 20 SAY " Cadastros Manutençöes Relatórios Utilitários Sair "
@ 21, 20 SAY SPACE( 60 )
@ 21, 21 SAY DTOC( M->DAT_HOJE ) + " │"
@ 21, 38 SAY "Escolha a opçäo desejada"
@ 21, 69 SAY "│ F1-Ajuda"
IF OPC_COR = 2
@ LIN_MENU + 4,22 SAY " ┌─────────────────────┐ "
@ LIN_MENU + 5,22 SAY " │ Opçäo um                                         │ "
@ LIN_MENU + 6,22 SAY " ├─────────────────────┤ "
@ LIN_MENU + 7,22 SAY " │ Opçäo dois                                        │ "
@ LIN_MENU + 8,22 SAY " │ Opçäo tres                                        │ "
@ LIN_MENU + 9,22 SAY " └─────────────────────┘ "
COR( "DESTAQUE DO MENU" )
@ LIN_MENU + 3, 22 SAY " Cadastros "
@ LIN_MENU + 5, 24 SAY " Opçäo um "
ENDIF
ELSEIF OPC_COR = 3
@ LIN_MENU + 3, 22 SAY " Cadastros "
@ LIN_MENU + 5, 24 SAY " Opçäo um "
ELSEIF OPC_COR = 5
@ 08, 28, 16, 71 BOX " "
@ 08, 28 SAY "■"
ELSEIF OPC_COR = 4
@ 09, 29 CLEAR TO 15, 70
@ 11, 38 SAY "Confirma o encerramento ?"
botao:ADD( 13, 36, "Sim " )
botao:ADD( 13, 53, "Näo " )
botao:MOSTRA()
COR( "BOTAO EM DESTAQUE" )
@ 13, 37 SAY "Sim "
ELSEIF OPC_COR = 6
botao:ADD( 13, 53, "Näo " )
botao:MOSTRA()
ELSEIF OPC_COR = 7
botao:ADD( 13, 36, "Sim " )
botao:MOSTRA()
COR( "BOTAO EM DESTAQUE" )
@ 13, 36 SAY " Sim "
ELSEIF OPC_COR = 12
@ 11, 27 TO 11, 48
@ 11, 52 TO 11, 72
@ 15, 27 TO 15, 48
@ 15, 52 TO 15, 63
@ 15, 66 TO 15, 72
ELSEIF OPC_COR = 11
@ 10, 27 SAY "Nome"
@ 10, 52 SAY "Empresa"
@ 14, 27 SAY "Endereço"
@ 14, 52 SAY "Bairro"
@ 14, 66 SAY "Cep"
ELSEIF OPC_COR = 9
@ 12, 27 SAY "TESTE" + SPACE( 17 )
ELSEIF OPC_COR = 8
@ 12, 52 SAY "TESTE" + SPACE( 16 )
@ 16, 27 SAY "TESTE" + SPACE( 17 )
@ 16, 52 SAY "TESTE" + SPACE( 7 )
@ 16, 66 SAY "9999999"
ELSEIF OPC_COR = 10
OK := .F.
SOMBRA( 03, 20, 21, 79 )
ENDIF
ELSEIF OPC_COR = 13
@ 03, 20 SAY " Titulo do aplicativo "
ENDIF
TECLA := INKEY( 0 )
SETCOLOR( "W/BG" )
@ X_COR + F_COR + 1, Y_COR + 17 SAY " "
@ X_COR, C_COR + Y_COR + 1 SAY " "
F_COR += IIF( TECLA = T_CIMA, -1, IIF( TECLA = T_BAIXO, 1, 0 ) )
C_COR += IIF( TECLA = T_ESQUERDA, -1, IIF( TECLA = T_DIREITA, 1, 0 ) )
F_COR = IIF( F_COR < 0, 7, IIF( F_COR > 7, 0, F_COR ) )
C_COR = IIF( C_COR < 0, 15, IIF( C_COR > 15, 0, C_COR ) )
IF TECLA = T_ESC .OR. TECLA = T_ENTER
EXIT
ENDIF
ENDDO
CONTECOR[ OPC_COR ] := STRZERO( C_COR, 2 ) + "/" + STRZERO( F_COR, 2 )
COR( "TITULO" )
@ 00, 00
@ 00, ( 80 - LEN( TITU_LO ) ) / 2 SAY TITU_LO
FUNDO()
COR( "MENU" )
@ LIN_MENU, 00
FOR F_MENU = 1 TO LEN( MENU_PRI )
@ LIN_MENU, MENU_POS[ F_MENU ] + 1 SAY MENU_PRI[ F_MENU ]
NEXT
@ 24, 00
@ 24, 01 SAY M->DAT_HOJE
@ 24, 10 SAY "│"
@ 24, 69 SAY "│"
@ 24, 71 SAY "F1-Ajuda"
MOUSE( DESLIGA )
TELA_PRI := SAVESCREEN( LIN_MENU + 1, 00, 23, 79 )
MOUSE( LIGA )
BUFFER := CHR( T_ENTER ) + "C"
RETURN .T.

FUNCTION FUNDO( EDITA_FUNDO )
//
// -> Monta papel de parede
LOCAL CONTAR, MONTA_TELA
IF EDITA_FUNDO = NIL
EDITA_FUNDO := 0
ENDIF
menu:LIMPA()
menu:TIPO_MENU := SUB_MENU
menu:ADD( "[~1] titio.info" )
menu:ADD( "[~2] ░░░░░░░░░░▒▒▒▒▒▒▒▒▒▓▓▓▓▓▓▓▓▓▓▒▒▒▒▒▒▒▒▒▒" )
menu:ADD( "[~3] ░░░░░░░░░░▒▒▒▒▒▒▒▒▒░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓" )
menu:ADD( "[~4] ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▒▒▒▒▒▒▒▒▒▒" )
menu:ADD( "[~5] ▓▓▓▓▓▓▓▓▓▓ ░░░░░░░░░░▒▒▒▒▒▒▒▒▒▒" )
menu:ADD( "[~6] ░░░░░░░░░░░░░░░░░░░▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒" )
menu:ADD( "[~7] ░░░░░░░░░░▒▒▒▒▒▒▒▒▒▓▓▓▓▓▓▓▓▓▓▒▒▒▒▒▒▒▒▒" )
menu:ADD( "[~8] ░░░░░░░░░░▒▒▒▒▒▒▒▒▒░░░░░░░░░░▓▓▓▓▓▓▓▓▓" )
menu:ADD( "[~9] ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▒▒▒▒▒▒▒▒▒" )
menu:ADD( "[~A] ▓▓▓▓▓▓▓▓▓▓ ░░░░░░░░░░▒▒▒▒▒▒▒▒▒" )
menu:ADD( "[~B] ░░░░░░░░░░░░░░░░░░░▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒" )
menu:ADD( "[~C] ░" )
menu:ADD( "[~D] ▒" )
menu:ADD( "[~E] ▓" )
menu:ADD( "[~F] " )
menu:ADD( "[~G] └┐└┐" )
menu:ADD( "[~H] ╩╦╦╩" )
menu:ADD( "[~I] ┴┬┬┴" )
menu:ADD( "[~J] ├┤┤├" )
menu:ADD( "[~K] ╣╠╠╣" )
menu:ADD( "[~L] ░░░░░▒▒▒▒▒░░░░░▓▓▓▓▓" )
menu:ADD( "[~M] ═╩═╦═╦═╩" )
menu:ADD( "[~N] ─┴─┬─┬─┴" )
menu:ADD( "[~O] Tela de apresentaçäo" )
ME_NU := menu:CONTEUDO()
IF EDITA_FUNDO = 1
S_MENU := menu:RODA()
IF S_MENU = 0
RETURN .F.
ENDIF
FUNDO := S_MENU
ELSE
menu:LIMPA()
ENDIF
COR( "FUNDO DA TELA" )
IF FUNDO = LEN( ME_NU[ _OPCOES_MENU ] )
TELA_ENT( 1 )
MOUSE( DESLIGA )
TELA_PRI := SAVESCREEN( LIN_MENU + 1, 00, 23, 79 )
MOUSE( LIGA )
RETURN .T.
ENDIF
IF FUNDO = 21
MONTA_TELA := 0
FOR CONTAR = LIN_MENU + 1 TO 23
MONTA_TELA++
IF MONTA_TELA < 3
@ CONTAR, 00 SAY REPL( "░░░░░▒▒▒▒▒", 8 )
ELSE
@ CONTAR, 00 SAY REPL( "▓▓▓▓▓░░░░░", 8 )
IF MONTA_TELA=4; MONTA_TELA := 0; ENDIF
ENDIF
NEXT
MOUSE( DESLIGA )
TELA_PRI := SAVESCREEN( LIN_MENU + 1, 00, 23, 79 )
MOUSE( LIGA )
RETURN .T.
ENDIF
IF FUNDO = 1
FUN_DO := "titio.info "
ELSEIF FUNDO = 15
FUN_DO := SPACE( 1 )
ELSE
FUN_DO := TRIM( SUBS( ME_NU[ _OPCOES_MENU ][ FUNDO ], 7 ) )
ENDIF
IF FUNDO < 16
FUN_DO := SUBS( FUN_DO + REPL( FUN_DO, 1840 / LEN( FUN_DO ) ), 1, 1840 )
ENDIF
FOR CONTAR := LIN_MENU + 1 TO 23
IF FUNDO < 16
@ CONTAR, 00 SAY SUBS( FUN_DO, CONTAR * 80 - 79, 80 )
ELSEIF FUNDO = 22 .OR. FUNDO = 23
@ CONTAR, 00 SAY REPL( SUBS( FUN_DO, 1, 4 ), 20 )
FUN_DO := SUBS( FUN_DO, 5 ) + SUBS( FUN_DO, 1, 4 )
ELSE
@ CONTAR, 00 SAY REPL( SUBS( FUN_DO, 1, 2 ), 40 )
FUN_DO := SUBS( FUN_DO, 3 ) + SUBS( FUN_DO, 1, 2 )
ENDIF
NEXT
IF EDITA_FUNDO = 1
MOUSE( DESLIGA )
TELA_PRI := SAVESCREEN( LIN_MENU + 1, 00, 23, 79 )
MOUSE( LIGA )
ENDIF
RETURN .T.

FUNCTION COR( NOM_COR )
QUAL_COR := ASCAN( NOMECOR, UPPER( NOM_COR ) )
IF QUAL_COR != 0
IF QUAL_COR = 2
SETCOLOR( CONTECOR[ 2 ] + "," + CONTECOR[ 3 ] + ",,," + CONTECOR[ 2 ] )
ELSEIF QUAL_COR = 8
SETCOLOR( CONTECOR[ 11 ] + "," + CONTECOR[ 9 ] + ",,," + CONTECOR[ 8 ] )
ELSE
SETCOLOR( CONTECOR[ QUAL_COR ] )
ENDIF
ENDIF
RETURN .T.

FUNCTION FUN_CFG( PAR1 )
IF LASTKEY() = T_ENTER
RETURN 1
ELSEIF LASTKEY() = T_ESC
RETURN 0
ELSEIF AT( UPPER( CHR( LASTKEY() ) ), "IFRSC" ) > 0 .OR.;
LASTKEY() = T_TAB .OR. LASTKEY() = T_SH_TAB
RETURN 0
ELSEIF PAR1 = 1
KEYBOARD CHR( T_CTRL_PGDN )
ELSEIF PAR1 = 2
KEYBOARD CHR( T_CTRL_PGUP )
ENDIF
CFG_COR := SETCOLOR()
COR( "MENU" )
FOR F_CFG = 1 TO LEN( MENU_CFG )
@ 09 + F_CFG, 34 SAY " "
NEXT
SETCOLOR( CFG_COR )
RETURN 2

FUNCTION CALCU
//
// -> Funçäo que ativa a calculadora
LOCAL ULT_CURSOR := SETCURSOR(), ULT_COR := SETCOLOR(), LINHA := ROW(),;
COLUNA := COL(), TELA, RESULTADO := 0, CONTADOR, CONTAR, LIN, COL,;
ALGARISMOS := SPACE( 14 ), DECIMAIS := "", TECLA := CHR( 0 ),;
MOV_TELA, ALG_OU_DEC := "A", PERCENTAGEM := " ", ULT_OPERADOR := "",;
OK_OPERADOR := .F., CALCULO, TRANSPORTE, BO_TAO, TELA_CALCU,;
L_CALCU, C_CALCU, TIPO_SAIDA := NIL, BOTOES := {;
{ 6, 4, " 7 ", { "7", CHR( T_HOME ) } },;
{ 6, 9, " 8 ", { "8", CHR( T_CIMA ) } },;
{ 6, 14, " 9 ", { "9", CHR( T_PGUP ) } },;
{ 6, 20, " - ", { "-" } },;
{ 6, 25, " + ", { "+" } },;
{ 8, 4, " 4 ", { "4", CHR( T_ESQUERDA ) } },;
{ 8, 9, " 5 ", { "5", CHR( 76 ) } },;
{ 8, 14, " 6 ", { "6", CHR( T_DIREITA ) } },;
{ 8, 20, " / ", { "/" } },;
{ 8, 25, " * ", { "*" } },;
{ 10, 4, " 1 ", { "1", CHR( T_END ) } },;
{ 10, 9, " 2 ", { "2", CHR( T_BAIXO ) } },;
{ 10, 14, " 3 ", { "3", CHR( T_PGDN ) } },;
{ 10, 20, " = ", { "=", CHR( T_ENTER ) } },;
{ 10, 25, " % ", { "%" } },;
{ 12, 4, " 0 ", { "0", CHR( T_INSERT ) } },;
{ 12, 9, " . ", { ".", CHR( T_DEL ) } },;
{ 12, 14, "Get", { "G" } },;
{ 12, 20, " C ", { "C", " " } },;
{ 12, 25, "cE ", { "E" } },;
{ 12, 41, " Imprime ", { "I" } } }
DADOS_CALCU := {}
MOUSE( LIGA )
SOMBRA( L_CALCU := L_SOM, C_CALCU := C_SOM, .T. )
MOUSE( DESLIGA )
TELA := SAVESCREEN( 00, 00, MAXROW(), MAXCOL() )
MOUSE( LIGA )
CURSOR( DESLIGA )
JANELA( MOV_LINHA, MOV_COLUNA, MOV_LINHA + 15, MOV_COLUNA + 61, "Calculadora" )
COR( "BOX DA JANELA DE DIALOGO" )
@ MOV_LINHA + 1, MOV_COLUNA + 30, MOV_LINHA + 14, MOV_COLUNA + 30 BOX SPACE( 8 )
COR( "MENU" )
@ MOV_LINHA + 2, MOV_COLUNA + 33 CLEAR TO MOV_LINHA + 10, MOV_COLUNA + 58
SETCOLOR( ALLTRIM( SUBS( CONTECOR[ 5 ], 4 ) ) + "/" + ALLTRIM( SUBS( CONTECOR[ 4 ], 4 ) ) )
@ MOV_LINHA + 2, MOV_COLUNA + 4, MOV_LINHA + 4, MOV_COLUNA + 26 BOX "▄▄▄█▀▀▀█"
FOR CONTAR := 1 TO LEN( BOTOES )
BOT_CALC( MOV_LINHA + BOTOES[ CONTAR ][ 1 ],;
MOV_COLUNA + BOTOES[ CONTAR ][ 2 ], BOTOES[ CONTAR ][ 3 ] )
NEXT
@ MOV_LINHA + 3, MOV_COLUNA + 5 SAY " " + STR( RESULTADO, 19, 4 ) + " " COLOR "W"
WHILE TECLA != CHR( T_ESC )
TECLA := CHR( 0 )
WHILE TECLA = CHR( 0 )
TECLA := CHR( INKEY() )
MOUSE( @BO_TAO, @LIN, @COL )
IF BO_TAO = M_ESQUERDO
DADO_CUR := SUBS( SAVESCREEN( LIN, COL, LIN, COL ), 1, 1 )
IF DADO_CUR = CHR( 254 )
TECLA := CHR( T_ESC )
EXIT
ELSEIF LIN = 24 .AND. ( COL >= 71 .AND. COL <= 78 )
TECLA := CHR( T_F1 )
EXIT
ENDIF
FOR CONTAR = 1 TO LEN( BOTOES )
IF LIN = BOTOES[ CONTAR ][ 1 ] + MOV_LINHA .AND.;
( COL >= BOTOES[ CONTAR ][ 2 ] + MOV_COLUNA .AND.;
COL <= MOV_COLUNA + BOTOES[ CONTAR ][ 2 ] +;
LEN( BOTOES[ CONTAR ][ 3 ] ) - 1 )
TECLA := BOTOES[ CONTAR ][ 4 ][ 1 ]
EXIT
ENDIF
NEXT
IF TECLA = CHR( 0 ); BEEP_MOUSE(); ENDIF
ELSEIF BO_TAO = M_OS_DOIS
TECLA := CHR( T_ESC )
ELSEIF BO_TAO = M_DIREITO
TECLA := CHR( T_ENTER )
ENDIF
ENDDO
TECLA := UPPER( TECLA )
FOR CONTAR := 1 TO LEN( BOTOES )
FOR CONTADOR := 1 TO LEN( BOTOES[ CONTAR ][ 4 ] )
IF TECLA = BOTOES[ CONTAR ][ 4 ][ CONTADOR ]
EXIT
ENDIF
NEXT
IF CONTADOR <= LEN( BOTOES[ CONTAR ][ 4 ] )
BOT_CALC( MOV_LINHA + BOTOES[ CONTAR ][ 1 ],;
MOV_COLUNA + BOTOES[ CONTAR ][ 2 ], BOTOES[ CONTAR ][ 3 ],;
.T. )
TECLA := BOTOES[ CONTAR ][ 4 ][ 1 ]
EXIT
ENDIF
NEXT
SETCOLOR( "W" )
IF AT( TECLA, CHR( 26 ) + CHR( 2 ) + CHR( 141 ) + CHR( 145 ) ) != 0
MOUSE( DESLIGA )
MOV_TELA := SAVESCREEN( MOV_LINHA, MOV_COLUNA, MOV_LINHA + 15, MOV_COLUNA + 61 )
RESTSCREEN( 00, 00, MAXROW(), MAXCOL(), TELA )
MOUSE( LIGA )
IF TECLA = CHR( 26 )
MOV_COLUNA--
ELSEIF TECLA = CHR( 2 )
MOV_COLUNA++
ELSEIF TECLA = CHR( 141 )
MOV_LINHA--
ELSEIF TECLA = CHR( 145 )
MOV_LINHA++
ENDIF
IF MOV_LINHA < 0
MOV_LINHA := 0
ELSEIF MOV_LINHA > 9
MOV_LINHA := 9
ELSEIF MOV_COLUNA < 0
MOV_COLUNA := 0
ELSEIF MOV_COLUNA > 20
MOV_COLUNA := 20
ENDIF
MOUSE( DESLIGA )
SOMBRA( MOV_LINHA, MOV_COLUNA, MOV_LINHA + 15, MOV_COLUNA + 61 )
RESTSCREEN( MOV_LINHA, MOV_COLUNA, MOV_LINHA + 15, MOV_COLUNA + 61, MOV_TELA )
MOUSE( LIGA )
ENDIF
IF TECLA = CHR( T_F1 )
HELP( "CALCULADORA" )
ENDIF
IF TECLA = CHR( T_ESC )
EXIT
ENDIF
IF TECLA = "."; ALG_OU_DEC := "D"; ENDIF
ALGARISMOS := IIF( TECLA = "." .AND. ALGARISMOS = SPACE( 14 ),;
SPACE( 13 ) + "0", ALGARISMOS )
IF TECLA = "%"
IF RESULTADO != 0 .AND. ULT_OPERADOR $ "+-/*"
PERCENTAGEM := IIF( PERCENTAGEM = "%", " ", "%" )
SETCOLOR( ALLTRIM( SUBS( CONTECOR[ 6 ], 1, 2 ) ) + "/" +;
ALLTRIM( SUBS( CONTECOR[ 5 ], 4 ) ) )
@ MOV_LINHA + 3, MOV_COLUNA + 26 SAY PERCENTAGEM
IMP_CALCU( ALGARISMOS + "." + SUBS( DECIMAIS + "00000", 1, 4 ) + "%" )
ELSE
@ MOV_LINHA + 3, MOV_COLUNA + 5 SAY SPACE( 13 ) + "0.0000" COLOR "W"
RESULTADO := 0; ALGARISMOS := SPACE( 14 ); DECIMAIS := ""
ENDIF
ELSEIF TECLA $ "0123456789" .AND.;
IIF( ALG_OU_DEC = "A", LEN( LTRIM( ALGARISMOS ) ) != 14,;
LEN( LTRIM( DECIMAIS ) ) != 4 )
OK_OPERADOR := .T.
IF ULT_OPERADOR = "="
ULT_OPERADOR = " "
RESULTADO = 0
ENDIF
IF ALG_OU_DEC = "A"
ALGARISMOS = SUBS( ALGARISMOS + TECLA, 2 )
ELSE
DECIMAIS += TECLA
ENDIF
@ MOV_LINHA + 3, MOV_COLUNA + 6 SAY ALGARISMOS + "." + SUBS( DECIMAIS +;
"00000", 1, 4 ) COLOR "W"
ELSEIF TECLA $ "+-/*="
IF TECLA != "="
IF !OK_OPERADOR
LOOP
ENDIF
OK_OPERADOR := .F.
ENDIF
IF RESULTADO != 0
IF VAL( ALGARISMOS + "." + DECIMAIS ) != 0
IF ULT_OPERADOR != "="
IF PERCENTAGEM = "%"
CALCULO := STR( RESULTADO, 19, 4 ) + ULT_OPERADOR + "(" +;
STR( RESULTADO, 19, 4 ) + "*" + ALGARISMOS +;
"." + SUBS( DECIMAIS + "00000" , 1, 4 ) + ")/100.000"
ELSE
CALCULO := STR( RESULTADO, 19, 4 ) + ULT_OPERADOR +;
ALGARISMOS + "." + SUBS( DECIMAIS + "00000", 1, 4 )
ENDIF
RESULTADO := &CALCULO
IF STR( RESULTADO, 19, 4 ) = REPL( "*", 19 )
@ MOV_LINHA + 3, MOV_COLUNA + 6 SAY " * E R R O * " COLOR "W"
RESULTADO := 0
SETCOLOR( ALLTRIM( SUBS( CONTECOR[ 6 ], 1, 2 ) ) + "/" +;
ALLTRIM( SUBS( CONTECOR[ 5 ], 4 ) ) )
@ MOV_LINHA + 3, MOV_COLUNA + 4 SAY " "
@ MOV_LINHA + 3, MOV_COLUNA + 26 SAY " "
IMP_CALCU()
IMP_CALCU( "E R R O " )
IMP_CALCU()
ELSE
@ MOV_LINHA + 3, MOV_COLUNA + 6 SAY STR( RESULTADO, 19, 4 ) COLOR "W"
IF TECLA != "=" .AND. PERCENTAGEM != "%"
IMP_CALCU( TRAN( VAL( ALGARISMOS + "." + SUBS( DECIMAIS +;
"00000", 1, 4 ) ), "@E 99,999,999,999,999.9999" ) + TECLA )
ENDIF
ENDIF
ENDIF
ELSE
IF TECLA != "="
IMP_CALCU( TRAN( RESULTADO, "@E 99,999,999,999,999.9999" ) +;
TECLA )
ENDIF
ENDIF
ELSEIF TECLA $ "+-/*"
RESULTADO := VAL( ALGARISMOS + "." + DECIMAIS )
IMP_CALCU( TRAN( VAL( ALGARISMOS + "." + SUBS( DECIMAIS + "00000", 1,;
4 ) ), "@E 99,999,999,999,999.9999" ) + TECLA )
ENDIF
SETCOLOR( ALLTRIM( SUBS( CONTECOR[ 6 ], 1 , 2 ) ) + "/" +;
ALLTRIM( SUBS( CONTECOR[ 5 ], 4 ) ) )
@ MOV_LINHA + 3, MOV_COLUNA + 4 SAY IIF( TECLA $ "+-/*", TECLA, " " )
@ MOV_LINHA + 3, MOV_COLUNA + 26 SAY " "
IF TECLA = "="
IF VAL( ALGARISMOS + "." + DECIMAIS ) != 0 .AND. PERCENTAGEM != "%"
IMP_CALCU( TRAN( VAL( ALGARISMOS + "." + SUBS( DECIMAIS + "00000",;
1, 4 ) ), "@E 99,999,999,999,999.9999" ) + " " )
ENDIF
IMP_CALCU( "=" )
IMP_CALCU( TRAN( RESULTADO, "@E 99,999,999,999,999.9999" ) +;
" " )
IMP_CALCU()
ENDIF
ALG_OU_DEC := "A"
ALGARISMOS := SPACE( 14 )
DECIMAIS := ""
ULT_OPERADOR := TECLA
PERCENTAGEM := " "
ELSEIF TECLA $ "EC"
ALG_OU_DEC := "A"
ALGARISMOS := SPACE( 14 )
DECIMAIS := ""
PERCENTAGEM := " "
IF TECLA $ "C"
RESULTADO := 0
SETCOLOR( ALLTRIM( SUBS( CONTECOR[ 6 ], 1, 2 ) ) + "/" +;
ALLTRIM( SUBS( CONTECOR[ 5 ], 4 ) ) )
@ MOV_LINHA + 3, MOV_COLUNA + 4 SAY " "
@ MOV_LINHA + 3, MOV_COLUNA + 26 SAY " "
IMP_CALCU()
IMP_CALCU( REPL( "─", 24 ) )
IMP_CALCU()
ENDIF
@ MOV_LINHA + 3, MOV_COLUNA + 6 SAY SPACE( 13 ) + "0.0000" COLOR "W"
ELSEIF TECLA = "G"
IF RESULTADO != 0
TRANSPORTE := ALLTRIM( STR( RESULTADO ) )
ELSE
TRANSPORTE := ALLTRIM( STR( VAL( ALGARISMOS + "." + DECIMAIS ) ) )
ENDIF
IF "." $ TRANSPORTE
FOR CONTADOR := LEN( TRANSPORTE ) TO 1 STEP -1
IF SUBS( TRANSPORTE, CONTADOR, 1 ) != "0"
TRANSPORTE := SUBS( TRANSPORTE, 1, CONTADOR )
EXIT
ENDIF
NEXT
IF SUBS( TRANSPORTE, LEN( TRANSPORTE ), 1 ) = "."
TRANSPORTE := SUBS( TRANSPORTE, 1, LEN( TRANSPORTE ) - 1 )
ENDIF
ENDIF
KEYBOARD TRANSPORTE
EXIT
ELSEIF TECLA = "I"
MOUSE( DESLIGA )
TELA_CALCU := SAVESCREEN( 00, 00, MAXROW(), MAXCOL() )
MOUSE( LIGA )
COR( "MENU" )
@ LIN_MENU, 00
@ LIN_MENU, 01 SAY "Calculadora │ Impressäo do conteudo da fita"
NUM_RELATORIO := 0
TIPO_SAIDA := MENU_PRN()
IF TIPO_SAIDA = NIL
MOUSE( DESLIGA )
RESTSCREEN( 00, 00, MAXROW(), MAXCOL(), TELA_CALCU )
MOUSE( LIGA )
LOOP
ENDIF
SET DEVI TO PRINT
@ 00, 00 SAY ""
FOR CONTADOR := 1 TO LEN( DADOS_CALCU )
@ PROW() + 1, 00 SAY DADOS_CALCU[ CONTADOR ]
IF PROW() > 62
@ 00, 00 SAY ""
ENDIF
NEXT
EJECT
SET DEVI TO SCREEN
IF TIPO_SAIDA = "A"
SET PRINTER TO
ELSEIF TIPO_SAIDA = "T"
SET PRINTER TO
IMP_TELA( 30 )
ENDIF
MOUSE( DESLIGA )
RESTSCREEN( 00, 00, MAXROW(), MAXCOL(), TELA_CALCU )
MOUSE( LIGA )
ENDIF
ENDDO
SETCOLOR( ULT_COR )
MOUSE( DESLIGA )
RESTSCREEN( 00, 00, MAXROW(), MAXCOL(), TELA )
MOUSE( LIGA )
SETCURSOR( ULT_CURSOR )
SOMBRA( L_CALCU, C_CALCU )
SETPOS( LINHA, COLUNA )

FUNCTION IMP_CALCU( CONTEUDO )
IF CONTEUDO = NIL; CONTEUDO := ""; ENDIF
COR( "MENU" )
SCROLL( MOV_LINHA + 2, MOV_COLUNA + 33, MOV_LINHA + 10, MOV_COLUNA + 58, 1 )
@ MOV_LINHA + 10, MOV_COLUNA + 33 SAY PADL( CONTEUDO, 25 )
IF CONTEUDO = REPL( "─", 24 )
AADD( DADOS_CALCU, REPL( "-", 24 ) )
ELSEIF CONTEUDO = "="
AADD( DADOS_CALCU, SPACE( 23 ) + "=" )
ELSE
AADD( DADOS_CALCU, CONTEUDO )
ENDIF
RETURN NIL

FUNCTIO BOT_CALC( BOT_X, BOT_Y, BOT_N )
LOCAL TEMPO := SECONDS()
IF PCOUNT() = 4
SETCOLOR( "N/" + ALLTRIM( SUBS( CONTECOR[ 4 ], 4 ) ) )
@ BOT_X, BOT_Y + LEN( BOT_N ) - 1 SAY " "
@ BOT_X + 1, BOT_Y - 1 SAY REPL( " ", LEN( BOT_N ) )
IF BOT_Y = 20 + MOV_COLUNA .OR. BOT_Y = 25 + MOV_COLUNA
COR( "BOTAO EM DESTAQUE" )
ELSE
COR( "BOTOES" )
ENDIF
@ BOT_X, BOT_Y - 1 SAY BOT_N
WHILE ( SECONDS() - TEMPO ) < .1; ENDDO
SETCOLOR( "N/" + ALLTRIM( SUBS( CONTECOR[ 4 ], 4 ) ) )
@ BOT_X, BOT_Y - 1 SAY "▄"
@ BOT_X + 1, BOT_Y - 1 SAY REPL( "▀", LEN( BOT_N ) )
ENDIF
IF BOT_Y = 20 + MOV_COLUNA .OR. BOT_Y = 25 + MOV_COLUNA
COR( "BOTAO EM DESTAQUE" )
ELSE
COR( "BOTOES" )
ENDIF
@ BOT_X, BOT_Y SAY BOT_N
SETCOLOR( "N/" + ALLTRIM( SUBS( CONTECOR[ 4 ], 4 ) ) )
@ BOT_X, BOT_Y - 1 SAY "▄"
@ BOT_X + 1, BOT_Y - 1 SAY REPL( "▀", LEN( BOT_N ) )
RETURN .T.

FUNCTION MENU_PRN
//
// -> Menu de direcionamento de impressao
ARQ_PRN := "REPORT"
FUNDO()
JANELA( 06, 21, 19, 59, TRIM( SUBS( NOME_IMP, 1, 33 ) ) )
COR( "MENU" )
@ 09, 26 CLEAR TO 13, 54
IF NUM_RELATORIO = 0
TIPO_FORMULARIO := "0"
ELSE
TIPO_FORMULARIO := FOR_MULARIO[ NUM_RELATORIO ]
ENDIF
WHILE .T.
@ 06, 23 SAY PADC( TRIM( SUBS( NOME_IMP, 1, 33 ) ), 35 ) COLOR CONTECOR[ 5 ]
botao:ADD( 15, 33, "Impressoras " )
botao:ADD( 17, 33, "Formulario " + IIF( TIPO_FORMULARIO = "1",;
"132", "080" ) )
botao:MOSTRA()
MENU_CFG := { " (" + CHR( 7 ) + ") Impressora",;
" (" + CHR( 7 ) + ") Tela ",;
" (" + CHR( 7 ) + ") Arquivo " }
SETCOLOR( CONTECOR[ 2 ] + "," + CONTECOR[ 7 ] )
KEYBOARD CHR( 32 )
OPC_PRN := ACHOICE( 10, 28, 12, 52, MENU_CFG, .T., "FUN_CFG" )
IF LASTKEY() = T_TAB .OR. LASTKEY() = T_SH_TAB
botao:ADD( 15, 33, "Impressoras " )
botao:ADD( 17, 33, "Formulario " + IIF( TIPO_FORMULARIO = "1",;
"132", "080" ) )
IF LASTKEY() = T_TAB
OPCAO_BOTAO := 1
ELSE
OPCAO_BOTAO := 2
ENDIF
OPCAO_BOTAO := botao:RODA( OPCAO_BOTAO )
IF OPCAO_BOTAO = 0
LOOP
ELSEIF OPCAO_BOTAO = 1
KEYBOARD "I"
ELSE
KEYBOARD "F"
ENDIF
INKEY( 0 )
ENDIF
IF LASTKEY() = ASC( "I" ) .OR. LASTKEY() = ASC( "i" )
botao:MOVIMENTA( 15, 33, "Impressoras " )
TELA_PRN := SAVESCREEN( 00, 00, 24, 79 )
IF LEN( IMP_ARQ ) != 0
ME_NU := {}
FOR CONTADOR := 1 TO LEN( IMP_ARQ )
AADD( ME_NU, " " + TRIM( IMP_ARQ[ CONTADOR ][ 1 ] ) )
NEXT
JANELA( 03, 08, 21, 72, "Seleçäo de impressora" )
botao:ADD( 19, 28, "Enter " )
botao:ADD( 19, 44, "Esc " )
botao:MOSTRA()
COR( "MENU" )
@ 05, 12 CLEAR TO 17, 68
KEYBOARD CHR( T_CIMA )
SELECAO_IMP := 1
SELECAO_IMP := ACHOICE( 06, 13, 16, 67, ME_NU )
IF SELECAO_IMP = 0
botao:MOVIMENTA( 19, 44, "Esc " )
RESTSCREEN( 00, 00, 24, 79, TELA_PRN )
LOOP
ENDIF
botao:MOVIMENTA( 19, 44, "Enter " )
CON_ARQ := IMP_ARQ[ SELECAO_IMP ][ 2 ]
LER_IMP( CON_ARQ )
ENDIF
RESTSCREEN( 00, 00, 24, 79, TELA_PRN )
LOOP
ENDIF
IF LASTKEY() = ASC( "F" ) .OR. LASTKEY() = ASC( "f" )
botao:MOVIMENTA( 17, 33, "Formulario " +;
IIF( TIPO_FORMULARIO = "1", "132", "080" ) )
TIPO_FORMULARIO := IIF( TIPO_FORMULARIO = "1", "0", "1" )
IF NUM_RELATORIO > 0
FOR_MULARIO[ NUM_RELATORIO ] := TIPO_FORMULARIO
ENDIF
LOOP
ENDIF
IF AT( UPPER( CHR( LASTKEY() ) ), "SCR" ) > 0
LOOP
ENDIF
IF OPC_PRN = 0
RETURN NIL
ELSEIF OPC_PRN = 1
TIPO_PRN := "I"
IF !ISPRINTER()
BEEP()
MENSAGEM( "Impressora desligada ou desconectada", 3 )
LOOP
ENDIF
ELSEIF OPC_PRN = 2
TIPO_PRN := "T"
EX_T := ( VAL( SUBS( TIME(), 4, 2 ) ) * 10 ) + VAL( SUBS( TIME(), 7, 2 ) )
ARQ_PRN += "." + STRZERO( EX_T, 3 )
SET PRINTER TO &ARQ_PRN
ELSEIF OPC_PRN = 3
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
MOUSE( LIGA )
JANELA( 07, 16, 17, 62, "Saidas" )
COR( "MENU" )
@ 10, 20 CLEAR TO 14, 58
@ 11, 23 SAY "Digite o nome do arquivo de saida"
ARQ_PRN := SPACE( 20 )
WHILE .T.
@ 13,29 GET ARQ_PRN PICT "@!" VALID ISALPHA( ARQ_PRN )
CURSOR( LIGA )
READ
CURSOR( DESLIGA )
IF LASTKEY() = T_ESC
RETURN NIL
ENDIF
IF AT(".",ARQ_PRN) != 0
BEEP()
MENSAGEM( "Digite o nome do arquivo sem extensäo", 3 )
LOOP
ENDIF
EXIT
ENDDO
ARQ_PRN := ALLTRIM( ARQ_PRN ) + ".PRN"
TIPO_PRN := "A"
SET PRINTER TO &ARQ_PRN
ENDIF
MENSAGEM( "Tecle para pausa ou interrupçäo" )
RETURN TIPO_PRN
ENDDO

FUNCTION IMP_TELA
PARA TAM_LIN
MARG_ESQ := 1
IF MARG_ESQ = NIL
MARG_ESQ := 0
ENDIF
ARQ_PRN := "REPORT"
MARG_ESQ++
MENSAGEM( "Aguarde processamento" )
SELE 100
PUBL QUAN_REG, ULT_POS
ARQ_PRN1 := ARQ_PRN + "." + STRZERO( EX_T, 3 )
ARQ_PRN2 := ARQ_PRN + "." + STRZERO( EX_T + 100, 3 )
DBCREATE( ARQ_PRN2, { { "LI_NHA", "C", TAM_LIN + 1, 0 } } )
IF !USEREDE(ARQ_PRN2,.T.,10)
BEEP()
MENSAGEM( "Nao foi possivel acesso, tente novamente", 5 )
RETURN .F.
ENDIF
APPEND FROM &ARQ_PRN1 SDF
QUAN_REG := LASTREC()
IF QUAN_REG = 0
QUAN_REG := 1
ENDIF
GOTO TOP
JANELA( LIN_MENU + 3, 02, 21, 77 )
@ LIN_MENU + 4, 77 SAY CHR( 30 )
@ 20, 77 SAY CHR( 31 )
IF TAM_LIN < 72
EDI_TAR := { "SUBS( LI_NHA, MARG_ESQ )" }
ELSE
IF INT( TAM_LIN / 36 ) = TAM_LIN / 36
NUM_COL := TAM_LIN / 36
ELSE
NUM_COL := INT( TAM_LIN / 36 ) + 1
ENDIF
X=1
EDI_TAR := {}
FOR CONTAR = 1 TO NUM_COL - 1
NUM_MAT := ( CONTAR * 36 ) - 34
AADD( EDI_TAR, "SUBS( LI_NHA, "+STR(NUM_MAT,3)+", 36 )" )
NEXT
NUM_MAT := ( CONTAR * 36 ) - 34
AADD( EDI_TAR, "SUBS( LI_NHA, " + STR( NUM_MAT, 3 ) + ") + SPACE(" + STR( ( NUM_COL * 36 ) - TAM_LIN, 2 ) + ")" )
ENDIF
KEYBOARD CHR( 65 )
ULT_POS := LIN_MENU + 5
MENSAGEM( "Tecle para sair" )
SOS_MENU := "RELATORIO"
SETCOLOR( CONTECOR[ 4 ] + "," + CONTECOR[ 7 ] )
DBEDIT( LIN_MENU + 4, 04, 20, 75, EDI_TAR, "FUN_IMP", "", "", "", "" )
SOS_MENU := " "
USE
FERASE( ARQ_PRN1 )
FERASE( ARQ_PRN2 )
RELEASE QUAN_REG, ULT_POS

FUNCTION FUN_IMP
IF LASTKEY() = T_ESC
RETURN 0
ELSEIF LASTKEY() = T_HOME
GOTO TOP
ELSEIF LASTKEY() = T_END
GOTO BOTT
ENDIF
COR( "BOX DA JANELA DE DIALOGO" )
@ ULT_POS, 77 SAY " "
ULT_POS := LIN_MENU + 5 + ( ( ( RECN() * 100 ) / QUAN_REG ) /;
( 100 / ( 19 - ( LIN_MENU + 5 ) ) ) )
IF RECN() = 1
ULT_POS := LIN_MENU + 5
ENDIF
@ ULT_POS, 77 SAY CHR( 4 )
SETCOLOR( CONTECOR[ 4 ] + "," + CONTECOR[ 7 ] )
RETURN 1

FUNCTION USEREDE( ARQ, EXUSE, TEMPO )
//
// -> Efetua tentativas para abrir o arquivo durante um determinado tempo en-
// viado atraves do parametro tempo ou indefinidamente, caso tempo=0. Se a
// tecla for precionada pela usuario, as tentaivas sao interrompidas.
//
PRIVATE SEMPRE
SEMPRE := ( TEMPO = 0 )
MENSAGEM( "Aguarde tentativa de acesso aos arquivos" )
WHILE ( SEMPRE .OR. TEMPO > 0 )
IF EXUSE
USE &ARQ EXCLUSIVE
//
// -> Uso exclusivo
ELSE
USE &ARQ
//
// -> Uso compartilhado
ENDIF
IF !NETERR()
RETURN .T.
ENDIF
IF INKEY( 1 ) = T_ESC
EXIT
ENDIF
TEMPO--
ENDDO
RETURN .F.

FUNCTION REGLOCK( TEMPO )
//
// -> Efetua tentativas para bloquear o registro durante um determinado tempo
// enviado atraves do parametro tempo ou indefinidamente caso, tyempo=0.
// Se a tecla for pressionada pelo usuario, as tentativas sao interrom-
// pidas.
//
PRIVATE SEMPRE
IF RLOCK()
RETURN .T.
ENDIF
MOUSE( DESLIGA )
SAVE SCREEN
MOUSE( LIGA )
MENSAGEM( "Aguarde tentativa de acesso ao arquivo" )
SEMPRE := ( TEMPO = 0 )
WHILE ( SEMPRE .OR. TEMPO > 0 )
IF RLOCK()
MOUSE( DESLIGA )
RESTORE SCREEN
MOUSE( LIGA )
RETURN .T.
ENDIF
IF INKEY( 0.5 ) = T_ESC
EXIT
ENDIF
TEMPO -= 0.5
ENDDO
MOUSE( DESLIGA )
RESTORE SCREEN
MOUSE( LIGA )
RETURN .F.

FUNCTION ADIREG( TEMPO )
//
// -> Efetua tentaivas para adicionar o registro durante um determinado tempo
// enviando atraves do paramentro tempo ou indefinidamente, caso tempo=0.
// Se a tecla for pressionada pelo usuario, as tentativas sao interrom-
// pidas.
//
PRIVATE SEMPRE
APPEND BLANK
IF !NETERR()
RETURN .T.
ENDIF
MOUSE( DESLIGA )
SAVE SCREEN
MOUSE( LIGA )
MENSAGEM( "Aguarde tentativa de acesso ao arquivo" )
SEMPRE := ( TEMPO = 0 )
WHILE ( SEMPRE .OR. TEMPO > 0 )
APPEND BLANK
IF !NETERR()
MOUSE( DESLIGA )
RESTORE SCREEN
MOUSE( LIGA )
RETURN .T.
ENDIF
IF INKEY( 0.5 ) = T_ESC
EXIT
ENDIF
TEMPO -= 0.5
ENDDO
MOUSE( DESLIGA )
RESTORE SCREEN
MOUSE( LIGA )
RETURN .F.
**
**BI [INI] FUN.B05
**BI [FIM] FUN.B05
**

/* Final do programa RECIBFU2.PRG */

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

10/03/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

Nova Configuração

De Template

* {margin:0;padding:0}
html, body {height:100%}
html {min-width:920px}
body {background:#90EE90;font-family:Arial, Helvetica, sans-serif;font-size:100%;line-height:1.8em;color:#FF0000;}

p {margin-bottom:10px; text-align: justify;}
a {color:#000000;text-decoration:none;}
a:hover{text-decoration:underline;}
h1 {}
h1 {font-size:30px;line-height:1.2em;color:#000000;font-weight:normal;font-weight:300;letter-spacing:-2px;margin-bottom:17px}
h3 {font-size:12px;color:#000000;margin-bottom:4px}
h3 a {text-decoration:none}
h3 a:hover {text-decoration:underline}
h4 {}
h5 {}
h6 {}

img {
border: none;
max-width: 650px;
width: expression(this.width > 650 ? 650: true);
}
.warning{color: #000000;}
.titulo {border:0;float:left;width:50%;margin:-202px 0 0 0;overflow:hidden;line-height:0;padding:0;font-size:0px}

ul, ol {list-style:none}
.fleft {float:left}
.fright {float:right}
.clear {clear:both}
.col-1, .col-2, .col-3 {float:left}
.alignright {text-align:right}
.aligncenter {text-align:center}


/* Site */
.container {width:920px;margin:0 auto;font-size:.875em}
.container2 {width:920px;margin:0 auto;font-size:.875em;background:url(https://img.comunidades.net/cas/casilva01/sidebar_extra_bg2.jpg) no-repeat 0 100%;}
.wrapper {width:100%;overflow:hidden;}


/* Header */
#header {height:430px;overflow:hidden;background:url(https://est.no.comunidades.net/estilos/premium/high-technologies/images/header-tail.gif) 0 0 repeat-x;min-width:920px}
#header .bg {background:url(https://img.comunidades.net/cas/casilva01/header_bg12022021.jpg) no-repeat 50% 0;height:430px}

#header .row-1 {height:91px;overflow:hidden}
#header .row-1 .fleft {padding:35px 0 10px 28px; font-size: 30px; color: #FFFFFF;}

#header .top-links {float:right;padding:41px 0 0 0}
#header .top-links li {float:left;background:url(https://est.no.comunidades.net/estilos/premium/high-technologies/images/divider.gif) no-repeat 0 0;padding:1px 28px 2px 28px}
#header .top-links li.first {background:none}
#header .top-links li.last {padding-right:10px}
#header .top-links li a {float:left;width:11px;height:10px;overflow:hidden;text-decoration:none}
#header .top-links li a.home {background:url(https://est.no.comunidades.net/estilos/premium/high-technologies/images/icon-home-sprite.gif) no-repeat 0 0}
#header .top-links li a.home:hover, #header .top-links li a.home-current {background:url(https://est.no.comunidades.net/estilos/premium/high-technologies/images/icon-home-sprite.gif) no-repeat 0 -10px}
#header .top-links li a.mail {background:url(https://est.no.comunidades.net/estilos/premium/high-technologies/images/icon-mail-sprite.gif) no-repeat 0 0}
#header .top-links li a.mail:hover, #header .top-links li a.mail-current {background:url(https://est.no.comunidades.net/estilos/premium/high-technologies/images/icon-mail-sprite.gif) no-repeat 0 -10px}
#header .top-links li a.sitemap {background:url(https://est.no.comunidades.net/estilos/premium/high-technologies/images/icon-sitemap-sprite.gif) no-repeat 0 0}
#header .top-links li a.sitemap:hover, #header .top-links li a.sitemap-current {background:url(https://est.no.comunidades.net/estilos/premium/high-technologies/images/icon-sitemap-sprite.gif) no-repeat 0 -10px}

#header .row-2 {height:84px;overflow:hidden}
#header .nav {padding:13px 0 0 15px}
#header .nav li {float:left;padding:0 15px}
#header .nav li a {float:left;font-size:16px;line-height:1.2em;color:#FFD700;text-decoration:none;}
#header .nav li a:hover, #header .nav li a.current {color:#FF00FF;text-decoration:none}

#header .row-3 {padding:1px 500px 0 30px;color:#000000}
#header .row-3 .fleft { font-size: 40px; color: #000000;}


/* Conteudo */
#content {background:url(https://img.comunidades.net/cas/casilva01/content_bgtitio.gif) 0 0 repeat-x}


/* Coluna da Esquerda */
#content .aside {float:left;width:170px; background-color:#000000; padding:20px;margin-bottom:285px;}

.sidebar_box {margin-bottom: 30px;padding: 20px 0 0 0px;}
.tmo_list { margin: 0; padding: 0; list-style: none; }
.tmo_list li { margin: 0 0 5px; padding: 0 0 5px 0; border-bottom: 1px dotted #000000; }
.tmo_list li a { color:#FFD700; text-decoration: none; }
.tmo_list li a:hover { color: #FF00FF; text-decoration: none; }


/* Coluna da Direita */
#content .mainContent {float:left;width:670px}
#content .mainContent .indent {padding:5px 0 5px 5px;}
#content .section {padding-bottom:10px}


/* Footer */
#footer {height:125px;background:url(https://est.no.comunidades.net/estilos/premium/high-technologies/images/footer-tail.gif) 0 0 repeat-x}
#footer .bg {height:125px;background:url(https://est.no.comunidades.net/estilos/premium/high-technologies/images/footer-bg.jpg) no-repeat 50% 0}
#footer {color:#000000;text-align:center}
#footer .indent {padding:40px 0 0 280px;line-height:30px}
#footer a {color:#000000}

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

09/03/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

A Primeira Parte

Do PRG De Funções

/*
TITULO : Emissao de recibos
DATA : 24/02/21
PROGRAMA : RECIBFU1.PRG
COMENTARIO : FUNCOES - PARTE 1
*/

#include "RECIB.CH"
#include "RECIBMOU.CH"
**
**BI [INI] FUN.B01
**BI [FIM] FUN.B01
**

FUNCTION AJUSTE
LOCAL MAXIMO, REDUCAO, MARGEM, CONTAR, CONTADOR, NUM_FORMULARIO
PARA LARGURA, FORMULARIO
IF VALTYPE( LARGURA ) = "C"
FORMULARIO := LARGURA
LARGURA := 150
ENDIF
REDUCAO := ""
MAXIMO := 0
IF FORMULARIO = "80"
NUM_FORMULARIO := 1
ELSE
NUM_FORMULARIO := 2
ENDIF
FOR CONTAR := 1 TO LEN( IMPRESSORA )
IF LARGURA <= IMPRESSORA[ CONTAR ][ 1 ][ NUM_FORMULARIO ]
MAXIMO := IMPRESSORA[ CONTAR ][ 1 ][ NUM_FORMULARIO ]
FOR CONTADOR := 1 TO LEN( IMPRESSORA[ CONTAR ][ 2 ] )
REDUCAO += CHR( IMPRESSORA[ CONTAR ][ 2 ][ CONTADOR ] )
NEXT
EXIT
ENDIF
NEXT
IF FORMULARIO = "ETIQUETA"
FOR CONTADOR := 1 TO LEN( IMPRESSORA[ REDUCAO_ETQ ][ 2 ] )
REDUCAO += CHR( IMPRESSORA[ REDUCAO_ETQ ][ 2 ][ CONTADOR ] )
NEXT
?? REDUCAO
SET MARG TO 0
ELSE
IF MAXIMO = 0
@ 00, 01 SAY "SEM AJUSTE"
RETURN .F.
ENDIF
MARGEM := INT( ( MAXIMO - LARGURA ) / 2 ) + relatorio:COL_INICIAL - 1
SET MARG TO MARGEM
@ PROW(), PCOL() + 1 SAY REDUCAO
ENDIF
RETURN .T.

FUNCTION GETREADER( GET )
//
// -> Funcao de leitura de um GET (modo padrao)
LOCAL TECLA, BO_TAO, COL, LIN
//
// -> Leitura do GET se WHEN for satisfeito
IF ( GETPREVALIDADE( GET ) )
//
// -> Ativa o GET para leitura
GET:SETFOCUS()
WHILE ( GET:EXITSTATE == GE_NOEXIT )
//
// -> Checagem para tipo de saida inicial (posicoes nao editaveis)
IF ( GET:TYPEOUT )
GET:EXITSTATE := GE_ENTER
ENDIF
//
// -> Aguarda acionamento de teclas (mouse ou teclado) e executa uma acao
WHILE ( GET:EXITSTATE == GE_NOEXIT )
WHILE( TECLA := INKEY() ) == 0
MOUSE( @BO_TAO, @LIN, @COL )
IF BO_TAO = M_ESQUERDO .OR. BO_TAO = M_OS_DOIS
DADO_CUR := SUBS( SAVESCREEN( LIN, COL, LIN, COL ), 1, 1 )
IF DADO_CUR = CHR( 254 ) .OR. BO_TAO = M_OS_DOIS
KEYBOARD CHR( T_ESC )
TECLA := INKEY( 0 )
ELSEIF LIN = 24 .AND. ( COL >= 71 .AND. COL <= 78 )
TECLA := T_F1
ELSE
BEEP_MOUSE()
LOOP
ENDIF
EXIT
ELSEIF BO_TAO = M_DIREITO
KEYBOARD CHR( T_ENTER )
TECLA := INKEY( 0 )
EXIT
ENDIF
ENDDO
MOUSE( DESLIGA )
GETAPPLYKEY( GET, TECLA )
MOUSE( LIGA )
ENDDO
//
// -> Desabilita saida se a condicao VALID nao for satisfeita
IF ( !GETPOSTVALIDADE( GET ) )
GET:EXITSTATE := GE_NOEXIT
ENDIF
ENDDO
//
// ->Desativa o GET
GET:KILLFOCUS()
ENDIF
RETURN NIL

FUNCTION MOUSE( BOTAO, LIN, COL )
//
// MOUSE() -> Inicializa mouse
// MOUSE( LIGA ) -> Liga cursor
// MOUSE( DESLIGA ) -> Desativa cursor
// MOUSE( @BOTAO, @LINHA, @COLUNA ) ->;
// -> Le o status do mouse retornando as variaveis passadas
// como parametros, os respectivos resultados.
// MOUSE( LINHA, COLUNA ) -> Move o cursor do mouse para posicao indicada
//
LOCAL REGISTRADORES := {}, NUM_PAR := PCOUNT()
IF NUM_PAR = 0
REGISTRADORES := { M_INICIALIZA, 0, 0, 0, 0, 0, 0 }
ELSEIF NUM_PAR = 1
IF BOTAO = LIGA
REGISTRADORES := { M_CURSOR_ON, 0, 0, 0, 0, 0, 0 }
ELSE
REGISTRADORES := { M_CURSOR_OFF, 0, 0, 0, 0, 0, 0 }
ENDIF
ELSEIF NUM_PAR = 2
REGISTRADORES := { M_POS_CURSOR, 0, LIN * 8, BOTAO * 8, 0, 0, 0 }
ELSEIF NUM_PAR = 3
REGISTRADORES := { M_LER_STATUS, 0, 0, 0, 0, 0, 0 }
ELSE
RETURN NIL
ENDIF
cint86( M_INTERRUPCAO, REGISTRADORES, REGISTRADORES )
IF NUM_PAR = 0
RETURN REGISTRADORES[ AX ] = -1
ELSEIF NUM_PAR = 3
//
// -> ESQUERDO = 1, DIREITO = 2, OS DOIS = 3
BOTAO := REGISTRADORES[ BX ]
LIN := INT( REGISTRADORES[ DX ] / 8 )
COL := INT( REGISTRADORES[ CX ] / 8 )
IF BOTAO != 0
//
// -> Tempo para o mouse nao ser clicado 2 vezes na mesma pressionada
INKEY( 0.2 )
ENDIF
ENDIF
RETURN NIL

//
// -> Aguarda uma tecla ou click do mouse
FUNCTION TEC_MOU( SEGUNDOS )
LOCAL TECLA := 0, BO_TAO := 0, LIN := 0, COL := 0, DADO_CUR,;
SEG_INI := SECONDS()
IF SEGUNDOS = NIL; SEGUNDOS := 0; ENDIF
WHILE( TECLA := INKEY() ) == 0
IF SEGUNDOS != 0
IF SECONDS() - SEG_INI >= SEGUNDOS; EXIT; ENDIF
ENDIF
IF TECLA = 0
MOUSE( @BO_TAO, @LIN, @COL )
ENDIF
IF BO_TAO != 0
IF BO_TAO = M_DIREITO; TECLA := T_ENTER; ENDIF
IF BO_TAO = M_OS_DOIS; TECLA := T_ESC; ENDIF
EXIT
ENDIF
ENDDO
RETURN TECLA

FUNCTION INDICES
LOCAL CONTAR, OPCAO_INDEX := PCOUNT(), TODOS, NUM_INDICE,;
MARCADOR
IF OPCAO_INDEX = 0
DECLARE ARQ_NTX[ ADIR( "*.NTX" ) ]
ADIR( "*.NTX", ARQ_NTX )
ELSEIF OPCAO_INDEX = 1
COR( "MENU" )
@ LIN_MENU, 00
@ LIN_MENU, 01 SAY "Utilitários │ Organizaçäo de arquivos"
MENU_IND := { " RECIB -> Unico Arquivo DBF [ ] " }
JANELA( 04, 12, 20, 67, "Organizaçäo de arquivos" )
COR( "MENU" )
@ 07, 17 CLEAR TO 15, 62
NUM_INDICE := 1
POS_JANELA := 1
TODOS := .T.
WHILE NUM_INDICE != 0
botao:ADD( 17, 27, "Todos [" + IIF( TODOS, "x", " " ) + "]" )
botao:ADD( 17, 43, "Organiza " )
botao:MOSTRA()
KEYBOARD CHR( 32 )
COR( "MENU" )
NUM_INDICE := ACHOICE( 08, 18, 14, 61, MENU_IND, .T., "IND_ACHO",;
NUM_INDICE, POS_JANELA )
IF LASTKEY() = ASC( "T" ) .OR. LASTKEY() = ASC( "t" )
botao:MOVIMENTA( 17, 27, "Todos [" + IIF( TODOS, "x", " " ) + "]" )
FOR CONTAR := 1 TO LEN( MENU_IND )
MENU_IND[ CONTAR ] := SUBS( MENU_IND[ CONTAR ], 1, 41 ) +;
IIF( TODOS, "x", " " ) + "] "
NEXT
TODOS = IIF( TODOS, .F. ,.T. )
NUM_INDICE := 1
POS_JANELA := 1
ELSEIF LASTKEY() = ASC( "O" ) .OR. LASTKEY() = ASC( "o" )
botao:MOVIMENTA( 17, 43, "Organiza " )
EXIT
ELSEIF NUM_INDICE != 0
MARCADOR := IIF( SUBS( MENU_IND[ NUM_INDICE ], 42, 1 ) = " ", "x",;
" " )
MENU_IND[ NUM_INDICE ] := SUBS( MENU_IND[ NUM_INDICE ], 1, 41 ) +;
MARCADOR + "] "
IF NUM_INDICE < LEN( MENU_IND )
NUM_INDICE++
IF POS_JANELA < 7
POS_JANELA++
ENDIF
ENDIF
ENDIF
ENDDO
FUNDO()
IF NUM_INDICE = 0
RETURN NIL
ENDIF
ARQS_DBF := {}
AEVAL( MENU_IND, { | MATRIZ | IIF( SUBS( MATRIZ, 42, 1 ) <> " ",;
AADD( ARQS_DBF, TRIM( SUBS( MATRIZ, 2, 8 ) ) ), NIL ) } )
IF LEN( ARQS_DBF ) = 0
BEEP()
MENSAGEM( "Näo há arquivos marcados para organizaçäo", 4 )
RETURN NIL
ENDIF
ENDIF
IF OPCAO_INDEX <> 0
MENSAGEM( "Aguarde organizaçäo dos arquivos" )
ENDIF
AEVAL( IN_DICES, { | MATRIZ | IN_DICE( MATRIZ[ 1 ], MATRIZ[ 2 ], MATRIZ[ 3 ],;
OPCAO_INDEX ) } )
RETURN NIL

FUNCTION IN_DICE( AQ_IND, AQ_DBF, AQ_EXP, OPCAO_INDEX )
LOCAL OK_IND := .F.
IF OPCAO_INDEX = 0
IF ASCAN( ARQ_NTX, AQ_IND ) = 0; OK_IND := .T.; ENDIF
ELSEIF OPCAO_INDEX = 1
IF ASCAN( ARQS_DBF, AQ_DBF ) <> 0; OK_IND := .T.; ENDIF
ELSEIF OPCAO_INDEX = 2
OK_IND := .T.
ENDIF
IF OK_IND
IF !USEREDE( AQ_DBF, .T., 10 )
BEEP()
MENSAGEM( "Näo foi possível acesso ao arquivo", 5 )
SETCOLOR( "W" )
SET CURSOR OFF
CLEAR
QUIT
ENDIF
MENSAGEM( "Organizando o arquivo " + AQ_IND )
INDEX ON &AQ_EXP TO &AQ_IND
USE
ENDIF
RETURN NIL

FUNCTION IND_ACHO
PARA P_MODO, P_ELE, P_JAN
POS_JANELA := P_JAN
IF LASTKEY() = 13
RETURN 1
ELSEIF LASTKEY() = 27
RETURN 0
ELSEIF LASTKEY() = ASC( "T" ) .OR. LASTKEY() = ASC( "t" ) .OR.;
LASTKEY() = ASC( "O" ) .OR. LASTKEY() = ASC( "o" )
RETURN 1
ENDIF
RETURN 2

FUNCTION CALEN
//
// -> Funçäo que ativa o calendário
STATIC MES, ANO, DATA
LOCAL ULT_CURSOR := SETCURSOR(), C_CALEN, L_CALEN, LINHA := ROW(),;
COLUNA := COL(), ULT_COR := SETCOLOR(), LIN, COL, NOVO_ANO,;
TELA, ES_COLHA := 1, ULT_DIA_MES, CONTAR, GETLIST := {}
IF MES = NIL
MES := MONTH( M->DAT_HOJE )
ANO := YEAR( M->DAT_HOJE )
DATA := CTOD( "01/" + STR( MES, 2 ) + "/" + STR( ANO, 4 ) )
ENDIF
MOUSE( LIGA )
CURSOR( DESLIGA )
SET CENTURY ON
SOMBRA( L_CALEN := L_SOM, C_CALEN := C_SOM, .T. )
MOUSE( DESLIGA )
TELA := SAVESCREEN( 04, 11, 21, 66 )
MOUSE( LIGA )
JANELA( 04, 13, 20, 66, "Calendário" )
M->SOS_MENU := "CALENDARIO"
WHILE .T.
COR( "JANELA DE DIALOGO" )
@ 06, 16 SAY "Dom Seg Ter Qua Qui Sex Sab"
SETCOLOR( SUBS( CONTECOR[ 6 ], 4, 2 ) + "/" + SUBS( CONTECOR[ 4 ], 4, 2 ) )
FOR CONTAR = 8 TO 18 STEP 2
@ CONTAR + 0, 16 SAY "████ ████ ████ ████ ████ ████ ████"
@ CONTAR + 1, 16 SAY "▀▀▀▀ ▀▀▀▀ ▀▀▀▀ ▀▀▀▀ ▀▀▀▀ ▀▀▀▀ ▀▀▀▀"
NEXT
IF AT( SUBS( STR( MES + 100, 3 ), 2 ), "01 03 05 07 08 10 12" ) != 0
ULT_DIA_MES := 31
ELSE
ULT_DIA_MES := IIF( MES != 2, 30, IIF( MOD( ANO, 4 ) = 0, 29, 28 ) )
ENDIF
COL := DOW( DATA )
LIN := 8
COR( "BOTOES" )
FOR CONTAR = 1 TO ULT_DIA_MES
IF COL = 1
COR( "BOTAO EM DESTAQUE" )
@ LIN, ( COL * 5 ) + 13 SAY STR( CONTAR, 2 )
COR( "BOTOES" )
ELSE
@ LIN, ( COL * 5 ) + 13 SAY STR( CONTAR, 2 )
ENDIF
COL++
IF COL > 7
COL := 1
LIN += 2
ENDIF
NEXT
COR( "BOTOES" )
@ 06, 53 CLEAR TO 07, 63
@ 06, 57 SAY SUBS( "JanFevMarAbrMaiJunJulAgoSetOutNovDez", MONTH( DATA ) * 3 - 2, 3 )
@ 07, 56 SAY TRAN( YEAR( DATA ), "@E 9,999" )
botao:ADD( 10, 53, "(+) Mês " )
botao:ADD( 12, 53, "(-) Mês " )
botao:ADD( 14, 53, "(+) Ano " )
botao:ADD( 16, 53, "(-) Ano " )
botao:ADD( 18, 53, "Ano " )
ES_COLHA := botao:RODA( ES_COLHA )
IF ES_COLHA = 0
EXIT
ELSEIF ES_COLHA = 5
@ 07, 54 SAY CHR( 26 ) COLOR CONTECOR[ 2 ]
NOVO_ANO := ANO
@ 07, 56 GET NOVO_ANO PICT "@E 9,999"
CURSOR( LIGA )
READ
CURSOR( DESLIGA )
IF LASTKEY() != T_ESC
ANO := NOVO_ANO
ENDIF
ENDIF
ANO += IIF( ES_COLHA = 4, -1, IIF( ES_COLHA = 3, 1, 0 ) )
ANO := IIF( ANO < 100, 100, IIF( ANO > 2999, 2999, ANO ) )
MES += IIF( ES_COLHA = 2, -1, IIF( ES_COLHA = 1, 1, 0 ) )
MES := IIF( MES < 1, 12, IIF( MES > 12, 1, MES ) )
DATA := CTOD( "01/" + STR( MES, 2 ) + "/" + STR( ANO, 4 ) )
ENDDO
M->SOS_MENU := ""
MOUSE( DESLIGA )
RESTSCREEN( 04, 11, 21, 66, TELA )
MOUSE( LIGA )
SOMBRA( L_CALEN, C_CALEN )
SETCOLOR( ULT_COR )
SETCURSOR( ULT_CURSOR )
SET CENTURY OFF
SETPOS( LINHA, COLUNA )

FUNCTION MENSAGEM( TEXTO, PAUSA )
//
// -> Funcao que imprime mensagens na tela
//
// TEXTO => Recebe o texto a ser impresso na linha de mensagem.
// TEMPO => Recebe o tempo de espera para a mensagem.
//
STATIC ULT_MENSAGEM := ""
LOCAL ULT_CURSOR := SETCURSOR()
IF TEXTO = NIL; TEXTO := ""; ENDIF
CURSOR( DESLIGA )
@ MAXROW(), 11 SAY PADC( TEXTO, 58 ) COLOR CONTECOR[ 2 ]
IF PAUSA = NIL
ULT_MENSAGEM := TEXTO
ELSE
TEC_MOU( PAUSA )
@ MAXROW(), 11 SAY PADC( ULT_MENSAGEM, 58 ) COLOR CONTECOR[ 2 ]
ENDIF
SETCURSOR( ULT_CURSOR )
RETURN NIL

FUNCTION DELE_TAR
RETURN IIF( DELETED(), "*", " " )

FUNCTION PERGUNTA( TEX_TO, RES_POSTA )
//
// -> Funcao que executa uma pergunta
IF RES_POSTA = NIL; RES_POSTA="S"; ENDIF
PER_COR := SETCOLOR()
CURSOR( DESLIGA )
MOUSE( DESLIGA )
SAVE SCREEN TO PER_TELA
MOUSE( LIGA )
M->SIM_NAO := IIF( RES_POSTA ="N", 2, 1 )
M->LAR_G := LEN( TEX_TO )
IF M->LAR_G < 37
M->LAR_G := 51
ELSE
M->LAR_G += 14
ENDIF
COL_SUP := INT( ( 80 - M->LAR_G ) / 2 )
COL_INF := COL_SUP + LAR_G - 1
JANELA( 08, COL_SUP, 16, COL_INF )
COR( "JANELA DE DIALOGO" )
@ 11, ( 80 - LEN( TEX_TO ) ) / 2 SAY TEX_TO
botao:ADD( 13, 25, "Sim " )
botao:ADD( 13, 42, "Näo " )
SIM_NAO := botao:RODA()
MOUSE( DESLIGA )
RESTORE SCREEN FROM PER_TELA
MOUSE( LIGA )
SETCOLOR( PER_COR )
RETURN IIF( M->SIM_NAO = 1, "S", "N" )

FUNCTION BOTAO( LINHA_SUPERIOR, COLUNA_ESQUERDA, NOME_BOTAO )
LOCAL BOTAO_MOUSE, COLUNA_MOUSE, LINHA_MOUSE, LEITURA_MOUSE,;
TIPO_OPERACAO, LARGURA_BOTAO, CONTAR, TECLA, PONTEIRO := 1
IF PCOUNT() = 0
TIPO_OPERACAO := EDITA_BOTOES
ELSEIF PCOUNT() = 1
TIPO_OPERACAO := EDITA_BOTOES
PONTEIRO := LINHA_SUPERIOR
ELSEIF PCOUNT() = 2
TIPO_OPERACAO := MOSTRA_BOTOES
ELSEIF PCOUNT() = 3
TIPO_OPERACAO := MOVIMENTA_BOTAO
ENDIF
IF TIPO_OPERACAO = MOVIMENTA_BOTAO
LARGURA_BOTAO := LEN( NOME_BOTAO ) + 2
COR( "JANELA DE DIALOGO" )
@ LINHA_SUPERIOR, COLUNA_ESQUERDA SAY " "
@ LINHA_SUPERIOR + 1, COLUNA_ESQUERDA - 1 SAY SPACE( LARGURA_BOTAO )
@ LINHA_SUPERIOR, COLUNA_ESQUERDA + LARGURA_BOTAO - 1 SAY " "
COR( "BOTAO EM DESTAQUE" )
@ LINHA_SUPERIOR, COLUNA_ESQUERDA - 1 SAY " " + NOME_BOTAO + " "
INKEY( .2 )
COR( "BOTOES" )
@ LINHA_SUPERIOR, COLUNA_ESQUERDA SAY " " + NOME_BOTAO + " "
SETCOLOR( "N/" + ALLTRIM( SUBS( CONTECOR[ 4 ], 4 ) ) )
@ LINHA_SUPERIOR, COLUNA_ESQUERDA - 1 SAY "▄"
@ LINHA_SUPERIOR + 1, COLUNA_ESQUERDA - 1 SAY REPL( "▀", LARGURA_BOTAO ) + " "
INKEY( .2 )
ENDIF
IF TIPO_OPERACAO = EDITA_BOTOES .OR. TIPO_OPERACAO = MOSTRA_BOTOES
FOR CONTAR := 1 TO LEN( ObjBotao )
LARGURA_BOTAO := LEN( ObjBotao[ CONTAR ][ 3 ] ) + 2
COR( "BOTOES" )
@ ObjBotao[ CONTAR ][ 1 ], ObjBotao[ CONTAR ][ 2 ] SAY " " + ;
ObjBotao[ CONTAR ][ 3 ] + " "
SETCOLOR( "N/" + ALLTRIM( SUBS( CONTECOR[ 4 ], 4 ) ) )
@ ObjBotao[ CONTAR ][ 1 ], ObjBotao[ CONTAR ][ 2 ] - 1 SAY "▄"
@ ObjBotao[ CONTAR ][ 1 ] + 1, ObjBotao[ CONTAR ][ 2 ] - 1 SAY;
REPL( "▀", LARGURA_BOTAO ) + " "
NEXT
ENDIF
IF TIPO_OPERACAO = EDITA_BOTOES
TECLA := 0
WHILE .T.
LARGURA_BOTAO := LEN( ObjBotao[ PONTEIRO ][ 3 ] ) + 2
COR( "BOTAO EM DESTAQUE" )
@ ObjBotao[ PONTEIRO ][ 1 ], ObjBotao[ PONTEIRO ][ 2 ] SAY;
" " + ObjBotao[ PONTEIRO ][ 3 ] + " "
SETCOLOR( "N/" + ALLTRIM( SUBS( CONTECOR[ 4 ], 4 ) ) )
@ ObjBotao[ PONTEIRO ][ 1 ], ObjBotao[ PONTEIRO ][ 2 ] - 1 SAY "▄"
@ ObjBotao[ PONTEIRO ][ 1 ] + 1, ObjBotao[ PONTEIRO ][ 2 ] - 1 SAY;
REPL( "▀", LARGURA_BOTAO ) + " "
IF TECLA = T_ENTER
INKEY( .2 )
botao:LIMPA()
RETURN PONTEIRO
ENDIF
TECLA := 0
WHILE TECLA = 0
TECLA := INKEY()
MOUSE( @BOTAO_MOUSE, @LINHA_MOUSE, @COLUNA_MOUSE )
IF BOTAO_MOUSE = M_ESQUERDO
LEITURA_MOUSE := SUBS( SAVESCREEN( LINHA_MOUSE, COLUNA_MOUSE, LINHA_MOUSE, COLUNA_MOUSE ), 1, 1 )
IF LEITURA_MOUSE = CHR( 254 )
TECLA := T_ESC
EXIT
ELSEIF LINHA_MOUSE = 24 .AND. ( COLUNA_MOUSE >= 71 .AND. COLUNA_MOUSE <= 78 )
TECLA := T_F1
EXIT
ENDIF
FOR CONTAR = 1 TO LEN( ObjBotao )
IF ObjBotao[ CONTAR ][ 1 ] = LINHA_MOUSE .AND.;
( COLUNA_MOUSE >= ObjBotao[ CONTAR ][ 2 ] .AND.;
COLUNA_MOUSE <= ObjBotao[ CONTAR ][ 2 ] +;
LEN( ObjBotao[ CONTAR ][ 3 ] ) + 1 )
TECLA := T_ENTER; PONTEIRO := CONTAR
ENDIF
NEXT
IF TECLA != T_ENTER
BEEP_MOUSE()
ENDIF
ELSEIF BOTAO_MOUSE = M_OS_DOIS
TECLA := T_ESC
ELSEIF BOTAO_MOUSE = M_DIREITO
TECLA := T_ENTER
ENDIF
ENDDO
IF TECLA = T_ESC
botao:LIMPA()
RETURN 0
ENDIF
IF TECLA = T_F1
HELP( "CALENDARIO", 1, "" )
ENDIF
COR( "BOTOES" )
@ ObjBotao[ PONTEIRO ][ 1 ], ObjBotao[ PONTEIRO ][ 2 ] + 1 SAY;
ObjBotao[ PONTEIRO ][ 3 ]
FOR CONTAR = 1 TO LEN( ObjBotao )
IF SUBS( ObjBotao[ CONTAR ][ 3 ], 1, 1 ) = UPPER( CHR( TECLA ) )
PONTEIRO := CONTAR
TECLA := T_ENTER
EXIT
ENDIF
NEXT
IF TECLA = T_ENTER
LARGURA_BOTAO := LEN( ObjBotao[ PONTEIRO ][ 3 ] ) + 2
COR( "JANELA DE DIALOGO" )
@ ObjBotao[ PONTEIRO ][ 1 ], ObjBotao[ PONTEIRO ][ 2 ] SAY " "
@ ObjBotao[ PONTEIRO ][ 1 ] + 1, ObjBotao[ PONTEIRO ][ 2 ] - 1 SAY;
SPACE( LARGURA_BOTAO )
@ ObjBotao[ PONTEIRO ][ 1 ], ObjBotao[ PONTEIRO ][ 2 ] +;
LARGURA_BOTAO - 1 SAY " "
COR( "BOTAO EM DESTAQUE" )
@ ObjBotao[ PONTEIRO ][ 1 ], ObjBotao[ PONTEIRO ][ 2 ] - 1 SAY ;
" " + ObjBotao[ PONTEIRO ][ 3 ] + " "
INKEY( .2 )
LOOP
ENDIF
IF TECLA = T_ESQUERDA .OR. TECLA = T_CIMA
PONTEIRO--
ELSEIF TECLA = T_DIREITA .OR. TECLA = T_BAIXO
PONTEIRO++
ENDIF
PONTEIRO := IIF( PONTEIRO < 1, LEN( ObjBotao ),;
IIF( PONTEIRO > LEN( ObjBotao ), 1, PONTEIRO ) )
ENDDO
ENDIF
botao:LIMPA()
RETURN NIL
**
**BI [INI] FUN.B03
**BI [FIM] FUN.B03
**

/* Final do programa RECIBFU1.PRG */

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

08/03/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

Um Pouco Mais

De Relatório

/*
TITULO : Emissao de recibos
DATA : 24/02/21
PROGRAMA : RECIBR02.PRG
COMENTARIO : RELATORIO (Recibos)
*/

#include "RECIB.CH"
#include "RECIBMOU.CH"
**
**BI [INI] R02.B01
**BI [FIM] R02.B01
**
***
*** Inicio do bloco de substituiçäo R022.B
MENSAGEM( "Aguarde abertura de arquivos" )
SELE 1
IF !USEREDE( "RECIB", .F., 10 )
BEEP()
MENSAGEM( "O arquivo RECIB näo está disponível", 3 )
RETURN
ELSE
SET INDEX TO RECIB001,RECIB002
ENDIF
*** Final do bloco de substituiçäo R022.B
***
MENSAGEM( "Tecle para retornar" )
COR( "MENU" )
@ LIN_MENU, 00
@ LIN_MENU, 01 SAY "Relatório │ Recibos"
SELE RECIB
SET ORDER TO 2
**
**BI [INI] R02.B02
**BI [FIM] R02.B02
**
GOTO TOP
***
*** Inicio do bloco de substituiçäo R023.B
//
// -> Inicializa variaveis para filtragem
M->FILTRO_1 := SPACE( 58 )
JANELA( 08, -1, 16, 82 )
COR( "MENU" )
@ 11, 03 CLEAR TO 13, 78
**
**BI [INI] R02.B03
**BI [FIM] R02.B03
**
WHILE .T.
**
**BI [INI] R02.B04
**BI [FIM] R02.B04
**
@ 12, 06 SAY "Quem Pagou:" GET M->FILTRO_1
CURSOR( LIGA )
READ
CURSOR( DESLIGA )
IF LASTKEY() = T_ESC
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
MOUSE( LIGA )
EXIT
ENDIF
SEEK M->FILTRO_1
IF EOF()
BEEP(); MENSAGEM( "Registro näo encontrado", 3 )
LOOP
ENDIF
EXIT
ENDDO
IF LASTKEY() = T_ESC
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
MOUSE( LIGA )
RETURN
ENDIF
*** Final do bloco de substituiçäo R023.B
***
**
**BI [INI] R02.B05
**BI [FIM] R02.B05
**
NUM_RELATORIO := 1
//
// -> Tipo do relatorio
relatorio:TIPO := FICHA
//
// -> Define cabecalhos do relatorio
relatorio:ADDTITULO( "Emissao de recibos" )
relatorio:ADDTITULO( "titio.info" )
//
// -> Define reducao de caracter
//
// -> Define margem do papel
relatorio:LIN_SUPERIOR := 1
relatorio:LIN_INFERIOR := 61
relatorio:COL_INICIAL := 0
//
// -> Define codigo de bloco com a expressao de filtro
relatorio:FILTRO( RECIB->RECEBI = M->FILTRO_1 )
//
// -> Define os campos ou expressoes a serem impressos
relatorio:ADD( "Numero:", RECIB->NUMERO, 1, 1, "@!" )
relatorio:ADD( "", RECIB->RECIBO, 1, 37, "@!" )
relatorio:ADD( "Valor:", RECIB->VALOR, 1, 62, "@Z 99999.99" )
relatorio:ADD( "Recebi (emos) de:", RECIB->RECEBI, 3, 1, "@!" )
relatorio:ADD( "Endereco:", RECIB->ENDERECO, 4, 1, "@!" )
relatorio:ADD( "A importancia de:", RECIB->IMPORT1, 5, 1, "@!" )
relatorio:ADD( "", RECIB->IMPORT2, 6, 1, "@!" )
relatorio:ADD( "Referente:", RECIB->REFERENTE, 7, 1, "@!" )
relatorio:ADD( "", RECIB->REFERENT2, 8, 1, "@!" )
relatorio:ADD( "", RECIB->MAIORCLARE, 9, 1 )
relatorio:ADD( "", RECIB->CIDESTDAT, 10, 1, "@!" )
relatorio:ADD( "Emitente:", RECIB->EMITENTE, 11, 1, "@!" )
relatorio:ADD( "CPF/RG:", RECIB->CPFRG, 12, 1, "@!" )
relatorio:ADD( "Endereco:", RECIB->ENDERECO2, 13, 1, "@!" )
relatorio:ADD( "", RECIB->ASSINATURA, 14, 1, "@!" )
//
// -> Executa impressao do objeto relatorio
**
**BI [INI] R02.B07
**BI [FIM] R02.B07
**
relatorio:RODA()
**
**BI [INI] R02.B08
**BI [FIM] R02.B08
**
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
MOUSE( LIGA )
**
**BI [INI] R02.B09
**BI [FIM] R02.B09
**

/* Final do programa RECIBR02.PRG */

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

06/03/2021

Role Para Cima

O Texto Que Está

Em Azul!!! 

Menu De
Cadastros
/*
TITULO : Emissao de recibos
DATA : 24/02/21
PROGRAMA : RECIBINC.PRG
COMENTARIO : MENU DE CADASTROS
*/

#include "RECIB.CH"
#include "RECIBMOU.CH"
**
**BI [INI] INC.B01
**BI [FIM] INC.B01
**
MENSAGEM( "Tecle para sair" )
menu:ADD( "> Emitindo...", SUBINC01() )
menu:RODA()
CLOSE DATABASES
**
**BI [INI] INC.B02
**BI [FIM] INC.B02
**

FUNCTION SUBINC01
menu:TIPO_MENU := SUB_MENU
menu:ADD( " Recibos", RECIBI02() )
menu:RODA()
RETURN NIL

/* Final do programa RECIBINC.PRG */

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

05/03/2021

A Documentação

Do Sistema

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

04/03/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

Mais Um PRG

Do Sistema Recib

/*
TITULO : Emissao de recibos
DATA : 24/02/21
PROGRAMA : RECIBI02.PRG
COMENTARIO : CADASTRO (Recibos)
*/

#include "RECIB.CH"
#include "RECIBMOU.CH"
**
**BI [INI] I02.B01
**BI [FIM] I02.B01
**
MENSAGEM( "Aguarde abertura de arquivos" )
SELE 1
IF !USEREDE( "RECIB", .F., 10 )
BEEP()
MENSAGEM( "O arquivo RECIB näo está disponível", 3 )
RETURN
ELSE
SET INDEX TO RECIB001, RECIB002
ENDIF
SELE RECIB
**
**BI [INI] I02.B02
**BI [FIM] I02.B02
**
***
*** Inicio do bloco de substituiçäo I02.B
COR( "MENU" )
@ LIN_MENU, 00
@ LIN_MENU, 01 SAY "Cadastro │ Recibos"
M->DU_PLICIDADE := .F.; M->MOSTRA_RESULTADO := .F.
PRIVATE NUMERO, RECIBO, VALOR, RECEBI, ENDERECO, IMPORT1, IMPORT2, REFERENTE,;
REFERENT2, MAIORCLARE, CIDESTDAT, EMITENTE, CPFRG, ENDERECO2, ASSINATURA
WHILE .T.
**
**BI [INI] I02.B03
**BI [FIM] I02.B03
**
MENSAGEM( "Tecle para retornar" )
IF !( M->DU_PLICIDADE )
**
**BI [INI] I02.B04
**BI [FIM] I02.B04
**
//
// -> Inicializa variaveis
CARREG02( INCLUSAO )
ELSE
M->MOSTRA_RESULTADO := .T.
**
**BI [INI] I02.B05
**BI [FIM] I02.B05
**
ENDIF
//
// -> Carrega tela de cadastro
IF CARGET02( INCLUSAO )=.F.
EXIT
ENDIF
**
**BI [INI] I02.B10
**BI [FIM] I02.B10
**
IF PERG( "Confirma as informaçöes ?" ) = "N"
//
// -> Faz reedicao
M->DU_PLICIDADE := .T.
**
**BI [INI] I02.B11
**BI [FIM] I02.B11
**
LOOP
ENDIF
M->DU_PLICIDADE := .F.
M->MOSTRA_RESULTADO := .F.
**
**BI [INI] I02.B12
**BI [FIM] I02.B12
**
IF !ADIREG( 0 )
M->DU_PLICIDADE := .T.
MENSAGEM( "Inclusäo näo foi bem sucedida", 3 )
LOOP
ENDIF
//
// -> Atualiza o banco de dados
SALVAR02()
COMMIT
UNLOCK
ENDDO
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
MOUSE( LIGA )
**
**BI [INI] I02.B13
**BI [FIM] I02.B13
**
*** Final do bloco de substituiçäo I02.B
***

FUNCTION IFU02001( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo NUMERO
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->NUMERO)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER VAZIO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02002( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo RECIBO
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( M->RECIBO="RECIBO") .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER ALTERADO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02003( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo VALOR
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->VALOR)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER VAZIO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02004( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo RECEBI
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->RECEBI)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER VAZIO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02005( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo ENDERECO
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->ENDERECO)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER VAZIO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02006( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo IMPORT1
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->IMPORT1)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER VAZIO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02008( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo REFERENTE
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->REFERENTE)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER VAZIO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02010( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo MAIORCLARE
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( M->MAIORCLARE="Para maior clareza firmo (amos) o presente") .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER ALTERADO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02011( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo CIDESTDAT
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->CIDESTDAT)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER VAZIO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02012( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo EMITENTE
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->EMITENTE)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER VAZIO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02013( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo CPFRG
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->CPFRG)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER VAZIO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02014( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo ENDERECO2
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->ENDERECO2)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER VAZIO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02015( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo ASSINATURA
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( M->ASSINATURA="____________________________________________________________________________") .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "NAO PODE SER ALTERADO!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION CARREG02( TIPO_ACAO )
//
// -> Carrega variaveis para entrada ou altercao de dados
**
**BI [INI] I02.B14
**BI [FIM] I02.B14
**
IF TIPO_ACAO = INCLUSAO
GOTO BOTT
SKIP
ENDIF
M->NUMERO := RECIB->NUMERO
M->RECIBO := RECIB->RECIBO
M->VALOR := RECIB->VALOR
M->RECEBI := RECIB->RECEBI
M->ENDERECO := RECIB->ENDERECO
M->IMPORT1 := RECIB->IMPORT1
M->IMPORT2 := RECIB->IMPORT2
M->REFERENTE := RECIB->REFERENTE
M->REFERENT2 := RECIB->REFERENT2
M->MAIORCLARE := RECIB->MAIORCLARE
M->CIDESTDAT := RECIB->CIDESTDAT
M->EMITENTE := RECIB->EMITENTE
M->CPFRG := RECIB->CPFRG
M->ENDERECO2 := RECIB->ENDERECO2
M->ASSINATURA := RECIB->ASSINATURA
IF TIPO_ACAO = INCLUSAO
//
// -> Deficao de valores constantes
M->ASSINATURA := "____________________________________________________________________________"
M->MAIORCLARE := "Para maior clareza firmo (amos) o presente"
M->RECIBO := "RECIBO"
ENDIF
//
// -> Codigo automatico
IF TIPO_ACAO = INCLUSAO
SET ORDER TO 1
GOTO BOTT
M->NUMERO := STRZERO( VAL( FIELD->NUMERO ) + 1, 7 )
ENDIF
**
**BI [INI] I02.B16
**BI [FIM] I02.B16
**

FUNCTION CARGET02( TIPO_ACAO )
//
// -> Formata a tela para entrada ou alteracao de dados
LOCAL PAGINA := 1
IF TIPO_ACAO != MOSTRA_PAG_1
M->AL_TERAR := .F.
ENDIF
**
**BI [INI] I02.B17
**BI [FIM] I02.B17
**
WHILE .T.
//
// -> Monta pagina 1
IF PAGINA = 1
COR( "MENU" )
@ LIN_MENU, 66 SAY "│ Página : 01"
FUNDO()
JANELA( 3, 0, 22, 79, "Recibos" )
COR( "CERCADURAS" )
//
// -> Monta cercaduras
@ 4, 1 TO 6, 78 DOUBL
@ 7, 1 TO 21, 78 DOUBL
**
**BI [INI] I02.B18
**BI [FIM] I02.B18
**
COR( "GETS" )
**
**BI [INI] I02.B21
**BI [FIM] I02.B21
**
//
// -> Monta tela de cadastro
@ 5, 2 SAY "Numero:" GET M->NUMERO PICTURE "@!" VALID IFU02001()
@ 5, 37 GET M->RECIBO PICTURE "@!" VALID IFU02002()
@ 5, 63 SAY "Valor:" GET M->VALOR PICTURE "@Z 99999.99" VALID IFU02003()
@ 8, 2 SAY "Recebi (emos) de:" GET M->RECEBI PICTURE "@!" VALID IFU02004()
@ 10, 2 SAY "Endereco:" GET M->ENDERECO PICTURE "@!" VALID IFU02005()
@ 12, 2 SAY "A importancia de:" GET M->IMPORT1 PICTURE "@!" VALID IFU02006()
@ 13, 2 GET M->IMPORT2 PICTURE "@!"
@ 15, 2 SAY "Referente:" GET M->REFERENTE PICTURE "@!" VALID IFU02008()
@ 16, 2 GET M->REFERENT2 PICTURE "@!"
@ 18, 2 GET M->MAIORCLARE VALID IFU02010()
@ 20, 2 GET M->CIDESTDAT PICTURE "@!" VALID IFU02011()
**
**BI [INI] I02.B24
**BI [FIM] I02.B24
**
IF TIPO_ACAO = MOSTRA_PAG_1
CLEAR GETS
RETURN .F.
ENDIF
IF TIPO_ACAO = CONSULTA .OR. TIPO_ACAO = EXCLUSAO
CLEAR GETS
IF TIPO_ACAO = EXCLUSAO
RETURN .T.
ENDIF
MENSAGEM( "Tecle algo para continuar" )
IF TEC_MOU( 0 ) = T_ESC
RETURN .F.
ENDIF
ELSE
CURSOR( LIGA )
READ
CURSOR( DESLIGA )
IF LASTKEY() = T_ESC
RETURN .F.
ENDIF
IF LASTKEY() = T_PGUP
PAGINA := 1
M->MOSTRA_RESULTADO := .T.
LOOP
ENDIF
ENDIF
PAGINA := 2
LOOP
ENDIF
//
// -> Monta pagina 2
IF PAGINA = 2
COR( "MENU" )
@ LIN_MENU, 66 SAY "│ Página : 02"
FUNDO()
JANELA( 7, 0, 17, 79, "Recibos" )
COR( "CERCADURAS" )
//
// -> Monta cercaduras
@ 8, 1 TO 16, 78 DOUBL
**
**BI [INI] I02.B19
**BI [FIM] I02.B19
**
COR( "GETS" )
**
**BI [INI] I02.B22
**BI [FIM] I02.B22
**
//
// -> Monta tela de cadastro
@ 9, 2 SAY "Emitente:" GET M->EMITENTE PICTURE "@!" VALID IFU02012()
@ 11, 2 SAY "CPF/RG:" GET M->CPFRG PICTURE "@!" VALID IFU02013()
@ 13, 2 SAY "ENDERECO:" GET M->ENDERECO2 PICTURE "@!" VALID IFU02014()
@ 15, 2 GET M->ASSINATURA PICTURE "@!" VALID IFU02015()
**
**BI [INI] I02.B25
**BI [FIM] I02.B25
**
IF TIPO_ACAO = MOSTRA_PAG_1
CLEAR GETS
RETURN .F.
ENDIF
IF TIPO_ACAO = CONSULTA .OR. TIPO_ACAO = EXCLUSAO
CLEAR GETS
IF TIPO_ACAO = EXCLUSAO
RETURN .T.
ENDIF
MENSAGEM( "Tecle algo para continuar" )
IF TEC_MOU( 0 ) = T_ESC
RETURN .F.
ENDIF
ELSE
CURSOR( LIGA )
READ
CURSOR( DESLIGA )
IF LASTKEY() = T_ESC
RETURN .F.
ENDIF
IF LASTKEY() = T_PGUP
PAGINA := 1
M->MOSTRA_RESULTADO := .T.
LOOP
ENDIF
ENDIF
RETURN .T.
ENDIF
ENDDO

FUNCTION SALVAR02
//
// -> Salva o conteudo das variaveis de entrada no arquivo
**
**BI [INI] I02.B27
**BI [FIM] I02.B27
**
RECIB->NUMERO := M->NUMERO
RECIB->RECIBO := M->RECIBO
RECIB->VALOR := M->VALOR
RECIB->RECEBI := M->RECEBI
RECIB->ENDERECO := M->ENDERECO
RECIB->IMPORT1 := M->IMPORT1
RECIB->IMPORT2 := M->IMPORT2
RECIB->REFERENTE := M->REFERENTE
RECIB->REFERENT2 := M->REFERENT2
RECIB->MAIORCLARE := M->MAIORCLARE
RECIB->CIDESTDAT := M->CIDESTDAT
RECIB->EMITENTE := M->EMITENTE
RECIB->CPFRG := M->CPFRG
RECIB->ENDERECO2 := M->ENDERECO2
RECIB->ASSINATURA := M->ASSINATURA
**
**BI [INI] I02.B28
**BI [FIM] I02.B28
**

/* Final do programa RECIBI02.PRG */

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

03/03/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

Um Pouco Mais

De Menu De

Manutenção

/*
TITULO : Emissao de recibos
DATA : 24/02/21
PROGRAMA : RECIBCON.PRG
COMENTARIO : MENU DE MANUTENCOES
*/

#include "RECIB.CH"
#include "RECIBMOU.CH"
**
**BI [INI] MCO.B01
**BI [FIM] MCO.B01
**
PARA R_CA
MENSAGEM( "Tecle para sair" )
menu:ADD( "> Emitindo...", SUBCON01() )
menu:RODA()
CLOSE DATABASES
**
**BI [INI] MCO.B02
**BI [FIM] MCO.B02
**

FUNCTION SUBCON01
menu:TIPO_MENU := SUB_MENU
menu:ADD( " Recibos", RECIBC02() )
menu:RODA()
RETURN NIL

FUNCTION EDIT_JAN( D_JAN )
LOCAL TA_MANHO, MAI_OR, COL_SUP, COL_INF, LIN_SUP, LIN_INF,;
L_EDJAN, C_EDJAN, CONTAR, TEL_EDJAN
TEL_EDJAN := SAVESCREEN( 00, 00, MAXROW(), MAXCOL() )
MENSAGEM( "Tecle para sair" )
SOMBRA( L_EDJAN := L_SOM, C_EDJAN := C_SOM, .T. )
//
// -> Determina o maior tamanho de linha
MAI_OR := 0
FOR CONTAR = 1 TO LEN( D_JAN )
TA_MANHO := LEN( D_JAN[ CONTAR ][ 1 ] ) + D_JAN[ CONTAR ][ 4 ] + 1
IF MAI_OR < TA_MANHO; MAI_OR := TA_MANHO; ENDIF
NEXT
//
// -> Calcula a linha superior da janela
LIN_SUP := INT( ( ( MAXROW() + 1 ) - ( ( LEN( D_JAN ) * 2 ) + 3 ) ) / 2 )
//
// -> Calcula a linha inferior da janela
LIN_INF := LIN_SUP + ( LEN( D_JAN ) * 2 ) + 2
//
// -> Calcula a coluna superior da janela
COL_SUP := INT( ( ( MAXCOL() + 1 ) - ( MAI_OR + 6 ) ) / 2 )
//
// -> Calcula a coluna inferior da janela
COL_INF := COL_SUP + MAI_OR + 5
JANELA( LIN_SUP, COL_SUP, LIN_INF, COL_INF )
COR( "GETS" )
//
// -> Monta os GET'S para edicao
FOR CONTAR = 1 TO LEN( D_JAN )
IF LEN( D_JAN ) = 5
//
// -> Se nao houver utilizacao de validacoes
IF D_JAN[ CONTAR ][ 3 ] = NIL
//
// -> Se nao houver utilizacao de mascaras
@ LIN_SUP + ( CONTAR * 2 ), COL_SUP + 3 SAY D_JAN[ CONTAR ][ 1 ];
GET D_JAN[ CONTAR ][ 2 ]
ELSE
//
// -> Se houver utilizacao de mascaras
@ LIN_SUP + ( CONTAR * 2 ), COL_SUP + 3 SAY D_JAN[ CONTAR ][ 1 ];
GET D_JAN[ CONTAR ][ 2 ] PICT D_JAN[ CONTAR ][ 3 ]
ENDIF
ELSE
//
// -> Se houver utilizacao de validacoes
IF D_JAN[ CONTAR ][ 3 ] = NIL
//
// -> Se nao houver utilizacao de mascaras
@ LIN_SUP + ( CONTAR * 2 ), COL_SUP + 3 SAY D_JAN[ CONTAR ][ 1 ];
GET D_JAN[ CONTAR ][ 2 ]
ELSE
//
// -> Se houver utilizacao de mascaras
@ LIN_SUP + ( CONTAR * 2 ), COL_SUP + 3 SAY D_JAN[ CONTAR ][ 1 ];
GET D_JAN[ CONTAR ][ 2 ] PICT D_JAN[ CONTAR ][ 3 ]
ENDIF
ENDIF
NEXT
CURSOR( LIGA )
READ
CURSOR( DESLIGA )
SOMBRA( L_EDJAN, C_EDJAN )
RESTSCREEN( 00, 00, MAXROW(), MAXCOL(), TEL_EDJAN )
IF LASTKEY() = T_ESC
RETURN .F.
ENDIF
//
// -> Faz atualizacao das variaveis atraves dos blocos de codigo
FOR CONTAR = 1 TO LEN( D_JAN )
EVAL( D_JAN[ CONTAR ][ 5 ], D_JAN[ CONTAR ][ 2 ] )
NEXT
RETURN .T.

FUNCTION BRO_WSE( MOS_TRA )
STATIC ES_COLHA := 1, UL_TIMO := { 1, .F. }
LOCAL AL_TERA, CONTAR, COLUNA_MEM, TECLA, RE_FAZ, TE_LA, DADO_CUR,;
LIN := 0, COL :=0 , BO_TAO :=0
IF MOS_TRA = NIL
MOS_TRA := .F.
ENDIF
//
// -> Definicao do BROWSE
OBJETO := TBROWSEDB( 06, 05, 19, 74 )
//
// -> Separador do cabecalho
OBJETO:HEADSEP := TB_SEP_CAB
//
// -> Separador de colunas
OBJETO:COLSEP := TB_SEP_LIN
//
// -> Cor do browse (1) (2) (3)
OBJETO:COLORSPEC := CONTECOR[ 2 ] + "," + CONTECOR[ 3 ] + "," + TB_COR_DEL
FOR CONTAR = 1 TO LEN( OB_COLUN )
OB_COLUNA := OB_COLUN[ CONTAR ]
//
// -> Adicionando as colunas ao browse
OBJETO:ADDCOLUMN( OB_COLUNA )
//
// -> Separador de rodape
OB_COLUNA:FOOTSEP := TB_RODAPE
//
// -> Definicao das cores do BROWSE e registros DELETADOS
OB_COLUNA:COLORBLOCK := { || IIF( DELETED(), { 3, 2 }, { 1, 2 } ) }
NEXT
COR( "MENU" )
WHILE .T.
//
// -> Loop de estabilizacao do browse
MOUSE( DESLIGA )
WHILE ( !OBJETO:STABILIZE() )
IF ( TECLA := INKEY() ) = 0
MOUSE( @BO_TAO, @LIN, @COL )
ENDIF
IF BO_TAO = M_ESQUERDO .OR. BO_TAO = M_OS_DOIS
DADO_CUR := SUBS( SAVESCREEN( LIN, COL, LIN, COL ), 1, 1 )
IF DADO_CUR = CHR( 254 ) .OR. BO_TAO = M_OS_DOIS
TECLA := T_ESC
ELSEIF LIN = 24 .AND. ( COL >= 71 .AND. COL <= 78 )
TECLA := T_F1
ELSEIF ( LIN = 5 .OR. LIN = 7 ) .AND. ( COL >= 5 .AND. COL <= 74 )
TECLA := T_CIMA
ELSEIF LIN = 19 .AND. ( COL >= 5 .AND. COL <= 74 )
TECLA := T_BAIXO
ELSEIF COL = 4 .AND. ( LIN >= 6 .AND. LIN <= 18 )
TECLA := T_ESQUERDA
ELSEIF COL = 75 .AND. ( LIN >= 6 .AND. LIN <= 18 )
TECLA := T_DIREITA
ELSE
BEEP_MOUSE()
ENDIF
ELSEIF BO_TAO = M_DIREITO
TECLA := T_ENTER
ENDIF
//
// -> Se alguma tecla for pressionada sai sem estabilizar
IF TECLA != 0
EXIT
ENDIF
ENDDO
MOUSE( LIGA )
//
// -> Se MOS_TRA = .T. abandona o BROWSE sem editar. E' utilizado para
// mostrar uma tela cheia do BROWSE e sair
IF MOS_TRA
RETURN .T.
ENDIF
//
// -> Se o browse estiver estabilizado espera uma o pressionamento
// de uma tecla
IF OBJETO:STABLE
SETCOLOR( CONTECOR[ 5 ] )
@ 21, 04 SAY STRZERO( RECN(), 7 ) + " " + IIF( DELETED(), "Del", " " )
WHILE( TECLA := INKEY() ) == 0
IF TECLA = 0
MOUSE( @BO_TAO, @LIN, @COL )
ENDIF
IF BO_TAO = M_ESQUERDO .OR. BO_TAO = M_OS_DOIS
C_COL := COL()
C_ROW := ROW()
DADO_CUR := SUBS( SAVESCREEN( LIN, COL, LIN, COL ), 1, 1 )
IF DADO_CUR = CHR( 254 ) .OR. BO_TAO = M_OS_DOIS
TECLA := T_ESC
ELSEIF LIN = 24 .AND. ( COL >= 71 .AND. COL <= 78 )
TECLA := T_F1
ELSEIF ( LIN = 5 .OR. LIN = 7 ) .AND. ( COL >= 5 .AND. COL <= 74 )
TECLA := T_CIMA
ELSEIF LIN = 19 .AND. ( COL >= 5 .AND. COL <= 74 )
TECLA := T_BAIXO
ELSEIF COL = 4 .AND. ( LIN >= 6 .AND. LIN <= 18 )
TECLA := T_ESQUERDA
ELSEIF COL = 75 .AND. ( LIN >= 6 .AND. LIN <= 18 )
TECLA := T_DIREITA
ELSEIF ( COL >= 6 .AND. COL <= 73 ) .AND. ( LIN >= 8 .AND. LIN <= 18 )
OBJETO:ROWPOS := LIN - 7
OBJETO:REFRESHALL()
WHILE ( !OBJETO:STABILIZE() )
ENDDO
TECLA := T_ENTER
ELSE
BEEP_MOUSE()
LOOP
ENDIF
EXIT
ELSEIF BO_TAO = M_DIREITO
TECLA := T_ENTER
EXIT
ENDIF
ENDDO
ENDIF
IF TECLA == T_CIMA
OBJETO:UP()
ELSEIF TECLA == T_BAIXO
OBJETO:DOWN()
ELSEIF TECLA == T_ESQUERDA
OBJETO:LEFT()
ELSEIF TECLA == T_DIREITA
OBJETO:RIGHT()
ELSEIF TECLA == T_F1
HELP( "BRO_ WSE" )
ELSEIF TECLA == T_F3
CALEN()
ELSEIF TECLA == T_F4
CALCU()
ELSEIF TECLA == T_HOME
GO TOP
OBJETO:REFRESHALL()
ELSEIF TECLA == T_END
GO BOTT
OBJETO:REFRESHALL()
ELSEIF TECLA == T_PGUP
OBJETO:PAGEUP()
ELSEIF TECLA == T_PGDN
OBJETO:PAGEDOWN()
ELSEIF TECLA == T_CTRL_PGUP
OBJETO:GOTOP()
ELSEIF TECLA == T_CTRL_PGDN
OBJETO:GOBOTTOM()
ELSEIF TECLA == T_CTRL_HOME
OBJETO:PANHOME()
ELSEIF TECLA == T_CTRL_END
OBJETO:PANEND()
ELSEIF TECLA == T_CTRL_ESQUERDA
OBJETO:PANLEFT()
ELSEIF TECLA == T_CTRL_DIREITA
OBJETO:PANRIGHT()
ELSEIF TECLA == T_ESC
RETURN .T.
ELSEIF TECLA = T_ENTER
MOUSE( DESLIGA )
SAVE SCREEN TO TE_LA
MOUSE( LIGA )
FUNDO()
RE_FAZ := .F.
WHILE .T.
MENSAGEM( "Tecle para sair" )
//
// -> Carrega o conteudo do registro em variaveis de memoria
EVAL( ROTI_NAS[ 1 ], ALTERACAO )
//
// -> Mostra em detalhe o registro atual
EVAL( ROTI_NAS[ 2 ], MOSTRA_PAG_1 )
ME_NU := {}
ES_COLHA := UL_TIMO[ 1 ]
IF !DELETED()
//
// -> Se o registro nao estiver DELETADO permite fazer
// altercao de exclusao dos dados
AADD( ME_NU, "Altera" )
AADD( ME_NU, "Exclui" )
AL_TERA := 1
IF UL_TIMO[ 2 ] = .T.
UL_TIMO[ 2 ] := .F.
ES_COLHA++
ENDIF
ELSE
//
// -> Se o registro estiver deletado permite sua recuperacao
AADD( ME_NU, "Recupera" )
AL_TERA := 0
IF UL_TIMO[ 2 ] = .F.
UL_TIMO[ 2 ] := .T.
ES_COLHA--
ENDIF
ENDIF
AADD( ME_NU, "Anterior" )
AADD( ME_NU, "Proximo" )
AADD( ME_NU, "Retorna" )
//
// -> Prepara MENU
COR( "MENU" ); @ LIN_MENU, 14
TECLA := 0
WHILE .T.
COLUNA_MEN := 14
MOUSE( DESLIGA )
FOR CONTAR := 1 TO LEN( ME_NU )
@ LIN_MENU, COLUNA_MEN PROMPT " " + ME_NU[ CONTAR ] + " "
COLUNA_MEN += LEN( ME_NU[ CONTAR ] ) + 3
NEXT
IF TECLA = 0 .OR. TECLA = T_ENTER .OR. TECLA = T_ESC
M_BUFFER := CHR( T_ENTER )
ELSE
M_BUFFER := CHR( TECLA ) + CHR( T_ENTER )
ENDIF
KEYBOARD M_BUFFER
MENU TO ES_COLHA
MOUSE( LIGA )
IF TECLA = T_ENTER .OR. TECLA = T_ESC
EXIT
ENDIF
WHILE( TECLA := INKEY() ) == 0
IF TECLA = 0
//
// -> Lê buffer do mouse
MOUSE( @BO_TAO, @LIN, @COL )
ENDIF
//
// -> Verifica se os botoes do mouse foram pressionados para ativar
// a acao equivalente a posicao do cursor do mouse
IF BO_TAO = M_ESQUERDO .OR. BO_TAO = M_OS_DOIS
DADO_CUR := SUBS( SAVESCREEN( LIN, COL, LIN, COL ), 1, 1 )
IF DADO_CUR = CHR( 254 ) .OR. BO_TAO = M_OS_DOIS
TECLA := T_ESC
ELSEIF LIN = 24 .AND. ( COL >= 71 .AND. COL <= 78 )
HELP( "MENU_BROWSE")
LOOP
ELSEIF LIN = LIN_MENU
COLUNA_MEN := 14
FOR CONTAR := 1 TO LEN( ME_NU )
IF COL >= COLUNA_MEN .AND.;
COL <= COLUNA_MEN + LEN( ME_NU[ CONTAR ] ) + 1
ES_COLHA := CONTAR
TECLA := T_ENTER
EXIT
ENDIF
COLUNA_MEN += LEN( ME_NU[ CONTAR ] ) + 3
NEXT
IF CONTAR > LEN( ME_NU ); LOOP; ENDIF
ELSE
BEEP_MOUSE()
LOOP
ENDIF
EXIT
ELSEIF BO_TAO = M_DIREITO
TECLA := T_ENTER
EXIT
ENDIF
ENDDO
IF TECLA = T_ESC
ES_COLHA := 0
EXIT
ENDIF
ENDDO
//
// -> Atualiza matriz quem contem a ultima açäo
IF ES_COLHA != 0
UL_TIMO[ 1 ] := ES_COLHA
ENDIF
//
// -> Retorna ao BROWSE
IF ES_COLHA = LEN( ME_NU ) .OR. ES_COLHA = 0
L_SOM := L_CON; C_SOM := C_CON
COR( "MENU" )
MOUSE( DESLIGA )
RESTORE SCREEN FROM TE_LA
MOUSE( LIGA )
EXIT
ENDIF
//
// -> Volta um registro
IF ES_COLHA = 2 + AL_TERA
RE_FAZ := .T.
SKIP -1
IF BOF()
BEEP()
ENDIF
LOOP
ENDIF
//
// -> Avança um registro
IF ES_COLHA = 3 + AL_TERA
RE_FAZ := .T.
SKIP 1
IF EOF()
BEEP()
SKIP -1
ENDIF
LOOP
ENDIF
M->TIPO_ACAO := SUBS( "AE", ES_COLHA + IIF( AL_TERA = 0, 1, 0 ), 1 )
IF M->TIPO_ACAO = ALTERACAO
IF !REGLOCK( 5 )
BEEP()
MENSAGEM( "Registro bloqueado, tente novamente", 3 )
MOUSE( DESLIGA )
RESTORE SCREEN FROM TE_LA
MOUSE( LIGA )
RETURN 1
ENDIF
//
// -> Edita a tela de cadastro indicada
OK_GETS := EVAL( ROTI_NAS[ 2 ], ALTERACAO )
IF OK_GETS
IF PERG( "Confirma alteraçöes ?" ) = "S"
//
// -> Atualiza o banco de dados
EVAL( ROTI_NAS[ 3 ] )
COMMIT
UNLOCK
COR( "MENU" )
MOUSE( DESLIGA )
RESTORE SCREEN FROM TE_LA
MOUSE( LIGA )
L_SOM := L_CON; C_SOM := C_CON
RE_FAZ := .T.
ELSE
UNLOCK
LOOP
ENDIF
ELSE
UNLOCK
COR( "MENU" )
MOUSE( DESLIGA )
RESTORE SCREEN FROM TE_LA
MOUSE( LIGA )
L_SOM := L_CON; C_SOM := C_CON
ENDIF
ELSEIF M->TIPO_ACAO = EXCLUSAO
//
// -> Mostra registro detalhadamente
EVAL( ROTI_NAS[ 2 ], EXCLUSAO )
L_SOM := L_CON; C_SOM := C_CON
CLEAR GETS
IF !DELETED()
//
// -> Marca registro para exclusao
IF !REGLOCK(5)
BEEP()
MENSAGEM( "Deleçäo mal sucedida", 3 )
MOUSE( DESLIGA )
RESTORE SCREEN FROM TE_LA
MOUSE( LIGA )
EXIT
ENDIF
FOR CONTAR = 1 TO LEN( GRA_VAR )
IF EVAL( GRA_VAR[ CONTAR ][ 1 ] ) = .F.
UNLOCK
MOUSE( DESLIGA )
RESTORE SCREEN FROM TE_LA
MOUSE( LIGA )
RETURN 1
ENDIF
NEXT
DELE
ELSE
//
// -> Recupera registro marcado para exclusao
IF !REGLOCK( 5 )
BEEP()
MENSAGEM( "Recuperaçäo mal sucedida", 3 )
MOUSE( DESLIGA )
RESTORE SCREEN FROM TE_LA
MOUSE( LIGA )
EXIT
ENDIF
FOR CONTAR = 1 TO LEN( GRA_VAR )
IF EVAL( GRA_VAR[ CONTAR ][ 2 ] ) = .F.
UNLOCK
MOUSE( DESLIGA )
RESTORE SCREEN FROM TE_LA
MOUSE( LIGA )
RETURN 1
ENDIF
NEXT
RECALL
ENDIF
UNLOCK
COR( "MENU" )
MOUSE( DESLIGA )
RESTORE SCREEN FROM TE_LA
MOUSE( LIGA )
RE_FAZ = .T.
ENDIF
EXIT
ENDDO
//
// -> Forca a reorganizacao do BROWSE
IF RE_FAZ
OBJETO:REFRESHALL()
ENDIF
ENDIF
ENDDO

/* Final do programa RECIBCON.PRG */

 

 coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

02/03/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

Mais Um Menu

De Relatórios

/*
TITULO : Emissao de recibos
DATA : 24/02/21
PROGRAMA : RECIBREL.PRG
COMENTARIO : MENU DE RELATORIOS
*/

#include "RECIB.CH"
#include "RECIBMOU.CH"
**
**BI [INI] REL.B01
**BI [FIM] REL.B01
**
MENSAGEM( "Tecle para sair" )
menu:ADD( "> Emitindo...", SUBREL01() )
menu:RODA()
CLOSE DATABASES
**
**BI [INI] REL.B02
**BI [FIM] REL.B02
**

FUNCTION SUBREL01
menu:TIPO_MENU := SUB_MENU
menu:ADD( " Recibos", RECIBR02() )
menu:RODA()
RETURN NIL

FUNCTION IMP_REL
//
// -> Variaveis e vetores locais
LOCAL SAIDA := "S", LARGURA := 0, CONTAR, TAMANHO, TIPO, RESULTADO,;
MAS_CARA, POSICAO, CORINGA, DIFERENCA, LOCALIZA, ADD_MASCARA,;
FIL_TRA, CONTADOR, ACAO_MEMO := 1, INICIO, MAIOR_MEMO
//
// -> Variaveis e vetores private
PARA PROGRAMA, LINHA_PROG
TO_TALIZA := {}; CO_LUNAS := {}; RE_SUMO := {}; QUE_BRAS := {}
TOTALIZADOR := {}; CAMPOS_MEMO := {}; TAM_MEMO := {}; TOT_QUEBRA := {}
FOR CONTAR := 1 TO LEN( relatorio:QUEBRA )
AADD( TOT_QUEBRA, {} )
NEXT
IF relatorio:TIPO = COLUNAR
//
// -> Ordena matriz de conteudo pelo posicionamento
ASORT( relatorio:CONTEUDO,,, { | X, Y | X[ _COLUNA ] < Y[ _COLUNA ] } )
ENDIF
POSICAO := 01
//
// -> Inicia linha de impressao na margem superior
relatorio:LINHA := relatorio:LIN_SUPERIOR
MAS_CARA := IIF( relatorio:TIPO = COLUNAR, 5, 4 )
//
// -> Prepara dados recebidos no objeto para impressao
FOR CONTAR := 1 TO LEN( relatorio:CONTEUDO )
IF relatorio:TIPO = COLUNAR
IF relatorio:CONTEUDO[ CONTAR ][ _COLUNA ] +;
LEN( relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ] ) - 1 > LARGURA
LARGURA := relatorio:CONTEUDO[ CONTAR ][ _COLUNA ] +;
LEN( relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ] ) - 1
ENDIF
ENDIF
IF NUM_RELATORIO = 0
MACRO := relatorio:CONTEUDO[ CONTAR ][ _DADOS ]
TIPO := VALTYPE( &MACRO )
ELSE
TIPO := VALTYPE( EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] ) )
ENDIF
IF LEN( relatorio:CONTEUDO[ CONTAR ] ) = MAS_CARA
IF NUM_RELATORIO = 0
MACRO := relatorio:CONTEUDO[ CONTAR ][ _DADOS ]
TAMANHO := LEN( TRANS( &MACRO, relatorio:CONTEUDO[ CONTAR ][ MAS_CARA ] ) )
ELSE
TAMANHO := LEN( TRANS( EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] ),;
relatorio:CONTEUDO[ CONTAR ][ MAS_CARA ] ) )
ENDIF
ELSE
IF TIPO = "N"
TAMANHO := 10
ELSEIF TIPO = "D"
TAMANHO := 8
ELSEIF TIPO = "L"
TAMANHO := 3
ELSEIF TIPO = "M"
TAMANHO := relatorio:MEMO_LARGURA
ELSE
IF NUM_RELATORIO = 0
MACRO := relatorio:CONTEUDO[ CONTAR ][ _DADOS ]
TAMANHO := LEN( &MACRO )
ELSE
TAMANHO := LEN( EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] ) )
ENDIF
ENDIF
ENDIF
IF relatorio:TIPO = COLUNAR
IF relatorio:CONTEUDO[ CONTAR ][ _COLUNA ] + TAMANHO - 1 > LARGURA
LARGURA := relatorio:CONTEUDO[ CONTAR ][ _COLUNA ] + TAMANHO - 1
ENDIF
AADD( CO_LUNAS, relatorio:CONTEUDO[ CONTAR ][ _COLUNA ] )
ELSE
IF TAMANHO < LEN( relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ] )
TAMANHO := LEN( relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ] )
ENDIF
LARGURA += TAMANHO
AADD( CO_LUNAS, POSICAO )
POSICAO += relatorio:SEPARADOR + TAMANHO
ENDIF
//
// -> Definicao de campos a serem resumidos (numericos)
IF relatorio:RESUMO != NIL .AND. TIPO = "N"
DIFERENCA := 0
CORINGA := NIL
IF LEN( relatorio:CONTEUDO[ CONTAR ] ) = MAS_CARA
CORINGA := relatorio:CONTEUDO[ CONTAR ][ MAS_CARA ]
CORINGA := STRTRAN( CORINGA, "#", "9" )
LOCALIZA := AT( "9", CORINGA )
IF LOCALIZA != 0
IF AT( ",", CORINGA ) != 0
ADD_MASCARA := SUBS( CORINGA, LOCALIZA, AT( ",",;
CORINGA ) - LOCALIZA )
IF LEN( ADD_MASCARA ) = 1
ADD_MASCARA := "99"; DIFERENCA := 2
ELSEIF LEN( ADD_MASCARA ) = 2 .OR.;
LEN( ADD_MASCARA ) = 3
ADD_MASCARA := "9,9"; DIFERENCA := 3
ENDIF
IF DIFERENCA != 0
CORINGA := STUFF( CORINGA, LOCALIZA, 0, ADD_MASCARA )
ENDIF
ELSE
IF LOCALIZA != 0
CORINGA := STUFF( CORINGA, LOCALIZA, 0, "99" )
DIFERENCA := 2
ENDIF
ENDIF
ENDIF
ENDIF
CO_LUNAS[ CONTAR ] -= DIFERENCA
IF CORINGA != NIL
relatorio:CONTEUDO[ CONTAR ][ MAS_CARA ] := CORINGA
ENDIF
IF relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ] != NIL
relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ] :=;
SPACE( DIFERENCA ) + relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ]
ENDIF
AADD( RE_SUMO, { relatorio:CONTEUDO[ CONTAR ][ _DADOS ], 0 } )
ENDIF
NEXT
IF relatorio:TIPO = COLUNAR_AUTOMATICO
LARGURA += ( LEN( relatorio:CONTEUDO ) - 1 ) * relatorio:SEPARADOR
ENDIF
IF LEN( relatorio:TITULOS ) > 1
IF NUM_RELATORIO = 0
IF LEN( relatorio:TITULOS[ 1 ] ) > LEN( relatorio:TITULOS[ 2 ] )
TAMANHO := LEN( relatorio:TITULOS[ 1 ] )
ELSE
TAMANHO := LEN( relatorio:TITULOS[ 2 ] )
ENDIF
ELSE
IF LEN( EVAL( relatorio:TITULOS[ 1 ] ) ) > LEN( EVAL( relatorio:TITULOS[ 2 ] ) )
TAMANHO := LEN( EVAL( relatorio:TITULOS[ 1 ] ) )
ELSE
TAMANHO := LEN( EVAL( relatorio:TITULOS[ 2 ] ) )
ENDIF
ENDIF
ELSEIF LEN( relatorio:TITULOS ) = 1
IF NUM_RELATORIO = 0
TAMANHO := LEN( relatorio:TITULOS[ 1 ] )
ELSE
TAMANHO := LEN( EVAL( relatorio:TITULOS[ 1 ] ) )
ENDIF
ELSE
TAMANHO := 18
ENDIF
IF TAMANHO + 17 > LARGURA; LARGURA := TAMANHO + 17; ENDIF
relatorio:LARGURA := LARGURA
//
// -> Prepara dados referentes a campos do tipo MEMO
FOR CONTAR := 1 TO LEN( relatorio:CONTEUDO )
IF NUM_RELATORIO = 0
MACRO := relatorio:CONTEUDO[ CONTAR ][ _DADOS ]
TIPO := VALTYPE( &MACRO )
ELSE
TIPO := VALTYPE( EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] ) )
ENDIF
IF TIPO = "M"
AADD( CAMPOS_MEMO,;
{ relatorio:CONTEUDO[ CONTAR ][ _DADOS ], CO_LUNAS[ CONTAR ] } )
ENDIF
NEXT
//
// -> Prepara dados para totalizacao de campo numericos
IF LEN( relatorio:TOTALIZA ) = 0
FOR CONTAR := 1 TO LEN( relatorio:CONTEUDO )
IF NUM_RELATORIO = 0
MACRO := relatorio:CONTEUDO[ CONTAR ][ _DADOS ]
TIPO := VALTYPE( &MACRO )
ELSE
TIPO := VALTYPE( EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] ) )
ENDIF
IF TIPO = "N"
CORINGA := {}
AADD( CORINGA, relatorio:CONTEUDO[ CONTAR ][ _DADOS ] )
AADD( CORINGA, relatorio:CONTEUDO[ CONTAR ][ _DADOS + 1 ] )
AADD( CORINGA, CO_LUNAS[ CONTAR ] )
IF LEN( relatorio:CONTEUDO[ CONTAR ] ) = MAS_CARA
AADD( CORINGA, relatorio:CONTEUDO[ CONTAR ][ MAS_CARA ] )
ENDIF
AADD( TOTALIZADOR, CORINGA )
ENDIF
NEXT
ELSE
TOTALIZADOR := relatorio:TOTALIZA
ENDIF
FOR CONTAR := 1 TO LEN( TOTALIZADOR )
IF NUM_RELATORIO = 0
MACRO := TOTALIZADOR[ CONTAR ][ 1 ]
TIPO := VALTYPE( &MACRO )
ELSE
TIPO := VALTYPE( EVAL( TOTALIZADOR[ CONTAR ][ 1 ] ) )
ENDIF
IF TIPO != "N"
SETCOLOR( "W" )
CLS
?
? "Tentativa de totalizar campo nao numerico"
?
? "Rotina -> " + PROGRAMA
? "Linha --> " + ALLTRIM( STR( LINHA_PROG ) )
?
QUIT
ENDIF
IF relatorio:TIPO = COLUNAR_AUTOMATICO
POSICAO := ASCAN( relatorio:CONTEUDO, { | X | UPPER( X[ 3 ] ) ==;
UPPER( TOTALIZADOR[ CONTAR ][ 2 ] ) } )
IF POSICAO = 0
SETCOLOR( "W" )
CLS
?
? "Tentativa de totalizar campo nao posicionado para impressao"
?
? "Rotina -> " + PROGRAMA
? "Linha --> " + ALLTRIM( STR( LINHA_PROG ) )
?
QUIT
ENDIF
DIFERENCA := 0; CORINGA := NIL
IF LEN( relatorio:CONTEUDO[ POSICAO ] ) = MAS_CARA
CORINGA := relatorio:CONTEUDO[ POSICAO ][ MAS_CARA ]
CORINGA := STRTRAN( CORINGA, "#", "9" )
LOCALIZA := AT( "9", CORINGA )
IF LOCALIZA != 0
IF AT( ",", CORINGA ) != 0
ADD_MASCARA := SUBS( CORINGA, LOCALIZA, AT( ",",;
CORINGA ) - LOCALIZA )
IF LEN( ADD_MASCARA ) = 1
ADD_MASCARA := "99"; DIFERENCA := 2
ELSEIF LEN( ADD_MASCARA ) = 2 .OR.;
LEN( ADD_MASCARA ) = 3
ADD_MASCARA := "9,9"; DIFERENCA := 3
ENDIF
IF DIFERENCA != 0
CORINGA := STUFF( CORINGA, LOCALIZA, 0, ADD_MASCARA )
ENDIF
ELSE
IF LOCALIZA != 0
CORINGA := STUFF( CORINGA, LOCALIZA, 0, "99" )
DIFERENCA := 2
ENDIF
ENDIF
ENDIF
ENDIF
AADD( TOTALIZADOR[ CONTAR ], CO_LUNAS[ POSICAO ] - DIFERENCA )
IF CORINGA != NIL
AADD( TOTALIZADOR[ CONTAR ], CORINGA )
ENDIF
ENDIF
AADD( TO_TALIZA, 0 )
FOR CONTADOR := 1 TO LEN( relatorio:QUEBRA )
AADD( TOT_QUEBRA[ CONTADOR ], 0 )
NEXT
NEXT
IF LEN( TOTALIZADOR ) > 0
//
// -> Em casos positivos de totalizacao diminuir 3 linhas da margem
// inferior para impressao dos totais
relatorio:LIN_INFERIOR -= 3
ENDIF
FOR CONTAR := 1 TO LEN( relatorio:QUEBRA )
IF NUM_RELATORIO = 0
MACRO := relatorio:QUEBRA[ CONTAR ][ 1 ]
AADD( QUE_BRAS, &MACRO )
ELSE
AADD( QUE_BRAS, EVAL( relatorio:QUEBRA[ CONTAR ][ 1 ] ) )
ENDIF
NEXT
//
// -> Menu que permite direcionar a saida de impressao
relatorio:SAIDA := MENU_PRN()
IF relatorio:SAIDA = NIL
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
MOUSE( LIGA )
relatorio:LIMPA()
RETURN
ENDIF
SET DEVI TO PRINT
//
// -> Inicio da impressao do relatorio
WHILE !EOF()
//
// -> Verifica se houve tentativa de interromper a impressao
IF INKEY() = T_ESC
SET DEVI TO SCREEN
//
// -> Permite interromper a impressao
SAIDA := PERG( "Continua a impressäo ?" )
MENSAGEM( "Tecle para pausa ou interrupçäo" )
SET DEVI TO PRINT
IF SAIDA = "N"; EXIT; ENDIF
ENDIF
IF relatorio:FILTRO != NIL
IF NUM_RELATORIO = 0
MACRO := relatorio:FILTRO
IF !( &MACRO )
TOTALIZE( .T. )
EXIT
ENDIF
ELSE
IF !( EVAL( relatorio:FILTRO ) )
TOTALIZE( .T. )
EXIT
ENDIF
ENDIF
ENDIF
//
// -> Verifica se esta sendo impressa a primeira linha do relatorio
IF relatorio:LINHA = relatorio:LIN_SUPERIOR
IF relatorio:BLOCO_CABECALHO != NIL
//
// -> Executa bloco de desvio de cabecalho
EVAL( relatorio:BLOCO_CABECALHO )
ELSE
//
// -> Determina o tipo de caracter para impressao
IF relatorio:SAIDA != "T"
IF relatorio:REDUCAO != NIL
@ 00, 01 SAY relatorio:REDUCAO
ENDIF
AJUSTE( relatorio:LARGURA, IIF( TIPO_FORMULARIO = "0", "80", "132" ) )
ENDIF
//
// -> Imprime o cabecalho do relatorio
IF LEN( relatorio:TITULOS ) > 0
IF NUM_RELATORIO = 0
@ relatorio:LINHA, 01 SAY relatorio:TITULOS[ 1 ]
ELSE
@ relatorio:LINHA, 01 SAY EVAL( relatorio:TITULOS[ 1 ] )
ENDIF
ENDIF
@ relatorio:LINHA, relatorio:LARGURA - 13 SAY;
"Pagina: " + STRZERO( relatorio:PAGINA, 4 )
relatorio:PAGINA++
IF LEN( relatorio:TITULOS ) > 1
IF NUM_RELATORIO = 0
@ ++relatorio:LINHA, 01 SAY relatorio:TITULOS[ 2 ]
ELSE
@ ++relatorio:LINHA, 01 SAY EVAL( relatorio:TITULOS[ 2 ] )
ENDIF
ENDIF
@ relatorio:LINHA, relatorio:LARGURA - 13 SAY;
"Data: " + DTOC( DAT_HOJE )
//
// -> Verifica se existem mais titulos a serem impresso
FOR CONTAR := 3 TO LEN( relatorio:TITULOS )
IF NUM_RELATORIO = 0
IF VALTYPE( relatorio:TITULOS[ CONTAR ] ) = "A"
MACRO := relatorio:TITULOS[ CONTAR ][ 2 ]
@ ++relatorio:LINHA, 01 SAY relatorio:TITULOS[ CONTAR ][ 1 ]
@ relatorio:LINHA, LEN( relatorio:TITULOS[ CONTAR ][ 1 ] ) +;
2 SAY &MACRO
ELSE
@ ++relatorio:LINHA, 01 SAY relatorio:TITULOS[ CONTAR ]
ENDIF
ELSE
@ ++relatorio:LINHA, 01 SAY EVAL( relatorio:TITULOS[ CONTAR ] )
ENDIF
NEXT
relatorio:LINHA++
@ ++relatorio:LINHA, 01 SAY;
REPL( relatorio:SEP_CABECALHO, relatorio:LARGURA )
relatorio:LINHA++
FOR CONTAR := 1 TO LEN( relatorio:CONTEUDO )
IF relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ] != NIL
@ relatorio:LINHA, CO_LUNAS[ CONTAR ] SAY;
relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ]
ENDIF
NEXT
@ ++relatorio:LINHA, 01 SAY;
REPL( relatorio:SEP_CABECALHO, relatorio:LARGURA )
relatorio:LINHA++
CORINGA := .F.
//
// -> Verifica a existencias de QUEBRAS com sub-titulos
IF LEN( relatorio:QUEBRA ) > 0
FOR CONTAR := 1 TO LEN( relatorio:QUEBRA )
IF LEN( relatorio:QUEBRA[ CONTAR ] ) > 2
IF VALTYPE( relatorio:QUEBRA[ CONTAR ][ 3 ] ) = "C"
@ ++relatorio:LINHA, 01 SAY;
relatorio:QUEBRA[ CONTAR ][ 3 ]
@ relatorio:LINHA, LEN( relatorio:QUEBRA[ CONTAR ][ 3 ] ) + 2 SAY;
QUE_BRAS[ CONTAR ]
CORINGA := .T.
ENDIF
ENDIF
NEXT
IF CORINGA; relatorio:LINHA += 2; ENDIF
ENDIF
ENDIF
ENDIF
//
// -> Imprime a primeira linha de conteudo do registro. No caso de
// registros que contenham campos do tipo MEMO serao impressas
// linhas de acordo com o tamanho do maior campo MEMO
IF ACAO_MEMO = 1
TAM_MEMO := {}
//
// -> Verifica se o relatorio e' sintetico ( Resumido )
IF relatorio:RESUMO != NIL
IF NUM_RELATORIO = 0
MACRO := relatorio:RESUMO
FIL_TRA := &MACRO
ELSE
FIL_TRA := EVAL( relatorio:RESUMO )
ENDIF
FOR CONTAR := 1 TO LEN( RE_SUMO )
RE_SUMO[ CONTAR ][ 2 ] := 0
NEXT
//
// -> Processa resumo
MACRO := relatorio:RESUMO
WHILE FIL_TRA = IIF( NUM_RELATORIO > 0, EVAL( relatorio:RESUMO ),;
&MACRO ) .AND. !EOF()
//
// -> Pre conteudo
FOR CONTAR := 1 TO LEN( relatorio:PRE_CONTEUDO )
EVAL( relatorio:PRE_CONTEUDO[ CONTAR ] )
NEXT
//
// -> Atualiza resumo
FOR CONTAR := 1 TO LEN( RE_SUMO )
IF NUM_RELATORIO = 0
MACRO := RE_SUMO[ CONTAR ][ 1 ]
RE_SUMO[ CONTAR ][ 2 ] += &MACRO
ELSE
RE_SUMO[ CONTAR ][ 2 ] += EVAL( RE_SUMO[ CONTAR ][ 1 ] )
ENDIF
NEXT
//
// -> Atualiza totalizacao de relatorios resumidos
FOR CONTAR := 1 TO LEN( TOTALIZADOR )
IF NUM_RELATORIO = 0
MACRO := TOTALIZADOR[ CONTAR ][ _DADOS -1 ]
TO_TALIZA[ CONTAR ] += &MACRO
ELSE
TO_TALIZA[ CONTAR ] += EVAL( TOTALIZADOR[ CONTAR ][ _DADOS -1 ] )
ENDIF
//
// -> Atualiza sub-totalizacao das quebras
FOR CONTADOR := 1 TO LEN( relatorio:QUEBRA )
IF NUM_RELATORIO = 0
MACRO := TOTALIZADOR[ CONTAR ][ _DADOS -1 ]
TOT_QUEBRA[ CONTADOR ][ CONTAR ] += &MACRO
ELSE
TOT_QUEBRA[ CONTADOR ][ CONTAR ] +=;
EVAL( TOTALIZADOR[ CONTAR ][ _DADOS -1 ] )
ENDIF
NEXT
NEXT
IF NUM_RELATORIO = 0
MACRO := relatorio:RESUMO
FIL_TRA := &MACRO
ENDIF
SKIP
ENDDO
SKIP -1
POSICAO := 1
//
// -> Imprime conteudo
FOR CONTAR := 1 TO LEN( relatorio:CONTEUDO )
IF NUM_RELATORIO = 0
MACRO := relatorio:CONTEUDO[ CONTAR ][ _DADOS ]
RESULTADO := &MACRO
TIPO := VALTYPE( &MACRO )
ELSE
RESULTADO := EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] )
TIPO := VALTYPE( EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] ) )
ENDIF
IF TIPO = "N"
RESULTADO := RE_SUMO[ POSICAO ][ 2 ]
POSICAO++
ENDIF
IF TIPO = "M"
AADD( TAM_MEMO, MLCOUNT( RESULTADO, relatorio:MEMO_LARGURA ) )
@ relatorio:LINHA, CO_LUNAS[ CONTAR ] SAY;
MEMOLINE( RESULTADO, relatorio:MEMO_LARGURA, 1 )
ELSE
IF LEN( relatorio:CONTEUDO[ CONTAR ] ) = MAS_CARA
@ relatorio:LINHA, CO_LUNAS[ CONTAR ] SAY;
RESULTADO PICT relatorio:CONTEUDO[ CONTAR ][ MAS_CARA ]
ELSE
@ relatorio:LINHA, CO_LUNAS[ CONTAR ] SAY RESULTADO
ENDIF
ENDIF
NEXT
ELSE
//
// -> Pre conteudo
FOR CONTAR := 1 TO LEN( relatorio:PRE_CONTEUDO )
EVAL( relatorio:PRE_CONTEUDO[ CONTAR ] )
NEXT
//
// -> Imprime o conteudo de relatorios nao resumidos
FOR CONTAR := 1 TO LEN( relatorio:CONTEUDO )
IF NUM_RELATORIO = 0
MACRO := relatorio:CONTEUDO[ CONTAR ][ _DADOS ]
RESULTADO := &MACRO
TIPO := VALTYPE( &MACRO )
ELSE
RESULTADO := EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] )
TIPO := VALTYPE( EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] ) )
ENDIF
IF TIPO = "M"
AADD( TAM_MEMO, MLCOUNT( RESULTADO, relatorio:MEMO_LARGURA ) )
@ relatorio:LINHA, CO_LUNAS[ CONTAR ] SAY;
MEMOLINE( RESULTADO, relatorio:MEMO_LARGURA, 1 )
ELSE
IF LEN( relatorio:CONTEUDO[ CONTAR ] ) = MAS_CARA
@ relatorio:LINHA, CO_LUNAS[ CONTAR ] SAY;
RESULTADO PICT relatorio:CONTEUDO[ CONTAR ][ MAS_CARA ]
ELSE
@ relatorio:LINHA, CO_LUNAS[ CONTAR ] SAY;
RESULTADO
ENDIF
ENDIF
NEXT
ENDIF
//
// -> Somente para campos do tipo MEMO
IF LEN( CAMPOS_MEMO ) != 0
ACAO_MEMO++; INICIO := 2
ENDIF
ENDIF
//
// -> Em caso de campos do tipo MEMO imprime o restante do seu conteudo
IF ACAO_MEMO = 2
MAIOR_MEMO := 0
FOR CONTAR := 1 TO LEN( TAM_MEMO )
IF TAM_MEMO[ CONTAR ] > MAIOR_MEMO
MAIOR_MEMO := TAM_MEMO[ CONTAR ]
ENDIF
NEXT
FOR CONTADOR := INICIO TO MAIOR_MEMO
relatorio:LINHA++
FOR CONTAR := 1 TO LEN( CAMPOS_MEMO )
IF NUM_RELATORIO = 0
MACRO := CAMPOS_MEMO[ CONTAR ][ 1 ]
RESULTADO := &MACRO
ELSE
RESULTADO := EVAL( CAMPOS_MEMO[ CONTAR ][ 1 ] )
ENDIF
@ relatorio:LINHA, CAMPOS_MEMO[ CONTAR ][ 2 ] SAY;
MEMOLINE( RESULTADO, relatorio:MEMO_LARGURA, CONTADOR )
NEXT
IF relatorio:LINHA > relatorio:LIN_INFERIOR
EXIT
ENDIF
NEXT
IF CONTADOR < MAIOR_MEMO
INICIO := CONTADOR + 1
ELSE
ACAO_MEMO := 3
ENDIF
ENDIF
//
// -> Atualiza Totalizacao de relatorios nao resumidos
IF relatorio:RESUMO = NIL
FOR CONTAR := 1 TO LEN( TOTALIZADOR )
IF NUM_RELATORIO = 0
MACRO := TOTALIZADOR[ CONTAR ][ _DADOS - 1 ]
TO_TALIZA[ CONTAR ] += &MACRO
ELSE
TO_TALIZA[ CONTAR ] += EVAL( TOTALIZADOR[ CONTAR ][ _DADOS - 1 ] )
ENDIF
//
// -> Atualizacao sub-totalizacao das quebras
FOR CONTADOR := 1 TO LEN( relatorio:QUEBRA )
IF NUM_RELATORIO = 0
MACRO := TOTALIZADOR[ CONTAR ][ _DADOS - 1 ]
TOT_QUEBRA[ CONTADOR ][ CONTAR ] += &MACRO
ELSE
TOT_QUEBRA[ CONTADOR ][ CONTAR ] +=;
EVAL( TOTALIZADOR[ CONTAR ][ _DADOS - 1 ] )
ENDIF
NEXT
NEXT
ENDIF
IF LEN( CAMPOS_MEMO ) = 0
//
// -> Caso nao exista campos do tipo MEMO sendo impresso
relatorio:LINHA++
SKIP
ELSE
//
// -> Somente para campos do tipo MEMO
IF ACAO_MEMO = 3
relatorio:LINHA++
SKIP
ACAO_MEMO := 1
ENDIF
ENDIF
//
// -> Processa as quebras
FOR CONTAR := LEN( relatorio:QUEBRA ) TO 1 STEP -1
//
// -> Verifica se houve uma quebra
IF NUM_RELATORIO = 0
MACRO := relatorio:QUEBRA[ CONTAR ][ 1 ]
ENDIF
IF QUE_BRAS[ CONTAR ] != IIF( NUM_RELATORIO = 0, &MACRO,;
EVAL( relatorio:QUEBRA[ CONTAR ][ 1 ] ) )
CORINGA := .F.
RESULTADO := ""
IF LEN( relatorio:QUEBRA[ CONTAR ] ) = 4
CORINGA := .T.
RESULTADO := relatorio:QUEBRA[ CONTAR ][ 3 ]
ELSEIF LEN( relatorio:QUEBRA[ CONTAR ] ) = 3
IF NUM_RELATORIO = 0
MACRO := relatorio:QUEBRA[ CONTAR ][ 1 ]
TIPO := VALTYPE( &MACRO )
ELSE
TIPO := VALTYPE( EVAL( relatorio:QUEBRA[ CONTAR ][ 1 ] ) )
ENDIF
IF TIPO = "L"
CORINGA := .T.
ELSE
RESULTADO := relatorio:QUEBRA[ CONTAR ][ 3 ]
ENDIF
ENDIF
IF CORINGA = .T.
//
// -> Imprime subtotalizacao da quebra
@ relatorio:LINHA, 01 SAY REPL( relatorio:SEP_CABECALHO, relatorio:LARGURA )
@ ++relatorio:LINHA, 01 SAY relatorio:TIT_SUBTOTAL_QUEBRA
FOR CONTADOR := 1 TO LEN( TOTALIZADOR )
IF LEN( TOTALIZADOR[ CONTADOR ] ) = 4
@ relatorio:LINHA, TOTALIZADOR[ CONTADOR ][ _COLUNA - 1 ] SAY;
TOT_QUEBRA[ CONTAR ][ CONTADOR ];
PICT TOTALIZADOR[ CONTADOR ][ 4 ]
ELSE
@ relatorio:LINHA, TOTALIZADOR[ CONTADOR ][ _COLUNA - 1 ] SAY;
TOT_QUEBRA[ CONTAR ][ CONTADOR ]
ENDIF
//
// -> Zera sub-total da quebra
TOT_QUEBRA[ CONTAR ][ CONTADOR ] := 0
NEXT
ENDIF
IF relatorio:QUEBRA[ CONTAR ][ 2 ] = SALTA_PAGINA
relatorio:LINHA := relatorio:LIN_INFERIOR + 1
ELSE
relatorio:LINHA += relatorio:QUEBRA[ CONTAR ][ 2 ]
IF LEN( TRIM( RESULTADO ) ) > 0 .AND. !EOF()
@ ++relatorio:LINHA, 01 SAY RESULTADO
IF NUM_RELATORIO = 0
MACRO := relatorio:QUEBRA[ CONTAR ][ 1 ]
@ relatorio:LINHA, LEN( RESULTADO ) + 2 SAY &MACRO
ELSE
@ relatorio:LINHA, LEN( RESULTADO ) + 2;
SAY EVAL( relatorio:QUEBRA[ CONTAR ][ 1 ] )
ENDIF
relatorio:LINHA += 2
ENDIF
ENDIF
//
// -> Reatualiza vetores para reiniciar uma quebra
FOR CONTADOR := CONTAR TO LEN( relatorio:QUEBRA )
IF NUM_RELATORIO = 0
MACRO := relatorio:QUEBRA[ CONTADOR ][ 1 ]
QUE_BRAS[ CONTADOR ] = &MACRO
ELSE
QUE_BRAS[ CONTADOR ] = EVAL( relatorio:QUEBRA[ CONTADOR ][ 1 ] )
ENDIF
AFILL( TOT_QUEBRA[ CONTADOR ], 0 )
NEXT
ENDIF
NEXT
//
// -> Verifica se a impressao ultrapassa a margem inferior ou se o
// final do arquivo foi encontrado
IF relatorio:LINHA > relatorio:LIN_INFERIOR .OR. EOF()
//
// Imprime a totalizacao
TOTALIZE()
//
// -> Reinicia controle de linha
relatorio:LINHA := relatorio:LIN_SUPERIOR
ENDIF
ENDDO
EJECT
SET DEVI TO SCREEN
IF relatorio:SAIDA = "A"
SET PRINTER TO
ELSEIF relatorio:SAIDA = "T" .AND. SAIDA = "S"
SET PRINTER TO
//
// -> Mostra relatorio na tela
IMP_TELA( relatorio:LARGURA + 1 )
ENDIF
relatorio:LIMPA()
RETURN NIL

FUNCTION TOTALIZE( TOT_OU_SUB )
IF LEN( relatorio:TOTALIZA ) = 0; RETURN NIL; ENDIF
IF TOT_OU_SUB = NIL; TOT_OU_SUB := EOF(); ENDIF
//
// -> Verifica se esta configuarada a impressao de sub-totais
IF !TOT_OU_SUB .AND. relatorio:SUB_TOTALIZACAO = NAO
RETURN NIL
ENDIF
//
// -> Em caso de total final salta para o fim da folha
IF TOT_OU_SUB .AND. relatorio:LINHA < relatorio:LIN_INFERIOR + 1
relatorio:LINHA := relatorio:LIN_INFERIOR + 1
ENDIF
@ relatorio:LINHA, 01 SAY;
REPL( relatorio:SEP_CABECALHO, relatorio:LARGURA )
relatorio:LINHA++
//
// -> Imprime os sub-titulos de totalizacao
IF TOT_OU_SUB
@ relatorio:LINHA, 01 SAY relatorio:TITULO_TOTAL
ELSE
@ relatorio:LINHA, 01 SAY relatorio:TITULO_SUB_TOTAL
ENDIF
//
// -> Imprime o conteudo da totalizacao
FOR CONTAR := 1 TO LEN( TOTALIZADOR )
IF LEN( TOTALIZADOR[ CONTAR ] ) = 4
@ relatorio:LINHA, TOTALIZADOR[ CONTAR ][ _COLUNA - 1 ] SAY;
TO_TALIZA[ CONTAR ] PICT TOTALIZADOR[ CONTAR ][ 4 ]
ELSE
@ relatorio:LINHA, TOTALIZADOR[ CONTAR ][ _COLUNA - 1 ] SAY;
TO_TALIZA[ CONTAR ]
ENDIF
NEXT
@ ++relatorio:LINHA, 01 SAY;
REPL( relatorio:SEP_CABECALHO, relatorio:LARGURA )
RETURN NIL

FUNCTION IMP_FICHA
//
// -> Variaveis e vetores locais
LOCAL SAIDA := "S", LARGURA := 0, CONTAR, TAMANHO, TIPO, RESULTADO,;
MAS_CARA, DIFERENCA, LOCALIZA, ADD_MASCARA, FIL_TRA, CONTADOR,;
TAM_CAB, TAM_SALTO := 0, TAM_MEMO
//
// -> Variaveis e vetores private
PARA PROGRAMA, LINHA_PROG
CO_LUNAS := {}; LI_NHAS := {}
//
// -> Inicia linha de impressao na margem superior
relatorio:LINHA := relatorio:LIN_SUPERIOR
MAS_CARA := 6
//
// -> Prepara dados recebidos no objeto para impressao
FOR CONTAR := 1 TO LEN( relatorio:CONTEUDO )
TAM_CAB := LEN( TRIM( relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ] ) )
IF TAM_CAB = 0; TAM_CAB--; ENDIF
TIPO := VALTYPE( EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] ) )
IF LEN( relatorio:CONTEUDO[ CONTAR ] ) = MAS_CARA
TAMANHO := LEN( TRANS( EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] ),;
relatorio:CONTEUDO[ CONTAR ][ MAS_CARA ] ) )
ELSE
IF TIPO = "N"
TAMANHO := 10
ELSEIF TIPO = "D"
TAMANHO := 8
ELSEIF TIPO = "L"
TAMANHO := 3
ELSEIF TIPO = "M"
TAMANHO := relatorio:MEMO_LARGURA
ELSE
TAMANHO := LEN( EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] ) )
ENDIF
ENDIF
IF relatorio:CONTEUDO[ CONTAR ][ _COLUNA + 1 ] + TAMANHO + TAM_CAB > LARGURA
LARGURA := relatorio:CONTEUDO[ CONTAR ][ _COLUNA + 1 ] + TAMANHO + TAM_CAB
ENDIF
AADD( CO_LUNAS, relatorio:CONTEUDO[ CONTAR ][ _COLUNA + 1 ] )
AADD( LI_NHAS, relatorio:CONTEUDO[ CONTAR ][ _COLUNA ] )
NEXT
FOR CONTAR := 1 TO LEN( LI_NHAS )
IF LI_NHAS[ CONTAR ] > TAM_SALTO
TAM_SALTO := LI_NHAS[ CONTAR ]
ENDIF
NEXT
IF LEN( relatorio:TITULOS ) > 1
IF LEN( EVAL( relatorio:TITULOS[ 1 ] ) ) > LEN( EVAL( relatorio:TITULOS[ 2 ] ) )
TAMANHO := LEN( EVAL( relatorio:TITULOS[ 1 ] ) )
ELSE
TAMANHO := LEN( EVAL( relatorio:TITULOS[ 2 ] ) )
ENDIF
ELSEIF LEN( relatorio:TITULOS ) = 1
TAMANHO := LEN( EVAL( relatorio:TITULOS[ 1 ] ) )
ELSE
TAMANHO := 18
ENDIF
IF TAMANHO + 17 > LARGURA; LARGURA := TAMANHO + 17; ENDIF
relatorio:LARGURA := LARGURA
//
// -> Menu que permite direcionar a saida de impressao
relatorio:SAIDA := MENU_PRN()
IF relatorio:SAIDA = NIL
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
MOUSE( LIGA )
relatorio:LIMPA()
RETURN
ENDIF
SET DEVI TO PRINT
//
// -> Inicio da impressao do relatorio
WHILE !EOF()
//
// -> Verifica se houve tentativa de interromper a impressao
IF INKEY() = T_ESC
SET DEVI TO SCREEN
//
// -> Permite interromper a impressao
SAIDA := PERG( "Continua a impressäo ?" )
MENSAGEM( "Tecle para pausa ou interrupçäo" )
SET DEVI TO PRINT
IF SAIDA = "N"; EXIT; ENDIF
ENDIF
IF relatorio:FILTRO != NIL
IF !( EVAL( relatorio:FILTRO ) )
EXIT
ENDIF
ENDIF
//
// -> Verifica se esta sendo impressa a primeira linha do relatorio
IF relatorio:LINHA = relatorio:LIN_SUPERIOR
IF relatorio:BLOCO_CABECALHO != NIL
//
// -> Executa bloco de desvio de cabecalho
EVAL( relatorio:BLOCO_CABECALHO )
ELSE
CAB_FICHA()
ENDIF
ENDIF
//
// -> Pre conteudo
FOR CONTAR := 1 TO LEN( relatorio:PRE_CONTEUDO )
EVAL( relatorio:PRE_CONTEUDO[ CONTAR ] )
NEXT
//
// -> Imprime o conteudo do relatorio
FOR CONTAR := 1 TO LEN( relatorio:CONTEUDO )
RESULTADO := EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] )
TIPO := VALTYPE( EVAL( relatorio:CONTEUDO[ CONTAR ][ _DADOS ] ) )
TAM_CAB := LEN( TRIM( relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ] ) )
IF TAM_CAB > 0
TAM_CAB++
@ relatorio:LINHA + LI_NHAS[ CONTAR ], CO_LUNAS[ CONTAR ] SAY;
TRIM( relatorio:CONTEUDO[ CONTAR ][ _CABECALHO ] )
ENDIF
IF TIPO = "M"
TAM_MEMO := MLCOUNT( RESULTADO, relatorio:MEMO_LARGURA )
FOR CONTADOR := 1 TO TAM_MEMO
@ relatorio:LINHA + LI_NHAS[ CONTAR ], CO_LUNAS[ CONTAR ] + TAM_CAB;
SAY MEMOLINE( RESULTADO, relatorio:MEMO_LARGURA, CONTADOR )
relatorio:LINHA++
IF relatorio:LINHA + LI_NHAS[ CONTAR ] > relatorio:LIN_INFERIOR
relatorio:LINHA := relatorio:LIN_SUPERIOR
IF relatorio:BLOCO_CABECALHO != NIL
//
// -> Executa bloco de desvio de cabecalho
EVAL( relatorio:BLOCO_CABECALHO )
ELSE
CAB_FICHA()
ENDIF
ENDIF
NEXT
IF TAM_MEMO > 0; relatorio:LINHA--; ENDIF
ELSE
IF LEN( relatorio:CONTEUDO[ CONTAR ] ) = MAS_CARA
@ relatorio:LINHA + LI_NHAS[ CONTAR ], CO_LUNAS[ CONTAR ] +;
TAM_CAB SAY RESULTADO PICT relatorio:CONTEUDO[ CONTAR ][ MAS_CARA ]
ELSE
@ relatorio:LINHA + LI_NHAS[ CONTAR ], CO_LUNAS[ CONTAR ] +;
TAM_CAB SAY RESULTADO
ENDIF
ENDIF
NEXT
//
// -> Caso nao exista campos do tipo MEMO sendo impresso
relatorio:LINHA += TAM_SALTO
@ ++relatorio:LINHA, 01 SAY;
REPL( relatorio:SEP_CABECALHO, relatorio:LARGURA )
SKIP
//
// -> Verifica se a impressao ultrapassa a margem inferior ou se o
// final do arquivo foi encontrado
IF relatorio:LINHA + TAM_SALTO > relatorio:LIN_INFERIOR
//
// -> Reinicia controle de linha
relatorio:LINHA := relatorio:LIN_SUPERIOR
ENDIF
ENDDO
EJECT
SET DEVI TO SCREEN
IF relatorio:SAIDA = "A"
SET PRINTER TO
ELSEIF relatorio:SAIDA = "T" .AND. SAIDA = "S"
SET PRINTER TO
//
// -> Mostra relatorio na tela
IMP_TELA( relatorio:LARGURA + 1 )
ENDIF
relatorio:LIMPA()
RETURN NIL

FUNCTION CAB_FICHA
//
// -> Determina o tipo de caracter para impressao
IF relatorio:SAIDA != "T"
IF relatorio:REDUCAO != NIL
@ 00, 01 SAY relatorio:REDUCAO
ENDIF
AJUSTE( relatorio:LARGURA, IIF( TIPO_FORMULARIO = "0", "80", "132" ) )
ENDIF
//
// -> Imprime o cabecalho do relatorio
IF LEN( relatorio:TITULOS ) > 0
@ relatorio:LINHA, 01 SAY EVAL( relatorio:TITULOS[ 1 ] )
ENDIF
@ relatorio:LINHA, relatorio:LARGURA - 13 SAY;
"Pagina: " + STRZERO( relatorio:PAGINA, 4 )
relatorio:PAGINA++
IF LEN( relatorio:TITULOS ) > 1
@ ++relatorio:LINHA, 01 SAY EVAL( relatorio:TITULOS[ 2 ] )
ENDIF
@ relatorio:LINHA, relatorio:LARGURA - 13 SAY;
"Data: " + DTOC( DAT_HOJE )
//
// -> Verifica se existem mais titulos a serem impresso
FOR CONTAR := 3 TO LEN( relatorio:TITULOS )
@ ++relatorio:LINHA, 01 SAY EVAL( relatorio:TITULOS[ CONTAR ] )
NEXT
relatorio:LINHA++
@ ++relatorio:LINHA, 01 SAY;
REPL( relatorio:SEP_CABECALHO, relatorio:LARGURA )
RETURN NIL

FUNCTION IMP_ETQ
RETURN NIL

/* Final do programa RECIBREL.PRG */

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

01/03/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

O Menu De

Manutenção

/*
TITULO : Emissao de recibos
DATA : 24/02/21
PROGRAMA : RECIBC02.PRG
COMENTARIO : MANUTENCAO (Recibos)
*/

#include "RECIB.CH"
#include "RECIBMOU.CH"
SET DELETED OFF
M->MOSTRA_RESULTADO := .T.
**
**BI [INI] C02.B01
**BI [FIM] C02.B01
**
MENSAGEM( "Aguarde abertura de arquivos" )
SELE 1
IF !USEREDE( "RECIB", .F., 10 )
BEEP()
MENSAGEM( "O arquivo RECIB näo está disponível", 3 )
RETURN
ELSE
SET INDEX TO RECIB001, RECIB002
ENDIF
SELE RECIB
**
**BI [INI] C02.B02
**BI [FIM] C02.B02
**
SET ORDER TO 2
PRIVATE NUMERO, RECIBO, VALOR, RECEBI, ENDERECO, IMPORT1, IMPORT2, REFERENTE,;
REFERENT2, MAIORCLARE, CIDESTDAT, EMITENTE, CPFRG, ENDERECO2, ASSINATURA
COR( "MENU" )
@ LIN_MENU, 00
@ LIN_MENU,01 SAY "Manutençäo │ Recibos"
JANELA( 03, 02, 21, 77, "Recibos" )
L_CON := L_SOM; C_CON := C_SOM
//
// -> Monta janela do TBROWSE
COR( "MENU" )
@ 05, 04 CLEAR TO 19, 75
@ 05, 04 SAY SUBS( TB_JANELA, 1, 1 ) +;
REPL( SUBS( TB_JANELA, 2, 1 ), 70 ) + SUBS( TB_JANELA, 3, 1 )
@ 06, 04 SAY SUBS( TB_JANELA, 12, 1 )
@ 06, 75 SAY SUBS( TB_JANELA, 4, 1 )
@ 07, 04 SAY SUBS( TB_JANELA, 11, 1 )
@ 07, 75 SAY SUBS( TB_JANELA, 5, 1 )
FOR CONTAR = 8 TO 18
@ CONTAR, 04 SAY SUBS( TB_JANELA, 10, 1 )
@ CONTAR, 75 SAY SUBS( TB_JANELA, 6, 1 )
NEXT
@ 19, 04 SAY SUBS( TB_JANELA, 9, 1 ) +;
REPL( SUBS( TB_JANELA, 8, 1 ), 70 ) + SUBS( TB_JANELA, 7, 1 )
//
// -> Define as rotinas a serem usadas pelo TBROWSE
ROTI_NAS := { { | X | CARREG02( X ) },;
{ | X | CARGET02( X ) },;
{ || SALVAR02() } }
GRA_VAR := {}
//
// -> Define as colunas para o TBROWSE
OB_COLUN := {}
AADD( OB_COLUN, TBCOLUMNNEW( "Numero Do Recibo", { || RECIB->NUMERO } ) )
AADD( OB_COLUN, TBCOLUMNNEW( "Valor Do Recibo", { || RECIB->VALOR } ) )
AADD( OB_COLUN, TBCOLUMNNEW( "Quem Esta Dando o Dinheiro", { || RECIB->RECEBI } ) )
AADD( OB_COLUN, TBCOLUMNNEW( "Quem Esta Dando o Recibo", { || RECIB->EMITENTE } ) )
//
// -> Mostra a tela BROWSE e sai retornando o controle ao programa
BRO_WSE( .T. )
M->RECEBI := SPACE( 58 )
ED_JAN := {}
AADD( ED_JAN, { "Quem Pagou:", M->RECEBI, "@!", 58,;
{ | DADOS | M->RECEBI := DADOS } } )
**
**BI [INI] C02.B03
**BI [FIM] C02.B03
**
WHILE .T.
**
**BI [INI] C02.B04
**BI [FIM] C02.B04
**
IF EDIT_JAN( ED_JAN ) = .F.
EXIT
ENDIF
SEEK TRIM( M->RECEBI )
IF EOF()
BEEP()
MENSAGEM( "Dados näo encontrados", 3 )
LOOP
ENDIF
MENSAGEM( "Posicione sobre o registro desejado e tecle " )
//
// -> Edita tela BROWSE
BRO_WSE()
ENDDO
SET DELETED ON
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, MAXROW() - 1, MAXCOL(), TELA_PRI )
MOUSE( LIGA )
SET DELETED ON
**
**BI [INI] C02.B05
**BI [FIM] C02.B05
**

/* Final do programa RECIBC02.PRG */

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

27/02/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

A Minha Nova Rotina

De Help

/*
TITULO : Emissao de recibos
DATA : 24/02/21
PROGRAMA : RECIBSOS.PRG
COMENTARIO : ROTINA DE HELP
*/

#include "RECIB.CH"
#include "RECIBMOU.CH"
//
FUNCTION HELP( PROG, LIN, VAR )
//
// -> Rotina de auxilio ao usuario
IF PROG == "HELP" .OR. PROG == "MEMOEDIT" .OR. PROG == "__XHELP"
RETURN .F.
ENDIF
CUR_SOS := SETCURSOR()
MOUSE( LIGA )
**
**BI [INI] SOS.B01
**BI [FIM] SOS.B01
**
SETKEY( T_F3, NIL )
SETKEY( T_F4, NIL )
SETKEY( T_F6, NIL )
IF SUBS(PROG,1,6) == "CARGET"
***
*** Inicio do bloco de substituiçäo SOS07.B
SOS := ""
SOS( "" )
SOS( " TECLAS DE CONTROLE DO PROGRAMA" )
SOS( " ──────────────────────────────" )
SOS( "" )
SOS( " F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-" )
SOS( " nuseio do aplicativo." )
SOS( "" )
SOS( " F3 > Apresenta Calendário." )
SOS( "" )
SOS( " F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-" )
SOS( " temáticas." )
SOS( "" )
SOS( "" )
SOS( " TECLAS DE CONTROLE DE EDIÇÄO" )
SOS( " ────────────────────────────" )
SOS( "" )
SOS( " Enter : Efetua a entrada de dados." )
SOS( " Setas : Movimentam o cursor para a direçäo indicada." )
SOS( " Home : Move o cursor para o início do campo." )
SOS( " End : Move o cursor para o final do campo." )
SOS( " <-- :="" apaga="" o="" caracter="" a="" esquerda="" do="" cursor="" strong="">
SOS( " Ins : Liga ou Desliga o modo de inserçäo de caracteres." )
SOS( " Del : Apaga o caracter sob o cursor." )
SOS( " CTRL T : Apaga a palavra à direita do cursor." )
SOS( " CTRL Y : Apaga todo o conteúdo de um campo." )
SOS( " Esc : Abandona a Ediçäo." )
ELSEIF PROG == "ACHOICE"
***
*** Inicio do bloco de substituiçäo SOS08.B
SOS := ""
SOS( "" )
SOS( " TECLAS DE CONTROLE DO PROGRAMA" )
SOS( " ──────────────────────────────" )
SOS( "" )
SOS( " F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-" )
SOS( " nuseio do aplicativo." )
SOS( "" )
SOS( " F3 > Apresenta Calendário." )
SOS( "" )
SOS( " F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-" )
SOS( " temáticas." )
SOS( "" )
SOS( "" )
SOS( " TECLAS DE NAVEGAÇÄO DO MENU" )
SOS( " ───────────────────────────" )
SOS( "" )
SOS( " Seta p/cima : Retorna a opçäo anterior." )
SOS( "" )
SOS( " Seta p/baixo : Acesso a opçäo seguinte." )
SOS( "" )
SOS( " PgUp : Retorna a página anterior." )
SOS( "" )
SOS( " PgDn : Acesso a página seguinte." )
SOS( "" )
SOS( " Enter : Confirma opçäo escolhida." )
SOS( "" )
SOS( " Esc : Retorna." )
*** Final do bloco de substituiçäo SOS08.B
***
ELSEIF SOS_MENU == "CALENDARIO"
***
*** Inicio do bloco de substituiçäo SOS01.B
SOS := ""
SOS( " " )
SOS( " " )
SOS( " MANUSEIO DO CALENDARIO" )
SOS( " ──────────────────────" )
SOS( " " )
SOS( " (+) Mês : Passa para o próximo mês." )
SOS( " " )
SOS( " (-) Mês : Volta para o mês anterior." )
SOS( " " )
SOS( " (+) Ano : Passa para o próximo ano." )
SOS( " " )
SOS( " (-) Ano : Volta para o ano anteiror." )
SOS( " " )
SOS( " Ano : Permite definir o ano desejado." )
*** Final do bloco de substituiçäo SOS01.B
***
ELSEIF PROG == "CALCULADORA"
***
*** Inicio do bloco de substituiçäo SOS02.B
SOS := ""
SOS( " " )
SOS( " TECLAS DE CONTROLE DA CALCULADORA" )
SOS( " ─────────────────────────────────" )
SOS( " " )
SOS( " * : Sinal de multiplicaçäo." )
SOS( " " )
SOS( " / : Sinal de divisäo." )
SOS( " " )
SOS( " + : Sinal de soma." )
SOS( " " )
SOS( " - : Sinal de subtraçäo." )
SOS( " " )
SOS( " E : Cancela o último valor digitado na calculadora." )
SOS( " " )
SOS( " C : Zera a calculadora." )
SOS( " " )
SOS( " Esc : Abandona o manuseio da calculadora." )
SOS( " " )
SOS( " ou = : Sinal de igualdade." )
SOS( " " )
SOS( " Ctrl + setas : Move a calculadora na tela." )
*** Final do bloco de substituiçäo SOS02.B
***
ELSEIF PROG == "DBEDIT" .AND. SOS_MENU != "RELATORIO"
***
*** Inicio do bloco de substituiçäo SOS05.B
SOS := ""
SOS( "" )
SOS( " TECLAS DE CONTROLE DO PROGRAMA" )
SOS( " ──────────────────────────────" )
SOS( "" )
SOS( " F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-" )
SOS( " nuseio do aplicativo." )
SOS( "" )
SOS( " F3 > Apresenta Calendário." )
SOS( "" )
SOS( " F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-" )
SOS( " temáticas." )
SOS( "" )
SOS( "" )
SOS( " TECLAS DE CONTROLE DA MANUTENCOES" )
SOS( " ─────────────────────────────────" )
SOS( "" )
SOS( " Seta p/cima : Move para o registro anterior." )
SOS( "" )
SOS( " Seta p/baixo : Move para o registro seguinte." )
SOS( "" )
SOS( " PgUp : Move para a página anterior." )
SOS( "" )
SOS( " PgDn : Move para a página seguinte." )
SOS( "" )
SOS( " Home : Move para o início do arquivo." )
SOS( "" )
SOS( " End : Move para o final do arquivo." )
SOS( "" )
SOS( " Enter : Apresenta o conteúdo do registro." )
SOS( "" )
SOS( " Esc : Finaliza manutençäo." )
*** Final do bloco de substituiçäo SOS05.B
***
ELSE
***
*** Inicio do bloco de substituiçäo SOS06.B
SOS := ""
SOS( "" )
SOS( " TECLAS DE CONTROLE DO PROGRAMA" )
SOS( " ──────────────────────────────" )
SOS( "" )
SOS( " F1 > Auxílio ao Usuário - Apresenta ao usuário informaçöes para ma-" )
SOS( " nuseio do aplicativo." )
SOS( "" )
SOS( " F3 > Apresenta Calendário." )
SOS( "" )
SOS( " F4 > Calculadora - Possibilta cálculos com as quatro operaçöes ma-" )
SOS( " temáticas." )
*** Final do bloco de substituiçäo SOS06.B
***
ENDIF
SOMBRA( L_HEL := L_SOM, C_HEL := C_SOM, .T. )
MOUSE( DESLIGA )
SAVE SCREEN
MOUSE( LIGA )
COR := SETCOLOR()
CURSOR( DESLIGA )
JANELA( 03, 02, 21, 77, "Auxilio ao usuário" )
SETCOLOR( CONTECOR[ 4 ] + "," + CONTECOR[ 4 ] )
**
**BI [INI] SOS.B08
**BI [FIM] SOS.B08
**
MEMOEDIT( SOS, 04, 04, 20, 75, .F. )
SETCOLOR( COR )
SETCURSOR( CUR_SOS )
MOUSE( DESLIGA )
RESTORE SCREEN
MOUSE( LIGA )
SOMBRA( L_HEL, C_HEL )
SETKEY( T_F3, { || CALEN() } )
SETKEY( T_F4, { || CALCU() } )
**
**BI [INI] SOS.B09
**BI [FIM] SOS.B09
**

/* Final do programa RECIBSOS.PRG */

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

26/02/2021

Digitação Da Criação

Do DBF!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Role Para Cima

O Texto Que Está

Em Azul!!!

 

Update:

25/02/2021

Meu PRG De Menu Principal:

PRG - Menu Principal!!!

/*
TITULO     : Emissao de recibos
DATA       : 24/02/21
PROGRAMA   : RECIB.PRG
COMENTARIO : MENU PRINCIPAL
*/

#include "RECIB.CH"
#include "RECIBMOU.CH"
**
**BI [INI] MENU.B01
**BI [FIM] MENU.B01
**
//
// -> Matriz ultilizada pelo objeto menu
ObjMenu := menu:LIMPA()
//
// -> Matriz ultilizada pelo objeto botao
ObjBotao := botao:LIMPA()
//
// -> Matriz ultilizada pelo objeto relatorio
ObjRelatorio := relatorio:LIMPA()
//
// ->            Arq. NTX, Arq. DBF, Chave, Area, Ordem
IN_DICES := {}
AADD( IN_DICES, { "RECIB001.NTX", "RECIB", "NUMERO", 1, 1 } )
AADD( IN_DICES, { "RECIB002.NTX", "RECIB", "RECEBI", 1, 2 } )
**
**BI [INI] FUN.B02
**BI [FIM] FUN.B02
**
//
AMBIENTE()
//
// -> Posicao do ultimo menu
POS_ULT_MENU := 0
//
// -> Variavel de controle do papel de parede
FUNDO := 1
//
// -> Controle de cores
NOMECOR := { "FUNDO DA TELA",;
             "MENU",;
             "DESTAQUE DO MENU",;
             "JANELA DE DIALOGO",;
             "BOX DA JANELA DE DIALOGO",;
             "BOTOES",;
             "BOTAO EM DESTAQUE",;
             "GETS",;
             "GET EM DESTAQUE",;
             "TELA DE APRESENTACAO",;
             "CARACTERES AVULSOS",;
             "CERCADURAS",;
             "TITULO" }
CONTECOR := {}
//
// -> Ativa o calendario na tecla F3
SETKEY( T_F3, { || CALEN() } )
//
// -> Ativa a calculadora na tecla F4
SETKEY( T_F4, { || CALCU() } )
MOV_LINHA := 5; MOV_COLUNA := 9
CON_ARQ := "EMILIA.IMP"
TIPO_FORMULARIO := "0"
DECLARE FOR_MULARIO[ 99 ]
AFILL( FOR_MULARIO, "0" )
IF FILE( "RECIB.CFG" )
   //
   // -> Restaurando configuracao
   VAR := MEMOREAD( "RECIB.CFG" )
   //
   // -> Cores
   FOR CONTAR = 1 TO 12
      AADD( CONTECOR, SUBS( VAR, ( CONTAR * 5 ) - 4, 5 ) )