Translate this Page
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-01-27

10:59:20 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:

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;
begin
with TFormMensagem.Create(Application) do
begin
Frase.Caption := Texto;
Largura := 70 + Frase.Width;
if Largura < 250 then Largura := 250;
Width := Largura;
BtnOk.Left := (Width - 80) div 2;
MessageBeep(0);
ShowModal;
Free;
end;
end;

function Pergunta( Texto: string ): string;
var
Largura: integer;
begin
with TFormPergunta.Create(Application) do
begin
Resposta.Caption := 'N';
Frase.Caption := Texto;
Largura := 70 + Frase.Width;
if Largura < 250 then Largura := 250;
Width := Largura;
BtnSim.Left := (Width - 170) div 2;
BtnNao.Left := BtnSim.Left + 90;
ShowModal;
Pergunta := Resposta.Caption;
Free;
end;
end;

function Space(N: integer): string;
var
I: integer;
Dados: string;
begin
Dados := '';
for I := 1 to N do
begin
Dados := Dados + ' ';
Application.ProcessMessages;
end;
Space := Dados;
end;

function Codifica(S: string): string;
var
Cod: string;
I: integer;
begin
S := S + #13 + ' ';
Cod := '';
for I := 9 downto 1 do
Cod := Cod + Copy( S, I, 1 );
S := Copy( Cod, 4, 3 ) +
Copy( Cod, 1, 3 ) +
Copy( Cod, 7, 3 );
Cod := '';
for I := 1 to 9 do
begin
if (I mod 2) = 0 then
begin
if ord( S[I] ) = 255 then
Cod := Cod + #0
else
Cod := Cod + chr( ord( S[I] ) + 1 );
end
else
begin
if ord( S[I] ) = 0 then
Cod := Cod + chr( 255 )
else
Cod := Cod + chr( ord( S[I] ) - 1 );
end;
end;
Codifica := Cod;
end;

function StrZero(N: longint; Tamanho: integer): string;
var
Conteudo: string;
Diferenca: longint;
begin
Conteudo := IntToStr( N );
Diferenca := Tamanho - Length( Conteudo );
if Diferenca > 0 then
Conteudo := Repl( '0', Diferenca ) + Conteudo;
StrZero := Conteudo;
end;

function Repl(C: string; Tamanho: integer): string;
var
Conteudo: string;
Contar: integer;
begin
Conteudo := '';
for Contar := 1 to Tamanho do
begin
Conteudo := Conteudo + C;
Application.ProcessMessages;
end;
Repl := Conteudo;
end;

function C_G_C( Dados: string ): boolean;
var
CGC: string;
Soma: integer;
Contar: integer;
Digito: integer;
begin
try
if Length( Dados ) > 14 then
Dados := Copy( Dados, 1, 2 ) + Copy( Dados, 4, 3 ) +
Copy( Dados, 8, 3 ) + Copy( Dados, 12, 4 )
+ Copy( Dados, 17, 2 );
if Length( Trim( Dados ) ) = 0 then
begin
Result := True;
exit;
end;
CGC := Copy( Dados, 1, 12 );
Soma := 0;
for Contar := 1 to 4 do
Soma := Soma +
StrToInt( copy( CGC, Contar, 1 ) )
* ( 6 - Contar );
for Contar := 1 to 8 do
Soma := Soma + StrToInt( copy( CGC,
Contar + 4, 1 ) ) * ( 10 - Contar );
Digito := 11 - Soma mod 11;
if Digito in [ 10, 11 ] then
CGC := CGC + '0'
else
CGC := CGC +IntToStr( Digito );
Soma := 0;
for Contar := 1 to 5 do
Soma := Soma + StrToInt( copy( CGC,
Contar, 1 ) ) * ( 7 - Contar );
for Contar := 1 to 8 do
Soma := Soma + StrToInt( copy( CGC,
Contar + 5, 1 ) ) * ( 10 - Contar );
Digito := 11 - Soma mod 11;
if Digito in [ 10, 11 ] then
CGC := CGC + '0'
else
CGC := CGC +
IntToStr( Digito );
if Dados <> CGC then
Result := false
else
Result := true;
except on econverterror do
Result := false;
end;
end;

