PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

RTL.LIB

https://pctoledo.org/viewtopic.php?t=6698

Página 1 de 1

RTL.LIB

Enviado: 04 Out 2007 19:17
por Luciano Bonfim
meu sistema está rodando perfeito na xharbour 0.99.6, mas agora foi compilá-lo com a versao 0.99.71 e está dando o seguinte erro durante a geraçäo do executável

Turbo Incremental Link 5.00 Copyright (c) 1997, 2000 Borland
Error: Unresolved external '_HB_PCREPOS_LIBRARY' referenced from C:\XHARBOUR\LIB
\RTL.LIB|regex

alguem sabe oq pode ser?

Muito Obrigado

Re: RTL.LIB

Enviado: 04 Out 2007 19:30
por Itamar M. Lins Jr.
Luciano Bonfim escreveu: Turbo Incremental Link 5.00 Copyright (c) 1997, 2000 Borland
Error: Unresolved external '_HB_PCREPOS_LIBRARY' referenced from C:\XHARBOUR\LIB
\RTL.LIB|regex

alguem sabe oq pode ser?

Muito Obrigado
Apartir da versão .71 a pcrepos.lib precisa ser adicionada.
É so marcar ela com hbmake.

Saudações
Itamar M. Lins Jr.

Enviado: 04 Out 2007 23:13
por Luciano Bonfim
Obrigado Itamar funcionou perfeitamente, o problema é que agora o DBEDIT näo funciona, eu tenho uma funçäo para consulta dos meus DBFs que agora quando chamo ela a tela do DBEDIT abre e fecha sem mostrar nada...

Alguem sabe oq pode ser....

Muito Obrigado

Enviado: 05 Out 2007 07:57
por Itamar M. Lins Jr.
Luciano Bonfim escreveu:Obrigado Itamar funcionou perfeitamente, o problema é que agora o DBEDIT näo funciona, eu tenho uma funçäo para consulta dos meus DBFs que agora quando chamo ela a tela do DBEDIT abre e fecha sem mostrar nada...

Alguem sabe oq pode ser....

Muito Obrigado
Eu uso apenas a classe tbrowse.

Seu xharbour é do CVS?
Porque o Eduardo Fernandes, sempre tem corrigidos erros nessas classes.

Saudações
Itamar M. Lins Jr.

Enviado: 05 Out 2007 11:03
por Luciano Bonfim
Sim, baixei pelo tortoise faz tres dias....

Enviado: 05 Out 2007 15:15
por sygecom
post como vc esta usando o DBEDIT() eu uso pouco ele mas uso ainda !!! com o xharbour 0.99.71

Enviado: 05 Out 2007 15:21
por Luciano Bonfim
dbedit(mlin_sup,mcol_sup,mlin_inf,mcol_inf, campo_db, "DBACTION", mask_db, tit_db)

Enviado: 05 Out 2007 15:30
por sygecom
post a função toda !!!

Enviado: 05 Out 2007 16:05
por Luciano Bonfim
claro...

essa h_cli é chamada quando eu pressiono a tecla F1 dentro do meu sistema


function h_cli
tem_alte=.t.
private campo_db[3],tit_db[3],mask_db[3]
mcol_sup=26
pedaco1()
campo_db[1] = "clientes->cod_cli"
campo_db[2] = "clientes->nome"
campo_db[3] = "clientes->contato"
tit_db[1] = "Codigo"
tit_db[2] = "Nome"
tit_db[3] = "Contato"
mask_db[1] = "99999"
mask_db[2] = "@X"
mask_db[3] = "@X"
select CLIENTES
set order to 2
go top
return(pedaco2())

function pedaco1
tem_hlp=.t.
tela_help = savescreen(mlin_sup-1,mcol_sup-1,mlin_inf+1,mcol_inf+1)
setcolor(cor[9])
Dropbox(mlin_sup-1,mcol_sup-1,mlin_inf+1,mcol_inf+1,1,100,.f.)
tela_h = savescreen(24, 01, 24, 79)
Tela902a()
return(NIL)


function pedaco2
dbedit(mlin_sup,mcol_sup,mlin_inf,mcol_inf, campo_db, "DBACTION", mask_db, tit_db)
restscreen(mlin_sup-1,mcol_sup-1,mlin_inf+1,mcol_inf+1,tela_help)
restscreen( 24, 01, 24, 79, tela_h)
set filter to
if key_stroke == K_ENTER
return(.t.)
else
return(.f.)
endif

