Translate this Page

Rating: 4.4/5 (174 votos)

ONLINE
2

 

 

 

 *****

Sempre

Em

Constante

Atualização!

*****

(Brasil)

Campo Grande

(MS)

*****
Copyright

by

Claudionor

Araújo

da

Silva

 

Obrigado Pela Visita!!!

Última

Publicação

No

Google:

2021-06-17

3:29:43 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:

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 ) )
   NEXT
   //
   // -> Posicao da Calculadora
   MOV_LINHA := VAL( SUBS( VAR, 61, 2 ) )
   MOV_COLUNA := VAL( SUBS( VAR, 63, 2 ) )
   //
   // -> Fundo da tela
   FUNDO := VAL( SUBS( VAR, 69, 2 ) )
   //
   // -> Cor do titulo
   AADD( CONTECOR, SUBS( VAR, 72, 5 ) )
   //
   // -> Dados de impressao
   IF LEN( TRIM( SUBS( VAR, 77, 12 ) ) ) > 0
      CON_ARQ := TRIM( SUBS( VAR, 77, 12 ) )
   ENDIF
   FOR CONTAR := 1 TO 99
      FOR_MULARIO[ CONTAR ] := SUBS( VAR, 88 + CONTAR, 1 )
   NEXT
ELSE
   PADRAO()
ENDIF
REDUCAO_ETQ := 1
IMPRESSORA := {}
IMP_ARQ := {}
NOME_IMP := ""
CONTADOR := ADIR( "*.IMP" )
IF CONTADOR != 0
   DECLARE ARQS_IMP[ CONTADOR ]
   ADIR( "*.IMP", ARQS_IMP )
   FOR CONTADOR := 1 TO LEN( ARQS_IMP )
      VAR := TRIM( MEMOLINE( MEMOREAD( ARQS_IMP[ CONTADOR ] ), 80, 1 ) )
      AADD( IMP_ARQ, { VAR, ARQS_IMP[ CONTADOR ] } )
   NEXT
ENDIF
LER_IMP( CON_ARQ )
TELA_ENT()
TITU_LO := "Emissao de recibos"
**
**BI [INI] MENU.B08
**BI [FIM] MENU.B08
**
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
MENU_P := 1; X := 1
M->SOS_MENU := " "
***
*** Inicio do bloco de substituiçäo MENUPRI1.B
BUFFER := CHR( T_ENTER )
MENU_PRI := { "Cadastros",;
              "Manutençöes",;
              "Relatórios",;
              "Utilitários",;
              "Saida" }
COL_MENU := 2
COR( "MENU" )
MENU_POS := {}
AEVAL( MENU_PRI, { | MATRIZ | AADD( MENU_POS, COL_MENU),;
       SETPOS( LIN_MENU, COL_MENU ), QQOUT( " " + MATRIZ + " " ),;
       COL_MENU += LEN( MATRIZ ) + 2 } )
*** Final do bloco de substituiçäo MENUPRI1.B
***
MOUSE( DESLIGA )
TELA_PRI := SAVESCREEN( LIN_MENU + 1, 00, 23, 79 )
MOUSE( LIGA )
//
// - > Grava a ultima sombra
C_SOM := ""; L_SOM := ""
//
// Desativa acesso exclusivo permitindo acesso multiusuario
SET EXCLUSIVE OFF
M->DAT_HOJE := DATE()
***
*** Inicio do bloco de substituiçäo AT_DATA.B
//
// -> Rotina de atualizaçäo de data
MENSAGEM( "Digite a data" )
JANELA( 06, 17, 18, 61, "Atualizaçäo de data" )
botao:ADD( 15, 34, "Enter   " )
botao:MOSTRA()
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    " +;
             "Julho    Agosto   Setembro Outubro  Novembro Dezembro "
M->DIA_EXT += " de " + TRIM( SUBS( ME_SES, MONTH( DAT_HOJE ) * 9 - 8 , 9 ) ) +;
              " de " + 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
