(Vas a tener que analizarlo un poquito, y no envío el recurso, pero te debe servir de algo
Code: Select all | Expand
memvar cOrden,cIndice,cIndkey,lUnique
*********************************************************************************************************************
function consulta(oCampo,cNomCampo,oDlgAnt,Clave)
*********************************************************************************************************************
local oDlg ,;
oLbx ,;
bSelect ,;
bfiltro ,;
cRfiltro ,;
bCancel ,;
bActivos ,;
cAlias :="CONSUL",;
xGetdata ,;
oButOk ,;
oButCancel,;
oGetFiltro,;
cGetFiltro:=space(38),;
nOldArch :=select(),;
cFiltro ,;
cDfiltro ,;
cDispfield ,;
cArch :="CONSUL",;
cTitulo :="Consulta",;
lExiste :=.t.,;
lUArch :=.t.,;
oCbx,;
lCbx,;
oSay ,;
oFKey
PRIVATE cOrden,cIndice,cIndKey,lUnique:=.f.
DEFAULT oDlgAnt:=oWnd
oFKey:=tvkey():NEW // CLASE TVKEY (control de teclas de funcion)
cursorwait()
cNomCampo :=Upper(cNomCampo)
cFiltro :=""
cDfiltro :=""
cDispfield:=""
bSelect :=""
cRfiltro :=""
IF Pcount()<4
Clave:=""
ENDIF
DEFINE DIALOG oDlg ;
FONT oFontGen;
RESOURCE "Consulta" OF oDlgAnt
oDlg:lHelpIcon:=.f.
do case
case cNomcampo="MTITU"
n_use(DDIR+"TITULAR","=",compartido,1,,"CONSUL")
CONSUL->(DBSETORDER("ORD1"))
CONSUL->(DBGOTOP())
cTitulo :="Consulta de Titulares"
cfiltro :=""
cDfiltro :=""
xGetdata :=""
cDispfield:="CONSUL->NOMBRE"
cIndice :=DDIR+'TITULAR'
cOrden :="ORD1"
cIndKey :="_field->CEDLETRA+STR(_FIELD->CEDULA,10)+_FIELD->TIPPER"
bSelect :={ || xGetdata:=CONSUL->CEDLETRA+'-'+STRZERO(CONSUL->CEDULA,10),;
oCampo:varput(xGetdata),;
oCampo:Refresh(),;
oDlg:End }
bCancel :={ || xGetdata:="",;
oDlg:End }
REDEFINE LISTBOX oLbx ;
FIELDS CONSUL->CEDLETRA+'-'+STRZERO(CONSUL->CEDULA,10),CONSUL->NOMBRE;
ALIAS cAlias ;
HEADERS "Cédula","Nombre";
FIELDSIZES 85,150;
ID 401 OF oDlg
OTHERWISE
lExiste:=.f.
endCase
if lExiste
SETKEY(VK_ESCAPE, { || eval(bCancel) })
SETKEY(VK_F4, { || IIF(oButOk:lActive .AND. !EMPTY(cDispfield),eval(bFiltro),) })
oLbx:bLdblClick :={ || eval(bSelect) }
oLbx:bKeyDown :={ | nKey | IIF(nKey==VK_RETURN,EVAL(bSelect),IIF(nKey==VK_ESCAPE,EVAL(bCancel),)) }
oLbx:cMsg:="Doble Click o [Enter] => Selecciona"
bFiltro:={|| oButOk:Disable(),;
oButCancel:Disable(),;
cGetFiltro:=LEE_FILTRO(oDlg,cGetFiltro),;
oGetFiltro:varput(cGetFiltro),;
oGetFiltro:Refresh(),;
oButOk:Enable(),;
oButCancel:Enable(),;
Valfiltro(cGetFiltro,oDlg,cDfiltro,cRfiltro,cDispfield,cAlias,oLbx),oLbx:setfocus(.t.)}
REDEFINE BUTTON oButOk ID 101 OF oDlg;
MESSAGE "Indicar Busqueda";
PROMPT "[F4]-Buscar";
ACTION eval(bFiltro);
WHEN !EMPTY(cDispfield)
REDEFINE BUTTON oButCancel ID 102 OF oDlg;
PROMPT "[Esc]-Salir";
MESSAGE "Cancela la Ayuda";
ACTION (eval(bCancel))
oDlg:cTitle:=ctitulo
REDEFINE GET oGetFiltro VAR cGetFiltro ID 201 OF oDlg;
PICTURE '@!';
MESSAGE "Coloque Valor a Buscar, Pulse Ok, (Escape=>Sale, en Blanco=>TODOS)";
VALID val_val({||oLbx:setfocus(.t.)});
WHEN .F.
cursorarrow()
IF LEN(ALLTRIM(CLAVE))<>0
SEEK(CLAVE)
ENDIF
oLbx:nHeaderHeight := 31 && Da la altura del header
oLbx:Set3DStyle()
ACTIVATE DIALOG oDlg CENTER
select("consul")
close
else
xGetData:=""
msgalert("No Existe Ayuda Para Este Campo","Atención...")
endif
if nOldArch<>0
select(nOldArch)
endif
oFKey:End()
return IIF(xGetdata=NIL,"",xGetdata)
*********************************************************************************************************************
static function Valfiltro(filtro,oDlg,d_filtro,crfiltro,disp_field,cArch,oLbx)
creafil(filtro,d_filtro,crfiltro,disp_field,cArch,oLbx)
oDlg:refresh()
return .t.
*********************************************************************************************************************
procedure creafil(filtro,d_Filtro,cRfiltro,disp_field,cArch,oLbx)
*********************************************************************************************************************
local bEval,bFiltro,breval
IF len(alltrim(filtro))=0
(cArch)->(dbsetfilter())
(cArch)->(dbgotop())
ordlistclear()
ordlistadd(cIndice)
(cArch)->(ordsetFOCUS(cOrden))
IF len(alltrim(d_filtro))=0
(cArch)->(dbsetfilter())
ELSE
(cArch)->(dbsetfilter(d_filtro))
ENDIF
ELSE
IF crfiltro=nil
crfiltro:=""
ENDIF
bEval:={ || &disp_field }
bfiltro:=alltrim(filtro)
(cArch)->(dbsetfilter())
(cArch)->(dbgotop())
ordlistclear()
ordlistadd(cIndice)
(cArch)->(ordsetFOCUS(cOrden))
DELFILE("C:\","TMFILT.CDX")
IF len(alltrim(crfiltro))=0
IF lUnique
INDEX ON &cIndkey to C:\TMFILT.CDX for bFiltro$eval(bEval) UNIQUE
ELSE
INDEX ON &cIndkey to C:\TMFILT.CDX for bFiltro$eval(bEval)
ENDIF
ELSE
breval:={ || &crfiltro }
IF lUnique
INDEX ON &cIndkey to C:\TMFILT.CDX for bFiltro$eval(bEval) .and. eval(breval) UNIQUE
ELSE
INDEX ON &cIndkey to C:\TMFILT.CDX for bFiltro$eval(bEval) .and. eval(breval)
ENDIF
ENDIF
ENDIF
(cArch)->(dbgotop())
oLbx:refresh()
RETURN
*********************************************************************************************************************
STATIC FUNCTION LEE_FILTRO(oDlgAnt,cGetFiltro)
*********************************************************************************************************************
LOCAL oDlg,oGetFiltro
DEFINE DIALOG oDlg ;
FONT oFontGen;
RESOURCE "Consul_filtro" OF oDlgAnt;
oDlg:lHelpIcon:=.f.
REDEFINE GET oGetFiltro VAR cGetFiltro ID 201 OF oDlg;
PICTURE '@!';
MESSAGE "Coloque Valor a Buscar, Pulse Enter, (Esc=>Sale, En Blanco=>TODOS)";
VALID val_val({||oDlg:End()})
oGetFiltro:bKeyDown:={ |nKey| iiF(nKey==VK_RETURN,oDlg:END(),)}
oGetFiltro:bLDblClick:= {|| oDlg:End()}
ACTIVATE DIALOG oDlg
RETURN cGetFiltro