function DBACTION
parameters mode,indx
public key_dbaction, key_stroke
key_stroke = lastkey()
retval=0
do case
case mode == 0
if key_stroke == K_HOME
go top
if bof()
skip
endif
elseif key_stroke == K_END
go bottom
if eof()
skip -1
endif
endif
retval = 1
case mode == 1
retval = 1
case mode == 2
retval = 1
case mode == 3
Rot_Mens([Arquivo Vazio], .F., .T.)
set cursor off
retval = 0
case mode == 4
if key_stroke == K_ESC
retval = 0
elseif key_stroke == K_ENTER
retval = 0
elseif key_stroke == K_SPACE
if call_prg == "ORC130"
bloqreg(0)
if mala=chr(251)
replace mala with space(1)
else
replace mala with chr(251)
endif
unlock
retval = 1
keyboard(chr(K_DOWN))
else
retval=2
endif
elseif (key_stroke == 43 .or. key_stroke == 45) .and. call_prg == "ORC130"
if key_stroke == 45
aviso('Desmarcando Todos os Registros ...')
else
aviso('Marcando Todos os Registros ...')
endif
retval = 2
if key_stroke == 45
mcara=space(1)
else
mcara=chr(251)
endif
go top
do while !eof()
if mala # mcara
bloqreg(0)
replace mala with mcara
unlock
endif
skip
enddo
go top
restscreen(ml1_avs,mc1_avs,ml2_avs,mc2_avs,tela_avs)
elseif key_stroke == K_F1
buffer = SAVESCREEN(0, 0, 24, 79)
if dbf()="AF"
mchama=upper(alltrim(readvar()))
if mchama="ESTR[2]"
keyboard estr[1]
endif
endif
dbeditsrch(mlin_sup,mcol_sup,mlin_inf,mcol_inf,mlin_sup-1,mcol_sup+1)
RESTSCREEN(0, 0, 24, 79, buffer)
retval = 1
elseif key_stroke == K_F6 .and. (call_prg # "ORC130" .or. tem_f6)
if !tem_pesq
return(1)
endif
mqual_filt=1
mdbf=DBF()
mind_old=indexord()
buffer = SAVESCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf)
if mdbf='DOCUMENT'
@ mlin_sup-1,mcol_sup+01 prompt "Por Titulo"
@ mlin_sup-1,mcol_sup+14 prompt "Por Codigo"
@ mlin_sup-1,mcol_sup+27 prompt "Por Contra Parte"
menu to mqual_filt
if mqual_filt=0
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
endif
if mdbf='AF'
@ mlin_sup-1,mcol_sup+01 prompt "Por Descricao"
@ mlin_sup-1,mcol_sup+16 prompt "Por Pedido"
@ mlin_sup-1,mcol_sup+28 prompt "Por Insumo"
menu to mqual_filt
if mqual_filt=0
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
endif
SAVE GETS
do case
case mqual_filt=1
mplv1=space(25)
mplv2=space(25)
mcone='O'
midio='P'
hcolor = SETCOLOR(cor[5])
@ mlin_sup-1,mcol_sup+01 SAY '['+SPACE(25)+']'
@ mlin_sup-1,mcol_sup+34 SAY '['+SPACE(25)+']'
@ mlin_sup-1,mcol_sup+65 SAY '['+SPACE(01)+']'
if mdbf='INSUMOS' .or. mdbf='CPU' .or. mdbf='CQP' .or. mdbf='CDM'
@ mlin_sup-1,mcol_sup+69 SAY '['+SPACE(01)+']'
endif
@ mlin_sup-1,mcol_sup+02 get mplv1 pict '@!' valid no_blank(mplv1)
@ mlin_sup-1,mcol_sup+35 get mplv2 pict '@!'
@ mlin_sup-1,mcol_sup+66 get mcone pict '@!' when !empty(mplv2) valid mcone$'EO'
if mdbf='INSUMOS' .or. mdbf='CPU' .or. mdbf='CQP' .or. mdbf='CDM'
@ mlin_sup-1,mcol_sup+70 get midio pict '!' valid midio$'PO'
endif
SETCOLOR(hcolor)
ex_read()
set key K_TAB to udf_tab
if lastkey()=K_ESC
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
private v_fil:={}
mplv1=rtrim(mplv1)
mtam1=len(mplv1)
mplv2=rtrim(mplv2)
mtam2=len(mplv2)
mmenor=min(mtam1,mtam2)
aviso('Filtrando Registros...')
xreg_ant=recno()
go top
do while !eof()
ok=.f.
do case
case mdbf='AF'
mtudo=alltrim(obs1+obs2)
case mdbf='FAMILIAS'
mtudo=alltrim(desc)
case mdbf='DOCUMENT'
mtudo=alltrim(titulo+titulo2+titulo3)
otherwise
if mdbf='INSUMOS' .or. mdbf='CPU' .or. mdbf='CQP' .or. mdbf='CDM'
if midio='P'
mtudo=alltrim(desc1+desc2)
else
mtudo=alltrim(desc1i+desc2i)
endif
else
mtudo=alltrim(desc1+desc2)
endif
endcase
mtama=len(mtudo)
if mcone='O'
for x = 1 to mtama-mmenor+1
if substr(mtudo,x,mtam1)=mplv1 .or. iif(!empty(mplv2),substr(mtudo,x,mtam2)=mplv2,.f.)
ok=.t.
exit
endif
next
else
mentra=.f.
for x = 1 to mtama-mtam1+1
if substr(mtudo,x,mtam1)=mplv1
mentra=.t.
exit
endif
next
if mentra .and. !empty(mplv2)
for x = 1 to mtama-mtam2+1
if substr(mtudo,x,mtam2)=mplv2
ok=.t.
exit
endif
next
endif
endif
if ok
if tem_f6
if mala=space(1)
bloqreg(0)
replace mala with chr(251)
unlock
endif
else
do case
case mdbf='AF'
select FORNECED
set order to 1
seek AF->cod_for
select AF
aadd(v_fil,{cod_obra,cod_af,num_ped,FORNECED->nome,obs1,obs2})
case mdbf='CPU'
if midio='P'
aadd(v_fil,{cod_cpu,desc1,desc2,imp_preco(2)})
else
aadd(v_fil,{cod_cpu,desc1i,desc2i,imp_preco(2)})
endif
case mdbf='INSUMOS'
if midio='P'
aadd(v_fil,{cod_ins,desc1,desc2})
else
aadd(v_fil,{cod_ins,desc1i,desc2i})
endif
case mdbf='FAMILIAS'
aadd(v_fil,{cod_fam,desc})
case mdbf='DOCUMENT'
aadd(v_fil,{cod_doc,nr_rev,titulo,titulo2,titulo3,cod_end,cod_end3,cod_end2})
case mdbf='CQP'
if midio='P'
aadd(v_fil,{cqp,desc1,desc2})
else
aadd(v_fil,{cqp,desc1i,desc2i})
endif
case mdbf='CDM'
if midio='P'
aadd(v_fil,{cdm,desc1,desc2})
else
aadd(v_fil,{cdm,desc1i,desc2i})
endif
endcase
endif
endif
skip
enddo
case mqual_filt=2
if mdbf='AF'
mtamanho=12
hfil_ope1 = '='
hfil_cod1 = space(mtamanho)
hcolor = SETCOLOR(cor[5])
@ mlin_sup-1,mcol_sup+01 SAY '['+SPACE(15)+']'
@ mlin_sup-1,mcol_sup+02 get hfil_ope1 pict '!' valid critletra(hfil_ope1,'=#',['=' - Igual ou '#' - Diferente])
@ mlin_sup-1,mcol_sup+04 get hfil_cod1 pict "@!"
SETCOLOR(hcolor)
ex_read()
if lastkey()=K_ESC
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
private v_fil:={},v_fil1:={}
hfil_cod1=hfil_cod1
for x=1 to mtamanho
xpedaco=substr(hfil_cod1,x,1)
if !empty(xpedaco)
aadd(v_fil1,{x,xpedaco})
endif
next
aviso('Filtrando Registros...')
xreg_ant=recno()
go top
do while !eof()
if pode_filtro(substr(num_ped,1,mtamanho),hfil_ope1,hfil_cod1,v_fil1)
select FORNECED
set order to 1
seek AF->cod_for
select AF
aadd(v_fil,{cod_obra,cod_af,num_ped,FORNECED->nome,obs1,obs2})
endif
skip
enddo
else
mtamanho=tira_sepa(memvar->mask_doc)
hfil_ope1 = '='
hfil_cod1 = space(mtamanho)
hfil_rev1 = space(3)
hcolor = SETCOLOR(cor[5])
@ mlin_sup-1,mcol_sup+01 SAY '['+SPACE(30)+']'
@ mlin_sup-1,mcol_sup+02 get hfil_ope1 pict '!' valid critletra(hfil_ope1,'=#',['=' - Igual ou '#' - Diferente])
@ mlin_sup-1,mcol_sup+04 get hfil_cod1 pict memvar->mask_doc
@ mlin_sup-1,mcol_sup+20 get hfil_rev1 pict '@!'
SETCOLOR(hcolor)
ex_read()
set key K_TAB to udf_tab
if lastkey()=K_ESC
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
private v_fil:={},v_fil1:={}
hfil_cod1=hfil_cod1+hfil_rev1
for x=1 to mtamanho+3
xpedaco=substr(hfil_cod1,x,1)
if !empty(xpedaco)
aadd(v_fil1,{x,xpedaco})
endif
next
aviso('Filtrando Registros...')
xreg_ant=recno()
go top
do while !eof()
if pode_filtro(substr(cod_doc,1,mtamanho)+nr_rev,hfil_ope1,hfil_cod1,v_fil1)
aadd(v_fil,{cod_doc,nr_rev,titulo,titulo2,titulo3,cod_end,cod_end3,cod_end2})
endif
skip
enddo
endif
case mqual_filt=3
if mdbf='AF'
mtamanho=7
hfil_ope1 = '='
hfil_cod1 = space(mtamanho)
hcolor = SETCOLOR(cor[5])
@ mlin_sup-1,mcol_sup+01 SAY '['+SPACE(11)+']'
@ mlin_sup-1,mcol_sup+02 get hfil_ope1 pict '!' valid critletra(hfil_ope1,'=#',['=' - Igual ou '#' - Diferente])
@ mlin_sup-1,mcol_sup+04 get hfil_cod1 pict "@!"
SETCOLOR(hcolor)
ex_read()
if lastkey()=K_ESC
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
private v_fil:={},v_fil1:={}
hfil_cod1=hfil_cod1
for x=1 to mtamanho
xpedaco=substr(hfil_cod1,x,1)
if !empty(xpedaco)
aadd(v_fil1,{x,xpedaco})
endif
next
aviso('Filtrando Registros...')
xreg_ant=recno()

