Ejecutar Rutina fuera de vfp
Muchas gracias por tu apoyo, te comento ese archivo no lo tengo en mi proyecto y te comparto lo que ejecuta mi boton de busqueda para que igual y veas que es lo que estoy haciendo mal, el boton esta dentro de un formulario y desde ahi se ejecuta el la rutina que te comparto mas adelante, mi proyecto inicia con una rutina y de ahi se dedica a abrir y cerrar formularios, todo esto sin tener activa la ventana de fox, la rutina es la siguiente:
IF SET("TALK") = "ON"
SET TALK OFF
m.talkstat = "ON"
ELSE
m.talkstat = "OFF"
ENDIF
m.compstat = SET("COMPATIBLE")
SET COMPATIBLE FOXPLUS
IF NOT WEXIST("PRIMERA")
DEFINE WINDOW PRIMERA;
FROM INT((SROW()-13)/2),INT((SCOL()-28)/2) ;
TO INT((SROW()-13)/2)+12,INT((SCOL()-28)/2)+27 ;
TITLE " Dato a buscar ? " FLOAT NOCLOSE SHADOW ;
NOMINIMIZE DOUBLE COLOR SCHEME 7
ENDIF
IF TYPE("segunda") $ "UL" OR EMPTY(m.segunda)
m.segunda = SPACE(60)
ENDIF
m.oksrch = 1
m.fldnum = 0
DIMENSION fldarry(10,4) && default dimensions. AFIELDS will reset if necessary.
m.fldcnt = AFIELDS(fldarry)
m.startord = ORDER()
m.startalias = ALIAS()
m.curord = ORDER()
IF EMPTY(m.curord)
SET ORDER TO 1
m.curord = ORDER()
ENDIF
FOR i = 1 TO FCOUNT()
IF FIELDS(i) == m.curord
m.fldnum = i
ENDIF
ENDFOR
IF m.fldnum > 0
m.fldname = FIELDS(m.fldnum)
ELSE
SET ORDER TO 1
m.fldnum = 1
m.fldname = FIELDS(1)
ENDIF
skipvar = .T.
curs_stat = (UPPER(SET("CURSOR")) = "ON")
SET CURSOR ON
*activa la busqueda
IF WVISIBLE("PRIMERA")
ACTIVATE WINDOW PRIMERA SAME
ELSE
ACTIVATE WINDOW PRIMERA NOSHOW
ENDIF
@ 4,3 SAY "En:" SIZE 1,3, 0
@ 1,1 GET m.segunda SIZE 1,24 DEFAULT " " PICTURE "@S60" ;
WHEN quinta()
@ 3,7 GET fldnum PICTURE "@^" FROM fldarry ;
SIZE 3,12 DEFAULT 1 VALID sexta() COLOR SCHEME 5, 6
@ 7,8 GET oksrch ;
PICTURE "@*VN \!\<OK;\?\<Cancelar" SIZE 1,10,1 ;
DEFAULT 1 VALID septima()
IF NOT WVISIBLE("PRIMERA")
ACTIVATE WINDOW PRIMERA
ENDIF
READ CYCLE MODAL ;
ACTIVATE tercera() ;
DEACTIVATE cuarta()
RELEASE WINDOW PRIMERA
IF m.talkstat = "ON"
SET TALK ON
ENDIF
IF m.compstat = "ON"
SET COMPATIBLE ON
ENDIF
IF curs_stat
SET CURSOR ON
ELSE
SET CURSOR OFF
ENDIF
skipvar = .F.
FUNCTION gettag
*) Returns tag number corresponding to field "fldname", or 0 if there
*) is not tag with the same name as "fldname."
parameter fldname
PRIVATE ALL
m.fldname = UPPER(ALLTRIM(m.fldname))
i = 1
DO WHILE !EMPTY(TAG(i)) AND i < 1000
IF UPPER(TAG(i)) == m.fldname
RETURN i
ENDIF
i = i + 1
ENDDO
RETURN 0
PROCEDURE waitmsg
IF RECCOUNT() > 1000
WAIT WINDOW "Buscando. Espere un momento..." NOWAIT
ELSE
WAIT WINDOW "Buscando" NOWAIT
ENDIF
PROCEDURE doloc
PARAMETERS term, answer
* See if the user wants to do a long substring search
IF NOT WEXIST("doloc")
DEFINE WINDOW doloc ;
FROM INT((srow()-9)/2),INT((scol()-62)/2) ;
TO INT((srow()-9)/2)+8,INT((scol()-62)/2)+61 ;
FLOAT NOCLOSE SHADOW panel COLOR SCHEME 3
ENDIF
answer = .F.
ACTIVATE WINDOW doloc NOSHOW
@ 5,16 GET locok ;
PICTURE "@*HT \!\<Buscar;\?\<Cancelar" ;
SIZE 1,12,4 ;
DEFAULT 1
@ 1,1 SAY " El dato a buscar no se ha localizado"
@ 2,1 SAY " Pudo ser capturado incorrectamente."
@ 3,1 SAY " ¨Desea realizar una nueva b£squeda ?"
IF NOT WVISIBLE("doloc")
ACTIVATE WINDOW doloc
ENDIF
READ CYCLE MODAL
RELEASE WINDOW doloc
answer = (locok = 1)
FUNCTION quinta && m.segunda WHEN
m.segunda = PADR(m.segunda,60)
SHOW GETS
FUNCTION sexta && fldnum VALID
m.fldname = FIELDS(m.fldnum)
tagnum = gettag(m.fldname) && tag number of tag with name fldname
IF tagnum > 0
SET ORDER TO TAG(m.tagnum)
ELSE
SET ORDER TO 0
ENDIF
SHOW GETS
FUNCTION septima && oksrch VALID
skipvar = .F.
IF m.oksrch = 1 AND !EMPTY(m.segunda)
m.segunda = ALLTRIM(m.segunda)
WAIT CLEAR
m.tagnum = gettag(m.fldname)
IF m.tagnum > 0
SET ORDER TO TAG(m.tagnum)
ELSE
DO waitmsg && warn user that this may take a while
ENDIF
m.thisrec = RECNO()
DO CASE
CASE TYPE("&fldname") $ "CM" && character or memo field
IF m.tagnum > 0
SEEK ALLTRIM(m.segunda)
IF !FOUND()
IF m.thisrec <= RECCOUNT() AND m.thisrec > 0
GOTO m.thisrec
ENDIF
answer = .F.
DO doloc WITH m.segunda, m.answer && prompt for locate
IF m.answer = .T.
DO waitmsg
GOTO TOP
LOCATE FOR UPPER(m.segunda) $ UPPER(&fldname)
ENDIF
ENDIF
ELSE
LOCATE FOR UPPER(m.segunda) $ UPPER(&fldname)
ENDIF
CASE TYPE("&fldname") $ "FN" && floating or numeric
m.segunda = CHRTRAN(m.segunda,'"','')
m.segunda = CHRTRAN(m.segunda,"'","")
LOCATE FOR VAL(ALLTRIM(m.segunda)) = &fldname
CASE TYPE("&fldname") = "D" && date
m.segunda = CHRTRAN(m.segunda,'{}"()','')
m.segunda = CHRTRAN(m.segunda,"'",'')
m.segunda = ALLTRIM(m.segunda)
LOCATE FOR CTOD(segunda) = &fldname
CASE TYPE("&fldname") = "L" && logical
IF "T" $ UPPER(m.segunda)
LOCATE FOR &fldname
ELSE
LOCATE FOR !&fldname
ENDIF
CASE TYPE("&fldname") = "U" && unknown field type--should't happen
WAIT WINDOW "Field "+m.fldname+" not found"
ENDCASE
IF !FOUND()
SET CURSOR OFF
mensaje=MESSAGEBOX("Dato no encontrado","Continuar")
IF m.thisrec <= RECCOUNT() AND m.thisrec > 0
GOTO m.thisrec
ENDIF
ELSE
SET CURSOR OFF
mensaje=MESSAGEBOX("Dato encontrado!","Continuar")
CLEAR READ
ENDIF
ELSE
SET ORDER TO (m.startord)
CLEAR READ
ENDIF
FUNCTION tercera && Read Level Activate
* Activate Code from screen: APPSRCH
SELECT (m.startalias)
FUNCTION cuarta && Read Level Deactivate
* Deactivate Code from screen: APPSRCH
?? CHR(7)
SET TALK OFF
RETURN .F.
