20 Mai 2015 18:49
21 Mai 2015 19:12
21 Mai 2015 19:31
clipper lote01
clipper c_lote
rtlink fi lote01, c_lote
hbmk2 lote01, c_lote
21 Mai 2015 20:38
func datavol4 // Funcao: Converte AAAAMMDD para dd/mm/aaaa
* para chamar esta rotina:
* variavel = datavol4(campo texto no formato aaaammdd)
* a variavel acabou de ser criada como data
* deixar sempre SET CENTURY ON - trabalhar com 4 casas no ano
* quando gravar, utilizar DTOS(variavel data)
* portanto, no DBF o campo data sera TEXTO de 8 posicoes
set century on
parameters wdv_data
w_data_dv = ctod(subst(wdv_data,7,2)+"/"+subst(wdv_data,5,2)+"/"+subst(wdv_data,1,4))
return (w_data_dv)
21 Mai 2015 20:49
clear
********************************************
@ 07,59 say "CLIPPER BASICO"
@ 03,01 say "PROC01 Clipper ³"
@ 04,01 say " ³"
@ 05,01 say "PROC11 Harbour Local DBF ³"
@ 06,01 say "PROC12 Harbour Remoto DBF ³"
@ 07,01 say "PROC13 Harbour Remoto MYSQL ³"
@ 08,01 say " ³"
@ 09,01 say "PROC21 xHarbour Local DBF ³"
@ 10,01 say "PROC22 xHarbour Remoto DBF ³"
@ 11,01 say "PROC23 xHarbour Remoto MYSQL ³"
@ 12,01 say "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
@ 16,01 say "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
@ 17,01 say "- Testando os campos b sicos ³"
@ 18,01 say "- C lculo de Data + Dias ³"
@ 19,01 say "- Inclus„o/Altera‡„o/Exclus„o³"
@ 20,01 say "- Uso DbEdit para Consulta ³"
@ 21,01 say "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
******************************************************************
******************************************************************
* CLIPPER
******************************************************************
******************************************************************
***************************************************** TELA E SET BASICO
set date brit
set epoch to 2001
set delete on
@ 02,01 to 02,80
@ 23,01 to 23,80
set color to w/b
@ 01,01 say space(80)
@ 01,01 say "LOTES - Aprendizado Harbour e xHarbour"
@ 01,70 say date()
set color to w/n
memoria = memory()
@ 03,54 say memory() pict "9,999,999,999"
@ 03,68 say "Kb Mem¢ria"
dc = " "
***************************************************** ABERTURA DE ARQUIVOS
sele a
use lotes alias lotes
index on lote to ilote1
index on estado+lote+dt_entrada to ilote2
index on dt_entrada+lote to ilote3
index on dt_saida+lote to ilote4
set index to ilote1, ilote2, ilote3, ilote4
go top
set order to 1
sele b
use estado alias estado
index on sigla_uf to iuf1
go top
set order to 1
***************************************************** OPERACAO
wlote = space(07)
westado = space(02)
wdt_entrada = datavol4(space(08))
wdias = 0
wdt_saida = datavol4(space(08))
wqtde = 0
wvlr_unit = 0
wvlr_total = 0
do while .t.
msg_1 ( "Informe o LOTE [branco] finaliza" )
@ 09,34 say "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
@ 10,34 say "³ Lote....: °°°°°° ? Pesquisa ³"
@ 11,34 say "³ ³"
@ 12,34 say "³ Estado..: °° °°°°°°°°°°°°°°°°°°° ³"
@ 13,34 say "³ ³"
@ 14,34 say "³ Entrada Dias Devolu‡„o ³"
@ 15,34 say "³ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ³"
@ 16,34 say "³ °°/°°/°°°° + °°°° = °°/°°/°°°° ³"
@ 17,34 say "³ ³"
@ 18,34 say "³ Qtde Unit rio Valor Total ³"
@ 19,34 say "³ ÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄ ³"
@ 20,34 say "³ °°°°°°°°° x °°°°°.°°° = °°°°°°°°°.°° ³"
@ 21,34 say "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
@ 22,34 say " "
@ 10,46 get wlote pict "@!"
read
if wlote = " "
clear
return
endif
if wlote = "?"
consulta()
loop
endif
******************************* consulta
sele lotes
set order to 1
go top
seek (wlote)
if .not. eof()
westado = estado
wdt_entrada = datavol4(dt_entrada)
wdias = dias
wdt_saida = datavol4(dt_saida)
wqtde = qtde
wvlr_unit = vlr_unit
wvlr_total = vlr_total
set color to g+/n
@ 12,46 say westado
@ 16,36 say wdt_entrada
@ 16,52 say wdias pict "9999"
@ 16,60 say wdt_saida
@ 20,36 say wqtde pict "9,999.999"
@ 20,48 say wvlr_unit pict "9,999.999"
@ 20,60 say wvlr_total pict "9,999,999.99"
sele estado
set order to 1
go top
seek (westado)
if eof()
alert ( "Erro - deveria existir o ESTADO" )
else
@ 12,49 say estado
endif
sele lotes
set color to w/n
msg_1 ( "Registro existente. Deseja Alterar, Excluir ou Voltar ? ... A/E/V ..." )
@ 24,73 get dc pict "!" valid dc $ "AEV"
read
if upper(dc) = "V"
loop
elseif upper(dc) = "A"
woquefazer = "ALT"
elseif upper(dc) = "E"
woquefazer = "EXC"
endif
else
woquefazer = "INC"
endif
******************************* exclusao
if woquefazer = "EXC"
msg_3 ( "Confirma a exclus„o do Lote " + rtrim(wlote) + " ? ... S/N ..." )
if upper(dc) = "S"
sele lotes
set order to 1
go top
seek (wlote)
if eof()
alert ( "Erro - chamar CPD - registro n„o existe mais" )
else
delete
endif
endif
loop
endif
******************************* inclusao e alteracao
set color to g+/n
if woquefazer = "INC"
@ 22,35 say "Registro Novo"
elseif woquefazer = "ALT"
@ 22,35 say "Edi‡„o de Registro"
endif
set color to w/n
pede_campo = "01"
preenche = "S"
do while preenche = "S"
if pede_campo = "01"
msg_1 ( "Informe o ESTADO [branco] abandona" )
@ 12,46 get westado pict "@!"
read
if westado = " "
msg_3 ( "Deseja abandonar este registro ? ... S/N ..." )
if upper(dc) = "S"
preenche = "ABANDONA"
endif
loop
endif
sele estado
set order to 1
go top
seek (westado)
if eof()
alert ( "Estado n„o encontrado" )
loop
else
set color to g+/n
@ 12,49 say estado
set color to w/n
endif
pede_campo = "02"
endif
if pede_campo = "02"
msg_1 ( "Informe a Data de Entrada [branco] retorna campo anterior" )
@ 16,36 get wdt_entrada
read
if dtos(wdt_entrada) = space(08)
pede_campo = "01"
elseif wdt_entrada > date() .or. dtos(wdt_entrada) < "20150101"
loop
else
pede_campo = "03"
endif
endif
if pede_campo = "03"
msg_1 ( "Informe o prazo em DIAS para devolu‡„o do lote" )
@ 16,52 get wdias pict "9999" valid wdias > 0
read
* calcula wdt_saida
wdt_saida = wdt_entrada + wdias
set color to g+/n
@ 16,60 say wdt_saida
set color to w/n
pede_campo = "04"
endif
if pede_campo = "04"
msg_1 ( "Informe a Quantidade e Pre‡o Unit rio [zero] retorna campo anterior" )
@ 20,36 get wqtde pict "9,999.999" valid wqtde >= 0
@ 20,48 get wvlr_unit pict "9,999.999" valid wvlr_unit >= 0
read
if wqtde = 0
pede_campo = "02"
else
* calcula wvlr_total
wvlr_total = wqtde * wvlr_unit
set color to g+/n
@ 20,60 say wvlr_total pict "9,999,999.99"
set color to w/n
pede_campo = "CONFIRMA_DADOS"
endif
endif
if pede_campo = "CONFIRMA_DADOS"
msg_3 ( "Confirma os dados ? ... S/N ..." )
if upper(dc) = "S"
preenche = "DADOS_OK"
else
msg_3 ( "Deseja continuar neste registro ? ... S/N ..." )
if upper(dc) = "S"
pede_campo = "01"
loop
endif
preenche = "ABANDONA"
endif
endif
enddo
if preenche = "DADOS_OK"
if woquefazer = "INC"
sele lotes
go bottom
append blank
elseif woquefazer = "ALT"
sele lotes
set order to 1
go top
seek (wlote)
if eof()
alert ( "Erro - chamar CPD - registro n„o existe mais" )
loop
endif
endif
rlock()
replace lote with wlote
replace estado with westado
replace dt_entrada with dtos(wdt_entrada)
replace dias with wdias
replace dt_saida with dtos(wdt_saida)
replace qtde with wqtde
replace vlr_unit with wvlr_unit
replace vlr_total with wvlr_total
unlock
endif
enddo
*****************************************************************************
*****************************************************************************
proc msg_1 (w_msg) // Procedure: Mensagem Sistema SEM parada
set color to w/n
@ 24,01 say space(80)
set color to gr+/n
@ 24,03 say w_msg
set color to w/n
return
*****************************************************************************
*****************************************************************************
proc msg_2 (w_msg) // Procedure: Mensagem Sistema COM parada
set color to w/n
@ 24,01 say space(80)
set color to gr+/n
@ 24,03 say w_msg
inkey(0)
set color to w/n
@ 24,01 say space(80) // Limpa apos a exibicao da mensagem
return
*****************************************************************************
*****************************************************************************
proc msg_3 (w_msg) // Procedure: Mensagem Com Retorno
// : SIM ou NAO
set color to w/n
@ 24,01 say space(80)
set color to gr+/n
dc = " "
@ 24,03 say w_msg get dc pict "!" valid dc $ "SNsn"
read
set color to w/n
@ 24,01 say space(80) // Limpa apos a exibicao da mensagem
return
*****************************************************************************
*****************************************************************************
func datavol4 // Funcao: Converte AAAAMMDD para dd/mm/aaaa
* para chamar esta rotina:
* variavel = datavol4(campo texto no formato aaaammdd)
* a variavel acabou de ser criada como data
* deixar sempre SET CENTURY ON - trabalhar com 4 casas no ano
* quando gravar, utilizar DTOS(variavel data)
* portanto, no DBF o campo data sera TEXTO de 8 posicoes
set century on
parameters wdv_data
w_data_dv = ctod(subst(wdv_data,7,2)+"/"+subst(wdv_data,5,2)+"/"+subst(wdv_data,1,4))
return (w_data_dv)
21 Mai 2015 20:56
21 Mai 2015 21:10
21 Mai 2015 21:36
STATIC FUNCTION TelaInicial()
@ 07,59 SAY "CLIPPER BASICO"
@ 03,01 SAY "PROC01 Clipper ³"
@ 04,01 SAY " ³"
@ 05,01 SAY "PROC11 Harbour Local DBF ³"
@ 06,01 SAY "PROC12 Harbour Remoto DBF ³"
@ 07,01 SAY "PROC13 Harbour Remoto MYSQL ³"
@ 08,01 SAY " ³"
@ 09,01 SAY "PROC21 xHarbour Local DBF ³"
@ 10,01 SAY "PROC22 xHarbour Remoto DBF ³"
@ 11,01 SAY "PROC23 xHarbour Remoto MYSQL ³"
@ 12,01 SAY "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
@ 16,01 SAY "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
@ 17,01 SAY "- Testando os campos b sicos ³"
@ 18,01 SAY "- C lculo de Data + Dias ³"
@ 19,01 SAY "- Inclus„o/Altera‡„o/Exclus„o³"
@ 20,01 SAY "- Uso DbEdit para Consulta ³"
@ 21,01 SAY "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
RETURN NIL
STATIC FUNCTION AbreArquivos()
SELECT 0
USE LOTES
INDEX ON lote TO ilote1
INDEX ON estado+lote+dt_entrada TO ilote2
INDEX ON dt_entrada+lote TO ilote3
INDEX ON dt_saida+lote TO ilote4
SET INDEX TO ilote1, ilote2, ilote3, ilote4
SELECT 0
USE estado
INDEX ON sigla_uf TO iuf1
SET INDEX TO iuf1
RETURN NIL
PROCEDURE Main
set date brit
set epoch to 2001
set delete on
SetMode(25,80)
clear
TelaInicial()
AbreArquivos()
@ 02,01 to 02,80
@ 23,01 to 23,80
...
CLOSE DATABASES
clipper lote01 c_lote /n
rtlink fi lote01 c_lote
hbmk2 lote01 c_lote
21 Mai 2015 22:05
FUNCTION msg_1( w_msg ) // Procedure: Mensagem Sistema SEM parada
set color to w/n
@ 24,01 say space(80)
set color to gr+/n
@ 24,03 say w_msg
set color to w/n
RETURN NIL
FUNCTION Msg_1( w_Msg )
@ 24, 01 SAY Space(80)
@ 24, 03 SAY w_Msg COLOR GR+/N
RETURN NIL
FUNCTION Msg( cTexto )
@ 24, 01 SAY Space(80)
@ 24, 03 SAY cTexto COLOR GR+/N
RETURN NIL
21 Mai 2015 22:26
FUNCTION Msg( cTexto )
RETURN ( DispOutAt( MaxRow(), 0, PadR( " " + Left( RTrim( cTexto ), MaxCol() - 2), MaxCol() ), "GR+/N", .F. ) )
FUNCTION Msg( cTexto, nRow, nCol, cColor )
RETURN ( DispOutAt( nRow, nCol, PadR( " " + Left( RTrim( cTexto ), MaxCol() - 2), MaxCol() ), cColor, .F. ) )
21 Mai 2015 22:54
FUNCTION msg_3(w_msg) // Procedure: Mensagem Com Retorno
// : SIM ou NAO
@ 24,01 SAY space(80)
dc = " "
@ 24,03 SAY w_msg COLOR "GR+/N" get dc pict "!" valid dc $ "SNsn"
read
@ 24,01 SAY space(80) // Limpa apos a exibicao da mensagem
return NIL
FUNCTION MsgSimNao( cTexto ) // Procedure: Mensagem Com Retorno
@ 24,01 SAY space(80)
cResposta := " "
@ 24,03 SAY cTexto COLOR "GR+/N" GET cResposta PICTURE "!" VALID cResposta $ "SN"
READ
@ 24,01 SAY space(80) // Limpa apos a exibicao da mensagem
RETURN cResposta == "S"
Msg_2( "sim ou nao" )
IF dc = 'S" // obriga que Msg_2 use DC
IF MsgSimNao( "Sim ou Nao" )
21 Mai 2015 23:08
JoséQuintas escreveu:Sobre o horário de verão, no Windows está marcando que vai mudar o horário em outubro.
Devo desativar mesmo estando tudo ok?
21 Mai 2015 23:33
sele estado
set order TO 1
go top
seek (westado)
if eof()
alert ( "Estado n„o encontrado" )
loop
else
SET COLOR TO g+/n
@ 12,49 SAY estado
SET COLOR TO w/n
endif
STATIC FUNCION EstadoOk( cEstado )
LOCAL nSelect := Select(), lOk := .T.
sele estado
set order TO 1
seek (westado)
if eof()
alert ( "Estado n„o encontrado" )
lOk := .F.
else
@ 12,49 SAY estado COLOR "GR/N"
endif
SELECT ( nSelect )
RETURN lOk
22 Mai 2015 00:07
SET MESSAGE TO 24 CENTER
@ 2, 3 GET variavel MESSAGE "teste"
READ
22 Mai 2015 00:19
@ 12, 46 GET wEstado PICTURE "@!" VALID EstadoOk( wEstado ) MESSAGE "Informe o ESTADO, ESC abandona"
@ 16, 36 GET wDt_Entrada VALID Dtos( wDt_Entrada ) >= "20150101" .AND. wDt_Entrada <= Date() MESSAGE "Informe a Data de Entrada, ESC abandona"
@ 16, 52 GET wDias PICTURE "9999" VALID wDias > 0 MESSAGE "Informe a qtde. de dias, ESC abandona"
@ 16, 60 GET wDt_Saida WHEN ( wDt_Saida := wDt_Entrada + wDias, .F. )
@ 20, 36 get wqtde PICTURE "9,999.999" valid wqtde >= 0 MESSAGE "Informe a Quantidade, ESC abandona"
@ 20, 48 get wvlr_unit PICTURE "9,999.999" valid wvlr_unit >= 0 MESSAGE "Informe o valor unitário, ESC abandona"
@ 20, 60 GET wVlr_Total PICTURE "9,999,999.99" WHEN ( wVlr_Total := wQtde * wVlr_Unit, .F. )
READ
Inkey(3)