select INS_AF
go top
do while !eof()
if pode_filtro(substr(cod_ins,1,mtamanho),hfil_ope1,hfil_cod1,v_fil1)
if ascan(v_fil, {|elem| elem[1]+elem[2] = INS_AF->cod_obra+INS_AF->cod_af}) = 0
select AF
set order to 1
seek INS_AF->cod_obra+INS_AF->cod_af

select FORNECED
set order to 1
seek AF->cod_for

select AF
aadd(v_fil,{cod_obra,cod_af,num_ped,FORNECED->nome,obs1,obs2})
endif
endif

select INS_AF
skip
enddo

select AF
else
mtamanho=25
hfil_ope1 = '='
hfil_cod1 = space(mtamanho)
hcolor = SETCOLOR(cor[5])
@ mlin_sup-1,mcol_sup+01 SAY '['+SPACE(30)+']'
@ mlin_sup-1,mcol_sup+02 get hfil_ope1 pict '!' valid critletra(hfil_ope1,'=#',['=' - Igual ou '#' - Diferente])
@ mlin_sup-1,mcol_sup+04 get hfil_cod1 pict '@!'
SETCOLOR(hcolor)
ex_read()
set key K_TAB to udf_tab
if lastkey()=K_ESC
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
private v_fil:={},v_fil1:={}
for x=1 to mtamanho
xpedaco=substr(hfil_cod1,x,1)
if !empty(xpedaco)
aadd(v_fil1,{x,xpedaco})
endif
next
aviso('Filtrando Registros...')
xreg_ant=recno()
go top
do while !eof()
if pode_filtro(substr(doc_origem,1,mtamanho),hfil_ope1,hfil_cod1,v_fil1)
aadd(v_fil,{cod_doc,nr_rev,titulo,titulo2,titulo3,cod_end,cod_end3,cod_end2})
endif
skip
enddo
endif
endcase
restscreen(ml1_avs,mc1_avs,ml2_avs,mc2_avs,tela_avs)
if len(v_fil)>0
do case
case mdbf='AF'
private xhead[6],xwidt[6],xmypi[6],eyerow
xhead[1]='Obra'
xwidt[1]=12
xmypi[1]=mask_obr
xhead[2]='Cod_PC'
xwidt[2]=12
xmypi[2]=mask_pc
xhead[3]='Pedido'
xwidt[3]=12
xmypi[3]='@!'
xhead[4]='Fornecedor'
xwidt[4]=27
xmypi[4]='@!'
xhead[5]='Descricao Resumida - 1'
xwidt[5]=60
xmypi[5]='@X'
xhead[6]='Descricao Resumida - 2'
xwidt[6]=60
xmypi[6]='@X'
case mdbf='CPU'
private xhead[4],xwidt[4],xmypi[4],eyerow
xhead[1]='CPU'
xwidt[1]=12
xmypi[1]=memvar->masc_cpu
xhead[2]='Descricao'
xwidt[2]=60
xmypi[2]='@X'
xhead[3]='Descricao - Continuacao'
xwidt[3]=60
xmypi[3]='@X'
xhead[4]="Preco de "+transf(EMPRESA->mes_ano,'@R 99/9999')
xwidt[4]=16
xmypi[4]="@R 999,999,999.9999"
case mdbf='INSUMOS'
private xhead[3],xwidt[3],xmypi[3],eyerow
xhead[1]='Insumo'
xwidt[1]=7
xmypi[1]=memvar->masc_ins
xhead[2]='Descricao'
xwidt[2]=60
xmypi[2]='@X'
xhead[3]='Descricao - Continuacao'
xwidt[3]=60
xmypi[3]='@X'
case mdbf='FAMILIAS'
private xhead[2],xwidt[2],xmypi[2],eyerow
xhead[1]='Familia'
xwidt[1]=8
xmypi[1]=mask_fami
xhead[2]='Descricao'
xwidt[2]=50
xmypi[2]='@X'
case mdbf='DOCUMENT'
private xhead[8],xwidt[8],xmypi[8],eyerow
xhead[1]='Codigo'
xwidt[1]=15
xmypi[1]=memvar->mask_doc
xhead[2]='Rev'
xwidt[2]=03
xmypi[2]='@!'
xhead[3]='Titulo'
xwidt[3]=50
xmypi[3]='@!'
xhead[4]='Titulo - Continuacao'
xwidt[4]=50
xmypi[4]='@X'
xhead[5]='Titulo - Continuacao'
xwidt[5]=50
xmypi[5]='@X'
xhead[6]='Original'
xwidt[6]=len(mask_ende)-3
xmypi[6]=mask_ende
xhead[7]='Copial'
xwidt[7]=len(mask_ende)-3
xmypi[7]=mask_ende
xhead[8]='Digital'
xwidt[8]=len(mask_ende)-3
xmypi[8]=mask_ende
case mdbf='CQP'
private xhead[3],xwidt[3],xmypi[3],eyerow
xhead[1]='CQP'
xwidt[1]=12
xmypi[1]='@!'
xhead[2]='Descricao'
xwidt[2]=60
xmypi[2]='@X'
xhead[3]='Descricao - Continuacao'
xwidt[3]=60
xmypi[3]='@X'
case mdbf='CDM'
private xhead[3],xwidt[3],xmypi[3],eyerow
xhead[1]='CDM'
xwidt[1]=12
xmypi[1]='@!'
xhead[2]='Descricao'
xwidt[2]=60
xmypi[2]='@X'
xhead[3]='Descricao - Continuacao'
xwidt[3]=60
xmypi[3]='@X'
endcase
mexc=abrowse(.t.,.f.,.t.,.f.,.f.,"",1,v_fil,mlin_sup,mcol_sup,22,78,xhead,xwidt,xmypi,{|t,l,c| gt_help(t,l,c)},,,.t.,,,{K_F6})
if mexc=K_ESC
go xreg_ant
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
else
set order to 1
seek v_fil[eyerow,1]
set order to mind_old
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
else
if !tem_f6
avi_rep('Nao Foi Encontrado Nenhum Registro')
set cursor off
endif
go xreg_ant
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(iif(tem_f6,2,1))
endif
elseif key_stroke == K_F11 .and. call_prg # "ORC130"
if !tem_expl
return(1)
endif
SAVE GETS
buffer = SAVESCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf)
hcolor = SETCOLOR(cor[5])
@ mlin_sup-1,mcol_sup+01 SAY '['+SPACE(72)+']'
@ mlin_sup-1,mcol_sup+02 SAY 'Fonte CPU:'
@ mlin_sup-1,mcol_sup+24 SAY 'Fonte Preco:'
@ mlin_sup-1,mcol_sup+48 SAY 'Expl:'
@ mlin_sup-1,mcol_sup+58 SAY 'Mes/Ano:'
SETCOLOR(hcolor)
mcod_fc = '00'
mcod_fp = '00'
mexplode = 'N'
mmes_ano = EMPRESA->mes_ano
c1_help(mcod_fc,mlin_sup-1,mcol_sup+15)
c1_help(mcod_fp,mlin_sup-1,mcol_sup+39)
@ mlin_sup-1,mcol_sup+12 get mcod_fc pict "99" valid c1_help(mcod_fc,mlin_sup-1,mcol_sup+15)
@ mlin_sup-1,mcol_sup+36 get mcod_fp pict "99" valid c1_help(mcod_fp,mlin_sup-1,mcol_sup+39)
@ mlin_sup-1,mcol_sup+54 get mexplode pict '@!' valid mexplode$'SN'
@ mlin_sup-1,mcol_sup+67 get mmes_ano pict '@R 99/9999' valid (!empty(mmes_ano) .and. len(alltrim(left(mmes_ano,2)))=2 .and. len(alltrim(right(mmes_ano,4)))=4)
ex_read()
set key K_TAB to udf_tab
if lastkey()=K_ESC
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
Private mcalc:={},v_fil:={}
mcod_cpu=CPU->cod_cpu
mano_mes=substr(mmes_ano,3)+substr(mmes_ano,1,2)
mtot_cpu=0
mzero=.t.
xreg_ant=recno()
if mcod_fc#"00"
if zerada(mcod_cpu,mcod_fc)
avi_rep('Composicao Invalida')
set cursor off
select CPU
go xreg_ant
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
endif
mmoeda='1'
mcom_bdi='N'
mpreco=Calc_cpu(mcod_cpu,mexplode,1,mcod_fc,mcod_fp,mano_mes,mcod_cpu,mcalc,'S','','')
if len(mcalc)=0
avi_rep('Composicao Sem Insumos, Verificar Arquivos')
set cursor off
select CPU
go xreg_ant
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
select INSUMOS
set order to 1
for i = 1 to len(mcalc)
seek mcalc[i,2]
private v_aux[8]
v_aux[1]=mcalc[i,2]
v_aux[2]=INSUMOS->desc1
v_aux[3]=INSUMOS->desc2
v_aux[4]=INSUMOS->unidade
v_aux[5]=mcalc[i,3]
v_aux[6]=mcalc[i,4]
v_aux[7]=mcalc[i,5]
v_aux[8]=mcalc[i,6]
mtot_cpu+=v_aux[8]
aadd(v_fil,v_aux)
next
buffer2= SAVESCREEN(mlin_inf+1,02,mlin_inf+1,75)
hcolor = SETCOLOR(cor[5])
@ mlin_inf+1,02 SAY '[Valor Fechado: '
select PREC_CPU
seek mcod_cpu+mano_mes+mcod_fp
@ mlin_inf+1,18 SAY pre_fon pict '@R 999,999,999.9999'
@ mlin_inf+1,34 SAY ']'
@ mlin_inf+1,41 SAY '[Valor Calculado: '
@ mlin_inf+1,59 SAY mtot_cpu pict '@R 999,999,999.9999'
@ mlin_inf+1,75 SAY ']'
SETCOLOR(hcolor)