function C_P_F( Dados: string ): boolean;
var
CPF: string;
Soma: integer;
Contar: integer;
Digito: integer;
begin
try
if Length( Dados ) > 11 then
Dados := Copy( Dados, 1, 3 ) + Copy( Dados, 5, 3 ) +
Copy( Dados, 9, 3 ) + Copy( Dados, 13, 2 );
if Length( Trim( Dados ) ) = 0 then
begin
Result := True;
exit;
end;
CPF := copy( Dados, 1, 9 );
Soma := 0;
for Contar := 1 to 9 do
Soma := Soma +
StrToInt( copy( CPF, Contar, 1 ) )
* ( 11 - Contar );
Digito := 11 - Soma mod 11;
if Digito in [ 10,11 ] then
CPF:= CPF + '0'
else
CPF := CPF + IntToStr( Digito );
Soma := 0;
for Contar := 1 to 10 do
Soma := Soma +
StrToInt( copy( CPF, Contar, 1 ) ) *
( 12 - Contar );
Digito := 11 - Soma mod 11;
if Digito in [ 10, 11 ] then
CPF := CPF + '0'
else
CPF := CPF +
IntToStr( Digito );
if Dados <> CPF then
Result := false
else
Result := true;
except on econverterror do
Result := false;
end;
end;

end.

{ Final TEMPOFUN.PAS }

 coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Em Delphi, A Visualização

Do Relatório, Na Tela!!!

Role Para Cima

O Texto Que Está

Em Azul!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool


{ Titulo : Calculo da Velocidade a Partir da Marca dos Pneus no Asfalto!
Data : 31/05/20
Programa : FREIAtel.PAS
Comentario : Visualizacao de relatorios em tela }

unit FREIAtel;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Grids, DBGrids, DB, DBTables, StdCtrls, ExtCtrls;