CURSOR( LIGA )
READ
CURSOR( DESLIGA )
IF LASTKEY() = T_ENTER
   botao:MOVIMENTA( 15, 34, "Enter   " )
ENDIF
MOUSE( DESLIGA )
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
MOUSE( LIGA )
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
**
**BI [INI] MENU.B02
**BI [FIM] MENU.B02
**
WHILE .T.
   **
   **BI [INI] MENU.B03
   **BI [FIM] MENU.B03
   **
   ***
   *** Inicio do bloco de substituiçäo MENUPRI2.B
   COR( "MENU" ); @ LIN_MENU, 00
   MOUSE( DESLIGA )
   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
   MOUSE( LIGA )
   BUFFER := CHR( T_ENTER )
   *** Final do bloco de substituiçäo MENUPRI2.B
   ***
   **
   **BI [INI] MENU.B04
   **BI [FIM] MENU.B04
   **
   IF MENU_P = 1
      RECIBINC()
   ELSEIF MENU_P = 2
      RECIBCON()
   ELSEIF MENU_P = 3
      RECIBREL()
   ELSEIF MENU_P = 4
      MENSAGEM( "Tecle  para sair" )
      menu:ADD( "~Reorganizar", INDICES( .T. ) )
      menu:ADD( "~Exclusäo fisica", EXCLUIR() )
      menu:ADD( "-" )
      menu:ADD( ">~Papel de parede", FUNDO( 1 ) )
      menu:ADD( ">~Configuraçäo de cores", CONFCOR() )
      menu:ADD( "C~onfiguraçäo padräo", CONFPADRAO() )
      **
      **BI [INI] MENU.B05
      **BI [FIM] MENU.B05
      **
      menu:RODA()
   ELSEIF MENU_P = 5
      menu:ADD( "~Fim de execuçäo" )
      IF menu:RODA() = 1
         IF PERGUNTA( "Confirma o encerramento ?" ) = "S"
            EXIT
         ENDIF
      ENDIF
   ENDIF
ENDDO
MOUSE( DESLIGA )
//
// -> Salvando configuracao
VAR := ""
//
// -> Cores
FOR CONTAR = 1 TO 12
   VAR += CONTECOR[ CONTAR ]
NEXT
//
// -> Posicao da Calculadora
VAR += STR( MOV_LINHA, 2 ) + STR( MOV_COLUNA, 2 )
VAR += "FF  "
//
// -> Fundo da tela
VAR += STR( FUNDO, 2 )
VAR += "A"
//
// -> Cor do titulo
VAR += CONTECOR[ 13 ]
//
// -> Dados de impressao
VAR += PADR( CON_ARQ, 12 )
FOR CONTAR := 1 TO 99
   VAR += FOR_MULARIO[ CONTAR ]
NEXT
//
// -> Gravando configuracao
MEMOWRIT( "RECIB.CFG", VAR )
SETCOLOR( "W" )
CLS
**
**BI [INI] MENU.B06
**BI [FIM] MENU.B06
**

FUNCTION LER_IMP( ARQUIVO )
IF FILE( ARQUIVO  )
   DADOS := MEMOREAD( ARQUIVO )
ELSE
   RETURN .F.
ENDIF
IMPRESSORA := {}
TAMANHO := MLCOUNT( DADOS, 70 )
NOME_IMP := ALLTRIM( MEMOLINE( DADOS, 80, 1 ) )
FOR CONTAR := 2 TO TAMANHO
   DADO_IMP := {}
   VAR := MEMOLINE( DADOS, 70, CONTAR )
   POSICAO := AT( "[", VAR )
   LARGURA := { VAL( SUBS( VAR, 1, 3 ) ), VAL( SUBS( VAR, 5, 3 ) ) }
   VAR := SUBS( VAR, POSICAO + 1 )
   VAR := SUBS( VAR, 1, LEN( VAR ) - 1 )
   WHILE AT( ",", VAR ) != 0
      POSICAO := AT( ",", VAR )
      AADD( DADO_IMP, VAL( ALLTRIM( SUBS( VAR, 1, POSICAO - 1 ) ) ) )
      VAR := SUBS( VAR, POSICAO + 1 )
   ENDDO
   AADD( DADO_IMP, VAL( ALLTRIM( VAR ) ) )
   AADD( IMPRESSORA, { LARGURA, DADO_IMP } )