select CPU
private xhead[8],xwidt[8],xmypi[8]
xhead[1]='Insumos'
xwidt[1]=7
xmypi[1]=memvar->masc_ins
xhead[2]='Descricao'
xwidt[2]=60
xmypi[2]='@X'
xhead[3]='Descricao - Continuacao'
xwidt[3]=60
xmypi[3]='@X'
xhead[4]='Unid'
xwidt[4]=4
xmypi[4]='@!'
xhead[5]=space(15)+'Qtd.'
xwidt[5]=19
xmypi[5]='@R 999,999,999.9999999'
xhead[6]=space(11)+'Preco'
xwidt[6]=16
xmypi[6]='@R 999,999,999.9999'
xhead[7]='St'
xwidt[7]=2
xmypi[7]='@!'
xhead[8]=space(11)+'Total'
xwidt[8]=16
xmypi[8]='@R 999,999,999.9999'
mexc=abrowse(.t.,.f.,.t.,.f.,.f.,"",1,v_fil,mlin_sup,mcol_sup+1,21,75,xhead,xwidt,xmypi,{|| .f.})
go xreg_ant
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
RESTSCREEN(mlin_inf+1,02,mlin_inf+1,75,buffer2)
return(1)
elseif key_stroke == K_F7 .and. call_prg # "ORC130"
if DBF()#'CPU'
return(1)
endif
xreg_ant=recno()
buffer = SAVESCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf)
Private v_fil:={}
select INSUMOS
set order to 2
seek CPU->cod_cpu
do while !eof() .and. cod_reut=CPU->cod_cpu
aadd(v_fil,{INSUMOS->cod_ins,INSUMOS->desc1,INSUMOS->desc2,INSUMOS->unidade})
skip
enddo
select CPU
if len(v_fil)#0
private xhead[4],xwidt[4],xmypi[4]
xhead[1]='Insumos'
xwidt[1]=7
xmypi[1]=memvar->masc_ins
xhead[2]='Descricao'
xwidt[2]=60
xmypi[2]='@X'
xhead[3]='Descricao - Continuacao'
xwidt[3]=60
xmypi[3]='@X'
xhead[4]='Unid'
xwidt[4]=4
xmypi[4]='@!'
mexc=abrowse(.t.,.f.,.t.,.f.,.f.,"",1,v_fil,mlin_sup,mcol_sup+1,21,75,xhead,xwidt,xmypi,{|| .f.})
go xreg_ant
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
else
avi_rep('Composicao nao pertence a nenhum reutilizavel')
set cursor off
endif
return(1)
elseif key_stroke == K_F9 .and. call_prg # "ORC130"
mdbf=DBF()
if mdbf#'CPU' .and. mdbf#'INSUMOS'
return(1)
endif
xreg_ant=recno()
buffer = SAVESCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf)
Private v_fil:={}
if mdbf='CPU'
xcod_cpu=cod_cpu
else
xcod_cpu=cod_ins
endif

