Translate this Page

Rating: 4.6/5 (17 votos)

ONLINE
1

 

 

 

 *****

Sempre

Em

Constante

Atualização!

*****

(Brasil)

(Campo Grande)

(MS)

*****
Copyright

by

Claudionor

Araújo

da

Silva

 

Obrigado Pela Visita!!!

Última

Publicação

No

Google:

2021-02-27

7:51:13 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:

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 <ESC> 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

De Apresentação

/*
TITULO : Diario
DATA : 12/02/21
PROGRAMA : DIARY.PRG
COMENTARIO : MENU PRINCIPAL
*/

#include "DIARY.CH"
#include "DIARYMOU.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, { "DIARY001.NTX", "DIARY", "DTOS(DATA)", 1, 1 } )
**
**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
//
// -> Ativa configuracao na tecla F6
SETKEY( T_F6, { || SET_CONF() } )
CNF_REP := .F.; CNF_CON := .F.; CNF_DEL := " "
CON_ARQ := "EMILIA.IMP"
TIPO_FORMULARIO := "0"
DECLARE FOR_MULARIO[ 99 ]
AFILL( FOR_MULARIO, "0" )
IF FILE( "DIARY.CFG" )
//
// -> Restaurando configuracao
VAR := MEMOREAD( "DIARY.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 ) )
//
// -> Configuracao para Entrada de Dados (Tecla F6)
CNF_REP := IIF( SUBS( VAR, 65, 1 ) = "F", .F., .T. )
CNF_CON := IIF( SUBS( VAR, 66, 1 ) = "F", .F., .T. )
CNF_DEL := SUBS( VAR, 67, 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 := "Diario"
**
**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
DIARYINC()
ELSEIF MENU_P = 2
DIARYCON()
ELSEIF MENU_P = 3
DIARYREL()
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 )
//
// -> Configuracao para Entrada de dados (Tecla F6)
VAR += IIF( CNF_REP, "T", "F" ) + IIF( CNF_CON, "T", "F" ) + CNF_DEL
//
// -> 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( "DIARY.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 := { "DIARY" }
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 DIARY.PRG */

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update2:

15/02/2021

Reindexar Arquivo é Fácil. Copie Os Arquivos DBT, DBF e NTX Pra Dentro Da Pasta CCBASE. Abra o DBF Na Interface Do CCBASE e Logo Em Seguida, Abra o NTX. Reindex é o Comando Do CCBASE Que Irá Fazer a Reindexação!

Após Reindexado, As Propriedades

Do Arquivo NTX Irão Mostar

Uma Nova Data e Um

Novo Horário De

Criação! 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update1:

15/02/2021

 

Role Para Cima

O Texto Que Está

Em Azul!!!

Mais Um PRG De

Menu De Relatórios!!!


/*
TITULO : Diario
DATA : 12/02/21
PROGRAMA : DIARYREL.PRG
COMENTARIO : MENU DE RELATORIOS
*/

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

FUNCTION SUBREL01
menu:TIPO_MENU := SUB_MENU
menu:ADD( " Diario", DIARYR02() )
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 DIARYREL.PRG */

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update2:

14/02/2021

Mais Um Pouco

De Marquee!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update1:

14/02/2021

O Relatório Por Data!!!

/*
TITULO : Diario
DATA : 12/02/21
PROGRAMA : DIARYR02.PRG
COMENTARIO : RELATORIO (Diario)
*/

#include "DIARY.CH"
#include "DIARYMOU.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( "DIARY", .F., 10 )
BEEP()
MENSAGEM( "O arquivo DIARY näo está disponível", 3 )
RETURN
ELSE
SET INDEX TO DIARY001
ENDIF
*** Final do bloco de substituiçäo R022.B
***
MENSAGEM( "Tecle para retornar" )
COR( "MENU" )
@ LIN_MENU, 00
@ LIN_MENU, 01 SAY "Relatório │ Diario"
SELE DIARY
SET ORDER TO 1
**
**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 := CTOD( " / / " )
JANELA( 08, 27, 16, 54 )
COR( "MENU" )
@ 11, 31 CLEAR TO 13, 50
**
**BI [INI] R02.B03
**BI [FIM] R02.B03
**
WHILE .T.
**
**BI [INI] R02.B04
**BI [FIM] R02.B04
**
@ 12, 34 SAY "Data:" 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 DTOS( 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( "Diario" )
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( DIARY->DATA = M->FILTRO_1 )
//
// -> Define os campos ou expressoes a serem impressos
relatorio:ADD( "Data..:", DIARY->DATA, 1, 1 )
relatorio:ADD( "Titulo:", DIARY->TITULO, 2, 1, "@!" )
relatorio:ADD( "Texto.:", DIARY->TEXTO, 3, 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 DIARYR02.PRG */

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update2:

13/02/2021

Template3 - TITIO.INFO!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update1:

13/02/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

O Menu De Inclusões

E

A Tela De Inclusão

Dos Dados

/*
TITULO : Diario
DATA : 12/02/21
PROGRAMA : DIARYINC.PRG
COMENTARIO : MENU DE CADASTROS
*/

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

FUNCTION SUBINC01
menu:TIPO_MENU := SUB_MENU
menu:ADD( " Diario", DIARYI02() )
menu:RODA()
RETURN NIL

/* Final do programa DIARYINC.PRG */
_______________________________________________________________________________________
/*
TITULO : Diario
DATA : 12/02/21
PROGRAMA : DIARYI02.PRG
COMENTARIO : CADASTRO (Diario)
*/

#include "DIARY.CH"
#include "DIARYMOU.CH"
**
**BI [INI] I02.B01
**BI [FIM] I02.B01
**
MENSAGEM( "Aguarde abertura de arquivos" )
SELE 1
IF !USEREDE( "DIARY", .F., 10 )
BEEP()
MENSAGEM( "O arquivo DIARY näo está disponível", 3 )
RETURN
ELSE
SET INDEX TO DIARY001
ENDIF
SELE DIARY
**
**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 │ Diario"
M->DU_PLICIDADE := .F.; M->MOSTRA_RESULTADO := .F.
M->RE_PETICAO := .F.
PRIVATE ME_MO, DATA, TITULO, TEXTO
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
**
IF !( M->RE_PETICAO )
IF M->CNF_REP
M->RE_PETICAO := .T.
ENDIF
//
// -> Inicializa variaveis
CARREG02( INCLUSAO )
ELSE
M->MOSTRA_RESULTADO := .T.
ENDIF
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 DATA
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->DATA)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "Entre Com a Data!!!", 3 )
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION IFU02002( VALIDA )
//
// -> Pos validacao ( Valid ) para o campo TITULO
IF VALIDA = NIL; VALIDA := .T.; ENDIF
IF VALIDA
IF !( .NOT.EMPTY(M->TITULO)) .AND. LASTKEY() != T_CIMA
BEEP()
MENSAGEM( "Entre Com o Titulo!!!", 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
**
M->ME_MO := "[memo]"
IF TIPO_ACAO = INCLUSAO
GOTO BOTT
SKIP
ENDIF
M->DATA := DIARY->DATA
M->TITULO := DIARY->TITULO
M->TEXTO := DIARY->TEXTO
**
**BI [INI] I02.B16
**BI [FIM] I02.B16
**

FUNCTION CARGET02( TIPO_ACAO )
//
// -> Formata a tela para entrada ou alteracao de dados
IF TIPO_ACAO != MOSTRA_PAG_1
M->AL_TERAR := .F.
ENDIF
**
**BI [INI] I02.B17
**BI [FIM] I02.B17
**
JANELA( 6, 8, 18, 71, "Diario" )
COR( "CERCADURAS" )
//
// -> Monta cercaduras
@ 8, 33 TO 10, 48 DOUBL
@ 11, 10 TO 13, 69 DOUBL
@ 14, 27 TO 16, 55 DOUBL
@ 7, 9 TO 17, 70 DOUBL
**
**BI [INI] I02.B18
**BI [FIM] I02.B18
**
COR( "GETS" )
//
// -> Carrega caracteres avulsos
@ 8, 10 SAY "***********************"
@ 9, 10 SAY "***********************"
@ 10, 10 SAY "***********************"
@ 14, 10 SAY "*****************"
@ 15, 10 SAY "*****************"
@ 16, 10 SAY "*****************"
@ 8, 49 SAY "*********************"
@ 9, 49 SAY "*********************"
@ 10, 49 SAY "*********************"
@ 14, 56 SAY "**************"
@ 15, 56 SAY "**************"
@ 16, 56 SAY "**************"
**
**BI [INI] I02.B21
**BI [FIM] I02.B21
**
//
// -> Monta tela de cadastro
@ 9, 34 SAY "Data:" GET M->DATA VALID IFU02001()
@ 12, 11 SAY "Titulo:" GET M->TITULO PICTURE "@!" VALID IFU02002()
@ 15, 28 SAY "Escreva o Seu Texto:" GET ME_MO PICT "9memo]" VALID EDITOR( @TEXTO, "Escreva o Seu Texto:" )
**
**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
EDITOR( TEXTO, "Escreva o Seu Texto:", .F. )
ELSE
CURSOR( LIGA )
READ
CURSOR( DESLIGA )
IF LASTKEY() = T_ESC
RETURN .F.
ENDIF
ENDIF
RETURN .T.

FUNCTION SALVAR02
//
// -> Salva o conteudo das variaveis de entrada no arquivo
**
**BI [INI] I02.B27
**BI [FIM] I02.B27
**
DIARY->DATA := M->DATA
DIARY->TITULO := M->TITULO
DIARY->TEXTO := M->TEXTO
**
**BI [INI] I02.B28
**BI [FIM] I02.B28
**

/* Final do programa DIARYI02.PRG */

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update2:

12/02/2021

Um Campo Data, o Título é Do Tipo Caractere e Tem Tamanho 50, Um Campo Memo e Duas Validações!!!

[019- Download do Diary]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update1:

12/02/2021

Template2 - TITIO.INFO!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update2:

11/02/2021

Template1 - TITIO.INFO!!!

Tabela de Cores:

Os Códigos das Cores!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update1:

11/02/2021

Um PRG De Inclusões!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update:

10/02/2021

[Delphi]

Na Tela,

A Visualização Dos Relatórios

 

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update:

08/02/2021

Consultas, Alterações

E Exclusões

Possuem o Comando

Convertendo e Este,

O Subcomando

Temperaturas!!! 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update:

07/02/2021

Ao Instalar o Delphi 7 No PC

Que Inicializa Com o

Windows 10, o Programa

Que Foi

Compilado No Delphi 3

Irá Rodar Nesse

Computador!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update:

06/02/2021

Um Arquivo Fonte

Do Delphi

A Comunicação

Entre o Usuário

E o Sistema

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update2:

05/02/2021

Criado Hoje Pelo

Titio.info!!!

O Código Fonte

De Um Gerador

De Relatórios!!!

Role Para Cima

O Texto Que Está

Em Azul!!!

/*
TITULO : CENTRO DE REFERENCIA ESPECIALIZADO PARA POPULACAO EM SITUACAO DE RUA-CENTRO POP
DATA : 05/02/21
PROGRAMA : RECREL.PRG
COMENTARIO : MENU DE RELATORIOS
*/

#include "REC.CH"
#include "RECMOU.CH"
**
**BI [INI] REL.B01
**BI [FIM] REL.B01
**
LOCAL TAM_MENU, CONTADOR, OPCAO_REL, VAR, TEXTO
CONTADOR := ADIR( "*.REL" )
NOMES_REL := {}
ARQS_REL := {}
DADOS := {}
IF CONTADOR != 0
DECLARE DADOS[ CONTADOR ]
ADIR( "*.REL", DADOS )
FOR CONTADOR := 1 TO LEN( DADOS )
TEXTO := MEMOREAD( DADOS[ CONTADOR ] )
VAR := MEMOLINE( TEXTO, 80, 4 )
IF SUBS( VAR, 7, 1 ) = "S"
VAR := MEMOLINE( TEXTO, 80, 10 )
AADD( NOMES_REL, SUBS( VAR, 7, 30 ) )
VAR := TRIM( DADOS[ CONTADOR ] )
VAR := PADR( SUBS( VAR, 1, LEN( VAR ) - 4 ), 8 )
AADD( ARQS_REL, VAR )
ENDIF
NEXT
ENDIF
MENSAGEM( "Tecle para sair" )
menu:ADD( "> Centro Pop", SUBREL01() )
IF LEN( NOMES_REL ) > 0
menu:ADD( "-" )
ENDIF
TAM_MENU := LEN( ObjMenu[ 2 ] )
FOR CONTADOR := 1 TO LEN( NOMES_REL )
menu:ADD( NOMES_REL[ CONTADOR ] )
NEXT
OPCAO_REL := menu:RODA()
IF OPCAO_REL > TAM_MENU .AND. OPCAO_REL < 999
OPCAO_REL -= TAM_MENU
NOME_REL := ARQS_REL[ OPCAO_REL ]
MENSAGEM( "Aguarde carregando relatorio " + TRIM( NOME_REL ) + ".REL" )
GerRelatorio := ZERA_REL()
LER_REL()
RODA_REL()
ENDIF
CLOSE DATABASES
**
**BI [INI] REL.B02
**BI [FIM] REL.B02
**

FUNCTION SUBREL01
menu:TIPO_MENU := SUB_MENU
menu:ADD( " Reconducao Familiar", RECR02() )
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 impressao?" )
MENSAGEM( "Tecle para pausa ou interrupcao" )
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 RECREL.PRG */

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update1:

05/02/2021

Para Ter Mais Opções De Pesquisa, Um Novo Comando Pode Ser Inserido No Menu De Relatórios. Ele Vai Ser Um Comando a Mais, Além Daqueles Já Existentes! Exemplo:

O Gerador de Relatórios Pode Ser Uma Opção do Menu Utilitários! Na Figura Acima Podemos Notar Que Um Arquivo Cujo Nome é NOME.REL, Vai Mostrar o Conteúdo Dos Campos NOME, TEXTO003 e TEXTO004, a Partir De Uma Pesquisa Por NOME. Vai Aparecer No Menu De Relatórios o Comando Busca Por Nome. Toda Pesquisa Por Nome Irá Mostrar o Cabeçalho Programador: titio.info. Os Campos Pertencem Ao Arquivo REC.DBF!!!  

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update:

04/02/2021

Arquivos NTX!!!

É o Formato De Arquivo Que é Usado Para o Índice De Um Banco De Dados. O Arquivo NTX Define a Estrutura e Os Campos De Um Banco De Dados Do Clipper. Ex.:

O Campo Número

Pode Ou Não,

Ser Um Campo Pra

Pesquisa Dos Dados 

Cadastrados!

O Campo Recebemos

Pode Ou Não,

Ser Um Campo Pra

Pesquisa Dos Dados 

Cadastrados!

O Campo Contador

Pode Ou Não,

Ser Um Campo Pra

Pesquisa Dos Dados 

Cadastrados!

Essa Chave Envolve Três Campos!

Os Mesmos São Utilizados

Pra Pesquisa Dos

Dados Cadastrados!

_________________

O Programa CCBASE

Mostrou As

Informações 

De Quatro Aquivos NTX!!!

A Chave é o Campo Que Foi

Utilizado Pra Definição

Da Estrutura Que

Foi Criada No Clipper!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update2:

02/02/2021

Arquivos CFG São Os Chamados Arquivos de Configuração. Eles Guardam As Informações Importantes De Um Determinado Programa!!! Exemplo:

Uma Informação Importante Desse CFG Criado Pelo Clipper, Diz Respeito a Uma Antiga Impressora Matricial (Emilia)!!! Programas Feitos No Clipper Imprimem Relatórios Com Excelência, Em Impressoras Matricias (LX 300 Series)!!! 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update1:

02/02/2021

Role Para Cima

O Texto Que Está

Em Azul!!!

Um Arquivo De

Documentação

Do Sistema!!!

No Arquivo De Documentação Do Sistema o Programador Apresentada o Resumo do Seu Programa! Ele Deve Conter a Descrição De Cada Arquivo PRG, As Características do DBF, o Tipo De Indentação, As Rotinas, etc. Quando Na Frente da Palavra Ou Da Frase Aparecer "+++", Significa Que A Opção Foi Utilizada Pelo programador!!!   

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Update:

31/01/2021

Um Bloco De Recibos Foi Programado No Clipper. A Partir De Uma Folha De Recibo Da São Domingos, Foi Criado Um Sistema Em Que Todos Os Campos Foram Validados. O Digitador Deverá Preencher Todos Os Campos Da Tela. A Assinatura Tem Um Campo Com Valor ConstanteUm Contador Foi Criado Para Que Seja Feita a Numeração Automática Dos Recibos!!!

018- Download - RECEB - Cadastrando Recibos No Clipper!!!

[Criado e Testado Pelo TITIO.INFO em 31/01/2021]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update:

30/01/2021

Oito Códigos HTML, Disponíveis Pra Download, Através do Comunidades.net! No Linux, Utilize o Notepadqq, e No Windows, o Bloco de Notas, Para Fazer a Edição Dos Mesmos! 

Download - HTML 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update:

29/01/2021

O HTML

Das

Estrelinhas

Que Caem

Do Mouse


Role Para Cima

O Texto Que Está

Em Azul!!!

 coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool  

Update:

28/01/2021

 

O Código HTML

[Letras Com Sombra]

 

Exemplo:

TITIO.INFO

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update:

27/01/2021

 

Role Para Cima

O Texto Que Está

Em Azul!!!

Um PRG de Menu De Relatórios

Do Clipper!!!

Títulos é Submenu De Biblioteca

E

Livros é Submenu De Empréstimos


* TITULO : BIBLIOTECA
* DATA : 11/06/20
* PROGRAMA : BIBREL.PRG
* COMENTARIO : MENU DE RELATORIOS

**
** Bloco de insercao REL.B01
**
MENSAGEM("Tecle para sair")
DECLARE ME_NU[2]
ME_NU[1]=">Biblioteca"
ME_NU[2]=">Emprestimos"
M->MENU_S=MENU()
IF M->MENU_S=0
RETURN
ENDIF
IF M->MENU_S=1
DECLARE ME_NU[1]
ME_NU[1]="Titulos"
S_MENU=MENU(1)
IF M->S_MENU=1
DO BIBR02.PRG
ENDIF
ELSEIF M->MENU_S=2
DECLARE ME_NU[1]
ME_NU[1]="Livros"
S_MENU=MENU(1)
IF M->S_MENU=1
DO BIBR04.PRG
ENDIF
ENDIF
CLOSE DATABASES
**
** Bloco de insercao REL.B02
**

* Final do programa BIBREL.PRG

 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update: 20/01/2021

Marquee - Texto Que Caminha!!!

 

01-Como o Texto Deve Rolar Na Página?

behavior="alternate"

behavior="scroll"

behavior="slide"

 


 

02-Pra Onde Vai o Texto

Quando A Página É Carregada?

direction="right"

direction="left"

direction="up"

direction="down"

 


 

03-O Comprimento Que o Texto Caminha?

width

 


 

04-A Velocidade do Texto?

scrollamount

 


 

05-A Configuração Da Fonte?

font-family (Tipo De Fonte)

color (A Cor Da Fonte)

font-size (O Tamanho Da Fonte)

strong (Negrito)

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Role Para Cima

O Texto Que Está

Em Azul!!!

Mais Um Arquivo PRG

Do Clipper

(Criação Dos Arquivos DBF)

* TITULO : BIBLIOTECA
* DATA : 11/06/20
* PROGRAMA : BIBARQ.PRG
* COMENTARIO : CRIACAO DE ARQUIVOS

FUNCTION CRIARQ
*
* -> Funcao que cria banco de dados (arquivos "DBF")
**
** Bloco de insercao ARQ.B01
**
IF .NOT. FILE("BIB.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("ESTANTE","C", 1, 0)
REPARQ("PRATELEIRA","C", 2, 0)
REPARQ("LIVRO","N", 5, 0)
REPARQ("TITULO","C", 60, 0)
CREATE BIB FROM ARQ_STRU
ENDIF
USE
ERASE ARQ_STRU.DBF
IF .NOT. FILE("EMP.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("DATAEMP","D", 8, 0)
REPARQ("DATADEV","D", 8, 0)
REPARQ("SALA","C", 10, 0)
REPARQ("ALUNO","C", 60, 0)
REPARQ("TITULO","C", 60, 0)
CREATE EMP 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 insercao ARQ.B02
**

* Final do programa BIBARQ.PRG

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

Em Delphi,

As Mensagens Que Aparecem

Na Tela, Quando Você Está

Manipulando o Sistema!!!

Role Para Cima

O Texto Que Está

Em Azul!!!


{ Titulo : CONVERTENDO TEMPERATURAS
Data : 29/05/20
Programa : TEMPOmsg.PAS
Comentario : Dialogo de mensagens }

unit TEMPOmsg;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls;

type
TFormMensagem = class(TForm)
BtnOk: TButton;
Frase: TLabel;
Imagem: TImage;
procedure BtnOkClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FormMensagem: TFormMensagem;

implementation

{$R *.DFM}

procedure TFormMensagem.BtnOkClick(Sender: TObject);
begin
Close;
end;

end.

{ Final TEMPOMSG.PAS } 

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Update: [18/01/2021]

[Delphi7] - A Pasta Keygen Contém Um Gerador De Seriais. Após A Instalação Do Software, Deixe O Arquivo Executável Do Mesmo No Modo De Compatibilidade Com O Windows XP SP3!!!

[Delphi7 - In My Dropbox]


coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Convertendo Temperaturas!!!

Escalas Utilizadas:

Celsius, Fahrenheit e Kelvin!!!

Um Arquivo de Funções,

Em Delphi!!!

Role Para Cima

O Texto Que Está

Em Azul!!!


{ Titulo : CONVERTENDO TEMPERATURAS
Data : 29/05/20
Programa : TEMPOfun.PAS
Comentario : Funcoes }

unit TEMPOfun;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Printers, DB,
DBTables, Forms, Classes, DbiProcs;

{ Funcao para criar N espacos }
function Space(N: integer): string;

{ Funcao de codificacao de senha }
function Codifica(S: string): string;

{ Coloca zeros a esquerda }
function StrZero(N: longint; Tamanho: integer): string;

{ Reproduz um string varias vezes }
function Repl(C: string; Tamanho: integer): string;

{ Janela para quetionamento }
function Pergunta( Texto: string ): string;

{ Janela para mensagens }
procedure Mensagem( Texto: string );

{ Retorna o Dia de uma data }
function Dia( Data: TDateTime ): string;

{ Retorna o Mes de uma data }
function Mes( Data: TDateTime ): string;

{ Retorna o Mes/Ano de uma data }
function MesAno( Data: TDateTime ): string;

{ Retorna o Ano de uma data }
function Ano( Data: TDateTime ): string;

{ Retorna o ultimo dia do mes }
function UltimoDiaDoMes( MesAno: string ): string;

{ Retorna a data no formato MM/DD/AA }
function MMDDAA( Data: string ): string;

{ Retira os espacos em branco da direita }
function Trim( Dados: string ): string;

{ Retira os espacos em branco da direita }
function AllTrim( Dados: string ): string;

{ Verifica se a string esta vazia }
function Empty( Dados: string ): boolean;

{ Verifica se a string nao esta vazia }
function NotEmpty( Dados: string ): boolean;

{ Calcula o digito verificador }
function Digito( Dados: string ): boolean;

{ Retorna uma string com zeros a esquerda }
function Zeros( Dados: string ): string;

{ Verifica se o CGC e' valido }
function C_G_C( Dados: string ): boolean;

{ Verifica se o CPF e' valido }
function C_P_F( Dados: string ): boolean;

{ Alinha algarismos a direita }
function Transform( Conteudo: Extended; const Mascara: string ): string;

{ Funcao para formatacao de data }
function FDateTime( const Mascara: string; Conteudo: TDateTime; Nulo: boolean ): string;

{ Simula o COMMIT do Clipper}
procedure Commit(DataSet: TDBDataSet);

{ Limpa strings para serem convertidas em valores numericos }
function LimpaNumeros( const Dados: string ): string;

implementation

uses
TEMPOmen, TEMPOper, TEMPOmsg;

procedure Commit( DataSet: TDBDataSet );
begin
with DataSet do
begin
UpdateCursorPos;
Check( dbiSaveChanges( Handle ) );
CursorPosChanged;
end;
end;

function LimpaNumeros( const Dados: string ): string;
var
Contar: integer;
Resultado: string;
begin
Resultado := '';
for Contar := 1 to Length( Dados ) do
begin
if Pos( Copy( Dados, Contar, 1 ) ,'-.0123456789' ) > 0 then
begin
if Copy( Dados, Contar, 1 ) = '.' then
Resultado := Resultado + ','
else
Resultado := Resultado + Copy( Dados, Contar, 1 );
end;
end;
if Copy( Resultado, 0, 1 ) = ',' then
Resultado := '0' + Resultado;
if Copy( Resultado, Length( Resultado ), 1 ) = ',' then
Resultado := Resultado + '00';
Result := Resultado;
end;

function FDateTime( const Mascara: string; Conteudo: TDateTime; Nulo: boolean ): string;
begin
if Nulo then
Result := Space( 10 )
else
Result := FormatDateTime( Mascara, Conteudo );
end;

function Transform( Conteudo: Extended; const Mascara: string ): string;
var
TamMascara: integer;
Brancos: string;
Dados: string;
begin
TamMascara := Length( Mascara );
Dados := FormatFloat( Mascara, Conteudo );
if TamMascara > Length( Dados ) then
begin
Brancos := Space( TamMascara - Length( Dados ) );
Dados := Brancos + Dados;
end;
Transform := Dados;
end;

function Zeros( Dados: string ): string;
begin
if Dados <> Space( Length( Dados ) ) then
Dados := StrZero( StrToInt( AllTrim( Dados ) ), Length( Dados ) );
Zeros := Dados;
end;

function Digito( Dados: string ): Boolean;
var
iDigito: integer;
begin
if Length( Trim( Dados ) ) = 0 then
Dados := '0' + Space( Length( Dados ) - 1 );
Dados := StrZero( StrToInt( AllTrim( Dados ) ), Length( Dados ) );
iDigito := StrToInt( Copy( Dados, 1, Length( Dados ) - 1 ) ) mod 11;
if iDigito = 10 then iDigito := 0;
if iDigito <> StrToInt( Copy( Dados, Length( Dados ), 1 ) ) then
Digito := False
else
Digito := True;
end;

function Trim( Dados: string ): string;
var
Contar: integer;
begin
for Contar := Length( Dados ) downto 1 do
begin
if Copy( Dados, Contar, 1 ) <> ' ' then
Break;
Dados := Copy( Dados, 1, Contar - 1 );
Application.ProcessMessages;
end;
Trim := Dados;
end;

function AllTrim( Dados: string ): string;
var
Contar: integer;
begin
Dados := Trim( Dados );
for Contar := 1 to Length( Dados ) do
begin
if Copy( Dados, Contar, 1 ) <> ' ' then
Break;
Dados := Copy( Dados, Contar + 1, Length( Dados ) - 1 );
Application.ProcessMessages;
end;
AllTrim := Dados;
end;

function Empty( Dados: string ): boolean;
begin
if ( Length( Trim( Dados ) ) = 0 ) or
( Trim( Dados ) = ' / /' ) then
Empty := True
else
Empty := False;
end;

function NotEmpty( Dados: string ): boolean;
begin
if Empty( Dados ) then
NotEmpty := False
else
NotEmpty := True;
end;

function MMDDAA( Data: string ): string;
var
sDia: string;
sMes: string;
sAno: string;
begin
sDia := Copy( Data, 1, 2 );
sMes := Copy( Data, 4, 2 );
sAno := Copy( Data, 7, 4 );
if sDia + sMes + sAno = ' ' then
MMDDAA := ''
else
MMDDAA := sMes + '/' + sDia + '/' + sAno;
end;

function UltimoDiaDoMes( MesAno: string ): string;
var
sMes: string;
sAno: string;
begin
sMes := Copy( MesAno, 1, 2 );
sAno := Copy( MesAno, 4, 2 );
if Pos( sMes, '01 03 05 07 08 10 12' ) > 0 then
UltimoDiaDoMes := '31'
else
if sMes <> '02' then
UltimoDiaDoMes := '30'
else
if ( StrToInt( sAno ) mod 4 ) = 0 then
UltimoDiaDoMes := '29'
else
UltimoDiaDoMes := '28';
end;

function Dia( Data: TDateTime ): string;
var
sAno, sMes, sDia: Word;
begin
DecodeDate( Data, sAno, sMes, sDia );
Dia := StrZero( sDia, 2 );
end;

function Mes( Data: TDateTime ): string;
var
sAno, sMes, sDia: Word;
begin
DecodeDate( Data, sAno, sMes, sDia );
Mes := StrZero( sMes, 2 );
end;

function MesAno( Data: TDateTime ): string;
var
sAno, sMes, sDia: Word;
begin
DecodeDate( Data, sAno, sMes, sDia );
MesAno := StrZero( sMes, 2 ) + '/' +
Copy( StrZero( sAno, 4 ), 3, 2 );
end;

function Ano( Data: TDateTime ): string;
var
sAno, sMes, sDia: Word;
begin
DecodeDate( Data, sAno, sMes, sDia );
Ano := Copy( StrZero( sAno, 4 ), 3, 2 );
end;

procedure Mensagem( Texto: string );
var
Largura: integer;