NEXT
RETURN .T.

FUNCTION EXCLUIR
IF PERGUNTA( "Confirma a exclusäo fisica dos registros ?", "N" ) = "N"
   RETURN .F.
ELSE
   CLOSE DATABASES
   AQ_PACK := { "RECIB" }
   AEVAL( AQ_PACK, { | MATRIZ | FUN_PACK( MATRIZ ) } )
   INDICES( .T., .T. )
ENDIF
RETURN NIL

FUNCTION FUN_PACK( AQ_DBF )
MENSAGEM( "Compactando o arquivo " + AQ_DBF )
IF USEREDE( AQ_DBF, .T., 10 )
   PACK
   USE
ELSE
   BEEP()
   MENSAGEM( "O arquivo " + AQ_DBF + " näo esta disponível", 3 )
ENDIF
RETURN NIL

FUNCTION CONFPADRAO
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 M->DAT_HOJE
   MOUSE( DESLIGA )
   TELA_PRI := SAVESCREEN( LIN_MENU + 1, 00, 23, 79 )
   MOUSE( LIGA )
ENDIF
RETURN NIL

FUNCTION JANELA( PJAN1, PJAN2, PJAN3, PJAN4, PJAN5 )
IF PCOUNT() != 5
   PJAN5 := ""
ENDIF
SOMBRA( PJAN1, PJAN2, PJAN3, PJAN4 )
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 DATE BRIT
SET BELL OFF
SET SCORE OFF
SET WRAP ON
CURSOR( DESLIGA )
SET DELETED ON
SETKEY( T_INSERT, { || INS_CUR() } )
//
// -> Inicializa mouse
MOUSE()
//
// -> Liga cursor do mouse
MOUSE( LIGA )
**
**BI [INI] MENU.B07
**BI [FIM] MENU.B07
**
RETURN .F.

FUNCTION INS_CUR
//
// -> Funcao de manipulacao do cursor ( NORMAL / INSERCAO )
IF SETCURSOR() != 0
   READINSERT( !READINSERT() )
   CURSOR( LIGA )
ENDIF

FUNCTION TELA_ENT( PAR )
//
// -> Tela de apresentacao
IF PCOUNT() > 0
   @ 01 + LIN_MENU, 00 CLEAR TO 23, 79
ENDIF
IF PCOUNT() = 0
   COR( "TELA DE APRESENTACAO" )
   CLS
ENDIF

IF PCOUNT() = 0
MOUSE( DESLIGA )
INKEY( 7 )
MOUSE( LIGA )
ENDIF
RETURN .T.

FUNCTION PADRAO
CONTECOR := { "09/01",;
"00/07",;
"15/04",;
"07/01",;
"00/03",;
"00/07",;
"15/07",;
"00/07",;
"15/04",;
"15/01",;
"07/01",;
"07/01",;
"15/03" }
RETURN .T.

FUNCTION PERG( TEX_TO, RES_POSTA )
//
// -> Funcao que executa uma pergunta
LOCAL LI, SIM_NAO, CUR_PERG := SETCURSOR()
COR( "MENU" )
CURSOR( DESLIGA )
IF PCOUNT() = 1; RES_POSTA := "S"; ENDIF
SIM_NAO := IIF( RES_POSTA = "N", 2, 1 )
@ 24, 11 SAY SPACE( 58 )
LI := ( 80 - ( LEN( TEX_TO ) + 11 ) ) / 2
@ 24, LI SAY TEX_TO
LI += LEN( TEX_TO ) + 2
WHILE .T.
@ 24, LI PROMPT "Sim"
@ 24, LI + 6 PROMPT "Näo"
@ 24, LI + 4 SAY "-"
MENU TO SIM_NAO
IF SIM_NAO != 0
EXIT
ENDIF
ENDDO
SETCURSOR( CUR_PERG )
RETURN IIF( SIM_NAO = 1, "S", "N" )