select OBRAS
set order to 1

select ORCAMENT
set order to 2
seek xcod_cpu
if !eof()
xcod_obra=' '
xversao =' '
do while !eof() .and. cod_cpu=xcod_cpu
if cod_obra+versao#xcod_obra+xversao .and. iif(mdbf='CPU',ORCAMENT->qual#"I",ORCAMENT->qual="I")
private v_aux[3]
v_aux[1]=cod_obra
v_aux[2]=versao
xcod_obra=v_aux[1]
xversao=v_aux[2]

select OBRAS
seek v_aux[1]+v_aux[2]
v_aux[3]=nome

select ORCAMENT
aadd(v_fil,v_aux)
endif
skip
enddo
endif
if mdbf='CPU'
select CPU
else
select INSUMOS
endif

if len(v_fil)#0
private xhead[3],xwidt[3],xmypi[3]
xhead[1]='Obra'
xwidt[1] =7
xmypi[1]=mask_obr
xhead[2]='V'
xwidt[2] =1
xmypi[2]='!'
xhead[3]='Nome'
xwidt[3] =40
xmypi[3]='@X'
mexc=abrowse(.t.,.f.,.t.,.f.,.f.,"",1,v_fil,mlin_sup,mcol_sup+16,21,75,xhead,xwidt,xmypi,{|| .f.})
go xreg_ant
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
else
avi_rep('Nenhuma Obra Selecionada')
set cursor off
endif
return(1)
elseif key_stroke == K_F12 &&.and. call_prg # "ORC130"
if !tem_alte
return(1)
endif
mdbf=DBF()
do case
case mdbf='CPU' .or. mdbf='FAMILIAS'
if indexord()=1
set order to 2
else
set order to 1
endif
case mdbf='INSUMOS'
if indexord()=1
set order to 4
else
set order to 1
endif
case mdbf='AF'
if indexord()=1
set order to 5
else
set order to 1
endif
otherwise
if indexord()=1
set order to 2
else
set order to 1
endif
endcase
return(2)
elseif (key_stroke == KP_CTRL_PLUS .or. key_stroke == KP_CTRL_MINUS) .and. tem_mrc .and. call_prg = "ORC130"
SAVE GETS
buffer = SAVESCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf)
hcolor = SETCOLOR(cor[5])
if !tem_mrc2
mdbf=DBF()
xreg_ant=recno()
if key_stroke == KP_CTRL_PLUS
@ mlin_sup-1,mcol_sup+02 SAY "Marca CPU's : "
else
@ mlin_sup-1,mcol_sup+02 SAY "Desmarca CPU's: "
endif
SETCOLOR(hcolor)
xfil_ope = '='
xfil_cpu = space(len(strtran(strtran(iif(mdbf='CPU',memvar->masc_cpu,mmasc_fon),'.',''),'-',''))-3)
@ mlin_sup-1,mcol_sup+18 get xfil_ope pict '!' valid critletra(xfil_ope,'=#',['=' - Igual ou '#' - Diferente])
@ mlin_sup-1,mcol_sup+20 get xfil_cpu pict memvar->masc_cpu
ex_read()
set key K_TAB to udf_tab
if lastkey()=K_ESC .or. empty(xfil_cpu)
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
if key_stroke == KP_CTRL_PLUS
aviso("Marcando CPU's Especificas ...")
mmala=chr(251)
else
aviso("Desmarcando CPU's Especificas ...")
mmala=space(1)
endif
v_fil:={}
for x=1 to len(space(len(strtran(strtran(iif(mdbf='CPU',memvar->masc_cpu,mmasc_fon),'.',''),'-',''))-3))
xped_cpu=substr(xfil_cpu,x,1)
if !empty(xped_cpu)
aadd(v_fil,{x,xped_cpu})
endif
next
go top
do while !eof()
mpode=iif(xfil_ope='=',.t.,.f.)
xcod_cpu=iif(mdbf='CPU',cod_cpu,codigo)
for x=1 to len(v_fil)
if substr(xcod_cpu,v_fil[x,1],1)#v_fil[x,2]
mpode=iif(xfil_ope='=',.f.,.t.)
exit
endif
next
if mpode
bloqreg(0)
replace mala with mmala
unlock
endif
skip
enddo
else
if key_stroke == KP_CTRL_PLUS
@ mlin_sup-1,mcol_sup+02 SAY "Marca Obras : "
else
@ mlin_sup-1,mcol_sup+02 SAY "Desmarca Obras: "
endif
SETCOLOR(hcolor)
xfil_ope = '='
xfil_cpu = space(7)
@ mlin_sup-1,mcol_sup+18 get xfil_ope pict '!' valid critletra(xfil_ope,'=#',['=' - Igual ou '#' - Diferente])
@ mlin_sup-1,mcol_sup+20 get xfil_cpu pict mask_obr2
ex_read()
set key K_TAB to udf_tab
if lastkey()=K_ESC .or. empty(xfil_cpu)
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
return(1)
endif
if key_stroke == KP_CTRL_PLUS
aviso("Marcando Obras Especificas ...")
mmala=chr(251)
else
aviso("Desmarcando Obras Especificas ...")
mmala=space(1)
endif
v_fil:={}
for x=1 to 7
xped_cpu=substr(xfil_cpu,x,1)
if !empty(xped_cpu)
aadd(v_fil,{x,xped_cpu})
endif
next

