Acontece que ela só está pesquisando (buscando) o primeiro caractere digitado. A partir do segundo, nada ocorre ou se perde a referencia.
Vejam o PRG completo que posto. A pesquisa letra a letra está entre as linhas 151 a 188.
Como sou um pouco leigo no TBROWSE, gostaria que comentassem se algumas linhas são ou não necessárias na parte que está ligada a isso.
Att.
ERASMO ANDRIOLI
Código: Selecionar todos
FUNCTION SIGMOVI
*------------------------
* SIGMOVI.PRG - Venda de Ve¡culos...
*------------------------
#include "Inkey.ch"
set key K_F9 to
PUBLIC t_nome,t_comis,t_comissao
VLMouseOFF() // (VISUAL LIB)
TEL_EST=SAVENV()
SET CURSOR ON
SELE 12
USE SIGASTOS SHARED ALIAS SIGAS
SET INDEX TO SIGASTOS
SET ORDER TO 1
SELE 13
USE SIGITENS SHARED ALIAS ITE
SET INDEX TO SIGITENS
SET ORDER TO 1
SELE 14
USE SIGRECE SHARED ALIAS SIREC
SET INDEX TO SIGRECE
SET ORDER TO 1 // por n§ de lancamento..
SELE 15
USE SIGVEND SHARED ALIAS VEND
SET INDEX TO SIGVEND
SET ORDER TO 1
SELE 19
USE SIGCOMIS SHARED ALIAS COMI
SET INDEX TO SIGCOMIS
SET ORDER TO 1
SELE 20
USE SIGIPVA SHARED ALIAS SIPVA
SET INDEX TO SIGIPVA
SET ORDER TO 1
SELE 2
USE CLIENTES SHARED ALIAS CLI
SET INDEX TO CLIENTES
SET ORDER TO 1
SELE 1
USE VEICULOS SHARED ALIAS VEI
SET INDEX TO VEICULOS
SET ORDER TO 10 // o index desse ORDER ‚ por modelo + vendido = NAO
* Desenhando Linha de Comandos...
@24,00 SAY "F2" COLOR("W+/BG");@24,02 SAY "GASTOS" COLOR("N/BG")
IF nivel_usu = 1 .OR. nivel_usu = 2
@24,09 SAY "F3" COLOR("W+/BG");@24,11 SAY "VENDER" COLOR("N/BG")
ENDIF
@24,19 SAY "F4" COLOR("W+/BG");@24,21 SAY "IPVA" COLOR("N/BG")
@24,29 SAY "F5" COLOR("W+/BG");@24,31 SAY "PLACA" COLOR("N/BG")
@24,39 SAY "F6" COLOR("W+/BG");@24,41 SAY "DATA" COLOR("N/BG")
@24,49 SAY "F7" COLOR("W+/BG");@24,51 SAY "CODIGO" COLOR("N/BG")
IF nivel_usu = 1
@24,59 SAY "F8" COLOR("GR+/BG");@24,61 SAY "CUSTO" COLOR("N/BG")
ENDIF
WIN(2,1,21,78,"VENDA DE VEICULOS",'GR+/N+*','N+*/W')
DBGOTOP()
PRIV aCampos:={{"codigo","999999","Codigo"},;
{"data","99999999","Aquisicao"},;
{"modelo","@!","Modelo"},;
{"ano","@!","Ano/Mod"},;
{"left(cor,4)","@!","Cor"},;
{"vlr_venda","@E 999,999.99","Valor"}}
BRW_ARQ(2,1,20,78,aCampos)
DESKTOP()
RSTENV(TEL_EST)
SET FILTER TO
RETURN
*****************
PROC BRW_ARQ
*****************
Local nTamNomeP:= 1
Local nQuantRegP:= 0
Local nQuantMaxR:= 60
PARAMETERS brw_ls,brw_cs,brw_li,brw_ci,brw_campos
brw:=TBrowseNew(brw_ls+1,brw_cs+1,brw_li-1,brw_ci-1)
//...Prepara cores padrao para o TBrowse
brw:colorspec := "n+*/w,G+/B,GR+/B,R+/B,GB+/B,RB+/B,W+/G,R*/B"
//...Prepara separadores de cabecalho e colunas
brw:headsep:=chr(205)+chr(209)+chr(205)
brw:colsep :=""+chr(179)+"" // Barra separadora colunas...
brw:footsep:=chr(205) // Ultima linha...
brw:gotopblock({|| dbGoTop()})
brw:gobottomblock({|| dbGoBottom()})
brw:skipblock({|_1| MOV_PTR(_1)})
//...Definicao de colunas com TBColummnNew()
FOR i_=1 TO LEN(brw_campos)
cp_titu:=brw_campos[i_,3]
cp_masc:=brw_campos[i_,2]
cp_:=brw_campos[i_,1]
brw:addcolumn(tbcolumnnew(cp_titu,&("{||TRAN("+cp_+",["+cp_masc+"])}")))
brw:getcolumn(i_):width := LEN(TRAN(&cp_.,cp_masc))
NEXT
* Mostrando nome adquirido de e placa...
t_placa=placa
origem =compra_de
SELE CLI
DBSEEK(origem)
COR_ANT=SETCOLOR()
SET COLOR TO N+*/W
@20,02 SAY "ADQUIRIDO DE:"
@20,63 SAY "PLACA:"
SET COLOR TO R*/W
@20,16 SAY nome
@20,70 say t_placa
SETCOLOR(COR_ANT)
SELE VEI
volta_db=.t.
st_pesq:=""
DO WHILE volta_db
brw:colorRect({brw:RowPos,1,brw:RowPos,brw:ColCount},{ 7 , 8 })
DO WHILE !brw:stabilize() .AND. NEXTKEY()=0
ENDDO
brw:refreshAll()
brw:ForceStable()
brw:colorRect({brw:RowPos,1,brw:RowPos,brw:ColCount},{ 7 , 8 })
cCorAnt:=SetColor("B*/W")
@ 23,12 SAY "BUSCAR:"
@ 23,20 SAY LEFT(st_pesq+spac(40),35)
SetPos(23,(20+Len(st_pesq)))
SetColor(cCorAnt)
tecl_p=INKEY(0)
carac_ = UPPER(CHR(tecl_p))
// pesquisa letra a letra...
IF (tecl_p>31 .and. tecl_p<1000) .or. tecl_p = K_BS
If tecl_p = K_BS
st_p=Left(st_pesq,Len(st_pesq)-1)
Else
st_p=st_pesq+carac_
Endif
st_p_:=st_p
nTamNomeP:= Len(st_p_)
nQuantRegP:= 0
VEI->(DBSeek(st_p_))
Private brw_mat:={}
SEEK st_p_
IF FOUND() .and. !EMPT(st_p_)
Do While !Eof()
If Substr(VEI->MODELO,1,nTamNomeP) == st_p_
nQuantRegP += 1
if nQuantRegP > nQuantMaxR
EXIT
EndIf
aadd(brw_mat, {VEI->MODELO} )
ElseIf Substr(VEI->MODELO,1,nTamNomeP) > st_p_
EXIT
Endif
SKIP
EndDo
ENDIF
if Len(brw_mat)==0
brw_mat:={{"",""}}
Endif
st_pesq=st_p
n:=1
ntot:=len(brw_mat)
brw:rowpos=1
brw:configure()
LOOP
ENDIF
* Mostrando nome adquirido de e placa...
t_placa=placa
origem =compra_de
SELE CLI
DBSEEK(origem)
COR_ANT=SETCOLOR()
SET COLOR TO N+*/W
@20,02 SAY "ADQUIRIDO DE:"
@20,63 SAY "PLACA:"
SET COLOR TO R*/W
@20,16 SAY nome
@20,70 say t_placa
SETCOLOR(COR_ANT)
SELE VEI
IF tecl_p= K_F2 // VER GASTOS...
TEL=SAVENV()
VER_GAS()
SELE VEI
RSTENV(TEL)
ENDIF
IF tecl_p = K_F3 // Vender o Veiculo selecionado...
TEL=SAVENV()
X_VENDE()
SELE VEI
RSTENV(TEL)
ENDIF
IF tecl_p = K_F4 // IPVA...
TEL=SAVENV()
VER_IPVA()
SELE VEI
RSTENV(TEL)
ENDIF
IF tecl_p = K_F5 // buscar por PLACA...
TEL=SAVENV()
WIN(08,09,11,27,"BUSCAR POR PLACA",'W/RB+*','RB+*/W')
SET CURSOR ON
T_PLA = " - "
@10,12 SAY "PLACA:" GET T_PLA
READ
IF LASTKEY()=27
RSTENV(TEL)
KEYBOARD CHR(176)
RETURN(1)
ENDIF
ffseek := T_PLA
SET SOFTSEEK ON
DBSEEK(ffseek)
SET SOFTSEEK OFF
brw:refreshAll()
ENDIF
IF tecl_p = K_F6 // buscar pela DATA DE COMPRA...
TEL=SAVENV()
WIN(08,09,11,27,"BUSCAR POR DATA",'W/RB+*','RB+*/W')
SET CURSOR ON
T_DT = DATE()
@10,12 SAY "DATA:" GET T_DT
READ
IF LASTKEY()=27
RSTENV(TEL)
KEYBOARD CHR(176)
RETURN(1)
ENDIF
ffseek := T_DT
SET SOFTSEEK ON
SET ORDER TO 6 // Ordena por data de compra...
DBSEEK(ffseek)
SET SOFTSEEK OFF
brw:refreshAll()
ENDIF
IF tecl_p = K_F7 // buscar por CODIGO...
TEL=SAVENV()
WIN(08,09,11,25,"BUSCAR CODIGO",'W/RB+*','RB+*/W')
SET CURSOR ON
T_VEBU = 0
@10,10 SAY "CODIGO:" GET T_VEBU PICT '999999'
READ
IF LASTKEY()=27
RSTENV(TEL)
KEYBOARD CHR(176)
RETURN(1)
ENDIF
ffseek := T_VEBU
SET SOFTSEEK ON
SET ORDER TO 1
DBSEEK(ffseek)
SET SOFTSEEK OFF
brw:refreshAll()
ENDIF
IF tecl_p = K_F8 // Consulta o Custo do Veiculo (S¢ pra NIVEL 1)
IF nivel_usu = 1
TELA_CUS=SAVENV(13,53,18,78)
WIN(13,53,17,77,"SIGARA INFORMA:","GR+/R*+","R+*/W")
SET COLOR TO "N*/W,W+/W+"
@15,55 SAY 'VLR COMPRA:'
@16,55 SAY 'VLR CUSTO.:'
@15,66 SAY VLR_COMPRA PICT "999,999.99"
@16,66 SAY VLR_CUSTO PICT "999,999.99"
INKEY(0)
RSTENV(TELA_CUS)
ENDIF
ENDIF
IF tecl_p = K_ENTER // ENTER Consulta Conteudo...
TEL=SAVENV()
V_CONSU()
SELE VEI
RSTENV(TEL)
ENDIF
brw:dehilite()
DO CASE
CASE tecl_p = K_ESC
volta_db=.f.
CASE tecl_p = K_UP
brw:up()
CASE tecl_p = K_DOWN
brw:down()
CASE tecl_p = K_RIGHT
brw:right()
CASE tecl_p = K_LEFT
brw:left()
CASE tecl_p = K_HOME
brw:home()
CASE tecl_p = K_END
brw:end()
CASE tecl_p = K_PGUP
brw:pageup()
CASE tecl_p = K_PGDN
brw:pagedown()
CASE tecl_p = K_CTRL_PGDN
brw:gobottom()
CASE tecl_p = K_CTRL_PGUP
brw:gotop()
CASE tecl_p = K_CTRL_END
brw:panend()
CASE tecl_p = K_CTRL_HOME
brw:panhome()
CASE tecl_p = K_CTRL_LEFT
brw:panleft()
CASE tecl_p = K_CTRL_RIGHT
brw:panright()
ENDCASE
ENDDO
RETU
*------------------------------
FUNC MOV_PTR(a_pular)
LOCAL ja_pulado := 0, chv_
IF a_pular = 0
SKIP 0
ELSE
DO WHILE !EOF() .AND. !BOF() .AND.;
a_pular != ja_pulado
IF a_pular > 0
SKIP
ja_pulado++
ELSE
SKIP -1
ja_pulado--
ENDI
ENDD
IF EOF() .OR. BOF()
IF a_pular > 0
GO BOTTOM
ja_pulado--
ELSE
GO TOP
ja_pulado++
ENDI
ENDI
ENDI
RETU ja_pulado
*********************
PROCEDURE V_CONSU
*********************
posireg=RECNO()
IF codigo = 0 // Se nao existir lancamentos, loop...
MSGBOX1("NÇO EXISTEM VEÖCULOS CADASTRADOS...")
RETURN(1)
ENDIF
WIN(02,00,23,78,"VEÖCULOS","GR+/R*+","R+*/W")
SET COLOR TO "N*/W,W+/W+"
@03,02 SAY "AQUISIۂO.......: / / "
@03,34 SAY "MODELO:"
@04,02 SAY "FABRICANTE......:"
@04,42 SAY "ANO/MODELO....:"
@05,02 SAY "COR PREDOMINANTE:"
@05,42 SAY "PLACAS........:"
@06,02 SAY "COMBUSTÖVEL.....:"
@07,02 SAY "N§ CHASSI.......:"
@07,42 SAY "N§ DOCUMENTO..:"
@08,02 SAY "PORTE (NOME)....:"
@09,02 SAY "CLIENTE.........:"
@10,02 SAY "PROPRIETµRIO....:"
@11,02 SAY "VALOR P/ VENDA..:"
@13,04 SAY "O"; @13,41 SAY "A"
@14,04 SAY "B"; @14,41 SAY "C"
@15,04 SAY "S"; @15,41 SAY "E"
@16,04 SAY "E"; @16,41 SAY "S"
@17,04 SAY "R"; @17,41 SAY "S"
@18,04 SAY "V"; @18,41 SAY "à"
@19,04 SAY "A"; @19,41 SAY "R"
@20,04 SAY "€"; @20,41 SAY "I"
@21,04 SAY "Ç"; @21,41 SAY "O"
@22,04 SAY "O"; @22,41 SAY "S"
* Memorizando o Fabricante...
FABRICA=SPACE(10)
FABRICANTE=SPACE(1)
MEMFAB()
IF t_combust='1'
combust='ALCOOL '
ELSEIF t_combust='2'
combust='GASOLINA'
ELSEIF t_combust='3'
combust='DIESEL '
ELSEIF t_combust='4'
combust='A/G FLEX'
ELSEIF t_combust='5'
combust='OUTROS '
ENDIF
SET COLOR TO "GR+/R+*"
@02,72 SAY STUFF(PADL(codigo,6,"0"),6,0,"")
SET COLOR TO "N/W"
@03,20 say data
@03,42 say modelo
@04,20 say fabricante + ' - ' + fabrica
@04,58 say ano
@05,20 say cor
@05,58 say placa
@06,20 say t_combust + ' - ' + combust
@07,20 say n_chassis
@07,58 say n_document
origem1 = prop_doc
origem2 = compra_de
origem3 = propriet
SELE CLI
DBSEEK(origem1)
@08,20 say origem1 PICT '9999'
@08,24 say ' - '+nome
DBSEEK(origem2)
@09,20 say origem2 PICT '9999'
@09,24 say ' - '+nome
DBSEEK(origem3)
@10,20 say origem3 PICT '9999'
@10,24 say ' - '+nome
SELE VEI
@11,20 say vlr_venda pict "999,999.99"
@13,06 say obs1
@14,06 say obs2
@15,06 say obs3
@16,06 say obs4
@17,06 say obs5
@18,06 say obs6
@19,06 say obs7
@20,06 say obs8
@21,06 say obs9
@22,06 say obs10
@13,43 say aces1
@14,43 say aces2
@15,43 say aces3
@16,43 say aces4
@17,43 say aces5
@18,43 say aces6
@19,43 say aces7
@20,43 say aces8
@21,43 say aces9
@22,43 say aces10
DBGOTO(posireg)
INKEY(0)
RETURN
***********************
PROCEDURE X_VENDE
***********************
IF nivel_usu <> 1 .AND. nivel_usu <> 2
MSGBOX1("VOCE NÇO POSSUI PRIVILGIO PARA VENDER!!!")
RETURN
ENDIF
TEL=SAVENV()
posireg=RECNO()
IF codigo = 0 // Se nao existir lancamentos, loop...
MSGBOX1("NÇO EXISTEM VEÖCULOS CADASTRADOS...")
RETURN(1)
ENDIF
WIN(04,3,22,77,"VENDAS",'GR+/R+*','R+*/W')
SET COLOR TO "N*/W,W+/W+"
SET CURSOR ON
t_dtvenda= date()
t_comprou= 0
t_nome = space(40)
t_cond1 = space(50)
t_cond2 = space(50)
t_cond3 = space(50)
t_cond4 = space(50)
t_cond5 = space(50)
t_cond6 = space(50)
t_cond7 = space(50)
t_cond8 = space(50)
t_cond9 = space(50)
t_cond10 = space(50)
t_vlrven = vlr_venda
t_vlrcom = vlr_venda
t_vlrprin = vlr_venda
cod_funci = 0
t_modelo = modelo
t_placa = placa
t_financia= space(10) // banco/operadora financiador
t_ret_fina=0 // vlr do retorno quando financeira
@06,07 SAY "MODELO.........:"+SPACE(1)+t_modelo
@07,07 SAY "DATA DA VENDA..:"
@08,07 SAY "COMPRADOR......:"
@09,07 SAY "VALOR DA VENDA.:"
@09,43 SAY "O.FINANC: R$"
@10,07 SAY "CONDIیES......:"
@21,07 SAY "VENDEDOR.......:"
WIN(12,6,13,20,'VALOR ORIGINAL',,,.F.)
SET COLOR TO 'N/G'
@13,6 SAY t_vlrprin pict ' 999,999.99 '
SET COLOR TO "N*/W,W+/W+"
* Mostrando os GASTOS com o Veiculo ACHADO para venda...
positem=codigo
saldo_gas=0
SELE SIGAS
DBGOTOP()
SET FILTER TO CODVEI = positem
SUM valor TO saldo_gas
WIN(15,6,16,20,'INVESTIMENTOS',,,.F.)
SET COLOR TO 'N*/R'
@16,6 SAY saldo_gas pict '999,999,999.99 '
SET COLOR TO "N*/W,W+/W+"
SET FILTER TO
* Memorizando o IPVA do Veiculo selecionado para venda...
saldo_ipva=0
SELE SIPVA
DBGOTOP()
SET FILTER TO COD_VEIC = positem
SUM vlr_ipva TO saldo_ipva
SET FILTER TO
WIN(18,6,19,20,'DBITOS DE IPVA',,,.F.)
SET COLOR TO 'N*/GR'
@19,6 SAY saldo_ipva pict ' 999,999.99 '
SET COLOR TO "N*/W,W+/W+"
* Testando para ver se tem os Itens Obrigatorios...
SELE ITE
DBGOTOP()
DBSEEK(positem)
IF FOUND()
IF ITEM01 = 'N' .OR. ITEM02 = 'N' .OR. ITEM03 = 'N' .OR. ;
ITEM04 = 'N' .OR. ITEM05 = 'N' .OR. ITEM06 = 'N' .OR. ITEM07 = 'N'
MSGBOX1("AUSÒNCIA DE ITENS DE SEGURAN€A!!!",,12)
SELE VEI
DBGOTO(posireg)
KEYBOARD CHR(255)
RSTENV(TEL)
RETURN(1)
ENDIF
ENDIF
SELE VEI
DO WHILE .T.
set key K_F9 to CTOX()
SET COLOR TO "N*/W,N/W"
@07,24 GET t_dtvenda
@08,24 GET t_comprou pict "9999" VALID le_comprou()
@09,24 GET t_vlrven pict "999,999.99" VALID LEVALOR_V()
@09,53 GET t_financia
@09,66 GET t_ret_fina pict "999,999.99"
@10,24 GET t_cond1
@11,24 GET t_cond2
@12,24 GET t_cond3
@13,24 GET t_cond4
@14,24 GET t_cond5
@15,24 GET t_cond6
@16,24 GET t_cond7
@17,24 GET t_cond8
@18,24 GET t_cond9
@19,24 GET t_cond10
@21,24 GET cod_funci PICT "999" valid lerfun()
READ
set key K_F9 to
IF LASTKEY()=27
SELE VEI
DBGOTO(posireg)
RETURN
ENDIF
IF t_comprou = 0
MSGBOX1("NéMERO DO COMPRADOR INCORRETO...")
LOOP
ENDIF
IF t_ret_fina <> 0 .and. EMPTY(t_financia)
MSGBOX1("INFORME A OPERADORA FINANCEIRA...")
LOOP
ENDIF
IF COD_FUNCI = 0
MSGBOX1("NéMERO DO VENDEDOR/FUNCIONARIO INCORRETO...")
LOOP
ENDIF
* Gravando a baixa do Veiculo...
DO WHILE .T.
TELA_1=SAVENV(12,18,18,62)
WIN(12,18,17,60,"CONFIRMA A VENDA?",'W/RB+*','RB+*/W')
opcao := LinButton2(,2,15,,1,"NÆo",,"Sim")
do case
case opcao=1
RSTENV(TELA_1)
case opcao=2
SELE VEI
DBRLOCK()
REPLACE dtvenda WITH t_dtvenda
REPLACE comprador WITH t_comprou
REPLACE nome_cmp WITH t_nome
REPLACE vlr_vendid WITH t_vlrven
REPLACE financia WITH t_financia
REPLACE ret_fina WITH t_ret_fina
REPLACE cond1 WITH t_cond1
REPLACE cond2 WITH t_cond2
REPLACE cond3 WITH t_cond3
REPLACE cond4 WITH t_cond4
REPLACE cond5 WITH t_cond5
REPLACE cond6 WITH t_cond6
REPLACE cond7 WITH t_cond7
REPLACE cond8 WITH t_cond8
REPLACE cond9 WITH t_cond9
REPLACE cond10 WITH t_cond10
REPLACE vendido WITH "S"
REPLACE funci_vend WITH cod_funci
DBCOMMIT()
DBUNLOCK()
* Gravando Dados da Comissao...
SELE COMI
SET ORDER TO 1
SET DELETED OFF
DBGOBOTTOM()
SET DELETED ON
num=lcto+1
DBRLOCK()
DBAPPEND()
REPLACE lcto WITH num
REPLACE placa WITH t_placa
REPLACE cod_vend WITH cod_funci
REPLACE cod_veic WITH positem
REPLACE data_movi WITH t_dtvenda
REPLACE historico WITH t_modelo
REPLACE vlr_venda WITH t_vlrven
if t_comissao <> 0
REPLACE credito WITH t_comissao
else
REPLACE porcent WITH t_comis
REPLACE credito WITH t_vlrven*porcent/100
endif
DBCOMMIT()
DBUNLOCK()
OTI := MsgBox2("INCLUIR PENDÒNCIAS?",,12,"NÇO","SIM",,1)
IF OTI=2
DO VENDA_PEN
ENDIF
* Parcelando os valores...
DO INC_REC2
SET DECIMALS TO
SELE VEI
RSTENV(TEL)
KEYBOARD CHR(176)
DBGOTOP()
RETURN(1)
OTHERWISE
IF LASTKEY()=27
SELE VEI
DBGOTO(posireg)
KEYBOARD CHR(255)
RSTENV(TEL)
RETURN(1)
ENDIF
ENDCASE
RSTENV(TELA_1)
EXIT
ENDDO
ENDDO
RETURN
*********************
PROCEDURE INC_REC2 // Rotina: Inclusao de Recebimentos
*********************
WIN(04,07,21,76,"CONTAS A RECEBER - INCLUSAO","GR+/R*+","R+*/W")
SET COLOR TO "N*/W,W+/W+"
SET CURSOR ON
TEL5=SAVENV()
TDOC = SPACE(10)
THP = RTRIM(LEFT(t_modelo,20))+' - '+t_placa // Nome Veiculo/Placa...
TVALORLCTO = t_vlrven
TCODIGO = t_comprou // Cliente da tela de Vendas...
TPARCELA = 0
TDTEMLCTO = DATE()
TDTMVLCTO = DATE()
TJUROS = 0
TMULTA = 0
TVEIC = positem
SET COLOR TO "N*/W,W+/W+"
SELE SIREC
DO WHILE .T.
TOTPARCE = 0
valor := t_vlrven
parce := 0
venct := Date()
tjuros:= 0
tmulta:= 0
@06,09 Say "Valor:"
@06,17 SAY valor Pict "@E 999,999.99"
@06,30 Say "Parcelas:" get parce Pict "99"
@06,45 Say "1§ Vencimento" get venct
@07,09 Say "Juros/M (%):" GET TJUROS PICT '99.999'
@07,30 SAY "Multa (%):" GET TMULTA PICT '99.999'
READ
IF LASTKEY()=27
LOOP
ENDIF
IF parce > 12
msgbox1("USE NO MµXIMO 12 PARCELAS!!!")
loop
ENDIF
li := 9
SET DECIMALS TO 2
SET FIXED ON
parcelas := {}
For i=1 to parce
valarred1=STR( valor / parce )
valarred2=VAL( valarred1 )
AADD(parcelas, { valarred2, i, venct})
* 1 , 2, 3
_var := venct+31
venct:= _var
Next
ANT_TEL=SAVENV()
For i=1 to parce
@ li,10 say 'PARCELA:'
@ li,20 get parcelas[i,2] Pict "99"
@ li,24 get parcelas[i,1] PICT '999,999.99'
@ li,40 get parcelas[i,3]
li := li + 1
Next
read
RSTENV(ANT_TEL)
IF LASTKEY()=27
LOOP
ENDIF
* Testando se o Valor de Venda Bate com o Valor das Parcelas informadas...
For i=1 to parce
totparce=totparce+parcelas[i,1]
li := li + 1
Next
totparce=str(totparce) // torna caracter
totparce=val(totparce) // e aqui remove as dizimas e quebras
IF totparce <> valor
msgbox1("SOMA DAS PARCELAS DIFERE DO TOTAL!"+TRANS(totparce,"@E 999,999.99"))
totparce=0
LOOP
ENDIF
WIN(10,32,10,45,"GRAVANDO...")
* GRAVANDO AS PARCELAS...
For i=1 to parce
SET DELETED OFF
DBGOBOTTOM()
SET DELETED ON
num=numlcto+1
DBAPPEND()
DBRLOCK()
REPLACE NUMLCTO WITH num
REPLACE CONTA WITH Tcodigo
REPLACE NOME_CLI WITH T_NOME
REPLACE DTMVLCTO WITH parcelas[i,3] // Vencimentos...
REPLACE DTEMLCTO WITH TDTEMLCTO
REPLACE DOC WITH LTRIM(STR(TVEIC))
REPLACE VEICULO WITH TVEIC
REPLACE HP WITH THP
REPLACE VALORLCTO WITH parcelas[i,1] // Valores das Parcelas...
REPLACE PARCELA WITH parcelas[i,2] // Numeros das Parcelas..
REPLACE JUROS WITH TJUROS
REPLACE MULTA WITH TMULTA
DBUNLOCK()
DBCOMMIT()
li := li + 1
NEXT
EXIT
ENDDO
*------------------------
static function LEVALOR
*------------------------
IF LASTKEY()=5
RETURN .T.
ENDIF
IF TVALORLCTO = 0 .OR. TVALORLCTO < 0.01
MSGBOX1("VALOR DEVE SER INFORMADO...",,12)
RETURN .F.
ENDIF
RETURN .T.
********************
PROCEDURE le_comprou
********************
SELE CLI
SET ORDER TO 1
DBGOTOP()
IF (t_comprou != 0)
DBSEEK(t_comprou)
IF (FOUND())
@08,24 say CODIGO
@08,28 SAY " - "+NOME
t_comprou=CODIGO
t_nome =NOME
return .t.
ENDIF
ENDIF
IF LASTKEY()=27 .AND. LASTKEY()=13
RETURN .F.
ENDIF
TELACLI=SAVENV()
WIN(03,02,21,78,'CONTAS CADASTRADAS','GR+/RB','RB*/W')
ar_dbf:=ALIAS()
nCol:=20
v_tel_p:=SAVESCREEN(0,0,MAXROW(),79)
nVar=0
IF !EMPTY(ar_dbf) // sava situacao atual
ultreg =RECNO() // registro e
ord_ind=INDEXORD() // indice utilizado
ENDIF
SELE CLI
SET ORDER TO 2
DBGOTOP()
KEYBOARD CHR(27)
dbedit(6,3,20,77, {"CODIGO", "NOME", "PESSOA"},,, {"Codigo", "Nome", "Pessoa"},'Ý')
@ 04, 05 SAY "Localizar:"
@ 04, 20 SAY SPAC(30) COLOR "N/W"
nCol=20
@ 04, 20 SAY "" COLOR "N/W"
cNome=SPAC(00)
DO WHILE .T.
IF LASTKEY()=13
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
KEYBOARD STR(nVar)
t_comprou=nVar
t_nome =NOME
KEYBOARD CHR(176)
RSTENV(TELACLI)
@08,24 SAY t_comprou PICT "9999"
SET ORDER TO 1
DBGOTOP()
DBSEEK(t_comprou)
t_comprou=codigo
t_nome =NOME
@08,28 SAY " - "+NOME
RETURN (.t.)
ELSE
nKey=INKEY(0)
IF nKey=27
RSTENV(TELACLI)
RETURN(.F.)
* EXIT
ENDIF
IF nKey=13
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
KEYBOARD STR(nVar)
t_comprou=nVar
KEYBOARD CHR(176)
RSTENV(TELACLI)
@08,24 SAY t_comprou PICT "9999"
SET ORDER TO 1
DBGOTOP()
DBSEEK(t_comprou)
t_comprou=codigo
t_nome =NOME
@08,28 SAY " - "+NOME
RETURN (.t.)
ENDIF
ENDIF
IF nKey=8 .or. nKey=19
nCol=nCol-1
IF nCol < 20
nCol=20
ENDIF
cNome=SUBS(cNome,1,LEN(cNome)-1)
@ 04, 20 SAY cNome+" " COLOR "N/W"
ELSEIF (nKey>=32 .and. nKey<=165)
nCol=nCol+1
IF nCol>=50
nCol=50
cNome=SUBS(cNome,1,LEN(cNome)-1)
ENDIF
cNome=UPPER(cNome+CHR(nKey))
@ 04,20 SAY cNome COLOR "N/W"
ENDIF
IF !PESQ_DBED2(cNome)
nCol=nCol - 1
IF nCol <20
nCol=20
ENDIF
cNome=SUBS(cNome,1,LEN(cNome)-1)
@ 04,20 SAY cNome COLOR "N/W"
ENDIF
@ 04,20 SAY cNome COLOR "N/W"
ENDDO
IF !EMPTY(ar_dbf)
SELE (ar_dbf)
DBSETORDER(ord_ind)
GO ultreg
ENDIF
RESTSCREEN(0,0,MAXROW(),79,v_tel_p)
RETURN
*------------------------
static function LEVALOR_V
*------------------------
IF LASTKEY()=5
RETURN .T.
ENDIF
IF T_VLRVEN = 0 .OR. T_VLRVEN < 0.01
MSGBOX1("VALOR DEVE SER INFORMADO...",,12)
RETURN .F.
ENDIF
SET COLOR TO BG*/W
@09,34 SAY ": %"
@09,35 SAY ( T_VLRVEN / T_VLRPRIN ) * 100 - 100 pict "999.99"
RETURN .T.
**********************
static function LERFUN
**********************
SELE VEND
DBGOTOP()
IF (COD_FUNCI != 0)
DBSEEK(COD_FUNCI)
IF (FOUND())
COR_ANT=SETCOLOR()
SET COLOR TO B+*/W
@21,28 say "- "+VENDEDOR
SETCOLOR(COR_ANT)
COD_FUNCI = CODVE
NOM_FUNCI = VENDEDOR
T_COMISSAO= COMIS_VLR
T_COMIS = COMIS
return .t.
ENDIF
ENDIF
IF LASTKEY()=27 .AND. LASTKEY()=13
RETURN .F.
ENDIF
GOTO TOP
ALTE=SAVENV()
SET ORDER TO 2
DBGOTOP()
WIN(10,19,20,59,"VENDEDORES EXISTENTES","W+/R",'R*/W')
dbedit(11,20,19,58, {"Codve", "Vendedor"},,, {"CODIGO","NOME"},"Ä")
RSTENV(ALTE)
IF LASTKEY()=27
RETURN .F.
ELSE
@21,24 say CODVE
COR_ANT=SETCOLOR()
SET COLOR TO B+*/W
@21,28 say "- "+vendedor
SETCOLOR(COR_ANT)
COD_FUNCI=CODVE
NOM_FUNCI=VENDEDOR
T_COMISSAO=COMIS_VLR
T_COMIS = COMIS
return .t.
ENDIF
return .t.
*********************
PROCEDURE VER_IPVA
*********************
WIN(06,18,09,45,'RELATàRIO DE IPVA')
SET COLOR TO "N*/W,G/W+"
SET CURSOR ON
FINAL1=SPACE(1)
FINAL2=SPACE(1)
DO WHILE .T.
@08,20 SAY "PLACAS COM FINAL: - "
SET COLOR TO "N*/W,N/W+"
@08,38 GET FINAL1 VALID (FINAL1$"0123456789")
@08,42 GET FINAL2 VALID (FINAL2$"0123456789")
READ
IF LASTKEY()=27
RETURN
ENDIF
EXIT
ENDDO
OTI := MsgBox3("ONDE DESEJA IMPRIMIR?",,12,"TELA","IMPRESSORA","CANCELAR")
IF OTI=1
WIN(11,13,17,69,"AGUARDE!!! IMPRIMINDO...","GR+/N","N+/W")
FRAME(14,14,16,68)
DO IPVA_TEL
ELSEIF OTI=2
WIN(11,13,17,69,"AGUARDE!!! IMPRIMINDO...","GR+/N","N+/W")
FRAME(14,14,16,68)
DO IPVA_IMP
ELSEIF OTI=3
RSTENV(TEL)
RETURN(1)
ENDIF
KEYBOARD CHR(255)
RETURN
*********************
PROCEDURE IPVA_TEL
*********************
SET DEVICE TO PRINTER
SET PRINTER TO EXTRA1.PRN
* Filtra as PLACAS com finais desejados pelo Usuario...
SELE VEI
SET ORDER TO 3 // Placa...
SET FILTER TO RIGHT(PLACA,1) = FINAL1 .OR. RIGHT(PLACA,1) = FINAL2
DBGOTOP()
P = 1
PAGINA = 1
AUTOS = 0
ACUMVLR= 0
control= 0
termom:= 53 / RECCOUNT()
porce := 100 / RECCOUNT()
DO WHILE .NOT. EOF()
SET DEVICE TO SCREEN
control++
@15,15+(control*termom) SAY "±" COLOR("BG+/W")
SET DEVICE TO PRINTER
IF PROW() = 0
@PROW()+1,0 SAY "CODIGO"
@PROW(),08 say "AQUISICAO"
@PROW(),20 say "MODELO"
@PROW(),50 say "ANO"
@PROW(),61 say "COR"
@PROW(),75 say "PLACA"
@PROW(),85 say "COMB"
@PROW(),90 say "ORIGEM"
@PROW(),110 say "VALOR VENDA-R$"
@prow()+1,0 SAY repl("-",124)
ENDIF
* Se for Vendido... saltar para o proximo...
IF VENDIDO='S'
DBSKIP()
LOOP
ENDIF
IF t_combust='1'
combust='ALCOOL '
ELSEIF t_combust='2'
combust='GASOLINA'
ELSEIF t_combust='3'
combust='DIESEL '
ELSEIF t_combust='4'
combust='A/G FLEX'
ELSEIF t_combust='5'
combust='OUTROS '
ENDIF
@PROW()+1,00 say STRZERO(codigo,6,0)
@PROW(),08 say data
@PROW(),20 say modelo
@PROW(),50 say ano
@PROW(),61 say LEFT(cor,10)
@PROW(),75 say placa
@PROW(),85 say left(combust,3)
origem2 = compra_de
SELE CLI
DBGOTO(origem2)
@PROW(),90 say LEFT(nome,20)
SELE VEI
@PROW(),114 say vlr_venda pict "999,999.99"
AUTOS=AUTOS+1
ACUMVLR=ACUMVLR+VLR_VENDA
DBSKIP()
ENDDO
@PROW()+2,0 SAY "QUANTIDE DE VEÖCULOS: "+STR(AUTOS)
@PROW(),90 SAY "TOTAL DO ESTOQUE:"
@PROW(),111 SAY ACUMVLR PICT "99,999,999.99"
@PROW()+1,0 SAY REPL("-",124)
@PROW()+1,0 SAY eu+mfone
@prow()+1,0 SAY repl("-",124)
SETPRC(0,0)
SET DEVICE TO SCREEN
SET PRINTER TO
SET FILTER TO
WIN(2,1,22,78,"EXTRATO DE VEÖCULOS P/ IPVA","GR+/R","R*/W")
MOSTRA("EXTRA1.PRN")
ERASE EXTRA1.PRN
RETURN
*********************
PROCEDURE IPVA_IMP
*********************
arq_x = "C:\TEMP\"+LEFT(TIME(),2)+RIGHT(LEFT(TIME(),5),2)+RIGHT(TIME(),2)+"SI"
SET DEVICE TO PRINTER
SET PRINTER TO &arq_x
* Filtra as PLACAS com finais desejados pelo Usuario...
SELE VEI
SET ORDER TO 3 // Placa...
SET FILTER TO RIGHT(PLACA,1) = FINAL1 .OR. RIGHT(PLACA,1) = FINAL2
DBGOTOP()
P = 1
PAGINA = 1
AUTOS = 0
ACUMVLR= 0
control= 0
termom:= 53 / RECCOUNT()
porce := 100 / RECCOUNT()
DO WHILE .NOT. EOF()
SET DEVICE TO SCREEN
control++
@15,15+(control*termom) SAY "±" COLOR("BG+/W")
SET DEVICE TO PRINTER
IF PROW() = 0
@PROW()+01,0 SAY REPL("=",132)
@PROW()+01,0 SAY "DATA: "+DTOC(DATE())
@PROW(),50 SAY Sistema
@PROW()+1,0 SAY "RELACAO DOS VEICULOS P/ RECOLHER I.P.V.A. COM PLACAS FINAIS: "+FINAL1+" E "+FINAL2
@PROW(),118 SAY "HORA: "+TIME()
@PROW()+01,0 SAY REPL("=",132)
@PROW()+1,0 SAY "CODIGO"
@PROW(),08 say "AQUISICAO"
@PROW(),20 say "MODELO"
@PROW(),50 say "ANO"
@PROW(),61 say "COR"
@PROW(),75 say "PLACA"
@PROW(),85 say "COMB"
@PROW(),90 say "ORIGEM"
@PROW(),110 say "VALOR VENDA-R$"
@prow()+1,0 SAY repl("-",132)
ENDIF
* Se for Vendido... saltar para o proximo...
IF VENDIDO='S'
DBSKIP()
LOOP
ENDIF
IF t_combust='1'
combust='ALCOOL '
ELSEIF t_combust='2'
combust='GASOLINA'
ELSEIF t_combust='3'
combust='DIESEL '
ELSEIF t_combust='4'
combust='A/G FLEX'
ELSEIF t_combust='5'
combust='OUTROS '
ENDIF
@PROW()+1,00 say STRZERO(codigo,6,0)
@PROW(),08 say data
@PROW(),20 say modelo
@PROW(),50 say ano
@PROW(),61 say LEFT(cor,10)
@PROW(),75 say placa
@PROW(),85 say left(combust,3)
origem2 = compra_de
SELE CLI
DBGOTO(origem2)
@PROW(),90 say LEFT(nome,20)
SELE VEI
@PROW(),114 say vlr_venda pict "999,999.99"
AUTOS=AUTOS+1
ACUMVLR=ACUMVLR+VLR_VENDA
DBSKIP()
IF PROW() = TLINPAG .OR. PROW() > TLINPAG
@PROW()+1,0 SAY REPL("=",130)
@PROW()+1,0 SAY eu+mfone
@prow(),121 SAY "Pag.: "+ STRZERO(PAGINA,3,0)
@prow()+1,0 SAY repl("=",130)
PAGINA++
SETPRC(0,0)
ENDIF
ENDDO
@PROW()+2,0 SAY "QUANTIDE DE VEÖCULOS: "+STR(AUTOS)
@PROW(),90 SAY "TOTAL DO ESTOQUE:"
@PROW(),111 SAY ACUMVLR PICT "99,999,999.99"
DO WHILE PROW() < TLINPAG-1
@PROW()+1,0 SAY ""
ENDDO
@PROW()+1,0 SAY REPL("-",132)
@PROW()+1,0 SAY eu+mfone
@prow(),121 SAY "Pag.: "+ STRZERO(PAGINA,3,0)
@prow()+1,0 SAY repl("-",132)
SET FILTER TO
FIMIMP()
RETURN
********************
PROCEDURE VENDA_PEN
********************
WIN(12,04,19,76,"INCLUSÇO DE PENDÒNCIAS")
SET COLOR TO "N*/W,N/W+"
SET CURSOR ON
SELE 11
USE SIGPEND SHARED ALIAS SIPEN
SET INDEX TO SIGPEND
SET ORDER TO 1
DBGOTOP()
@14,5 SAY "DATA.....:"
@16,5 SAY "HISTàRICO:"
LIXO2 = DATE()
LIXO3 = SPACE(60)
TDTPEN = date()
THPPEN = space(60)
THPPEN2 = space(60)
THPPEN3 = space(60)
@14,16 GET LIXO2
@16,16 GET LIXO3
@17,16 GET LIXO3
@18,16 GET LIXO3
CLEAR GETS
DO WHILE .T.
@14,16 GET TDTPEN
@16,16 GET THPPEN
@17,16 GET THPPEN2
@18,16 GET THPPEN3
READ
SELE SIPEN
IF LASTKEY()=27
SELE VEI
SET ORDER TO 2
RSTENV(TEL)
RETURN(1)
ENDIF
DBAPPEND()
DBRLOCK()
REPLACE VEIC_PEN WITH POSITEM
REPLACE VENOM_PEN WITH T_MODELO
REPLACE VEPLA_PEN WITH T_PLACA
REPLACE DT_PEN WITH TDTPEN
REPLACE HIST_PEN WITH THPPEN
REPLACE HIST_PEN2 WITH THPPEN2
REPLACE HIST_PEN3 WITH THPPEN3
DBUNLOCK()
SELE VEI
SET ORDER TO 2
RSTENV(TEL)
RETURN(1)
ENDDO
*********************
PROCEDURE VER_GAS // Mostrar na TELA...
*********************
SELE VEI
campo1 = data
campo2 = modelo
campo3 = ano
campo4 = cor
campo5 = placa
positem=codigo
posireg=RECNO()
SELE SIGAS
SET ORDER TO 2
SET FILTER TO CODVEI = positem
DBGOTOP()
saldo_gas=0
SET DEVICE TO PRINTER
SET PRINTER TO EXTRA1.PRN
DO WHILE .NOT. EOF()
IF PROW()=0
@ PROW()+1,0 SAY 'CODIGO:'
@ PROW(),8 SAY STUFF(PADL(positem,6,"0"),6,0,"")
@ PROW(),23 SAY 'DATA DA COMPRA: '+DTOC(campo1)
@ PROW(),55 SAY 'ANO/MODELO: '+campo3
@ PROW(),90 SAY 'COR: '+campo4
@ PROW()+1,0 SAY 'MODELO: '+campo2
@ PROW(),60 SAY 'PLACA: '+campo5
@ PROW()+01,0 SAY REPL("-",130)
@ PROW()+1,0 SAY "DT.MVTO"
@ PROW(),13 SAY "DOC/NF"
@ PROW(),25 SAY "HISTORICO"
@ PROW(),65 SAY "VALOR - R$"
@ PROW()+1,0 SAY REPL("-",130)
ENDIF
@ PROW()+1,0 SAY DATA_GAS
@ PROW(),13 SAY DOC
@ PROW(),25 SAY SUBSTR(HISTOR,1,35)
@ PROW(),62 SAY VALOR PICT '999,999,999.99'
saldo_gas = saldo_gas + valor
DBSKIP()
ENDDO
@PROW()+1,0 SAY REPL("-",130)
@prow()+1,25 say "TOTAL DE GASTOS/INVESTIMENTOS:"
@prow(),62 say saldo_gas pict '999,999,999.99'
@PROW()+1,0 SAY REPL("-",130)
SETPRC(0,0)
SET FILTER TO
SET DEVICE TO SCREEN
SET PRINTER TO
IF saldo_gas = 0
MSGBOX1("VEICULO NAO POSSUI GASTOS/INVESTIMENTOS!!!")
DBGOTO(posireg)
RETURN
ENDIF
WIN(2,1,22,78,"GASTOS E/OU IVESTIMENTOS NO VEICULO","GR+/RB","RB*/W")
SET COLOR TO "N*/W,B/W+"
MOSTRA("EXTRA1.PRN")
ERASE EXTRA1.PRN
RETURN
*---------------------------
STATIC FUNCTION CTOX
*---------------------------
origem = t_comprou
SELE CLI
DBSEEK(origem)
V_NOME = NOME
V_CPFCNPJ= CPF_CGC
V_RG = RG
V_ENDER = ENDERECO
V_BAIRRO = BAIRRO
V_CIDADE = CIDADE
V_UF = UF
V_FONE = FONE
IF EMPTY(V_RG)
V_RG=SPACE(15)
ENDIF
SELE VEI
// fazendo BACKUP do Contrato Original para o DISCO RIGIDO...
COPY FILE CTOVENBK.DOC TO C:\SIG\CTOVENDA.DOC
KEYBOARD CHR(255)
INKEY()
cARQ2="C:\SIG\CTOVENDA.DOC"
TRY
oWord := GetActiveObject( "Word.Application" )
CATCH
TRY
oWord := CreateObject( "Word.Application" )
CATCH
MsgBOX1("NÆo foi possivel localizar o Word instalado!!!")
RETURN
END
END
*---------------------------------------------------------
* Abrindo documento...
*---------------------------------------------------------
*---------------------------------------------------------
oDoc2 := oWord:Documents:Open(cARQ2) // ABRE DOC...
oText:=oWord:Selection()
oFind:=oText:Find()
* Parte do comprador...
oFind:Text :="&W_COMPRADOR" // imprimindo parte inicial...
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(V_NOME))
oFind:Text :="&W_COMPRADOR" // repetindo parte clausula terceira...
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(V_NOME))
oFind:Text :="&W_COMPRADOR" // repetindo campo assinatura...
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(V_NOME))
oFind:Text :="&W_CPFCNPJ"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(V_CPFCNPJ))
oFind:Text :="&W_RG"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(V_RG))
oFind:Text :="&W_ENDER"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(V_ENDER))
oFind:Text :="&W_BAIRRO"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(V_BAIRRO))
oFind:Text :="&W_CIDADE"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(V_CIDADE))
oFind:Text :="&W_UF"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(V_UF))
oFind:Text :="&W_FONE"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(V_FONE))
* dados do veiculo...
marcax=''
LE_MARCA()
oFind:Text :="&W_MARCA"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(marcax))
oFind:Text :="&W_MODELO"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(MODELO))
oFind:Text :="&W_ANOMOD"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(ANO))
oFind:Text :="&W_COR"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(COR))
oFind:Text :="&W_PLACA"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(PLACA))
oFind:Text :="&W_UFPLACA"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(UF_PLACA))
X_VAL_KM = ALLTRIM(TRANS(KM_VEIC,"@E 999,999"))
oFind:Text :="&W_KMVEIC"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(X_VAL_KM))
oFind:Text :="&W_CHASSI"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(N_CHASSIS))
oFind:Text :="&W_RENAVAM"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(RTRIM(N_DOCUMENT))
X_VALOR_V = ALLTRIM(TRANS(T_VLRVEN,"@E 999,999.99"))
oFind:Text :="&W_VALOR"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(X_VALOR_V)
* pegando valor numerico para gerar extensos...
XTOTEXT := lower (EXTENSO( T_VLRVEN ,.T.,"real","reais" )) // +SPACE(2)
oFind:Text :="&W_EXTENSO"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(XTOTEXT)
* Preenchendo mes, dia e ano...
IF MONTH(DATE()) = 1
xmescto="janeiro"
ELSEIF MONTH(DATE()) = 2
xmescto="fevereiro"
ELSEIF MONTH(DATE()) = 3
xmescto="marco"
ELSEIF MONTH(DATE()) = 4
xmescto="abril"
ELSEIF MONTH(DATE()) = 5
xmescto="maio"
ELSEIF MONTH(DATE()) = 6
xmescto="junho"
ELSEIF MONTH(DATE()) = 7
xmescto="julho"
ELSEIF MONTH(DATE()) = 8
xmescto="agosto"
ELSEIF MONTH(DATE()) = 9
xmescto="setembro"
ELSEIF MONTH(DATE()) = 10
xmescto="outubro"
ELSEIF MONTH(DATE()) = 11
xmescto="novembro"
ELSEIF MONTH(DATE()) = 12
xmescto="dezembro"
ENDIF
oFind:Text :="&W_MES"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext(xmescto)
oFind:Text :="&W_DIA"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext( SUBS( DTOC (DATE() ) ,1,2 ) )
oFind:Text :="&W_ANO"
oFind:Wrap := 1
oFind:Set("MatchWildcards",.t.) // localizar se existir
oFind:Execute() // substituir uma vez
oText:Typetext( SUBS( DTOC (DATE() ) ,7,4 ) )
oWord:visible:= .T. // para visualizar ou nao antes..
oWord:WindowState:=1 // maximizar
SELE VEI
RETURN
*------------------------
static function LE_MARCA
*------------------------
IF fabricante = '1'
marcax= 'VOLKSWAGEM'
ELSEIF fabricante = '2'
marcax= 'CHEVROLET '
ELSEIF fabricante = '3'
marcax= 'FIAT '
ELSEIF fabricante = '4'
marcax= 'FORD '
ELSEIF fabricante = '5'
marcax= 'MOTOS '
ELSEIF fabricante = '6'
marcax= 'OUTROS '
ELSEIF fabricante = '7'
marcax= 'RENAULT '
ELSEIF fabricante = '8'
marcax= 'HONDA '
ELSEIF fabricante = '9'
marcax= 'TOYOTA '
ELSEIF fabricante = 'A'
marcax= 'CITROEN '
ELSEIF fabricante = 'B'
marcax= 'MITSUBISHI'
ELSEIF fabricante = 'C'
marcax= 'CHRYSLER '
ELSEIF fabricante = 'D'
marcax= 'HYUNDAI '
ELSEIF fabricante = 'E'
marcax= 'KIA '
ELSEIF fabricante = 'F'
marcax= 'PEUGEOT '
ELSEIF fabricante = 'G'
marcax= 'NISSAN '
ELSEIF fabricante = 'H'
marcax= 'LAND ROVER'
ELSEIF fabricante = 'I'
marcax= 'JEEP '
ENDIF
******************************
STATIC function Extenso(nBase ,; // valor numérico original
lVMonet ,; // se verdadeiro, trata-se de valor monetário
cStrSingul,; // string da moeda (lVMonet=TRUE) no singular
cStrPlural,; // idem, no plural
nGenero ; // nGenero que define o artigo de tratamento: 1=Masculino e 2=Feminino
)
******************************
local cExtenso := ""
local aDenomin := {""," mil"," m"," b"," tr"}
local nInteiro := Int(nBase)
local nVlrFrac
local cStrFrac
lVMonet := if(lVMonet=nil, .T., lVMonet)
nGenero := if(nGenero=nil, 1, nGenero)
cStrSingul := if(Empty(cStrSingul), "", " "+AllTrim(cStrSingul))
cStrPlural := if(Empty(cStrPlural), if(Empty(cStrSingul),"",cStrSingul+"s"), " "+AllTrim(cStrPlural))
nVlrFrac := Val(Right(Str(nBase,18,if(lVMonet,2,3)),if(lVMonet,2,3)))
if !lVMonet
while nVlrFrac > 0 .and. Right(LTrim(Str(nVlrFrac)),1) = "0"
nVlrFrac := Int(nVlrFrac/10)
end
end
cStrFrac := if(lVMonet, "centavo", if(nVlrFrac<10, "décimo", if(nVlrFrac<100, "centésimo", "milésimo")))
for nPasso := 5 to 1 step -1
nParte := Val(Left(Str(nInteiro,nPasso*3),3))
if nParte > 0
nInteiro -= nParte * Val("1"+Replicate("0",3*(nPasso-1)))
cExtenso += ExtCentena(nParte,nGenero) + aDenomin[nPasso] + if(nPasso < 3, "", "ilh" + if(nParte = 1, "ao", "oes")) + ", "
end
next
nInteiro := Int(nBase)
cExtenso := if(nInteiro = 0, "", Left(cExtenso,Len(cExtenso)-2))
nPasso := RAt(", ",cExtenso)
cExtenso := if(nPasso=0, cExtenso, if(" e " $ SubStr(cExtenso,nPasso), cExtenso, Stuff(cExtenso,nPasso,2," e ")))
cExtenso += if(nInteiro=0, "", if(nInteiro=1, cStrSingul, if(Val(Right(Str(nInteiro,15),6)) = 0, "de", "") + cStrPlural))
cExtenso += if(nVlrFrac=0, "", if(nInteiro=0, "", " e ") + ExtCentena(nVlrFrac,nGenero) + " "+cStrFrac + if(nVlrFrac=1, "", "s"))
return cExtenso
/**************************************************************************************************/
static function ExtCentena(nBase,nGenero)
local cExtenso := ""
priva aUnidade := {{"um","","a"},{"d","ois","uas"},"tres","quatro","cinco","seis","sete","oito","nove"}
priva aDezena1 := {"onze","doze","treze","quatorze","quinze","dezesseis","dezessete","dezoito","dezenove"}
priva aDezena2 := {"dez","vinte","trinta","quarenta","cincoenta","sessenta","setenta","oitenta","noventa"}
priva aCentena := {"cento",{"duzent","os","as"},{"trezent","os","as"},{"quatrocent","os","as"},{"quinhent","os","as"},;
{"seiscent","os","as"},{"setecent","os","as"},{"oitocent","os","as"},{"novecent","os","as"}}
nGenero := if(nGenero=nil, 1, nGenero)
cExtenso += if(nBase < 100, "", if(nBase = 100, "cem", ExtPorGen(nGenero,aCentena[Int(nBase/100)]) + if(nBase%100 > 0, " e ", "")))
nBase %= 100
cExtenso += if(nBase = 10, aDezena2[1], "")
cExtenso += if(nBase > 10 .and. nBase < 20, aDezena1[nBase%10], "")
cExtenso += if(nBase >= 20, aDezena2[Int(nBase/10)] + if(nBase%10 > 0, " e ", ""), "")
cExtenso += if(nBase%10 > 0 .and. (nBase > 20 .or. nBase < 10), ExtPorGen(nGenero,aUnidade[nBase%10]), "")
return cExtenso
/**************************************************************************************************/
static function ExtPorGen(nGenero,xStr)
return if(ValType(xStr) = "A", xStr[1] + xStr[nGenero+1], xStr)