type
TRelTela = class(TForm)
ArqRel: TTable;
DataRel: TDataSource;
DBGrid1: TDBGrid;
Image1: TImage;
Label1: TLabel;
Button1: TButton;
procedure FormActivate(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
RelTela: TRelTela;

implementation

{$R *.DFM}

uses
FREIAmen, FREIArel;

procedure TRelTela.FormActivate(Sender: TObject);
begin
ArqRel.Open;
Label1.Caption := StatusImpressora.Titulo;
end;

procedure TRelTela.FormDeactivate(Sender: TObject);
begin
ArqRel.Close;
end;

procedure TRelTela.Button1Click(Sender: TObject);
begin
Close;
end;

procedure TRelTela.FormResize(Sender: TObject);
begin
if RelTela.Height < 315 then
RelTela.Height := 315;
if RelTela.Width < 450 then
RelTela.Width := 450;
DBGrid1.Height := RelTela.Height - 114;
DBGrid1.Width := RelTela.Width - 21;
Button1.Left := ( RelTela.Width - 85 ) div 2;
Button1.Top := RelTela.Height - 56;
Label1.Width := RelTela.Width - 121;
end;

procedure TRelTela.FormCreate(Sender: TObject);
begin
WindowState := wsMaximized;
end;

end.

{ Final FREIATEL.PAS }

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

O Código Fonte

(Em Delphi)

Da

Função De Calendário

Role Para Cima

O Texto Que Está

Em Azul!!!

 coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool


{ Titulo : A AREA DE UM TRIANGULO QUALQUER
Data : 31/05/20
Programa : AREAcal.PAS
Comentario : Calendario }

unit AREAcal;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Grids, Calendar, StdCtrls, ExtCtrls, Buttons, Spin;

type
TCalendario = class(TForm)
ComboCal: TComboBox;
Label1: TLabel;
Label2: TLabel;
EditAno: TEdit;
Button1: TButton;
Calendar1: TCalendar;
SpinButton1: TSpinButton;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
Panel7: TPanel;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure ComboCalChange(Sender: TObject);
procedure EditAnoExit(Sender: TObject);
procedure SpinButton1UpClick(Sender: TObject);
procedure SpinButton1DownClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Calendario: TCalendario;
abc: TForm;
Dia, Mes, Ano: Word;

implementation

{$R *.DFM}

procedure TCalendario.Button1Click(Sender: TObject);
begin
Close;
end;

procedure TCalendario.ComboCalChange(Sender: TObject);
begin
Mes := ComboCal.ItemIndex + 1;
try
Calendar1.Month := Mes;
except
Calendar1.Day := 1;
Calendar1.Month := Mes;
end;
end;

procedure TCalendario.EditAnoExit(Sender: TObject);
begin
Ano := StrToInt( EditAno.Text );
if Ano = 0 then
EditAno.SetFocus
else
Calendar1.Year := Ano;
end;

procedure TCalendario.SpinButton1UpClick(Sender: TObject);
begin
Ano := Ano + 1;
EditAno.Text := IntToStr( Ano );
Calendar1.Year := Ano;
end;

procedure TCalendario.SpinButton1DownClick(Sender: TObject);
begin
Ano := Ano - 1;
EditAno.Text := IntToStr( Ano );
Calendar1.Year := Ano;
end;

procedure TCalendario.FormCreate(Sender: TObject);
begin
DecodeDate( Now, Ano, Mes, Dia );
ComboCal.ItemIndex := Mes - 1;
EditAno.Text := IntToStr( Ano );
end;

end.

{ Final AREACAL.PAS }

 coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Role Para Cima

O Texto Que Está

Em Azul!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

 

O Meu Super Código HTML!!!

Bloqueia A Cópia E A Seleção

Do Conteúdo De Uma Página

Do Site!!!

Um Arquivo de Imagem

Foi Inserido Dentro Da

Caixa De Texto!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

* TITULO : A AREA DE UM TRIANGULO QUALQUER
* DATA : 31/05/20
* PROGRAMA : AREAARQ.PRG
* COMENTARIO : CRIACAO DE ARQUIVOS

FUNCTION CRIARQ
*
* -> Funcao que cria banco de dados (arquivos "DBF")
**
** Bloco de insersao ARQ.B01
**
IF .NOT. FILE("AREA.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("LADO1","N", 6, 2)
REPARQ("LADO2","N", 6, 2)
REPARQ("LADO3","N", 6, 2)
REPARQ("SEMIPER","N", 10, 2)
REPARQ("AREA","N", 10, 2)
CREATE AREA 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 AREAARQ.PRG

 

Role Para Cima

O Texto Que Está

Em Azul!!!

A Estrutura do DBF que Vai

Armazenar os Dados de Cadastro

De Triângulos!!!

O PRG Está Dentro

Desse Código HTML:

 Até Mesmo no Celular

A Barra de Rolagem Vai

Funcionar!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Nesse Relatório Nós Não Temos

A Totalização Dos Campos Numéricos,

E Nem Os Índices!!!

Ao Acessar O Submenu, Todos Os Dados

Cadastrados Vão Pra Tela, Ou Vão Pra

Um Arquivo PRN, Ou Pra Uma Impressora

(De Preferência Matricial)!!!

* TITULO : Passaros x Galhos
* DATA : 13/01/21
* PROGRAMA : PGR02.PRG
* COMENTARIO : RELATORIO (A Resposta Esta No Rel)

**
** Bloco de insercao R02.B01
**
MENSAGEM("Aguarde abertura de arquivos")
SELE 1
IF .NOT. USEREDE("PG",.F.,10)
BEEP()
MENSAGEM("O arquivo PG nao esta disponivel",3)
RETURN
ELSE
SET INDEX TO
ENDIF
***
*** Inicio do bloco de substituicao R02.B
MENSAGEM("Tecle para retornar")
COR("MENU")
@ LIN_MENU,00
@ LIN_MENU,01 SAY "Relatorio | A Resposta Esta No Rel"
SELE 1
SET ORDER TO 0
**
** Bloco de insercao R02.B02
**
GOTO TOP
M->TIPO_PRN="I"
*
* -> Menu que permite direcionar a saida de impressao
IF .NOT. MENU_PRN("PG_02")
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
RETURN
ENDIF
SET DEVI TO PRINT
M->LI_NHA=1
M->PAG=1
**
** Bloco de insercao R02.B05
**
M->SAI_DA="S"
*** Final do bloco de substituicao R02.B
***
DO WHILE .NOT. EOF()
**
** Bloco de insercao R02.B06
**
IF INKEY()=27
**
** Bloco de insercao R02.B07
**
SET DEVI TO SCREEN
*
* -> Permite interromper a impressao
M->SAI_DA=PERG("Continua a impressao ?")
MENSAGEM("Tecle para pausa ou interrupcao")
SET DEVI TO PRINT
IF M->SAI_DA="N"
EXIT
ENDIF
ENDIF
IF M->LI_NHA=1
**
** Bloco de insercao R02.B09
**
*
* -> Determina o tipo de caracter para impressao
IF TIPO_PRN<>"T"
@ 00,01 SAY CHR(18)
ENDIF
@ 01,01 SAY "Passaros x Galhos"
@ 01, 68 SAY "Pagina: "+SUBS(STR(M->PAG+10000,5),2)
M->PAG=M->PAG+1
@ 02,01 SAY "Resposta: Primeira Resposta = Segunda Resposta"
@ 02, 68 SAY "Data: "+DTOC(DAT_HOJE)
@ 04,01 SAY REPL("-", 81)
@ 05,001 SAY "A Quantidade de Galhos"
@ 05,025 SAY "Passaros - Primeira Resposta"
@ 05,055 SAY "Passaros - Segunda Resposta"
@ 06,01 SAY REPL("-", 81)
M->LI_NHA=07
**
** Bloco de insercao R02.B10
**
ENDIF
**
** Bloco de insercao R02.B20
**
@ M->LI_NHA,001 SAY G PICTURE "99"
@ M->LI_NHA,025 SAY P PICTURE "999"
@ M->LI_NHA,055 SAY P2 PICTURE "999"
**
** Bloco de insercao R02.B21
**
M->LI_NHA=M->LI_NHA+1
**
** Bloco de insercao R02.B12
**
SKIP
IF M->LI_NHA>61
M->LI_NHA=1
ENDIF
ENDDO
**
** Bloco de insercao R02.B18
**
EJECT
SET DEVI TO SCREEN
IF M->TIPO_PRN = "A"
SET PRINTER TO
ELSEIF M->TIPO_PRN = "T" .AND. M->SAI_DA="S"
SET PRINTER TO
IMP_TELA("PG_02", 82)
ENDIF
**
** Bloco de insercao R02.B19
**
RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)

* Final do programa PGR02.PRG

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Um Exemplo de 

Menu de Consultas!!!

A Resposta Esta No Rel,

Nesse Menu de Consultas,

É um Submenu de

Passaros x Galhos

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Um Sistema Simples!!! Entre Com a Quantidade de Galhos. Quando a Primeira Resposta for Igual a Segunda Resposta, Então Você Vai Ter Encontrado a Solução do Problema. Existe Uma Árvore Que é a Resposta Certa!!! Foi Utilizada a Validação >0!!! Download: 

017- Pássaros x Galhos - Encontre a Árvore que é a Resposta!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Pra Saber a Relação dos Dados Cadastrados, o Menu de Relatórios Recebeu o Menu Convertendo, que Teve "Temperaturas", como Submenu. A Digitação Feita no TEMPOR02.PRG Dita as Regras de Como Deve Ser o Relatório

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Uma Rotina de Help

Teclas de Ajuda:

F1 - F2 - F3 - F4

Nesse Exemplo a Tecla F3

Mostra um Calendário,

E a Tecla F4 Apresenta

Uma Calculadora!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Um PRG de Inclusões de Dados. Nesse Exemplo a Fórmula Matemática D=[V*V]/[250*CA] Foi Trabalhada Nas Linhas de Comandos!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Exemplo de Arquivo PRG

A figura acima mostra o conteúdo de um arquivo PRG (Arquivo Fonte do Clipper). Nesse exemplo foram criados dois arquivos DBF. O arquivo COMA.DBF possui 12 campos. O arquivo CLIENTE.DBF possui 03 campos. Campo tipo caractere é "C". Campo tipo numérico é "N". Pra estudarmos o tamanho de cada campo, precisamos entender o que diz essa parte da função:

Ex.1: { "CAMPO1", "C", X, 0 }

 Ex.2: { "CAMPO2", "N", X, Y } 

No exemplo1 o CAMPO1 é do tipo caractere. Tem tamanho X e nenhuma casa decimal. No exemplo2 o CAMPO2 é do tipo numérico. Tem tamanho X e possui um tamanho de casa decimal igual a Y.

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Exemplo de Comanda de Restaurante!!! Um Sistema que Possui a Validação Not Empty, a Verificação de Duplicidade, a Rotina de Mouse, Um Contador Automático e a Possibilidade de Acesso a um Campo de um DBF, Quando o Cadastro Está Sendo Feito Num Outro DBF!!!  

[016- Comanda - by titio.info]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

As Linguagens de Programação São Softwares de Desenvolvimento, ou Seja, São os Softwares que Criam Novos Softwares. São as Linguagens de Programação de Alto Nível. Ex.: Basic, Pascal, Cobol, Clipper, etc.

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

O Montador Converte a Linguagem de Montagem (Assembly) Para a Linguagem de Baixo Nível (Linguagem de Máquina). O Interpretador Converte a Linguagem de Alto Nível Para a Linguagem de Baixo Nível (Linguagem de Máquina), Mas Não Cria o Arquivo OBJ. O Compilador Faz a Mesma Tarefa Desempenhada Pelo Interpretador, Mas Cria o Arquivo OBJ!!!

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Eu tenho o dobro da idade que tu tinhas, quando eu tinha a tua idade. Quando tu tiveres a minha idade, a soma das nossas idades será...

[015- Ages - Download]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Uma pedra está sendo solta de uma determinada altura, e você calcula o tempo que ela gasta pra chegar até o chão!

[014- Altp - Download]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Calculando a quantidade de animais que possuem 04 patas, e a quantidade de animais que possuem 02 patas, ou calculando a quantidade de veículos com 04 rodas, e a quantidade de veículos com 02 rodas!

[013- Farm - Download]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Um veículo vem numa certa velocidade e de repente freia. Calcule essa velocidade, a partir do comprimento da marca de frenagem!

[012- Freia - Download]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Sistema que calcula a área de um triângulo qualquer, a partir das medidas dos lados!

[011- Herão - Download]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Cálculo dos Juros Compostos!

[010- Juros - Download]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Cálculo das raízes de uma equação do segundo grau!

[009- Raízes - Download]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Recondução Familiar!

[008- Rec - Download]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Calculando a altura de um prédio, a partir de um ângulo de 30 graus!

[007- Teoc - Download]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

O Problema Clássico das Torneiras!

[006- Tor - Download]

coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Conversão de Temperaturas!

[005- Tempo - Download]

 coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

Estão Rodando Normalmente!!!

Foram Testados No DosBox!!!

Linguagem Utilizada:

Clipper!!!

 coolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcoolcool

O Fascinante Clipper 5.2

E As Suas Configurações De Instalação

 


 

Configuração Do Autoexec.bat

E Do Autoexec.nt:

 


 

Configuração Do Config.sys

E Do Config.nt:

FILES=50

BUFFERS=40

 


 

Se Existe o Arquivo CLIPPER5.2.RAR,

Então Vai Existir a Pasta CLIPPER5.2!!!

 


 

Dentro da Pasta CLIPPER5.2

Nós Vamos Encontrar a Pasta

DISK1, a Pasta DISK2 e a Pasta

PWRTOOLS

 


 

Todos os Arquivos do Diretório DISK1

Devem ser Copiados pra 

Todos os Arquivos do Diretório DISK2,

Com Exceção do Arquivo DISK.ID,

Devem ser Copiados pra 

 


 

O Arquivo INSTALL.EXE Vai Fazer a

Instalação do CLIPPER, e Na Pasta

CLIPPER5 é onde nós Vamos Encontrar

   Os Arquivos que Foram Instalados!

 


 

Todos os Arquivos da Pasta

PWRTOOLS Devem ser Copiados

Para 

O Arquivo PTOOLS.EXE,

Ao ser Executado,

Criará a Pasta

PTOOLS

 


 

Obs.: INSTALL.EXE e PTOOLS.EXE

Devem Ser Executados

A Partir de

   

 


 

CLIPPER5.2:

[Download do CLIPPER5.2]

Se Você Instalou Na

Sua Máquina o 

Windows 10 ou o Linux,

Com o VirtualBox Você

Instala o "XP" ou o "SEVEN"!!!

Utilize as Versões 32 Bits!!!

 


 

Os Sistemas que Foram

Criados na Máquina Virtual,

Irão Rodar

Sem Problemas,

Através do DosBox,

Em Qualquer Sistema Operacional!!!

 


 

 Importantes Downloads Podem

Ser Feitos A Partir

Desse Site:

https://vetusware.com/ 

 


 

Os Arquivos Fontes do Clipper Possuem a Extensão PRG!

Se as Linhas de Programação Estiverem Corretas,

O Clipper Vai Criar um Arquivo com a Extensão OBJ,

E depois Nós Vamos Ter o Arquivo Executável,

Ou seja, o Arquivo Com a Extensão EXE!!!

 


 

O Sistema de Cadastro

Dos Usuários De um Centro Pop!!!

[004- Pop - Ficha Cadastral]

 


 

O Estatístico de Um Centro Pop!!!

[003- Stat - by titio.info]

 


 

Cadastro dos Atendimentos

Diários

De um CRAS!!!

[002- SCU - CRAS]

 


 

Cadastro de Livros

[001- Bib - Cadastro de Livros]