select OBRAS
xreg_ant=recno()
go top
do while !eof()
mpode=iif(xfil_ope='=',.t.,.f.)
xcod_cpu=cod_obra+versao
for x=1 to len(v_fil)
if substr(xcod_cpu,v_fil[x,1],1)#v_fil[x,2]
mpode=iif(xfil_ope='=',.f.,.t.)
exit
endif
next
if mpode
bloqreg(0)
replace mala with mmala
unlock
endif
skip
enddo
endif
go xreg_ant
RESTSCREEN(mlin_sup-1,mcol_sup,mlin_sup-1,mcol_inf,buffer)
restscreen(ml1_avs,mc1_avs,ml2_avs,mc2_avs,tela_avs)
return(2)
else
retval = 1
endif
endcase
return(retval)

Enviado: 05 Out 2007 16:28
por sygecom
Tente colocar um INKEY(0) antes de key_stroke = lastkey() olhe abaixo como estou usando:

Código: Selecionar todos

dbedit(n1,n2,n3,n4,FIELDS,"AUX_SERV",pics,heads,chr(194)+chr(196),chr(179),chr(193)+CHR(196))

***********************
FUNC AUX_SERV(modo,pos)
***********************
LOCAL aQUADRO:= savenv( 01, 00, 23, 79 )
local valret:=1
setcursor(0)
restscreen(row(),n2,row(),n4,transf(savescreen(row(),n2,row(),n4),repli('X'+chr(63),2*n4)))
Inkey(0)