/* Final do programa RECIB.PRG */

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

24/02/2021

Uma Nova Versão Do Programa Receb Foi Programada No Clipper. Recib Segue o Modelo Da Folha De Recibo Da Tilibra!!! Esse é o Vigésimo Sistema Em Clipper Que Está Postado No Domínio titio.info!!! 

020- Download do Recib!!!

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update:

23/02/2021

Download - Atualização Dos Códigos!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

22/02/2021

Para A Direita

E Para A Esquerda,

Role O Texto

Que Está Em

Azul!!!

O Código HTML

Do

Botão do WhatsApp!!!

 

Position: Fixed Or Absolute

Use Right / Left / Center

 

          coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

20/02/2021

Uma Super Apostila

De Clipper 5.2!!!

Download - PDF - CLIPPER 5.2

 

   coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

18/02/2021

 

Role Para Cima

O Texto Que Está

Em Azul!!!

O Código Da Data

E Da Hora Atual

Pra Centralizar

Use o Código

Center

Antes e Depois Do Código

HTML!!! 

Exibir Data e Hora Em HTML:

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update2:

17/02/2021

Execução Do CCBASE:

 

Se o DBF, o DBT e o NTX

Estiverem Dentro Da

Pasta CCBASE,

Ao Abrir o DBF, o NTX

Deverá Ser Aberto!!!

Download - [CCBASE - by titio.info]  

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update1:

17/02/2021

Quatro Sistemas Em Delphi

Que Vão Rodar No

Windows 10,

Após a Instalação Do

Delphi 7:

[De 001 Até 004 - Delphi]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update2:

16/02/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

PRG De Funções

[Parte I e Parte II]

/*
TITULO : Diario
DATA : 12/02/21
PROGRAMA : DIARYFU1.PRG
COMENTARIO : FUNCOES - PARTE 1
*/

#include "DIARY.CH"
#include "DIARYMOU.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 := { " DIARY -> [ ] " }
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 LIN_MEMO( CAM_PO, LAR_GURA )
//
// -> Retorna uma linha do campo MEMO
RETURN MEMOLINE( CAM_PO, LAR_GURA, 1 )