SETCURSOR( 1 )

keyboard chr(lastkey())
if lastkey()==27 .OR. lastkey()==70 .OR. lastkey()==102
    valret := 0
ELSEIF lastkey()==13
   IF vTIPOPESQ="S"
       valret := 0
   ENDIF
ELSEif LASTKEY()=67 .OR. LASTKEY()=99     // letra c/C
   CLEAR TYPEAHEAD
   IF vTIPOPESQ="S"
      valret := 0
      return(valret)
   ENDIF
   SELE TIPSERV
   SET ORDER TO 1
   GOTO BOTT
   vCOD=CODSERV+1

   TRAVAREG()
   AppRede()
   REPL CODSERV WITH vCOD
   SETCOLOR( "N/W,N*/RG,N/W* , , N*/W" )
   @ ROW(),24 GET SERVICO when DwnMsg( "Informe o Nome do Servico")
   READ
   LIBERAREG()

   SETCOLOR( "N*/W,W+/BG" )
   IF LASTKEY()==27
      IF EMPTY(SERVICO)
         TRAVAREG()
         DELE
         DBCOMMIT()
         LIBERAREG()
      ENDIF
   ENDIF

   SELE TIPSERV
   SET ORDER TO 1
   GOTO TOP
ELSEif LASTKEY()=65 .OR. LASTKEY()=97     // letra a/A
   CLEAR TYPEAHEAD
   IF vTIPOPESQ="S"
      valret := 0
      return(valret)
   ENDIF
   TRAVAREG()
   SETCOLOR( "N/W,N*/RG,N/W* , , N*/W" )
   @ ROW(),24 GET SERVICO when DwnMsg( "Informe o Nome do Servico")
   READ
   SETCOLOR( "N*/W,W+/BG" )
   DBCOMMIT()
   LIBERAREG()
   GOTO TOP