FUNCTION SET_CONF
LOCAL CFG_X, CFG_Y, CFG_COR, TEL_CONF, TEC_CONF, CUR_CFG := SETCURSOR()
MOUSE( LIGA )
SETKEY( T_F6, NIL )
M->CFG_X := ROW(); M->CFG_Y := COL(); M->CFG_COR := SETCOLOR()
SOMBRA( L_CFG := L_SOM, C_CFG := C_SOM, .T. )
MOUSE( DESLIGA )
M->TEL_CONF := SAVESCREEN( 06, 16, 19, 62 )
MOUSE( LIGA )
CURSOR( DESLIGA )
JANELA( 06, 18, 18, 62, "Configuraçäo" )
COR( "MENU" )
@ 09, 23 CLEAR TO 13, 57
botao:ADD( 15, 44, "Esc " )
WHILE .T.
botao:ADD( 15, 27, "Enter " )
botao:MOSTRA()
SETCOLOR( CONTECOR[ 2 ] + "," + CONTECOR[ 7 ] )
@ 10, 25 PROMPT "[" + IIF( CNF_CON, "x", " " ) + "] Confirmaçäo para entradas "
@ 11, 25 PROMPT "[" + IIF( CNF_REP, "x", " " ) + "] Repetiçäo de registros "
@ 12, 25 PROMPT "[" + IIF( CNF_DEL = " ", " ", "x" ) + "] Delimitadores para entradas"
MENU TO M->TEC_CONF
IF M->TEC_CONF = 0
botao:MOVIMENTA( 15, 44, "Esc " )
EXIT
ELSE
botao:MOVIMENTA( 15, 27, "Enter " )
ENDIF
IF M->TEC_CONF = 1
M->CNF_CON := IIF( M->CNF_CON, .F., .T. )
IF M->CNF_CON
SET CONFIRM ON
ELSE
SET CONFIRM OFF
ENDIF
ELSEIF M->TEC_CONF = 2
M->CNF_REP := IIF( M->CNF_REP, .F., .T. )
M->CNF_XXX := IIF( M->CNF_REP, .F., .T. )
ELSEIF M->TEC_CONF = 3
M->CNF_DEL := IIF( M->CNF_DEL = " ", "[]", " " )
IF M->CNF_DEL = " "
SET DELIMITERS OFF
ELSE
SET DELIMITERS ON
SET DELIMITERS TO M->CNF_DEL
ENDIF
ENDIF
ENDDO
MOUSE( DESLIGA )
RESTSCREEN( 06, 16, 19, 62, M->TEL_CONF )
MOUSE( LIGA )
SETCOLOR( M->CFG_COR )
SETCURSOR( CUR_CFG )
SOMBRA( L_CFG, C_CFG )
SETPOS( M->CFG_X, M->CFG_Y )
SETKEY( T_F6, { || SET_CONF() } )

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 EDITOR
PARA ME_VAR, ME_COM, ALTE_RA
//
// -> Funcao que edita campos do tipo "MEMO"
IF ALTE_RA = NIL; ALTE_RA := .T.; ENDIF
IF M->ME_MO != "[memo]"
M->ME_MO := "[memo]"
RETURN .F.
ENDIF
IF LASTKEY() = T_ENTER .OR. !ALTE_RA
MOUSE( DESLIGA )
SAVE SCREEN TO TELA
MOUSE( LIGA )
SOMBRA( L_EDITOR := L_SOM, C_EDITOR := C_SOM, .T. )
MENSAGEM( "Tecle para finalizar a ediçäo" )
JANELA( 12, 02, 21, 77, ALLTRIM( ME_COM ) )
@ 21, 05 SAY "Linha"
@ 21, 19 SAY "Coluna"
M->INS_ERT := READINSERT()
IF M->INS_ERT
@ 21, 31 SAY "Insert"
ENDIF
ME_VAR = MEMOEDIT( ME_VAR, 13, 03, 20, 76, ALTE_RA, "FUNMEMO" )
COR( "GETS" )
L_SOM := L_EDITOR; C_SOM := C_EDITOR
MOUSE( DESLIGA )
RESTORE SCREEN FROM TELA
MOUSE( LIGA )
ENDIF
RETURN .T.

FUNCTION FUNMEMO( MODO, LINHA, COLUNA )
//
// -> Funcao de usuario para campo memo
IF LASTKEY() = T_ESC .AND. ALTE_RA
BEEP()
IF PERG( "Confirma atualizaçäo do campo memo ?" ) = "S"
MENSAGEM( "Tecle para retornar" )
RETURN T_CTRL_W
ELSE
MENSAGEM( "Tecle para retornar" )
RETURN T_ESC
ENDIF
ENDIF
COR( "BOX DA JANELA DE DIALOGO" )
IF LASTKEY() = T_INSERT .AND. ALTE_RA
IF M->INS_ERT
M->INS_ERT := .F.
@ 21, 31 SAY " "
ELSE
M->INS_ERT := .T.
@ 21, 31 SAY "Insert"
ENDIF
ENDIF
@ 21, 11 SAY STRZERO( LINHA, 5 )
@ 21, 26 SAY STRZERO( COLUNA + 1, 2 )
COR( "JANELA DE DIALOGO" )
RETURN 0

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 DIARYFU1.PRG */

 

Download - Funções - Parte 2

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update1:

16/02/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

Um PRG De Menu

Principal

A Criação Da Tela