ELSEif LASTKEY()=7                         // TECLA DEL / DELETAR
   IF MsgYesNo("Deseja Realmente Excluir ?","Aviso do Sistema")
      TRAVAREG()
      DELE
      DBCOMMIT()
      LIBERAREG()
      GOTO TOP
   ENDIF
Elseif lastkey()==19
   keyboard chr(26)
elseif lastkey()==4
   keyboard chr(2)
elseif lastkey()==-1
ENDIF
return(valret)

Enviado: 05 Out 2007 17:10
por Luciano Bonfim
Caro Leonardo,

näo é iso näo... o problema é que a funçäo que é chamada pelo DBEDIT o parâmetro "mode" está vindo com valores diferentes do clipper e da versäo anterior 0.99.6 do xharbour...

onde eu consigo a relaçäo desses valores do dbedit desa versäo para ver oq cada um significa

Muito Obrigado

Enviado: 05 Out 2007 17:13
por sygecom
No Help do xharbour tem, baixe ele no site do xharbour comercial...

Enviado: 06 Out 2007 12:55
por Luciano Bonfim
Resolvi o problema, é isso mesmo no clipper e na versäo 0.99.6 do xharbour nunca era passado -1 para a funçäo do usuário, nem mesmo no dbedit.ch existia esse -1 veja as o conteúdos dos arquivos:

* $Id: dbedit.ch,v 1.1.1.1 2001/12/21 10:47:13 ronpinkas Exp $
#ifndef _DBEDIT_CH
#define _DBEDIT_CH

/* User function entry modes */
#define DE_IDLE 0 /* Idle */
#define DE_HITTOP 1 /* Attempt to cursor past top of file */
#define DE_HITBOTTOM 2 /* Attempt to cursor past bottom of file */
#define DE_EMPTY 3 /* No records in work area */
#define DE_EXCEPT 4 /* Key exception */

/* User function return codes */
#define DE_ABORT 0 /* Abort DBEDIT() */
#define DE_CONT 1 /* Continue DBEDIT() */
#define DE_REFRESH 2 /* Force reread/redisplay of all data rows */

#endif /* _DBEDIT_CH */



* $Id: dbedit.ch,v 1.2 2006/04/04 23:08:28 modalsist Exp $

#ifndef _DBEDIT_CH
#define _DBEDIT_CH


/* Status return code */
#define DE_INIT -1 /* Initialization. (xHarbour extension) */#define DE_IDLE 0 /* Idle */
#define DE_HITTOP 1 /* Attempt to cursor past top of file */
#define DE_HITBOTTOM 2 /* Attempt to cursor past bottom of file */
#define DE_EMPTY 3 /* No records in work area */
#define DE_EXCEPT 4 /* Key exception */

/* User function return codes */
#define DE_ABORT 0 /* Abort DBEDIT() */
#define DE_CONT 1 /* Continue DBEDIT() */
#define DE_REFRESH 2 /* Force reread/redisplay of all data rows */

#endif /* _DBEDIT_CH */

Como a minha funçäo näo estava testando o -1 ela retornava sempre 0 por isso näo aparecia nada... passei a tratar 0 -1 e resolveu

Muito Obrigado
Todos os horários são UTC-03:00
Página 1 de 1

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB